[LON-CAPA-cvs] cvs: modules /raeburn layering.pl loncapa_import.pl shadowzone.pl singlespread.pl spreading.pl

raeburn lon-capa-cvs@mail.lon-capa.org
Wed, 10 Sep 2003 15:31:57 -0000


This is a MIME encoded message

--raeburn1063207917
Content-Type: text/plain

raeburn		Wed Sep 10 11:31:57 2003 EDT

  Added files:                 
    /modules/raeburn	layering.pl loncapa_import.pl shadowzone.pl 
                    	singlespread.pl spreading.pl 
  Log:
  Sync
  
--raeburn1063207917
Content-Type: text/plain
Content-Disposition: attachment; filename="raeburn-20030910113157.txt"


Index: modules/raeburn/layering.pl
+++ modules/raeburn/layering.pl
#!/usr/bin/perl
use GD;

use lib 'GD-1.41/blib/arch','GD-1.41/blib/lib';

# Setting random seed
srand (time() ^ ($$ + ($$  << 15)) );

# Global parameters
my $pi = 3.1415927;
my $framewidth = 200;
my $frameheight = 200;
my $leftindent = 60;
my $rightindent = 60;
my $topindent = 60;
my $botindent = 60;
my $rowspace = 40;
my $colspace = 40;
my $fullradius = 550;

my $total = 1;
  
for (my $j=0; $j<$total; $j++)
{
  open(FILE,">xsection_$j.png");
# create a new image
  $im = new GD::Image(800,600);
    
# allocate some colors
  my $white = $im->colorAllocate(255,255,255);
  my $black = $im->colorAllocate(0,0,0);
  my $yellow = $im->colorAllocate(255,255,0);
  my $orange = $im->colorAllocate(255,153,0);
  my $red = $im->colorAllocate(255,0,0);
  my $blue = $im->colorAllocate(0,102,255);
  my @colors = ($black,$white);

# make the background transparent and interlaced
  $im->transparent($white);
  $im->interlaced('true');
# Put a black frame around the picture
  $im->rectangle(0,0,799,599,$black);

  my $imgcount = 0;
  my %imgid = ();
  my @letts = ("(a)","(b)","(c)","(d)","(e)","(f)");
  for (my $row=0; $row<2; $row++)
  {
    for (my $col=0; $col<3; $col++)
    { 
# Draw bounding box.
      my $ytop = $topindent+($colspace+$frameheight)*$row;
      my $ybot = $ytop + $frameheight;
      my $xleft = $leftindent+($rowspace+$framewidth)*$col;
      my $xright = $xleft + $framewidth;
      $im->rectangle($xleft-1,$ytop-1,$xright+1,$ybot+1,$black);
      $im->string(gdMediumBoldFont,$xleft-15,$ytop-15,$letts[$imgcount],$blue);
      $imgcount ++;

# Create the earth cross section
# Parameters are radii of inner core, outer core, mantle

      my $cy = $ytop + int ($frameheight/2);
      my $cx = $xleft + int ($framewidth/2);
      my $icore = 278;
      my $ocore = 3478;
      my $mantle = 6328;
      my $whole = 6378;
      my $fullr = $framewidth/2-10;
      my $conversion = $fullr/6378;

      my $sign1 = rand;
      if ($sign1 > 0.5)
      {
        $sign1 = -1;
      }
      else
      {
        $sign1 = 1;
      }
      my $sign2 = rand;

      if ($sign2 > 0.5)
      {
        $sign2 = 1;
      }
      else
      {
        $sign2 = -1;
      }

      my $sign3 = rand;

      if ($sign3 > 0.5)
      {
        $sign3 = 1;
      }
      else
      {
        $sign3 = -1;
      }

      
      
      my $ic = int( ($conversion * $icore) * (-1)*$sign1 * rand(0.2)  );
#      my $oc = int( ($conversion * $ocore) * (-1)*$sign2 * rand(0.2)  );

#      while ($ic >= $oc)
#      {
#        $oc = int( ($conversion * $ocore) * (-1)*$sign2 * rand(0.2)  );
#      }

#      my $mt = int( ($conversion * $mantle) * (-1) * rand(0.2)  );

      $mt = int( ($conversion * $mantle) );
      $oc = int( ($conversion * $ocore)  );
      $ic = int( ($conversion * $icore)  );

      $im->arc($cx,$cy,$fullr*2,$fullr*2,0,360,$blue);
      $im->fillToBorder($cx,$cy,$blue,$blue);
      $im->arc($cx,$cy,$mt*2,$mt*2,0,360,$orange);
      $im->fillToBorder($cx,$cy,$orange,$orange); 
      $im->arc($cx,$cy,$oc*2,$oc*2,0,360,$yellow);
      $im->fillToBorder($cx,$cy,$yellow,$yellow);
      $im->arc($cx,$cy,$ic*2,$ic*2,0,360,$red);
      $im->fillToBorder($cx,$cy,$red,$red);

# make sure we are writing to a binary stream
      binmode STDOUT;
    }
  }
# Convert the image to JPEG and print it on standard output
  print FILE $im->png;
  close(FILE);
}
  

Index: modules/raeburn/loncapa_import.pl
+++ modules/raeburn/loncapa_import.pl
#!/usr/bin/perl 

BEGIN {
  use lib qw /lib ..\/..\/lib/;
 
  use strict;
  use vars qw($dbh);
  use CILib;
  use MSULib;
  use Crypt::BPE;
  use HTML::Entities;
  use CGI::Enurl;
 
  $dbh =  &CILib::DB_CONNECT();
  if ( !defined $dbh ) { die "Cannot connect to database server: $DBI::errstr\n";
}
  use vars qw ($nolock);
  $nolock = CILib::nolock_str;
 
  use HTTP::Request::Common;
  use LWP::UserAgent;
  use CGI qw/:standard/;
  use vars qw($MACHINE $MASTERDIR);
  $MACHINE = "localhost";
  $MASTERDIR = "/home/courseinfo/admindata/pool_management";
  $CGI::POST_MAX=1024 * 10000;  # max 10 Mb posts 
}
# Use unbuffered output
 $| = 1;

  display_control();
  my $rc = $dbh->disconnect();
  exit();

 sub display_control() {
  my $q = new CGI;
  my $classid = 0;
  $classid = $q->param("course_id");
  my $contact_name="Blackboard Administrator";
  my $contact_email="blkboard\@msu.edu";

  my $user_id; if (($user_id = &CILib::get_user_id_nohdr($dbh,$q)) eq "") { exit(); }
  my $group = &MSULib::GET_GROUP($dbh,$user_id,$classid);
  print $q->header(-expires=>'-1d');
  my ($course_name) = $dbh->selectrow_array("SELECT course_name FROM course_main $nolock WHERE course_id='$classid'");
 
  if (!($group =~ m/^[ptz]$/) || !$classid)  {
   print qq(<html><head><title>CourseInfo Error -- Access Denied</title>
           </head><body bgcolor='#ffffff'><img alt='Access Denied' src='/common/images/ci20_system_401.gif'</body></html>);
   exit();
  }
  else {

# this defines the contents of the fill out forms on each page

   my @PAGES = ('Welcome','Blocks','Format','Target','Confirmation');
 
# figure out what page we're on and where we're heading.
   my $page = $q->param('page');
   my $command = $q->param('go');
   my $current_page = calculate_page($page,$command);
   my $page_name = $PAGES[$current_page];

#   print "$page,$command,$current_page,$page_name\n";
   my $user =$q->remote_user();
   my $keyword;
   my $passwd;
   if($ENV{MOD_PERL}) {
    my $ciphkey = "iago";
    my $cipher =  new BPE;
    $keyword = Apache->request->notes->{_KEYWD};
    $passwd = $cipher->decode($keyword,$ciphkey);
   }
   else {
    $keyword = '';
   }
   open(LOG,">/home/ciuser/testingpool.txt");
 
   display_zero($q,$classid,$current_page,$course_name) if $page_name eq 'Welcome' ;

   display_one($q,$classid,$current_page,$course_name) if $page_name eq 'Blocks';

   display_two($q,$classid,$current_page,$course_name) if $page_name eq 'Format';
 
   display_three($q,$classid,$user,$passwd,$current_page,$course_name) if $page_name eq 'Target';
 
   final_display($q,$classid,$user,$passwd,$current_page,$course_name) if $page_name eq 'Confirmation';

   close(LOG);
  }
}

# CALCULATE THE CURRENT PAGE
sub calculate_page($$) {
    my ($prev,$dir) = @_;
    return 0 if $prev eq '';    # start with first page
    return $prev + 1 if $dir eq 'NextPage';
    return $prev - 1 if $dir eq 'PreviousPage';
    return $prev     if $dir eq 'ExitPage';
    return 0 if $dir eq 'BackToStart';
}
  
sub display_zero ($$$$) {
  my ($req,$classid,$page,$course_name) = @_;
  my $filename = $req->param('filename');
  print <<"END_OF_HEADER";
<html>
<head>
<title>Pool Questions Upload Page One</title>
<script language=javascript type = "text/javascript">
<!--
function nextPage() {
 if (document.forms.first.filename.value == "") {
  alert('You must select a data file to upload')
 }
 else {
  document.forms.first.go.value = "NextPage"
  document.forms.first.submit()
 } 
}
function setElements() {
 document.forms.first.filename.value = "$filename"
}
// End hiding -->
</script>
</head>
<body bgcolor="#FFFFFF" onLoad="setElements()">
<img src = "/images/msuassmnthdr.gif" width="628" height="109" align="center" usemap="#usermanage" border="0">
<map name="usermanage"><area shape="rect" coords="155,69,301,96" href="../msu.pl?course_id=$classid"target="_self"><area shape="rect" coords="353,70,499,93" href="../../../courses/$classid" target="_self"></map>
<form method="post" name="first" enctype="multipart/form-data">
<table border='0' cellspacing='0' cellpadding='3' width='628'>
 <tr>
  <td width='10'><img src='/common/images/trans_25.gif' width='10' height='5'></td>
  <td width='2' bgcolor='#006699'>&nbsp; &nbsp;</td>
  <td>
   <table border='0' bgcolor='#EEF6F6' cellspacing='0' cellpadding ='0' width='100%'>
    <tr>
     <td bgcolor='#339999' width='350'>
      <img src='/images/up_questions.gif' width='350' height='24'>
     </td>
     <td bgcolor='#339999' width='100%' align='right'><font face='arial,helvetica' size='3' color='#FFFFFF'>$course_name&nbsp;</font>
     </td>
    </tr>
    <tr>
     <td colspan='2'>&nbsp;</td>
    </tr>
    <tr>
     <td colspan='2'>
      <table border='0' cellspacing='0' cellpadding='0' width='100%'>
       <tr>
        <td>&nbsp;</td>
        <td colspan='2'><font size='2' face='arial,helvetica'> 
The <b>Pool Questions Upload</b> utility can be used by Instructors and TAs to import <i>multiple choice</i>, <i>multiple answer correct</i>, <i>fill-in-the-blank</i>, <i>true/false</i> and <i>essay</i> questions from a plain text file into a Blackboard Question Pool.  Five requirements must be met to ensure that you will succeed in building a Blackboard pool using your file of questions.
        <ol>
         <li>The questions and answers you plan to upload must be in plain text format.  Any header lines should occur before the text containing the questions and answers.</li>
         <li>All questions must occur before any of the answers.  Each question should begin on a new line, and should start with the question number. Questions should be numbered sequentially using a number followed immediately by a space, a period, or enclosed in parentheses, i.e., 1 , 1., (1), 1), or (1 .</li>
         <li>One or more correct answers should be provided for all questions (although blank answers may be provided for <i>essay</i> questions).  Answers should be numbered sequentially, using the same scheme as used for the questions, and must occur after all the questions.        
         <li><i>Multiple choice</i> and <i>multiple answer correct</i> questions should consist of (i) the question number followed by (ii) a question stem beginning on the same line and (iii) two or more foils, with each foil beginning on a new line and prefixed by a unique letter, or Roman numeral, listed in alphabetic or numeric order, beginning at a (alphabetic) or i (Roman numeral), followed by a period, or enclosed in parentheses, i.e., a., (a), i., or (i) .</li>
         <li>If <i>fill-in-the-blank</i> or <i>multiple answer</i> questions have more than one correct answer, each answer should appear in a comma-, tab-, space-, or new line-delimited list. </li> 
        </ol>      
Five steps are involved in the import process.
        <ol>
         <li>Upload your text file to the server.</li>
         <li>Provide information about the question format - i.e.,  question numbering style, and the number of blocks of questions of the same question type.</li>
         <li>Provide information about the questions in each block, including question type, start and end question numbers for each block, and foil labelling style and answer format where required.</li>
         <li>Choose an existing pool or create a new pool to receive the imported data.</li>
         <li>Complete the import of questions to the selected pool.</li>
        </ol>
        </font>
        </td>
       </tr>
       <tr>
        <td colspan ='3'>&nbsp;</td>
       </tr>
       <tr bgcolor='#b5c5d1'>
        <td width='21' colspan='2'>
         <img src='/images/bl_step1.gif' width='21' height='24' valign='bottom'>
        </td>
        <td  align='left'>&nbsp;&nbsp;
         <font size='3' face='arial,helvetica'><b>Choose the text file to upload</b></font>
        </td>
       </tr>
       <tr>
        <td colspan='3'>&nbsp;</td>
       </tr>
       <tr>
        <td>&nbsp;</td>
        <td colspan='2'>
          <font face='Arial, Helvetica' size='2'>Please use the "Browse" button to choose the name of the questions pool file you wish to upload to Blackboard. This file should be a plain text (or ascii) file. If you have questions stored in a Word file, please save a copy of the Word file as a plain text file first, before using this Upload utility.</font>  
        </td>
       </tr>
       <tr>
        <td colspan='3'>&nbsp;</td>
       </tr>
       <tr>
        <td>&nbsp;</td>
        <td colspan='2'>
         &nbsp;<input type="file" name="filename" size ="30">
        </td>
       </tr>
       <tr>
        <td>&nbsp;</td>
        <td colspan='2' align='right'>
         <a href='javascript:nextPage()'><img border='0' src="/images/nextpage.gif"></a>
        </td>
       </tr>
       <tr>
        <td>&nbsp;</td>
        <td colspan='2'>&nbsp;
         <input type="hidden" name="course_id" value="$classid">
         <input type="hidden" name="go" value=''>
         <input type="hidden" name="page" value="$page">
         <input type="hidden" name="timestamp" value="">
        </td>
       </tr>
      </table>
     </td>
    </tr>
   </table>
  </td>
 </tr>
</table>
</form>
</body>
</html>
END_OF_HEADER
}

sub display_one ($$$$) {
 my ($req,$classid,$page,$course_name) = @_;
 my $filename = $req->param("filename");
 my $timestamp = $req->param("timestamp");
 my @text = ();
 if (!$timestamp) {
   $timestamp = time;
   @text = file_upload($classid,$filename,$timestamp);
 }
 else {
   if (-e "$MASTERDIR/uploads/$classid/$timestamp") {
     open(FILE,"<$MASTERDIR/uploads/$classid/$timestamp") || exit("can't open $MASTERDIR/uploads/$classid/$timestamp for reading");
     @text = <FILE>;
     close(FILE);
   }
 }
 print <<"END_OF_FUNC";
<HTML>
<HEAD>
<TITLE>Pool Questions Upload Page Two</TITLE>
<script language=javascript type = "text/javascript">
<!--
function verify() {
 if ((document.forms.display.blocks.value == "") || (!document.forms.display.blocks.value) || (document.forms.display.blocks.value == "0")) {
   alert("You must enter the number of blocks of questions of a given question type.  This number must be 1 or more.")
   return false
 }
 if (document.forms.display.qnumformat.options[document.forms.display.qnumformat.selectedIndex].value == "-1") {
   alert("You must select the format used for the question number, e.g., (1), 1., (1, or 1).")
   return false
 }
 return true
}
function nextPage() {
 if (verify()) {
  document.forms.display.go.value="NextPage"
  document.forms.display.submit()
 }
}
function backPage() {
  document.forms.display.go.value="PreviousPage"
  document.forms.display.submit()
}
function setElements() {
 var iter = 0
 var selParam = 0
END_OF_FUNC
    foreach my $name ($req->param()) {
       my $value = $req->param("$name");
       if ($value ne "") {
        if ($name eq "blocks") {
          print qq|
  document.forms.display.$name.value = $value\n|;
        }
        elsif ($name eq "qnumformat") {
          print <<"TO_HERE";
 for (iter=0; iter<document.forms.display.$name.length; iter++) {
   if(document.forms.display.$name.options[iter].value == "$value") {
     selParam = iter
   }
 }
 document.forms.display.$name.selectedIndex = selParam
TO_HERE
        }
       }
    }
  print qq|
}
// End hiding -->
</script>
</HEAD>
<BODY bgcolor="#FFFFFF" onLoad= "setElements()">
<img src = "/images/msuassmnthdr.gif" width="628" height="109"
align="center" usemap="#usermanage" border="0">
<map name="usermanage"><area shape="rect"
coords="155,69,301,96" href="../msu.pl?course_id=$classid"
target="_self"><area shape="rect" coords="353,70,499,93"
href="../../../courses/$classid" target="_self"></map>
<form method='post' name='display'>
<table border='0' cellspacing='0' cellpadding='3' width='628'>
 <tr>
  <td width='10'><img src='/common/images/trans_25.gif' width='10' height='5'></td>
  <td width='2' bgcolor='#006699'>&nbsp; &nbsp;</td>
  <td>
   <table border='0' bgcolor='#EEF6F6' cellspacing='0' cellpadding ='0'>
    <tr>
     <td bgcolor='#339999'><img src='/images/up_questions.gif'></td><td bgcolor='#339999' align='right'><font face='arial,helvetica' size='3' color='#FFFFFF'>$course_name&nbsp;</font>
     </td>
    </tr>
    <tr>
     <td colspan='2'>&nbsp;</td>
    </tr>
    <tr>
     <td colspan='2'>
      <table border="0" cellspacing="0" cellpadding="0">
       <tr>
        <td>&nbsp;</td>
        <td><font face='arial,helvetica' size='2'>
You need to provide some information about the format of the questions you uploaded, so that the
 data in your plain text file can be stored in appropriate Blackboard database tables.</font>
        </td>
       </tr>
       <tr>
        <td colpsan='2'>&nbsp;</td>
       </tr>
       <tr>
        <td>&nbsp;</td>
        <td>
<font face='arial,helvetica' size='2'>The following data were uploaded to the server</font><br>
<textarea name="rawdata" cols="70" rows="6" wrap="virtual" align="center">
|;
foreach my $line (@text) {
 $line =~ s/\n//g;
 print "$line\n";
}
print qq|
</textarea>
      </td>
     </tr>
     <tr>
      <td colspan='2'>&nbsp;</td>
     </tr>
     <tr bgcolor='#b5c5d1'>
      <td width='21'>
       <img src='/images/bl_step2.gif' width='21' height='24' valign='bottom'>
      </td>
      <td width='100%' align='left'>&nbsp;&nbsp;
       <font size='3' face='arial,helvetica'><b>Format information for questions and answers</b>
</font>
      </td>
     </tr>
     <tr>
      <td colspan='2'>&nbsp;</td>
     </tr>
     <tr>
      <td>&nbsp;</td>
      <td>
       <font face='arial,helvetica' size='2'>
Please specify the format of the question number [e.g., 1,  1., 1), (1 or (1)].
</font><br><br>
      </td>
     </tr>
     <tr>
      <td>&nbsp;</td>
      <td>
       <table border="0" cellspacing="0" cellpadding="0" bgcolor="#000000" align="left">
        <tr>
         <td>
          <table border="1" valign="top" align="center">
           <tr bgcolor="#eef6f6" align="left">
            <td>
             <table border='0' cellspacing='1' cellpadding='1' align='left'>
              <tr bgcolor="#B5C5D1" align='center'>
               <td align="left">
                <font face='arial,helvetica' size='2'>
                 <b>Number format used at start of each question (and answer)</b>&nbsp;&nbsp;
                </font>
                <font face='arial,helvetica' size='2'>
                 <select name="qnumformat">
                  <option value = "-1" selected>Please Select
                  <option value="number">1
                  <option value="period">1.
                  <option value="paren">(1)
                  <option value="leadparen">(1
                  <option value="trailparen">1)
                 </select>
                </font>
               </td>
              </tr>
             </table>
            </td>
           </tr>
          </table>
         </td>
        </tr>
       </table>
      </td>
     </tr>
     <tr>
      <td colspan='2'>&nbsp;</td>
     </tr>
     <tr>
      <td>&nbsp;</td>
      <td><font face='arial,helvetica' size='2'>
A number in the specified format should appear at the start of each question (and each answer). Within the uploaded text file, each question (and answer) should begin on a new line. The answers should be numbered in the same way as the questions and should appear after <b>all</b> the questions. Each numbered question must have a corresponding numbered answer, although the answer itself may be blank for essay questions.</td>
     </tr>
    <tr>
     <td colspan="2">&nbsp;</td>
    </tr>
    <tr>
     <td colspan="2">&nbsp;</td>
    </tr>
    <tr>
      <td>&nbsp;</td>
      <td>
       <font face='arial,helvetica' size='2'>
Please indicate the number of blocks of different question types in the text file.</font>
     </td>
    </tr>
    <tr>
     <td colspan="2">&nbsp;</td>
    </tr>
    <tr>
     <td>&nbsp;</td>
     <td>
       <table border="0" cellspacing="0" cellpadding="0" bgcolor="#000000" align="left">
        <tr>
         <td>
          <table border="1" valign="top" align="center">
           <tr bgcolor="#eef6f6" align="left">
            <td>
             <table border='0' cellspacing='0' cellpadding='1' align='left'>
              <tr bgcolor="#B5C5D1" align='center'>
               <td align="left">
                <font face='arial,helvetica' size='2'>
                 <b>Number of blocks of different question types:</b></font>&nbsp;&nbsp;<input type="text" name="blocks" value="" size="5">
               </td>
              </tr>
             </table>
            </td>
           </tr>
          </table>
         </td>
        </tr>
       </table>
      </td>
     </tr>
     <tr>
      <td colspan="2">&nbsp;</td>
     </tr>
     <tr>
      <td>&nbsp;</td>
      <td>
       <font face='arial,helvetica' size='2'>
        For example, you would enter <b>6</b> if your text file contained the following sequence of questions:<br><br>
 10 multiple choice questions<br>
  5 essay questions<br>
  5 fill-in-the-blank questions<br>
  5 multiple answer questions<br>
  4 multiple choice questions<br>
  3 essay questions<br>
      </font>
      </td>
     </tr>
     <tr>
      <td colspan='2'>&nbsp;</td>
     </tr>
     <tr>
       <td>&nbsp;</td>
       <td><font face='arial,helvetica' size='2'>You will indicate the question type and the question number range for each of the blocks on the next page.</font></td>
     </tr>
     <tr>
      <td colspan='2'>&nbsp;</td>
     </tr>
     <tr>
      <td colspan='2'>
      <input type="hidden" name="timestamp" value="$timestamp">
       <table border='0' width="100%" cellspacing='0' cellpadding='2'>
        <tr>
         <td align='left'>
      <a href='javascript:backPage()'><img border='0' src="/images/previouspage.gif"></a>
     </td>
     <td align='right'>
      <a href='javascript:nextPage()'><img border='0' src="/images/nextpage.gif"></a>
     </td>
    </tr>
   </table>
   <input type="hidden" name="filename" value="$filename">
   <input type="hidden" name="page" value ="$page">
   <input type="hidden" name="course_id" value="$classid">
   <input type="hidden" name="go" value="">
  </form>
 </td>
</tr>
</table>
</td>
</tr>
</table>
</td>
</tr>
</table>
</BODY>
</HTML>
|;
}

sub display_two ($$$$) {
 my ($req,$classid,$page,$course_name) = @_;
 my $timestamp = $req->param("timestamp");
 my $blocks = $req->param("blocks");
 my $qnumformat = $req->param("qnumformat");
 my @text = ();
 my @types = ("MC","MA","TF","Ess","FIB");
 my %typenames = (
             MC => "Multiple Choice",
             TF => "True/False",
             MA => "Multiple Answer",
             Ess => "Essay",
             FIB => "Fill-in-the-blank",
             );
 my %qnumtypes = (
             number => "1",
             period => "1.",
             paren => "(1)",
             leadparen => "(1",
             trailparen => "1)",
             );
 my @bgcolors = ('#bfbfbf','#dfdfdf');
 if (-e "$MASTERDIR/uploads/$classid/$timestamp") {
   open(FILE,"<$MASTERDIR/uploads/$classid/$timestamp") || exit("can't open $MASTERDIR/uploads/$classid/$timestamp for reading");
   @text = <FILE>;
   close(FILE);
 }
 my $qcount = question_count($qnumformat,\@text);
 print <<"END_OF_FUNC"; 
<HTML>
<HEAD>
<TITLE>Pool Questions Upload Page Three</TITLE>
<script language=javascript type = "text/javascript">
<!--
function verify() {
  var poolForm = document.forms.display
  var curmax = 0
  var curmin = 0
  for (var i=0; i<$blocks; i++) {
    var iter = i+1
    if (poolForm.elements[5*i+3].options[poolForm.elements[5*i+3].selectedIndex].value == "MC") {
      if (poolForm.elements[5*i+4].selectedIndex == 0) {
        alert ("You must choose the foil labelling format in Multiple Choice questions")
        return false
      }
    }
    if (poolForm.elements[5*i+3].options[poolForm.elements[5*i+3].selectedIndex].value == "MA") {
      if (poolForm.elements[5*i+4].selectedIndex == 0) {
        alert ("You must choose the foil labelling format in Multiple Answer questions")
        return false
      }
      if (poolForm.elements[5*i+5].selectedIndex == 0) {
        alert ("You must choose the answer format in Multiple Answer questions") 
        return false
      }
    }
    if (poolForm.elements[5*i+3].options[poolForm.elements[5*i+3].selectedIndex].value == "FIB") {
      if (poolForm.elements[5*i+5].selectedIndex == 0) {
        alert ("You must choose the answer format in Fill-in-the-blank questions") 
        return false
      }
    }
    if (poolForm.elements[5*i+3].options[poolForm.elements[5*i+3].selectedIndex].value == "TF") {
      if (poolForm.elements[5*i+5].selectedIndex == 0) {
        alert ("You must choose the answer format in True/False questions") 
        return false
      }
    }
    if (poolForm.elements[5*i+3].options[poolForm.elements[5*i+3].selectedIndex].value == "-1") {
      alert ("You must choose the question type for block "+iter)
      return false
    }
    if ((poolForm.elements[5*i+1].value == "") || !(poolForm.elements[5*i+1].value)) {
      alert ("You must choose the start number for block "+iter)
      return false
    }
    if ((poolForm.elements[5*i+2].value == "") || !(poolForm.elements[5*i+2].value)) {
      alert ("You must choose the end number for block "+iter)
      return false
    }
    if (poolForm.elements[5*i+2].value - poolForm.elements[5*i+1].value < 0) {
      alert ("In block: "+iter+" the end number must be the same or greater than the start number")
      return false
    }
    if (i == 0) {
      curmin = parseInt(poolForm.elements[5*i+1].value)
      curmax = parseInt(poolForm.elements[5*i+2].value)
    }
    else {
      if (parseInt(poolForm.elements[5*i+1].value) < curmin) {
        if (parseInt(poolForm.elements[5*i+2].value) >= curmin ) {
          alert("The question number range for block "+iter+" overlaps with the question number range for one of the previous blocks - this is not permitted.")
          return false
        }
      }
      else {
        if (parseInt(poolForm.elements[5*i+1].value) <= curmax) {
          for (var j=parseInt(poolForm.elements[5*i+1].value); j<=parseInt(poolForm.elements[5*i+2].value); j++) {
            for (var k=0; k<i; k++) {
              if ((j >= parseInt(poolForm.elements[5*k+1].value)) && (j <= parseInt(poolForm.elements[5*k+2].value))) {
                var overlap = k+1
                alert("The question number range for block "+iter+" overlaps with the question number range for block "+overlap+" - this is not permitted.")
                return false
              }
            }
          }
        }
      }
      if (parseInt(poolForm.elements[5*i+1].value) < curmin) {
        curmin = parseInt(poolForm.elements[5*i+1].value)
      }
      if (parseInt(poolForm.elements[5*i+2].value) > curmax) {
        curmax = parseInt(poolForm.elements[5*i+2].value)
      }
    }
  }
  if (curmax >$qcount+curmin) {
    alert("The last # for one or more of the blocks is too large -  the last number of the last block can not be greater than $qcount: the total number of questions in the uploaded file.")
    return false
  }
  var endpt = $qcount + curmin
  for (var n=curmin; n<endpt; n++) {
    var warnFlag = true
    for (var m=0; m<$blocks; m++) {
      if ((n >= parseInt(poolForm.elements[5*m+1].value)) && (n <= parseInt(poolForm.elements[5*m+2].value))) {
        warnFlag = false
      }
    }
    if (warnFlag) {
      alert("The question type for question "+n+" could not be identified because it does not fall within the number ranges you have provided for any of the $blocks block(s)")
      return false
    }
  } 
  return true 
}
 
function nextPage() {
  if (verify()) {
    document.forms.display.go.value="NextPage"
    document.forms.display.submit()
  }
}
function backPage() {
  document.forms.display.go.value="PreviousPage"
  document.forms.display.submit()
}
function colSet(caller) {
 var poolForm = document.forms.display
 var curVal = poolForm.elements[caller*5+3].options[poolForm.elements[caller*5+3].selectedIndex].value  
 poolForm.elements[caller*5+4].length = 0
 if (poolForm.elements[caller*5+3].options[poolForm.elements[caller*5+3].selectedIndex].value == "-1") {
   poolForm.elements[caller*5+4].options[0] = new Option("<--- Set type ","-1",true,true)
 }
 else {
   if ((poolForm.elements[caller*5+3].options[poolForm.elements[caller*5+3].selectedIndex].value == "MC") || (poolForm.elements[caller*5+3].options[poolForm.elements[caller*5+3].selectedIndex].value == "MA")) {
     poolForm.elements[caller*5+4].options[0] = new Option("Please Select","-1",true,true)
     poolForm.elements[caller*5+4].options[1] = new Option("a.","lcperiod",false,false)
     poolForm.elements[caller*5+4].options[2] = new Option("A.","ucperiod",false,false)
     poolForm.elements[caller*5+4].options[3] = new Option("(a)","lcparen",false,false)
     poolForm.elements[caller*5+4].options[4] = new Option("(A)","ucparen",false,false)
     poolForm.elements[caller*5+4].options[5] = new Option("(i)","romparen",false,false)
     poolForm.elements[caller*5+4].options[6] = new Option("i.","romperiod",false,false)
     poolForm.elements[caller*5+4].selectedIndex = 0
   }
   else {
     poolForm.elements[caller*5+4].options[0] = new Option("Not required","0",true,true)
   }
 }
 poolForm.elements[caller*5+5].length = 0
 if (poolForm.elements[caller*5+3].options[poolForm.elements[caller*5+3].selectedIndex].value == "-1") {
   poolForm.elements[caller*5+5].options[0] = new Option("<--- Set type ","-1",true,true)
 }
 else {
   if ((poolForm.elements[caller*5+3].options[poolForm.elements[caller*5+3].selectedIndex].value == "MA") || (poolForm.elements[caller*5+3].options[poolForm.elements[caller*5+3].selectedIndex].value == "FIB")) {
     poolForm.elements[caller*5+5].options[0] = new Option("Please Select","-1",true,true)
     poolForm.elements[caller*5+5].options[1] = new Option("single answer","single",false,false)
     poolForm.elements[caller*5+5].options[2] = new Option("comma","comma",false,false)
     poolForm.elements[caller*5+5].options[3] = new Option("space","space",false,false)
     poolForm.elements[caller*5+5].options[4] = new Option("new line","line",false,false)
     poolForm.elements[caller*5+5].options[5] = new Option("tab","tab",false,false)
   }
   else { 
     if (poolForm.elements[caller*5+3].options[poolForm.elements[caller*5+3].selectedIndex].value == "TF") {
       poolForm.elements[caller*5+5].options[0] = new Option("Please Select","-1",true,true)
       poolForm.elements[caller*5+5].options[1] = new Option("True or False","word",false,false)
       poolForm.elements[caller*5+5].options[2] = new Option("T or F","lett",false,false)
     }
     else {
       poolForm.elements[caller*5+5].options[0] = new Option("Not required","0",true,true)
     }
   }
 }
}

function setElements() {
 var iter = 0
 var selParam = 0
END_OF_FUNC
  my @names = ("start_","end_","qtype_","foilformat_","ansr_");
  for (my $x=0; $x<$blocks; $x++) {
    foreach my $name (@names) {
      $parname = $name.$x;
      my $value = $req->param("$parname");
      if ($value ne "") {
        if (($name eq "start_")  || ($name eq "end_")) {
          print qq|
  document.forms.display.$parname.value = $value\n|;
        }
        elsif ($name eq "qtype_") {
          print qq|
 for (iter=0; iter<document.forms.display.$parname.length; iter++) {
   if(document.forms.display.$parname.options[iter].value == "$value") {
     selParam = iter
   }
 }
 document.forms.display.$parname.selectedIndex = selParam
 colSet($x)
          |;
        }
        elsif (($name eq "foilformat_") || ($name eq "ansr_")) {
          print <<"TO_HERE";
 for (iter=0; iter<document.forms.display.$parname.length; iter++) {
   if(document.forms.display.$parname.options[iter].value == "$value") {
     selParam = iter
   }
 }
 document.forms.display.$parname.selectedIndex = selParam
TO_HERE
        }
      }
    }
  }
  print qq|
} 
// End hiding -->
</script>
</HEAD>
<BODY bgcolor="#FFFFFF" onLoad= "setElements()">
<img src = "/images/msuassmnthdr.gif" width="628" height="109" align="center" usemap="#usermanage" border="0">
<map name="usermanage"><area shape="rect" coords="155,69,301,96" href="../msu.pl?course_id=$classid" target="_self"><area shape="rect" coords="353,70,499,93" href="../../../courses/$classid" target="_self"></map>
<form method='post' name='display'>
<table border='0' cellspacing='0' cellpadding='3' width='628'>
 <tr>
  <td width='10'><img src='/common/images/trans_25.gif' width='10' height='5'></td>
  <td width='2' bgcolor='#006699'>&nbsp; &nbsp;</td>
  <td>
   <table border='0' bgcolor='#EEF6F6' cellspacing='0' cellpadding ='0'>
    <tr>
     <td bgcolor='#339999' width=><img src='/images/up_questions.gif' width='350' height='24'></td><td bgcolor='#339999' align='right'><font face='arial,helvetica' size=3 color='FFFFFF' width='100%'>$course_name&nbsp;</font>
     </td>
    </tr>
    <tr>
     <td colspan='2'>&nbsp;</td>
    </tr>
    <tr>
     <td colspan='2'>
      <table border="0" cellspacing="0" cellpadding="0">
       <tr>
        <td>&nbsp;</td>
        <td><font face='arial,helvetica' size='2'>
          You indicated that <b>all</b> questions (and the corresponding answer(s) for each question) begin with a number in the following format:  <b>$qnumtypes{$qnumformat}</b>.<br><br>A total of <b>$qcount</b> questions and <b>$qcount</b> corresponding answers were found in the file you uploaded. If this questions total does not match the number you expect, please examine your original text file to verify that each question <i>and</i> each answer begins with a number in the specified format. If necessary use a text editor to edit your text file of pool questions, and click "Previous Page" on this page and the preceding one to return to Step 1, so you can upload your text file again.<br><br>
          You also indicated that the <b>$qcount</b> questions can be divided into <b>$blocks</b> blocks of questions of a particular question type.</font>
        </td>
       </tr>
       <tr>
        <td colpsan='2'>&nbsp;</td>
       </tr>
       <tr>
        <td>&nbsp;</td>
        <td><font face='arial,helvetica' size='2'>
          Please provide additional information below ,about the types of questions you have uploaded, and, if applicable, the format of answers and &quot;foils&quot; for specific types of questions.
        </td>
       </tr>
       <tr>
        <td colpsan='2'>&nbsp;</td>
       </tr>
       <tr>
        <td>&nbsp;</td>
        <td>
<font face='arial,helvetica' size='2'>The following data were uploaded to the server</font><br>
<textarea name="rawdata" cols="70" rows="6" wrap="virtual" align="center">
|;
foreach $line (@text) {
 $line =~ s/\n//g;
 print "$line\n";
}
print qq| 
</textarea>
      </td>
     </tr>
     <tr>
      <td colspan='2'>&nbsp;</td>
     </tr>
     <tr bgcolor='#b5c5d1'>
      <td width='21'>
       <img src='/images/bl_step3.gif' width='21' height='24' valign='bottom'>
      </td>
      <td width='100%' align='left'>&nbsp;&nbsp;
       <font size='3' face='arial,helvetica'><b>Information about question types and formats in each block.</b></font>
      </td>
     </tr>
     <tr>
      <td colspan='2'>&nbsp;</td>
     </tr>
     <tr>
      <td>&nbsp;</td>
      <td><font face='arial,helvetica' size='2'>For <i>each</i> of the <b>$blocks</b> question blocks, please specify the question numbers of the first and last questions in the block (e.g., 1 and 10), and the question type of the questions in the block. Please provide additional information about foil formats and answer formats if required for the question type you selected.</font>
      </td>
     </tr>
     <tr>
      <td colspan='2'>&nbsp;</td>
     </tr>
     <tr>
      <td>&nbsp;</td>
      <td>
       <table border="0" cellspacing="0" cellpadding="0" bgcolor="#000000" align="left">
        <tr>
         <td>
          <table border="1" valign="top" align="center">
           <tr bgcolor="#eef6f6" align="left">
            <td>
             <table border='0' cellspacing='2' cellpadding='2' align='left' width='100%'>
              <tr bgcolor="#B5C5D1" align='center'>
               <td align="center"><font face='arial,helvetica' size='2'>
                <b>Block</b></font>
               </td>
               <td align="center"><font face='arial,helvetica' size='2'>&nbsp;
                <b>First #</b>&nbsp;</font>
               </td>
               <td align="center"><font face='arial,helvetica' size='2'>&nbsp;
                <b>Last #</b>&nbsp;</font>
               </td>
               <td align="center"><font face='arial,helvetica' size='2'>&nbsp;
                <b>Question type</b>&nbsp;</font>
               </td>
               <td align="center"><font face='arial,helvetica' size='2'>&nbsp;
                <b>&quot;Foil&quot; format</b>&nbsp;</font>
               </td>
               <td align="center"><font face='arial,helvetica' size='2'>&nbsp;
                <b>Answer format</b>&nbsp;</font>
               </td>
              </tr>
   |;
   for (my $i=0; $i<$blocks; $i++)
   {
     my $iter = $i+1;
     my $rowcol = $i%2;
     print qq|
 <tr bgcolor="$bgcolors[$rowcol]">
  <td align="left">
   <font face='arial,helvetica' size='2'>&nbsp;$iter.</font>
  </td>
  <td align="left">&nbsp;
   <input type="text" name="start_$i" value="" size="5">&nbsp;
  </td>
  <td align="left">&nbsp;
   <input type="text" name="end_$i" value="" size="5">&nbsp;
  </td>
  <td align="left">
   <font face='arial,helvetica' size='2'>
   <select name="qtype_$i" onChange="colSet($i)">
    <option value= "-1" selected>Please Select
     |;
     foreach my $qtype (@types) {
       print qq|<option value= "$qtype">$typenames{$qtype}|;
     }
     print qq|
   </select>
   </font>
  </td>
  <td align="left">&nbsp;
    <select name="foilformat_$i">
     <option value="-1">&lt;--- Set type&nbsp; 
    </select>&nbsp;
  </td>
  <td align="left">&nbsp;
    <select name="ansr_$i">
     <option value="-1">&lt;--- Set type&nbsp;
    </select>
  </td>
 </tr>
     |;
   }
   print qq|
       </table>
      </td>
     </tr>
    </table>
   </td>
  </tr>
 </table>
</td>
</tr>
<tr>
 <td colspan="2">&nbsp;</td>
</tr>
<tr>
 <td>&nbsp;</td>
 <td>
<font face='arial,helvetica' size='2'>For <i>multiple choice</i> and <i>multiple correct answer</i> type questions, you must use the <b>&quot;Foil&quot; format</b> column to choose the format of the identifier used for each of the possible answers (e.g., (a), a, a., i, (i) etc.) provided for a given question stem. For <i>multiple correct answer</i>, and <i>fill-in-the-blank</i> questions with more than one correct answer you must use the <b>Answer format</b> column to choose the separator used between the answers, e.g., if the correct answers for question 28. were listed as: 28. (a),(d),(e) you would choose &quot;comma&quot;, or if they were listed as:</font><br><table border='0'><tr><td><font face='arial,helvetica' size='2'>28.&nbsp</font></td><td><font face='arial,helvetica' size='2'>(a)</font></td></tr><tr><td>&nbsp;</td><td><font face='arial,helvetica' size='2'>(d)</font></td></tr><tr><td>&nbsp;</td><td><font face='arial,helvetica' size='2'>(e)</font></td></tr></table>
<font face='arial,helvetica' size='2'>you would choose &quot;new line&quot;. For <i>true/false</i> questions you must use the <b>Answer format</b> column to choose how the correct answer - True or False, is displayed in the text file (e.g., T or F, true or false etc.).</font><br><br>
      </td>
     </tr>
     <tr>
      <td colspan='2'>&nbsp;</td>
     </tr>
     <tr>
      <td colspan='2'>
<input type="hidden" name="timestamp" value="$timestamp">
<input type="hidden" name="blocks" value="$blocks">
<input type="hidden" name="qnumformat" value="$qnumformat">
   <table border='0' width="100%" cellspacing='0' cellpadding='2'>
    <tr>
     <td align='left'>
      <a href='javascript:backPage()'><img border='0' src="/images/previouspage.gif"></a>
     </td>
     <td align='right'>
      <a href='javascript:nextPage()'><img border='0' src="/images/nextpage.gif"></a>
     </td>
    </tr>
   </table>
   <input type="hidden" name="filename" value="$filename">
   <input type="hidden" name="page" value ="$page">
   <input type="hidden" name="course_id" value="$classid">
   <input type="hidden" name="go" value="">
   </form>
  </td>
 </tr>
</table>
</td>
</tr>
</table>
</td>
</tr>
</table>
</BODY>
</HTML>
|;
}

sub display_three($$$$$$) {
  my ($req,$classid,$user,$passwd,$page,$course_name) = @_;
  my $qnumformat = $req->param("qnumformat");
  my $filename = $req->param("filename");
  my $source = $req->param("go");
  my $timestamp = $req->param("timestamp");
  my $blocks = $req->param("blocks");
  my @items = ();
  my @imported = ();
  my @bgcolors = ('#bfbfbf','#dfdfdf');
  my @types = ("MC","MA","TF","Ess","FIB");
  my @alphabet = ("a","b","c","d","e","f","g","h","i","j","k","l","m","n","o","p","q","r","s","t","u","v","w","x","y","z");
  my @romans = ("i","ii","iii","iv","v","vi","vii","viii","ix","x","xi","xii","xiii","xiv","xv","xvi","xvii","xviii","xix","xx","xxi","xxii","xxiii","xxiv","xxv","xxvi");
  my @start = ();
  my @end = ();
  my @nums = ();
  my @qtype = ();
  my @foilformats = ();
  my @ansrtypes = ();
  my %multparts = ();
  my $numitems = 0;
  for (my $i=0; $i<$blocks; $i++) {
    if (($req->param("start_$i") ne '') && ($req->param("end_$i") ne '')) {
      $start[$i] = $req->param("start_$i");
      $end[$i] = $req->param("end_$i");
      $nums[$i] = $end[$i]-$start[$i] +1;
      $qtype[$i] = $req->param("qtype_$i");
      if (($qtype[$i] eq "MC") || ($qtype[$i] eq "MA")) {
        $foilformats[$i] = $req->param("foilformat_$i");
        print LOG "type is $qtype[$i] Foil format is $foilformats[$i], I is $i\n";
      }
      else {
        $foilformats[$i] = '';
      } 
      if (($qtype[$i] eq "MA") || ($qtype[$i] eq "FIB") || ($qtype[$i] eq "TF")) {
        $ansrtypes[$i] = $req->param("ansr_$i");
      }
      else {
        $ansrtypes[$i] = '';
      }  
    }
    else { 
      $nums[$i] = 0;
    }
    $numitems += $nums[$i];
  }
  if (-e "$MASTERDIR/uploads/$classid/$timestamp") {
   open(FILE,"<$MASTERDIR/uploads/$classid/$timestamp") || exit ("Can't open $MASTERDIR/uploads/$classid/$timestamp for reading");
   @imported = <FILE>;
   close(FILE);
  }
  my $import = join//,@imported;
  @items = file_split(\@start,\@end,\@nums,$qnumformat,\@foilformats,\@imported,\%multparts,$numitems,\@qtype,$blocks);
  foreach my $key (sort keys %multparts) {
    for (my $k=0; $k<@{$multparts{$key}}; $k++) {
      print LOG "Key is $key, foil for $k is $multparts{$key}[$k]\n";
    }
  }

  foreach my $item (@items) {
#    print LOG "Item is $item\n";
  }
  
  print LOG "Number of items = $numitems\n";

# Get existing pool IDs.

  print <<"END_OF_ONE";
<html>
<head><title>Pool Questions Upload Page Four</title>
<script language=javascript type = "text/javascript">
<!--

function verify() {
 if ((document.forms.dataForm.pool_id.value == '')  || (!document.forms.dataForm.pool_id.value)) {
   alert("Step 5: You must choose a target pool for the import") 
   return false
 }
 return true
} 

function nextPage() {
 if (verify()) {
   document.forms.dataForm.go.value="NextPage"
   document.forms.dataForm.submit()
 }
}
function backPage() {
  document.forms.dataForm.go.value="PreviousPage"
  document.forms.dataForm.submit()
}
END_OF_ONE
if ($source eq "PreviousPage") { 
  print qq|  
function setElements() {
 var iter = 0
 var selParam = 0
 |;
 foreach my $name ($req->param()) {
   my $value = $req->param("$name");
   if ($value ne "") {
     if ($name eq "pool_id") {
       print qq(  document.forms.dataForm.$name.value = "$value"\n);
     }
   }
 }
 print "}";
}
print qq( 
// End hiding -->
</script>
</head>
        );
 if ($source eq "PreviousPage") {
   print qq| <body bgcolor="#FFFFFF" onLoad = "setElements()">|;
 }
 else {
   print qq(<body bgcolor="#FFFFFF">);
 }
 print <<"END_OF_ONE";
<img src = "/images/msuassmnthdr.gif" width="628" height="109" align="center" usemap="#usermanage" border="0">
<map name="usermanage"><area shape="rect" coords="155,69,301,96" href="../msu.pl?course_id=$classid" target="_self"><area shape="rect" coords="353,70,499,93" href="../../../courses/$classid" target="_self"></map>
<form method="post" name="dataForm">
<table border='0' cellspacing='0' cellpadding='3' width='628'>
 <tr>
  <td width='10'><img src='/common/images/trans_25.gif' width='10' height='5'></td>
  <td width='2' bgcolor='#006699'>&nbsp; &nbsp;</td>
  <td>
    <table border='0' bgcolor='#EEF6F6' cellspacing='0' cellpadding ='0'>
      <tr><td bgcolor='#339999' width='350'><img src='/images/up_questions.gif' width='350' height='24'></td><td bgcolor='#339999' align='right' width='310'><font face='arial,helvetica' size=3 color='FFFFFF' width='310'>$course_name&nbsp;</font></td></tr>
      <tr>
       <td colspan='2'>
        <table border='0' cellspacing='0' cellpadding='0'>
         <tr>
          <td colspan='2'  align='left'>&nbsp;
          </td>
         </tr>
         <tr bgcolor='#b5c5d1'>
          <td width='30' valign='top'>
          <img src='/images/bl_step4.gif' width='21' height='24' valign='bottom'>
          </td>
          <td width='100%' align='left'>&nbsp;&nbsp;
           <font size='3' face='arial,helvetica'><b>Display of questions and answers extracted from uploaded data file.</b></font>
          </td>
       </tr>
       <tr>
        <td colspan='2'>&nbsp;</td>
       </tr>
       <tr>
        <td>&nbsp;</td>
        <td><font face='arial,helvetica' size='2'>
Based on your previous responses your data have been split into total of $numitems questions. 
        </td>
      </tr>
      <tr>
        <td colspan='2'>&nbsp;</td>
      </tr>
      <tr>
       <td>&nbsp;</td>
     <td width="95%" bgcolor="#000000" align="left">
     <table width="100%" border="0" cellpadding="1" cellspacing="0">
      <tr>
       <td width="100%" bgcolor="#000000">
        <table border="0" cellspacing="0" cellpadding="1" width="100%">
         <tr>
          <td width="100%" bgcolor="#000000">
           <table border="0" cellpadding="0" cellspacing="1" bgcolor="#ffffff" width="100%">
            <tr>
             <td bgcolor="#eef6f6" width="100%">
              <table border='0' cellspacing='1' cellpadding='2' align='left' width= '100%'>
               <tr><td bgcolor="#B5C5D1" align="center" width='3%'><font face='arial,helvetica' size='2'><b>#</b></font></td><td bgcolor="#B5C5D1" align="center" width='5%'><font face='arial,helvetica' size='2'><b>Type</b></font></td><td bgcolor="#B5C5D1" align="center" width='60%'><font face='arial,helvetica' size='2'><b>Question</b></font></td><td bgcolor="#B5C5D1" align="center" width='32%'><font face='arial,helvetica' size='2'><b>Answer</b></font></td></tr>
END_OF_ONE
 for (my $j=0; $j<$numitems; $j++) {
   my $qnum = $j+1;
   my $rowcol = $j%2;
   $rowcol = @bgcolors[$rowcol];
   for (my $i=0; $i<$blocks; $i++) {
     if ($nums[$i] > 0) {
       if (($j+1 >= $start[$i]) && ($j+1 <= $end[$i])) { 
         if (($qtype[$i] eq "MC") || ($qtype[$i] eq "MA")) { 
           for (my $k=0; $k<@{$multparts{$j}}; $k++) {
             print LOG "J is $j,  K is $k\n";
             if ($k == 0) {
               print qq|<tr><td bgcolor="$rowcol" valign='top'><font face='arial,helvetica' size='2'>$qnum.</font></td><td bgcolor="$rowcol" valign='top'><font face='arial,helvetica' size='2'><b>$qtype[$i]</b></font></td><td bgcolor="$rowcol" valign='top'><font face='arial,helvetica' size='2'>$multparts{$j}[$k]<br><br>\n|;
             }
             else { 
               my $foiltag = '';
               if ($foilformats[$i] eq "lcperiod") {
                 $foiltag = $alphabet[$k-1].'.'; 
               }
               elsif ($foilformats[$i] eq "lcparen") {
                 $foiltag = '('.$alphabet[$k-1].')';
               }
               elsif ($foilformats[$i] eq "ucperiod") {
                 $foiltag = $alphabet[$k-1].'.';
                 $foiltag =~ tr/a-z/A-Z/;
               }
               elsif ($foilformats[$i] eq "ucparen") {
                 $foiltag = '('.$alphabet[$k-1].')';
                 $foiltag =~ tr/a-z/A-Z/;
               }
               elsif ($foilformats[$i] eq "romperiod") {
                 $foiltag = $romans[$k-1].'.';
               }
               elsif ($foilformats[$i] eq "romparen") {
                 $foiltag = '('.$romans[$k-1].')';
               }
               print qq|$foiltag $multparts{$j}[$k]<br>\n|;
             }
           }
           print qq|<br></font></td><td bgcolor="$rowcol" valign='top'><font face='arial,helvetica' size='2'>$items[$j+$numitems]</font></td></tr>|;
         }
         else {
           print qq|<tr><td bgcolor="$rowcol" valign="top"><font face='arial,helvetica' size='2'>$qnum.</font></td><td bgcolor="$rowcol" valign="top"><font face='arial,helvetica' size='2'><b>$qtype[$i]</b></font></td><td bgcolor="$rowcol" valign="top"><font face='arial,helvetica' size='2'>$items[$j]</font></td><td bgcolor="$rowcol" valign="top"><font face='arial,helvetica' size='2'>$items[$j+$numitems]</font></td></tr>|;
         }
         last;
       }
     }
   }
 }
 print qq(
              </table>
              </td>
              </tr>
              </table>
             </td>
            </tr>
           </table>
          </td>
         </tr>
        </table>
       </td>
      </tr>
      <tr>
       <td colspan='2'>&nbsp;</td>
      </tr>
      <tr bgcolor='#b5c5d1'>
       <td width='30' align='top'>
        <img src='/images/bl_step5.gif' width='21' height='24' valign='bottom'>
       </td>
       <td width='100%' align='left'>&nbsp;&nbsp;
        <font size='3' face='arial,helvetica'><b>Identify destination question pool</b></font>
       </td>
      </tr>
      <tr>
       <td colspan='2'>&nbsp;</td>
      </tr>
      <tr>
       <td>&nbsp;</td>
       <td>
        <font face='Arial,Helvetica,sans-serif' size='2'>
Please choose a destination LONCAPA file in which to store your uploaded questions.</font>
       </td>
      </tr>
      <tr>
       <td colspan='2'>&nbsp;</td>
      </tr>
      <tr>
       <td>&nbsp;</td>
       <td>
        <table border="0" cellspacing="0" cellpadding="0" bgcolor="#000000" align="left">
         <tr>
          <td>
           <table border="1" valign="top" align="center">
            <tr bgcolor="#eef6f6" align="left">
             <td>
              <table border='0' cellspacing='1' cellpadding='3' align='left' width='100%'>
               <tr bgcolor="#B5C5D1" align='center'>
                <td><font face='arial,helvetica' size='2'><b>Pool Name</b></font></td>
               </tr>
 );
 print qq|     <tr align="center" bgcolor='#ffffff'>
                <td>Enter PoolID&nbsp;                 
                 <input type="text" name="pool_id" value="">
                </td>
               </tr>
 |;
 print qq|    </table>
             </td>
            </tr>
           </table>
          </td>
         </tr>
        </table>
       </td>
      </tr>
      <tr>
       <td colspan='2'>&nbsp;</td>
      </tr>
      <tr>
       <td>&nbsp;</td>
       <td><font face='arial,helvetica' size='2'>If you are satisfied with the questions and answers extracted from your uploaded text file, as shown above, and you have selected a destination pool from the existing pools, or have created a new one, you should use the "Next Page" button to complete the process of uploading the questions (and answers) to your Blackboard Pool.  This process may take a minute or two if there are several questions in the text file.  Once all questions have been imported, a table will be displayed that shows the updated contents of the destination pool including the new questions you just added. You should wait for the page to load completely, to verify that the pool import process succeeded, before closing the browser window or going to a different web page.</font></td>
      </tr>
      <tr>
       <td colspan='2'>
          <input type='hidden' name="timestamp" value="$timestamp">
          <input type='hidden' name="go" value="">
          <input type='hidden' name="qnumformat" value="$qnumformat">
          <input type='hidden' name="blocks" value="$blocks">
          <input type='hidden' name="course_id" value="$classid">
          <input type='hidden' name="page" value="$page">
 |;
 for (my $i=0; $i<$blocks; $i++) {
   print qq|
          <input type='hidden' name="start_$i" value="$start[$i]">
          <input type='hidden' name="end_$i" value="$end[$i]">
          <input type='hidden' name="qtype_$i" value="$qtype[$i]">
   |;
   if (($qtype[$i] eq "MC") || ($qtype[$i] eq "MA")) {
     print qq|
          <input type='hidden' name="foilformat_$i" value="$foilformats[$i]">
     |;
   }
   if (($qtype[$i] eq "MA") || ($qtype[$i] eq "FIB") || ($qtype[$i] eq "TF")) {
     print qq|
          <input type='hidden' name="ansr_$i" value="$ansrtypes[$i]">
     |;
   }
 }
 print qq|
       </td>
      </tr>
      <tr>
       <td colspan='2'>&nbsp;</td>
      </tr>
      <tr>
       <td colspan='2'>
        <table border='0' cellspacing='0' cellpadding='0' width="100%">
         <tr>
          <td align='left'>
           <a href='javascript:backPage()'><img border='0' src="/images/previouspage.gif"></a>
          </td>
          <td align='right'>
           <a href='javascript:nextPage()'><img border='0' src="/images/nextpage.gif"></a>
          </td>
         </tr>
        </table>
       </td>
      </tr>
     </table>
    </td>
   </tr>
  </table>
 </td>
 </tr>
</table>
</form>
</body>
</html>
 |;  
}

sub final_display($$$$$$) {
  my ($req,$classid,$user,$passwd,$page,$course_name) = @_;
  my $qnumformat = $req->param("qnumformat");
  my $blocks = $req->param("blocks");
  my $pool_id = $req->param("pool_id");
  my $timestamp = $req->param("timestamp");
  my $question_id = '';
  my @question_title = ();
  my @question_status  = ();
  my @start = ();
  my @nums = ();
  my @end = ();
  my @foilformats = ();
  my @ansrtypes = ();
  my %multparts = ();
  my $numitems = 0;
  for (my $i=0; $i<$blocks; $i++) {
    $start[$i] = $req->param("start_$i");
    $end[$i] = $req->param("end_$i");
    if (($end[$i] - $start[$i]) >= 0) {
      $nums[$i] = $end[$i] - $start[$i]+1;
    }
    else {
      $nums[$i] = 0;
    }
    $qtype[$i] = $req->param("qtype_$i");
    if (($qtype[$i] eq "MC") || ($qtype[$i] eq "MA")) {
      $foilformats[$i] = $req->param("foilformat_$i");
      print LOG "type is $qtype[$i] Foil format is $foilformats[$i], I is $i\n";
    }
    else {
      $foilformats[$i] = '';
    }
    if (($qtype[$i] eq "MA") || ($qtype[$i] eq "FIB") || ($qtype[$i] eq "TF")) {
      $ansrtypes[$i] = $req->param("ansr_$i");
    }
    $numitems += $nums[$i];
  }

  print LOG "Number of items is $numitems\n";

  my @imported = ();
  my @bgcolors = ('#bfbfbf','#efefef');

  if (-e "$MASTERDIR/uploads/$classid/$timestamp") {
    open(FILE,"<$MASTERDIR/uploads/$classid/$timestamp") || exit("can't open $MASTERDIR/uploads/$classid/$timestamp for reading");
    @imported = <FILE>;
    close(FILE);
  }
  my $import = join/'\s'/,@imported;
  my %answers = ();
  my @items = file_split(\@start,\@end,\@nums,$qnumformat,\@foilformats,\@imported,\%multparts,$numitems,\@qtype,$blocks);

 foreach my $key (sort keys %multparts) {
   print LOG "Key is $key\n";
   for (my $k=0; $k<@{$multparts{$key}}; $k++) {
     print LOG "Value is $key, foil for $k is $multparts{$key}[$k]\n";
   }
 }
  
# Converting MC and MA answer to number, and splitting answers for FIB.
  my @alphabet = ("a","b","c","d","e","f","g","h","i","j","k","l","m","n","o","p","q","r","s","t","u","v","w","x","y","z");
  my @romans = ("i","ii","iii","iv","v","vi","vii","viii","ix","x","xi","xii","xiii","xiv","xv","xvi","xvii","xviii","xix","xx","xxi","xxii","xxiii","xxiv","xxv","xxvi");
  my %patterns = (
         comma => ',',
         space => '\s+',
         line => '[\r\n\f]+',
         tab => '\t+',
       );
  for (my $i=0; $i<$blocks; $i++) {
    if ($nums[$i] > 0) {
     if (($qtype[$i] eq "MC") || ($qtype[$i] eq "MA") || ($qtype[$i] eq "FIB")) {
      for (my $k=$numitems+$start[$i]-1; $k<$numitems+$end[$i]; $k++) {
        @{$answers{$k}} = ();
        if ($qtype[$i] eq "MC") {
          lc $items[$k];
          $items[$k] =~ s/\W//g;
   print LOG "count is $k, item is ||$items[$k]||, foilformat is $foilformats[$i]\n"; 
          if ($foilformats[$i] eq "lcperiod" || $foilformats[$i] eq "lcparen" || $foilformats[$i] eq "ucparen" || $foilformats[$i] eq "ucperiod") {
            for (my $j=0; $j<@alphabet; $j++) {
              if ($alphabet[$j] eq $items[$k]) {
                push @{$answers{$k}}, $j;
                last;
              }
            }
          }
          elsif (($foilformats[$i] eq "romparen") || ($foilformats[$i] eq "romperiod")) {
            for (my $j=0; $j<@romans; $j++) {
              if ($romans[$j] eq $items[$k]) {
                push @{$answers{$k}}, $j;
                last;
              }
            }
          }
        }
        elsif ($qtype[$i] eq "MA") {
          lc $items[$k];
          print LOG "Answer string is $items[$k].  Pattern is $patterns{$ansrtypes[$i]}\n"; 
          my @corrects = split/$patterns{$ansrtypes[$i]}/,$items[$k];
          foreach my $correct (@corrects) {
            $correct =~s/\W//g;
            print LOG "Correct is $correct for $qtype[$i] and number $k, foilformat is $foilformats[$i]\n";
            if ($foilformats[$i] eq "lcperiod" || $foilformats[$i] eq "lcparen" || $foilformats[$i] eq "ucparen" || $foilformats[$i] eq "ucperiod") {
              for (my $j=0; $j<@alphabet; $j++) {
                if ($alphabet[$j] eq $correct) {
                  push @{$answers{$k}}, $j;
                  print LOG "Added $j to answer array for $k\n";
                  last;
                }
              }
            }
            elsif (($foilformats[$i] eq "romparen") || ($foilformats[$i] eq "romperiod")) {
              for (my $j=0; $j<@romans; $j++) {
                if ($romans[$j] eq $correct) {
                  push @{$answers{$k}}, $j;
                  print LOG "Added $j to answer array for $k\n";
                  last;
                }
              }
            }
          }
        }
        elsif ($qtype[$i] eq "FIB") {
          @{$answers{$k}} = split/$patterns{$ansrtypes[$i]}/,$items[$k];
          for (my $j=0; $j<@{$answers{$k}}; $j++) {
            $answers{$k}[$j] =~ s/^\s+//;
            $answers{$k}[$j] =~ s/\s+$//;
            print LOG "Answer for FIB is $answers{$k}[$j]\n";
          }
        }
      }
     }
    }
  }
  my $pooltarget = '';
  my $pooldesc = '';
  my @newquestions = ();
  my $numquestions = 0;
  my %qtype = ();
  my %qtext = ();
  my %qflag = ();
  my %qfoilnum = ();

# Store questions in pool

print <<"END_OF_BLOCK";
<html>
<head>
<title>Pool Questions Upload Page Five</title>
<script language=javascript type = "text/javascript">
<!--
function backPage() {
  document.forms.verify.go.value="BackToStart"
  document.forms.verify.submit()
}
// End hiding -->
</script>
</head>
<body bgcolor="#FFFFFF">
<img src = "/images/msuassmnthdr.gif" width="628" height="109"
align="center" usemap="#usermanage" border="0">
<map name="usermanage"><area shape="rect"
coords="155,69,301,96" href="../msu.pl?course_id=$classid"
target="_self"><area shape="rect" coords="353,70,499,93"
href="../../../courses/$classid" target="_self"></map>
<form method="post" name="verify">
<table border='0' cellspacing='0' cellpadding='3' width='628'>
 <tr>
  <td width='10'><img src='/common/images/trans_25.gif' width='10' height='5'></td>
  <td width='2' bgcolor='#006699'>&nbsp; &nbsp;</td>
  <td>
    <table border='0' bgcolor='#EEF6F6' cellspacing='0' cellpadding ='0'>
      <tr><td bgcolor='#339999'><img src='/images/up_questions.gif'></td><td bgcolor='#339999' align='right'
><font face='arial,helvetica' size=3 color='FFFFFF'>$course_name&nbsp;</font></td></tr>
      <tr>
       <td colspan='2'>
        <table border='0' cellspacing='0' cellpadding='0' width="100%">
         <tr>
          <td colspan='2'  align='left'>&nbsp;
          </td>
         </tr>
         <tr bgcolor='#b5c5d1'>
          <td align='top'>
           <img src='/images/bl_step6.gif' width='21' height='24' valign='bottom'>
          </td>
          <td>&nbsp;&nbsp;
           <font size='3' face='arial,helvetica'>&nbsp;<b>Result of import of questions to pool</b></font>
          </td>
         </tr>
         <tr>
          <td colspan='2'>&nbsp;</td>
         </tr>
END_OF_BLOCK
  if (($pool_id ne "") && ($pool_id ne "-1") && ($pool_id ne "-2")) {
       my $titlesfiles = "titles_".$pool_id.".txt";
       my @buffer;
       if (-e "/home/courseinfo/admindata/loncapa/$titlesfiles")
       {
         open(FILE,"</home/courseinfo/admindata/loncapa/$titlesfiles");
         @buffer = <FILE>;
         close(FILE);
       }
       else
       {
         print "Did not find /home/courseinfo/admindata/loncapa/$titlesfiles\n";
         return;
       }
       my @dirname = ();
       my @probname = ();
       for (my $i=0; $i<@buffer; $i++)
       {
         chomp($buffer[$i]);
         ($dirname[$i],$probname[$i]) = split/,/,$buffer[$i];
       } 
       my @qn_file = ();
       my $qcount = 0;
       for (my $i=0; $i<$blocks; $i++) {
       if ($nums[$i] > 0) {
         if (($qtype[$i] eq "MC") || ($qtype[$i] eq "MA") || ($qtype[$i] eq "FIB")) {
           for (my $j=$start[$i]-1; $j<$end[$i]; $j++) {
             my $answer = $j + $numitems;
             my $numans = scalar(@{$answers{$answer}});
             print LOG "Num answers is $numans for $qtype[$i] for $j\n";
             my $foilcount = 0;
             if (($qtype[$i] eq "MC") || ($qtype[$i] eq "MA")) {
               $foilcount = @{$multparts{$j}};
               $foilcount --;
             }
             $qn_file[$qcount] = create_mcq($classid,$pool_id,$user,\@{$multparts{$j}},\@{$answers{$answer}},$qtype[$i],$j,$dirname[$j],$probname[$j]);
             print LOG "Passed parameters are $user,\@info,\@{$multparts{$j}},\@{$answers{$answer}},$qtype[$i]\n";
             $question_status[$j] = 1;
             if (($qtype[$i] eq "MC") || ($qtype[$i] eq "MA")) {
               $qfoilnum{$question_id} = " - $foilcount foils";
             }
             else {
               $question_status[$j] = 0;
             }
             if ($question_status[$j]) {
               $qcount ++;
               push @newquestions, $question_id;
             }
           }
         }
         elsif ($qtype[$i] eq "TF") {
           for (my $j=$start[$i]-1; $j<$end[$i]; $j++) {
             my $answer = $j + $numitems;
             $items[$answer] =~ s/^\s+//;
             $items[$answer] =~ s/\s+$//;
             $items[$answer] =~ s/\W//g;
             $items[$answer] =~ tr/A-Z/a-z/;
             print LOG "TF answer is $items[$answer]";
             my $answer_id = '';
             if ($ansrtypes[$i] eq 'word' ) {
               if ($items[$answer] =~ m/true/) {
                   $answer_id = 0;
               }
               else {
                  $answer_id = 1;
               }
             }
             elsif ($ansrtypes[$i] eq 'lett') {
               if ($items[$answer] =~ m/^t/) {
                  $answer_id = 0;
               }
               else {
                  $answer_id = 1;
               }
             }
             create_ess($classid,$user,$answer_id,$items[$j],$items[$answer],$qtype[$i]);
             push @newquestions, $question_id;
           }
         }
         elsif ($qtype[$i] eq "Ess") {
           for (my $j=$start[$i]-1; $j<$end[$i]; $j++) {
             my $answer = $j + $numitems;
             my $answer_id = '';
             create_ess($classid,$user,$answer_id,$items[$j],$items[$answer],$qtype[$i]);
             push @newquestions, $question_id;
           }
         }
       }
     }
     print qq|<tr><tr><td>&nbsp;</td><td><font size='2' face='arial,helvetica'>Individual textfiles have been created for your new problems.
       These files are accessible to instructors and TAs via the following links:<ul>|;
     for (my $i=0; $i<@qn_file; $i++)
     {
       my $display = $i+1;
       print qq|
       <li><b><a href="/courses/$classid/admin/loncapa/$dirname[$i]/$qn_file[$i]">Problem $display text file</a></b></li>
       |;
     }
     print qq|
       </ul></font></td></tr>
     |;
  }
  else {
     print qq|
         <tr>
          <td>&nbsp;</td>
          <td><font size='2' face='arial,helvetica'>No destination pool was selected or created, so import of your questions could not proceed.  
          Please return to the previous page and select a valid pool into which to import the questions. </font>
           <input type="hidden" name="course_id" value="$classid">
           <input type="hidden" name="go" value="">
           <input type="hidden" name="page" value="$page">
           <input type="hidden" name="qnumformat" value="$qnumformat">
           <input type="hidden" name="timestamp" value="$timestamp">
           <input type="hidden" name="pool_id" value="$pool_id">
     |;
     for (my $i=0; $i<$blocks; $i++) {
       print qq|
           <input type="hidden" name="start_$i" value="$start[$i]">
           <input type="hidden" name="end_$i" value="$end[$i]">
           <input type="hidden" name="qtype_$i" value="$qtype[$i]">
           <input type="hidden" name="foilformat_$i" value="$foilformats[$i]">
           <input type="hidden" name="ansr_$i" value="$ansrtypes[$i]">
       |;
     }
     print <<"END_OF_FAIL";
          </td>
         </tr>
         <tr>
          <td colspan='2'>
           <table border='0' width='100%'>
            <tr>
             <td align='right'>
              <a href='javascript:backPage()'><img border='0' src="/images/previouspage.gif"></a>
             </td>
            </tr>
           </table>
          </td>
         </tr>
        </table>
       </td>
      </tr>
     </table>
    </td>
   </tr>
  </table>
 </form>
</body>
</html>
END_OF_FAIL
    return;
  }
                
  print <<"END_OF_BODY";
             </table>
            </td>
           </tr>
          </table>
          <p>
          <br>
        </td>
       </tr>
       <tr>
        <td colspan='2'>&nbsp;
         <input type="hidden" name="course_id" value="$classid">
         <input type="hidden" name="go" value="">
         <input type="hidden" name="page" value="$page">
         <input type="hidden" name="mcnum" value="$mcnum"> 
         <input type="hidden" name="essaynum" value="$essaynum"> 
         <input type="hidden" name="qnumformat" value="$qnumformat"> 
         <input type="hidden" name="foilformat" value="$foilformat"> 
         <input type="hidden" name="timestamp" value="$timestamp">
         <input type="hidden" name="pool_id" value="$pool_id">
        </td>
       </tr>
       <tr>
        <td colspan='2'>
         <table border='0' width='100%'>
          <tr>
           <td align='right'>
             <a href='javascript:backPage()'><font face="arial,helvetica" size="3"><b>Back to Start Page</b></font></a>&nbsp;&nbsp;<br><br>
           </td>
          </tr>
         </table>
        </td>
       </tr>
      </table>
     </td>
    </tr>
   </table>
  </td>
 </tr>
</table>
</form>
</body>
</html>
END_OF_BODY
}

sub file_upload($$$) {
  my ($classid,$filename,$timestamp) =@_;
  my @buffer =();
  if ($filename ne "") {
    if (!$filename) {
      error_upload();
    }

# Read the text file
    @buffer = <$filename>;
    close($filename);
# Save the file
    if (!-e "$MASTERDIR/uploads/$classid") {
      mkdir("$MASTERDIR/uploads/$classid",0755);
    }
    open (OUTFILE, ">$MASTERDIR/uploads/$classid/$timestamp");
    print OUTFILE @buffer;
    close(OUTFILE);
  }
  return @buffer;
}

sub question_count ($$) {
 my ($qnumformat,$textref) = @_;
 my $text_in = join "\n", @{$textref};
 $text_in = "\n ".$text_in;
 my $qpattern ='';
 if ($qnumformat eq "period") {
   $qpattern = '\d{1,}\.';
 }
 elsif ($qnumformat eq "paren") {
   $qpattern = '\(\d{1,}\)';
 }
 elsif ($qnumformat eq "number") {
   $qpattern = '\d{1,}';
 }
 elsif ($qnumformat eq "leadparen") {
   $qpattern = '\(\d{1,}';
 }
 elsif ($qnumformat eq "trailparen") {
   $qpattern = '\d{1,}\)';
 }
 my @questions = split/[\r\n\f]+\s?$qpattern\s?/,$text_in;
 my $qcount = scalar(@questions);
 $qcount = $qcount/2;
 $qcount = int($qcount);
 return $qcount;
}

sub file_split ($$$$$$$$$$) {
 my ($startsref,$endsref,$numsref,$qnumformat,$foilsref,$textref,$multpartsref,$numitems,$qtyperef,$blocks) = @_;
 my $text_in = join "\n", @{$textref};
 $text_in = "\n ".$text_in;
 my $dignum = length($numitems);
 my $numpat;
 if ($dignum > 1) {
   $numpat = ','.$dignum.'}';
 }
 else {
   $numpat = '}';
 }
 my $qpattern ='';
 if ($qnumformat eq "period") {
   $qpattern = '\d{1'.$numpat.'\.'; 
 }
 elsif ($qnumformat eq "paren") {
   $qpattern = '\(\d{1'.$numpat.'\)';
 }
 elsif ($qnumformat eq "number") {
   $qpattern = '\d{1'.$numpat;
 }
 elsif ($qnumformat eq "leadparen") {
   $qpattern = '\(\d{1'.$numpat;
 }
 elsif ($qnumformat eq "trailparen") {
   $qpattern = '\d{1'.$numpat.'\)';
 }
 my @questions = split/[\r\n\f]+\s?$qpattern\s?/,$text_in;
# my @questions = split/\n\s\d{1,3}\.\s/,$text_in;
 shift @questions;
 my %multparts = ();
 for (my $i=0; $i<$blocks; $i++) {
   print LOG "Total blocks = $blocks; Block is $i, questions = ${$numsref}[$i]\n";
   if (${$numsref}[$i] > 0) {
     if ((${$qtyperef}[$i] eq "MC") || (${$qtyperef}[$i] eq "MA")) {
       my $splitstr = '';
       if (${$foilsref}[$i] eq "lcperiod") {
         $splitstr = '[a-z]\.';
       }
       elsif (${$foilsref}[$i] eq "lcparen") {
         $splitstr = '\([a-z]\)';
       }
       elsif (${$foilsref}[$i] eq "ucperiod") {
         $splitstr = '[A-Z]\.';
       }
       elsif (${$foilsref}[$i] eq "ucparen") {
         $splitstr = '\([A-Z]\)';
       }
       elsif (${$foilsref}[$i] eq "romperiod") {
         $splitstr = '[ivx]+\.';
       }
       elsif (${$foilsref}[$i] eq "romparen") {
         $splitstr = '\([ivx]+\)';
       }
       for (my $j=${$startsref}[$i]-1; $j<${$endsref}[$i]; $j++) {
         print LOG "Q is $j, question is $questions[$j]\n";
         @{$multparts{$j}} = split/[\r\n\f]+\s?$splitstr\s?/,$questions[$j];
         chomp(@{$multparts{$j}});
         foreach my $foil (@{$multparts{$j}}) {
           print LOG "Foil is $foil\n";
         } 
       }
     }
     elsif (${$qtyperef}[$i] eq "FIB") { 
       for (my $j=${$startsref}[$i]-1; $j<${$endsref}[$i]; $j++) {
         @{$multparts{$j}} = ("$questions[$j]");
       }
     }
   }
 }    
 %{$multpartsref} = %multparts;
 return @questions;
}
 
# create_mcq builds an MC, MA or FIB question

sub create_mcq($$$$$$$$$) {
  my ($classid,$pool_id,$user,$qstnref,$answerref,$qtype,$qnum,$dir,$prob) = @_;
  if (length($qnum) == 1)
  {
   $qnum = "00".$qnum;
  }
  elsif (length($qnum) == 2)
  {
    $qnum = "0".$qnum;
  }
  print LOG "Received parameters are $classid,$user,$qstnref,$answerref,$qtype,$qnum,$dir,$prob\n";
  my $qstn = ${$qstnref}[0];
  my $numfoils = scalar(@{$qstnref}) - 1; 
  my $datestamp = localtime;
  my $timestamp = time;
  my $count = 0;
  if (!-e "/home/courseinfo/coursedata/$classid/loncapa")
  {
    mkdir("/home/courseinfo/coursedata/$classid/loncapa",0755);
  }
  if (-e "/home/courseinfo/coursedata/$classid/loncapa/$dir")
  {
    opendir(DIR,"/home/courseinfo/coursedata/$classid/loncapa/$dir");
    my @probs = grep(!/^\./,readdir(DIR));
    closedir(DIR);
    foreach my $file (@probs)
    {
      if ($file =~ m/^$prob/)
      {
        $count ++;
      }
    }
  }
  else
  {
    mkdir("/home/courseinfo/coursedata/$classid/loncapa/$dir",0755);
  }
  my $csvfile = $prob;
  if ($count > 0)
  {
     $csvfile .= $count;
  }
  $csvfile .= ".problem";
  my $numansrs = scalar(@{$answerref});
  print LOG "Number of answers is $numansrs\n"; 
  foreach my $one (@{$answerref}) 
  {
    print LOG "Answer is $one\n";
  }
  foreach my $one (@{$qstnref} ) {
   print LOG "Answer text is: $one\n";
 }
 my $output = qq|<problem>
 <startouttext />$qstn<endouttext />
 |;
  
 if ($qtype eq "MA") {
   print LOG "$qtype is MA\n";
 }
 if ($qtype eq "MC") {
   $output .= qq|
   <radiobuttonresponse max="$numfoils" randomize="yes">
    <foilgroup>
   |;
   for (my $k=0; $k<@{$qstnref}-1; $k++) {
     $output .= "   <foil name=\"foil".$k."\" value=\"";
     if (grep/^$k$/,@{$answerref})
     {
       $output .= "true\" location=\"";
     }
     else
     {
       $output .= "false\" location=\"";
     }
     if (lc (${$qstnref}[$k+1]) =~ m/^\s?([Aa]ll)|([Nn]one)\sof\sthe\sabove\.?/)
     { 
       $output .= "bottom\"";
     }
     else
     {
       $output .= "random\"";
     }
     $output .= "\><startouttext />".${$qstnref}[$k+1]."<endouttext /></foil>\n";
   }
   chomp($output);
   $output .= qq|
    </foilgroup>
   </radiobuttonresponse>
  </problem>
   |;
 }
   
 if ($qtype eq "FIB") {
   for (my $i=0; $i<@{$answerref}; $i++) {
     my $name = "fib_answer__text__".${$qidsref}[$i];
     my $value = ${$answerref}[$i];
     $postparams{$name} = $value;
   }
 }
 open(PROB,">/home/courseinfo/coursedata/$classid/loncapa/$dir/$csvfile");
 print PROB $output;
 close PROB;
 return $csvfile;
}

# create_ess builds an essay or True/False question

sub create_ess($$$$$$) {
  my ($classid,$user,$answer_id,$qstn,$answertxt,$qtype) = @_;
  my $answer = '';
  if ($qtype eq "Ess") {
    $answer = $answertxt;
  }
  elsif ($qtype eq "TF") {
    $answer = $answer_id;
    print LOG "Adding: $answer_param = $answer\n";
  }
}

sub error_upload() {
print <<"END_OF_FILE";
<HTML>
<HEAD>
<TITLE>Problem with file upload</TITLE>
</HEAD>
<BODY BGCOLOR = "#FFFFFF">
The file you attempted to upload exceeded the file
upload limit of 10 Mb.
Click the Back button in your browser and try your request again without trying
to upload your file.
<p>
Please contact $contact_name at
<A HREF="mailto:$contact_email">$contact_email</A> when you are done to report t
he problem you encountered uploading the zip file.
<BR>
</BODY>
</HTML>
END_OF_FILE
}

Index: modules/raeburn/shadowzone.pl
+++ modules/raeburn/shadowzone.pl
#!/usr/bin/perl
use GD;

use lib 'GD-1.41/blib/arch','GD-1.41/blib/lib';

# Setting random seed
srand (time() ^ ($$ + ($$  << 15)) );

# Global parameters
my $total = 1;
my $pi = 3.1415927;
my $degrad = $pi/180;
  
for (my $j=0; $j<$total; $j++)
{
  my $count = 0;
  my $duration =  0;
  my $end =0;
  my $start = 0;
  my $x1 = 0;
  my $x2 = 0;
  my $cx = 200;
  my $cy = 200;
  my $fullr = 80;
  open(FILE,">seismic_$j.jpg");
  
# create a new image
  $im = new GD::Image(400,400);
    
# allocate some colors
  my $white = $im->colorAllocate(255,255,255);
  my $black = $im->colorAllocate(0,0,0);
  my @colors = ($black,$white);

# make the background transparent and interlaced
  $im->transparent($white);
  $im->interlaced('true');

# Put a black frame around the picture
  $im->rectangle(0,0,399,399,$black);
  
  $im->arc($cx,$cy,$fullr*2,$fullr*2,0,360,$black);
  
  my @letts = ("(a)","(b)","(c)","(d)","(e)","(f)");
  my @range = ();
  
  $range[0] = 105 - int ( rand(50) );
  $range[1] = 140 - int ( rand(35) );
  $range[2] = 255 + int ( rand(105) );
  $range[3] = 220 + int ( rand(35) );
  $range[4] = 140 + int ( rand(80)  );
  
  my @testpts = ();
  
  for (my $i=0; $i<@range; $i++)
  {
    $testpts[$i][0] = 5 + $cx + $fullr * sin($range[$i]*$degrad);
    $testpts[$i][1] = 5 + $cy + $fullr * cos($range[$i]*$degrad);
    $im->string( gdSmallFont,$testpts[$i][0],$testpts[$i][1],$letts[$i],$black);
  }

# make sure we are writing to a binary stream
  binmode STDOUT;

# Convert the image to PNG and print it on standard output
  print FILE $im->png;
  close(FILE);
}
exit;

Index: modules/raeburn/singlespread.pl
+++ modules/raeburn/singlespread.pl
#!/usr/bin/perl
use GD;

use lib 'GD-1.41/blib/arch','GD-1.41/blib/lib';

# Setting random seed
srand (time() ^ ($$ + ($$  << 15)) );

# Global parameters
my $pi = 3.1415927;
my $scaleEnd = 20;
my $y1 = 300;
my $y2 = 360;
my $ax1 = 120;
my $ax2 = 280;
my $total = 1;
my $km_to_pix = 12.5;
  
for (my $j=0; $j<$total; $j++)
{
  my $count = 0;
  my $duration =  0;
  my $end =0;
  my $start = 0;
  my $x1 = 0;
  my $x2 = 0;
  open(FILE,">single_$j.png");
  
# create a new image
  $im = new GD::Image(400,400);
    
# allocate some colors
  my $white = $im->colorAllocate(255,255,255);
  my $black = $im->colorAllocate(0,0,0);
  my $blue = $im->colorAllocate(0,220,220);
  my @colors = ($blue,$white);

# make the background transparent and interlaced
  $im->transparent($white);
  $im->interlaced('true');

# Put a black frame around the picture
  $im->rectangle(0,0,399,399,$black);
  
# Draw the distance scale
  my $yscale = 30;
  my $yscale2 = 32;
  my $xscale1 = 20;
  my $xpos = 340;
  
  my $ysc1 = $yscale-2;
  my $ysc2 = $yscale-6;

  for (my $t=0; $t<=10; $t++)
  {
     $dist = $t*100;
     my $xdist = $xscale1+$t*32; 
     $im->string(gdSmallFont,$xdist,$yscale-20,$dist,$black);
     $im->line($xdist,$ysc1,$xdist,$ysc2,$black);
  }
  $im->string( gdSmallFont,$xpos+10,$ysc2,"km",$black);
  $im->filledRectangle($xscale1,$yscale,$xpos,$yscale2,$black);
#  $im->rectangle($xscale1,$yscale,$xpos,$yscale2,$black);
#  my $scalecount = 0;
#  my $scale_start = 0;
#  my $scale_end = 0;
  
#  for (my $t=0; $t<=10; $t++)
#  {
#    my $iter = $scalecount%2;
#    $scale_start = $scale_end;
#    $scale_end += 32;
#    $x1 = $xscale1 + $scale_start + 1;
#    $x2 = $xscale1 + $scale_end + 1;
#    $im->filledRectangle($x1,$yscale1+1,$x2,$yscale2-1,$colors[$iter]);
      
#    $scalecount ++;
#  }
  
    
# Draw the anomaly time scale
  my @reversals = ();
  $im->rectangle($ax1,$y1,$ax2,$y2,$black);
  
# Create the timescale
  my $yage = $y1-16;
  my $ytick1 = $y1-2;
  my $ytick2 = $y1-6;

  for (my $t=0; $t<=10; $t++)
  {
     my $age = $t*2;
     my $xage = $ax1+$t*16; 
     $im->string( gdTinyFont,$xage,$yage,$age,$black);
     $im->line($xage,$ytick1,$xage,$ytick2,$black);
  }
  my $labelpos = $ax2 + 15;
  $im->string( gdSmallFont,$labelpos,$y1-10,"age (Ma)",$black);

  print "Reversals are:"; 
  while ($end < $scaleEnd)
  {
    $iter = $count%2;
    $start = $end;
    $duration = int(rand 20) + 1;
    $end += 0.25*$duration;
    $x1 = $ax1+int($start*8)+1;
    $x2 = $ax1+int($end*8)+1;
    if ($end >= $scaleEnd)
    {
      $x2 = $ax2-1;
    }
    push @reversals, $end;
    print " $end,";
#    print "Found $x1, $y1, $x2, $y2, $iter\n";
    $im->filledRectangle($x1,$y1+1,$x2,$y2-1,$colors[$iter]);
      
    $count ++;
  }
  print " Ma\n";
  
# Create the seafloor map
# Parameters are x,y coords of the top of spreading axis (pixels), 
# rotation angle of axis, and spread rate (km/Ma). This will create polygons of 
# seafloor, centered at the spread axis.

  my @mapcol = ();
  my $ytop = 50;
  my $ybot = 250;
  my $xleft = 20;
  my $xright = 360;
  
  $im->rectangle($xleft-1,$ytop-1,$xright+1,$ybot+1,$black);
  
  my $rate = 10 + int(rand 30);
  my $angle = rand;
  if ($angle < 0.05)
  { 
    $angle = 0.05;
  }
  elsif ($angle > 0.95)
  {
    $angle = 0.95;
  }
  $angle = ($pi/2) * $angle;

  my $xridge = int(rand 20) + 190;
  my $yridge = int(rand 20) + 150;
  my $x0;
  my $y0;
  my @vertse = ();
  my @vertne = ();
  my @vertsw = ();
  my @vertnw = ();
  my $necorner = ();
  my $secorner = ();
  my @nwcorner = ();
  my @swcorner = ();
  my $seflag;
  my $neflag;
  my $swflag;
  my $nwflag;
  print "Rate is $rate, Angle is $angle, Ridge is ($xridge,$yridge)\n";
  
  $x0 = $xridge + int(($ybot - $yridge)*cos($angle)/sin($angle));
#  print "x0 is $x0\n";
  if ($x0 > $xright)
  {
    $y0 = $yridge + int(($xright - $xridge)*sin($angle)/cos($angle));
    print "y0 is $y0\n";
    @{$vertse[0]} = ($xright,$y0);
    $seflag = "y";
  }
  else
  {
    @{$vertse[0]} = ($x0,$ybot);
    $seflag = "x";
  }
  @{$vertsw[0]} = @{$vertse[0]};
  $swflag = $seflag;
#  print "vertsw is $vertsw[0][0], $vertsw[0][1]\n";
  
  $x0 = $xridge - int(($yridge - $ytop)*cos($angle)/sin($angle));
  if ($x0 < $xleft)
  {
    $y0 = $yridge - int(($xridge - $xleft)*sin($angle)/(cos($angle)));
    @{$vertne[0]} = ($xleft,$y0);
    $neflag = "y";
  }
  else
  {
    @{$vertne[0]} = ($x0,$ytop);
    $neflag = "x";
  }
  @{$vertnw[0]} = @{$vertne[0]};
  $nwflag = $neflag;

  for (my $i=0; $i<@reversals; $i++)
  {
    @{$necorner[$i]} = ();
    @{$secorner[$i]} = ();
    @{$nwcorner[$i]} = ();
    @{$swcorner[$i]} = ();

    my $newcorner = '';
    my $xinc;
    my $yinc;
    my $rinc;
    if ($i == 0)
    {
      $rinc =  ($reversals[$i]*$rate)/2;
    }
    else
    {
      $rinc = ($reversals[$i]-$reversals[$i-1])*$rate/2;
    }    
    $xinc = $rinc/(sin($angle));
    if ($xinc - int($xinc) > 0.5)
    {
      $xinc = int($xinc) + 1;
    }
    else
    {
      $xinc = int($xinc);
    }
    $yinc = $rinc/(cos($angle));
    if ($yinc - int($yinc) > 0.5)
    {
      $yinc = int($yinc) + 1;
    }
    else
    {
      $yinc = int($yinc);
    }
#    print "incs are $rinc, $xinc, $yinc\n";
# Get first intersections 
# 1. SE corner
     my $x;
     my $y;
     if ($seflag eq "x")
     {
       $x = $vertse[$i][0] + $xinc;
       $y = $vertse[$i][1];
       if ($x > $xright)
       {  
          $x = $xright;
          $delx = $xright - $vertse[$i][0];
          $y = $vertse[$i][1] - ($rinc-$delx*sin($angle))/cos($angle);
          if ($y < $ytop)
          {
            $y = $ytop;
          }
          if ($y - int($y) > 0.5)
          {
            $y = int($y) +1;
          }
          else
          {
            $y = int($y);
          }
#          print "Found y is $y, delX is $delx\n";

          $newcorner = "se";
       }
     }
     elsif ($seflag eq "y")
     {
        $x=$vertse[$i][0];
        $y=$vertse[$i][1] - $yinc;
     }
     
     if ($y < $ytop)
     {
       $y = $ytop;
     }
     
     @{$vertse[$i+1]} = ($x,$y);
     if ($newcorner eq "se")
     {
       @{$secorner[$i]} = ($xright,$ybot);
       $seflag = "y";
     }
     
# 2. NE corner
     if ($neflag eq "x")
     {
       $x = $vertne[$i][0] + $xinc;
       $y = $vertne[$i][1];
       if ($x > $xright)
       {  
         $x = $xright;
         $y = $vertne[$i][1];
       }
     }
     elsif ($neflag eq "y")
     {
       $x=$vertne[$i][0];
       $y=$vertne[$i][1] - $yinc;
       if ($y < $ytop)
       {
         $y = $ytop;
         $dely =  $vertne[$i][1] - $ytop;
         $x = $vertne[$i][0] + ($rinc-$dely*cos($angle))/sin($angle);
         if ($x > $xright)
         {
           $x = $xright;
         }
         if ($x - int($x) > 0.5)
         {
            $x = int($x) +1;
         }
         else
         {
            $x = int($x);
         }
#         print "Found x is $x, delY is $dely\n";
         $newcorner = "ne";
       }
     }
     
     @{$vertne[$i+1]} = ($x,$y);
     if ($newcorner eq "ne")
     {
       @{$necorner[$i]} = ($xleft,$ytop);
       $neflag = "x";
     }
     
# 3. SW corner
     if ($swflag eq "x")
     {
       $x = $vertsw[$i][0] - $xinc;
       $y = $vertsw[$i][1];
       if ($x < $xleft)
       {
          $x = $xleft;
          $y = $ybot;
       }     
     }
     elsif ($swflag eq "y")
     {
        $x=$vertsw[$i][0];
        $y=$vertsw[$i][1] + $yinc;
        if ($y > $ybot)
        {         
          $y = $ybot;
          $dely =  $ybot - $vertsw[$i][1];
          $x = $vertsw[$i][0] - ($rinc-$dely*cos($angle))/sin($angle);
          if ($x < $xleft)
          {
            $x = $xleft;
          } 
          if ($x - int($x) > 0.5)
          {
            $x = int($x) +1;
          }
          else
          {
            $x = int($x);
          }
#          print "SW: Found x is $x, delY is $dely\n";
          $newcorner = "sw";
        }
     }
     @{$vertsw[$i+1]} = ($x,$y);
     if ($newcorner eq "sw")
     {
       @{$swcorner[$i]} = ($xright,$ybot);
       $swflag = "x";
     }
     

#4. NW corner
     if ($nwflag eq "x")
     {
       $x = $vertnw[$i][0] - $xinc;
       $y = $vertnw[$i][1];
       if ($x < $xleft)
       {
          $x = $xleft;
          $delx =$vertnw[$i][0] - $xleft;
          $y = $vertnw[$i][1] + ($rinc-$delx*sin($angle))/cos($angle);
          if ($y > $ybot)
          {
            $y = $ybot;
          }
          if ($y - int($y) > 0.5)
          {
            $y = int($y) +1;
          }
          else
          {
            $y = int($y);
          }
#          print "NW: Found y is $y, delX is $delx\n";

          $newcorner = "nw"; 
       }
     }
     elsif ($nwflag eq "y")
     {
        $x=$vertnw[$i][0];
        $y=$vertnw[$i][1] + $yinc;
        if ($y > $ybot)
        {
          $y = $ybot;
        }
     }
     @{$vertnw[$i+1]} = ($x,$y);
     if ($newcorner eq "nw")
     {
       @{$nwcorner[$i]} = ($xleft,$ytop);
       $nwflag = "y";
     }

     if ($i%2 == 0)
     {
       $mapcol[$i] = $blue;
     }
     else
     {
       $mapcol[$i] = $white;
     }
     if ($vertse[$i][1] == $ytop || $vertne[$i][0] == $xright)
     {
       last;
     }
     else
     {
       print "Vertices: $vertse[$i][0],$vertse[$i][1],$vertse[$i+1][0],$vertse[$i+1][1],$vertne[$i+1][0],$vertne[$i+1][1],$vertne[$i][0],$vertne[$i][1]\n";
       my $rtpoly = new GD::Polygon;
       $rtpoly->addPt($vertse[$i][0],$vertse[$i][1]);
#       print "$i: SEPt: $vertse[$i][0],$vertse[$i][1]\n";
       if (@{$secorner[$i]})
       {
           $rtpoly->addPt($secorner[$i][0],$secorner[$i][1]);
#           print "$i: SECorPt: $secorner[$i][0],$secorner[$i][1]\n";
       }
       $rtpoly->addPt($vertse[$i+1][0],$vertse[$i+1][1]);
#       print "$i: SEPt: $vertse[$i+1][0],$vertse[$i+1][1]\n";

       $rtpoly->addPt($vertne[$i+1][0],$vertne[$i+1][1]);
#       print "$i: NEPt: $vertne[$i+1][0],$vertne[$i+1][1]\n";

       if (@{$necorner[$i]})
       {
           $rtpoly->addPt($necorner[$i][0],$necorner[$i][1]);
#           print "$i: NECorPt: $necorner[$i][0],$necorner[$i][1]\n";

       }
       $rtpoly->addPt($vertne[$i][0],$vertne[$i][1]);
#       print "$i: NEPt: $vertne[$i][0],$vertne[$i][1]\n";
       $im->filledPolygon($rtpoly,$mapcol[$i]);
	 }
	 if ($vertsw[$i][0] == $xleft || $vertnw[$i][1] == $ybot)
	 {
	   last; 
	 }
	 else
	 {       
#	   print "Vertices: $vertsw[$i][0],$vertsw[$i][1],$vertsw[$i+1][0],$vertsw[$i+1][1],$vertnw[$i+1][0],$vertnw[$i+1][1],$vertnw[$i][0],$vertne[$i][1]\n";
       my $rtpoly = new GD::Polygon;
       $rtpoly->addPt($vertsw[$i][0],$vertsw[$i][1]);
#       print "$i: SWPt: $vertsw[$i][0],$vertsw[$i][1]\n";
       if (@{$swcorner[$i]})
       {
           $rtpoly->addPt($swcorner[$i][0],$swcorner[$i][1]);
#           print "$i: SWCorPt: $swcorner[$i][0],$swcorner[$i][1]\n";
       }
       $rtpoly->addPt($vertsw[$i+1][0],$vertsw[$i+1][1]);
#       print "$i: SWPt: $vertsw[$i+1][0],$vertsw[$i+1][1]\n";
       $rtpoly->addPt($vertnw[$i+1][0],$vertnw[$i+1][1]);
#       print "$i: NWPt: $vertnw[$i+1][0],$vertnw[$i+1][1]\n";
       if (@{$nwcorner[$i]})
       {
           $rtpoly->addPt($nwcorner[$i][0],$nwcorner[$i][1]);
#           print "$i: NWCorPt: $nwcorner[$i][0],$nwcorner[$i][1]\n";
       }
       $rtpoly->addPt($vertnw[$i][0],$vertnw[$i][1]);
#       print "$i: NWPt: $vertnw[$i][0],$vertnw[$i][1]\n";
       $im->filledPolygon($rtpoly,$mapcol[$i]);
	 }
  }

# make sure we are writing to a binary stream
  binmode STDOUT;

# Convert the image to PNG and print it on standard output
  print FILE $im->png;
  close(FILE);
  $output = qq|
<problem>
<randomlabel width="576" height="432" texwidth="60" bgimg="../images/single1.png">
<labelgroup name="face" type="text">
<location x="$loc[0][0]" y="$loc[0][1]" value="">
</location>
<location x="$loc[1][0]" y="$loc[1][1]" value="">
</location>
<location x="$loc[2][0]" y="$loc[2][1]" value="">
</location>
<location x="$loc[3][0]" y="$loc[3][1]" value="">
</location>
<location x="$loc[4][0]" y="$loc[4][1]" value="">
</location>
<label>A</label>
<label>B</label>
<label>C</label>
<label>D</label>
<label>E</label>
</labelgroup>
</randomlabel><startouttext />Match the following:<endouttext />
<optionresponse max="10" id="11" randomize="yes">
  <foilgroup options="('A', 'B', 'C', 'D')">
   <foil location="random" value="$face{1}" name="$range[0]">
    <startouttext />$label[0]<endouttext />
   </foil>
   <foil location="random" value="$face{2}" name="$range[1]">
    <startouttext />$label[1]<endouttext />
   </foil>
   <foil location="random" value="$face{3}" name="$range[2]">
    <startouttext />$label[2]<endouttext />
   </foil>
   <foil location="random" value="$face{4}" name="$range[3]">
    <startouttext />$label[3]<endouttext />
   </foil>
  </foilgroup>
</optionresponse>
</problem>
  |;
  print $output;
}
exit;

Index: modules/raeburn/spreading.pl
+++ modules/raeburn/spreading.pl
#!/usr/bin/perl
use GD;

use lib 'GD-1.41/blib/arch','GD-1.41/blib/lib';

# Setting random seed
srand (time() ^ ($$ + ($$  << 15)) );

# Global parameters
my $pi = 3.1415927;
my $scaleEnd = 40;
my $framewidth = 200;
my $frameheight = 200;
my $leftindent = 60;
my $rightindent = 60;
my $topindent = 60;
my $botindent = 60;
my $rowspace = 40;
my $colspace = 40;
my $y1 = 560;
my $y2 = 590;
my $ax1 = 240;
my $ax2 = 560;
my $total = 20;
my $km_to_pix = 12.5;
my $output = qq|
<problem>
<allow src="/res/msu/raeburn/problems/images/*.gif" />
<randomlist show="1">
|;
  
for (my $j=0; $j<$total; $j++)
{
  my %rank = ();
  my $count = 0;
  my $duration =  0;
  my $end =0;
  my $start = 0;
  my $x1 = 0;
  my $x2 = 0;
  open(FILE,">sprate_$j.jpg");
  
# create a new image
  $im = new GD::Image(800,600);
    
# allocate some colors
  my $white = $im->colorAllocate(255,255,255);
  my $black = $im->colorAllocate(0,0,0);
  my $green = $im->colorAllocate(255,255,0);
  my $blue =$im->colorAllocate(0,0,255);
  my @colors = ($black,$white);

# make the background transparent and interlaced
  $im->transparent($white);
  $im->interlaced('true');

# Put a black frame around the picture
  $im->rectangle(0,0,799,599,$black);
  
# Draw the distance scale
  my $yscale = 30;
  my $yscale2 = 32;
  my $xscale1 = 20;
  my $xpos = 212;
  
  my $ysc1 = $yscale-2;
  my $ysc2 = $yscale-8;

  for (my $t=0; $t<=6; $t++)
  {
     $dist = $t*400;
     my $xdist = $xscale1+$t*32; 
     $im->string(gdSmallFont,$xdist,$yscale-24,$dist,$black);
     $im->line($xdist,$ysc1,$xdist,$ysc2,$black);
     for (my $s=1; $s<4; $s++)
     {
       if($t<6)
       {
         $im->line($xdist+$s*8,$ysc1,$xdist+$s*8,$ysc2+4,$black);
       }
     }
  }
  $im->string( gdSmallFont,$xpos+10,$ysc2,"km",$black);
  $im->filledRectangle($xscale1,$yscale,$xpos,$yscale2,$black);
#

# Draw the anomaly time scale
  my @reversals = ();
  my @rates = ();
  $im->rectangle($ax1,$y1,$ax2,$y2,$black);
  
# Create the timescale
  my $yage = $y1-16;
  my $ytick1 = $y1-2;
  my $ytick2 = $y1-6;

  for (my $t=0; $t<=20; $t++)
  {
     my $age = $t*2;
     my $xage = $ax1+$t*16; 
     $im->string( gdTinyFont,$xage,$yage,$age,$black);
     $im->line($xage,$ytick1,$xage,$ytick2,$black);
  }
  
  my $labelpos = $ax2 + 15;
  $im->string( gdSmallFont,$labelpos,$y1-10,"age (Ma)",$black);

#  print "Reversals are:"; 
  while ($end < $scaleEnd)
  {
    $iter = $count%2;
    $start = $end;
    $duration = int(rand 10) + 1;
    $end += 0.25*$duration;
    $x1 = $ax1+int($start*8)+1;
    $x2 = $ax1+int($end*8)+1;
    if ($end >= $scaleEnd)
    {
      $x2 = $ax2-1;
    }
    push @reversals, $end;
#    print " $end,";
#    print "Found $x1, $y1, $x2, $y2, $iter\n";
    $im->filledRectangle($x1,$y1+1,$x2,$y2-1,$colors[$iter]);
      
    $count ++;
  }
#  print " Ma\n";
  my $imgcount = 0;
  my %imgid = ();
  my @letts = ("(a)","(b)","(c)","(d)","(e)","(f)");
  for (my $row=0; $row<2; $row++)
  {
    for (my $col=0; $col<3; $col++)
    { 
# Draw bounding box.
     
      my @mapcol = ();
      my $ytop = $topindent+($colspace+$frameheight)*$row;
      my $ybot = $ytop + $frameheight;
      my $xleft = $leftindent+($rowspace+$framewidth)*$col;
      my $xright = $xleft + $framewidth;
      $im->rectangle($xleft-1,$ytop-1,$xright+1,$ybot+1,$black);
      $im->string(gdMediumBoldFont,$xleft-15,$ytop-15,$letts[$imgcount],$blue);
     
# Create the seafloor map
# Parameters are x,y coords of the top of spreading axis (pixels), 
# rotation angle of axis, and spread rate (km/Ma). This will create polygons of 
# seafloor, centered at the spread axis.

      my @mapcol = ();
      my $rate = 10 + 4*int(rand 8); 
      while (grep/^$rate$/,@rates)
      {
        $rate = 10 + 4*int(rand 8);
      }
      push @rates,$rate;
      $imgid{$rate} = $imgcount;
      $imgcount ++;
      
      my $angle = rand;
      if ($angle < 0.05)
      { 
        $angle = 0.05;
      }
      elsif ($angle > 0.95)
      {
        $angle = 0.95;
      }
      $angle = ($pi/2) * $angle;

      my $xridge = int(rand 20) + $xleft + $framewidth/2;
      my $yridge = int(rand 20) + $ytop + $frameheight/2;
      my $x0;
      my $y0;
      my @vertse = ();
      my @vertne = ();
      my @vertsw = ();
      my @vertnw = ();
      my $necorner = ();
      my $secorner = ();
      my @nwcorner = ();
      my @swcorner = ();
      my $seflag;
      my $neflag;
      my $swflag;
      my $nwflag;
#     print "Rate is $rate, Angle is $angle, Ridge is ($xridge,$yridge)\n";
  
      $x0 = $xridge + int(($ybot - $yridge)*cos($angle)/sin($angle));
#  print "x0 is $x0\n";
      if ($x0 > $xright)
      {
        $y0 = $yridge + int(($xright - $xridge)*sin($angle)/cos($angle));
#        print "y0 is $y0\n";
        @{$vertse[0]} = ($xright,$y0);
        $seflag = "y";
      }
      else
      {
        @{$vertse[0]} = ($x0,$ybot);
        $seflag = "x";
      }
      @{$vertsw[0]} = @{$vertse[0]};
      $swflag = $seflag;
#  print "vertsw is $vertsw[0][0], $vertsw[0][1]\n";
  
      $x0 = $xridge - int(($yridge - $ytop)*cos($angle)/sin($angle));
      if ($x0 < $xleft)
      {
        $y0 = $yridge - int(($xridge - $xleft)*sin($angle)/(cos($angle)));
        @{$vertne[0]} = ($xleft,$y0);
        $neflag = "y";
      }
      else
      {
        @{$vertne[0]} = ($x0,$ytop);
        $neflag = "x";
      }
      @{$vertnw[0]} = @{$vertne[0]};
      $nwflag = $neflag;
     
      for (my $i=0; $i<@reversals; $i++)
      {
        @{$necorner[$i]} = ();
        @{$secorner[$i]} = ();
        @{$nwcorner[$i]} = ();
        @{$swcorner[$i]} = ();
     
        my $newcorner = '';
        my $xinc;
        my $yinc;
        my $rinc;
        if ($i == 0)
        {
          $rinc =  ($reversals[$i]*$rate)/2;
        }
        else
        {
          $rinc = ($reversals[$i]-$reversals[$i-1])*$rate/2;
        }    
        $xinc = $rinc/(sin($angle));
        if ($xinc - int($xinc) > 0.5)
        {
          $xinc = int($xinc) + 1;
        }
        else
        {
          $xinc = int($xinc);
        }
        $yinc = $rinc/(cos($angle));
        if ($yinc - int($yinc) > 0.5)
        {
          $yinc = int($yinc) + 1;
        }
        else
        {
          $yinc = int($yinc);
        }
#    print "incs are $rinc, $xinc, $yinc\n";
# Get first intersections 
# 1. SE corner
        my $x;
        my $y;
        if ($seflag eq "x")
        {
          $x = $vertse[$i][0] + $xinc;
          $y = $vertse[$i][1];
          if ($x > $xright)
          {  
            $x = $xright;
            $delx = $xright - $vertse[$i][0];
            $y = $vertse[$i][1] - ($rinc-$delx*sin($angle))/cos($angle);
            if ($y < $ytop)
            {
              $y = $ytop;
            }
            if ($y - int($y) > 0.5)
            {
              $y = int($y) +1;
            }
            else
            {
              $y = int($y);
            }
#          print "Found y is $y, delX is $delx\n";

            $newcorner = "se";
          }
        }
        elsif ($seflag eq "y")
        {
          $x=$vertse[$i][0];
          $y=$vertse[$i][1] - $yinc;
        }
     
        if ($y < $ytop)
        {
          $y = $ytop;
        }
     
        @{$vertse[$i+1]} = ($x,$y);
        if ($newcorner eq "se")
        {
          @{$secorner[$i]} = ($xright,$ybot);
          $seflag = "y";
        }
     
# 2. NE corner
        if ($neflag eq "x")
        {
          $x = $vertne[$i][0] + $xinc;
          $y = $vertne[$i][1];
          if ($x > $xright)
          {  
            $x = $xright;
            $y = $vertne[$i][1];
          }
        }
        elsif ($neflag eq "y")
        {
          $x=$vertne[$i][0];
          $y=$vertne[$i][1] - $yinc;
          if ($y < $ytop)
          {
            $y = $ytop;
            $dely =  $vertne[$i][1] - $ytop;
            $x = $vertne[$i][0] + ($rinc-$dely*cos($angle))/sin($angle);
            if ($x > $xright)
            {
              $x = $xright;
            }
            if ($x - int($x) > 0.5)
            {
              $x = int($x) +1;
            }
            else
            {
              $x = int($x);
            }
#         print "Found x is $x, delY is $dely\n";
            $newcorner = "ne";
          }
        }
       
        @{$vertne[$i+1]} = ($x,$y);
        if ($newcorner eq "ne")
        {
          @{$necorner[$i]} = ($xleft,$ytop);
          $neflag = "x";
        }
     
# 3. SW corner
        if ($swflag eq "x")
        {
          $x = $vertsw[$i][0] - $xinc;
          $y = $vertsw[$i][1];
          if ($x < $xleft)
          {
            $x = $xleft;
            $y = $ybot;
          }     
        }
        elsif ($swflag eq "y")
        {
          $x=$vertsw[$i][0];
          $y=$vertsw[$i][1] + $yinc;
          if ($y > $ybot)
          {         
            $y = $ybot;
            $dely =  $ybot - $vertsw[$i][1];
            $x = $vertsw[$i][0] - ($rinc-$dely*cos($angle))/sin($angle);
            if ($x < $xleft)
            {
              $x = $xleft;
            } 
            if ($x - int($x) > 0.5)
            {
               $x = int($x) +1;
            }
            else
            {
              $x = int($x);
            }
#          print "SW: Found x is $x, delY is $dely\n";
            $newcorner = "sw";
          }
        }
        @{$vertsw[$i+1]} = ($x,$y);
        if ($newcorner eq "sw")
        {
          @{$swcorner[$i]} = ($xright,$ybot);
          $swflag = "x";
        }

#4. NW corner
        if ($nwflag eq "x")
        {
          $x = $vertnw[$i][0] - $xinc;
          $y = $vertnw[$i][1];
          if ($x < $xleft)
          {
            $x = $xleft;
            $delx =$vertnw[$i][0] - $xleft;
            $y = $vertnw[$i][1] + ($rinc-$delx*sin($angle))/cos($angle);
            if ($y > $ybot)
            {
              $y = $ybot;
            }
            if ($y - int($y) > 0.5)
            {
              $y = int($y) +1;
            }
            else
            {
              $y = int($y);
            }
#          print "NW: Found y is $y, delX is $delx\n";

            $newcorner = "nw"; 
          }
        }
        elsif ($nwflag eq "y")
        {
          $x=$vertnw[$i][0];
          $y=$vertnw[$i][1] + $yinc;
          if ($y > $ybot)
          {
            $y = $ybot;
          }
        }
        @{$vertnw[$i+1]} = ($x,$y);
        if ($newcorner eq "nw")
        {
          @{$nwcorner[$i]} = ($xleft,$ytop);
          $nwflag = "y";
        }

        if ($i%2 == 0)
        {
          $mapcol[$i] = $black;
        }
        else
        {
          $mapcol[$i] = $white;
        }

        if ($vertse[$i][1] == $ytop || $vertne[$i][0] == $xright)
        {
          last;
        }
        else
        {
#       print "Vertices: $vertse[$i][0],$vertse[$i][1],$vertse[$i+1][0],$vertse[$i+1][1],$vertne[$i+1][0],$vertne[$i+1][1],$vertne[$i][0],$vertne[$i][1]\n";
          my $rtpoly = new GD::Polygon;
          $rtpoly->addPt($vertse[$i][0],$vertse[$i][1]);
#          print "$i: SEPt: $vertse[$i][0],$vertse[$i][1]\n";
          if (@{$secorner[$i]})
          {
             $rtpoly->addPt($secorner[$i][0],$secorner[$i][1]);
#             print "$i: SECorPt: $secorner[$i][0],$secorner[$i][1]\n";
          }
          $rtpoly->addPt($vertse[$i+1][0],$vertse[$i+1][1]);
#          print "$i: SEPt: $vertse[$i+1][0],$vertse[$i+1][1]\n";

          $rtpoly->addPt($vertne[$i+1][0],$vertne[$i+1][1]);
#          print "$i: NEPt: $vertne[$i+1][0],$vertne[$i+1][1]\n";

          if (@{$necorner[$i]})
          {
            $rtpoly->addPt($necorner[$i][0],$necorner[$i][1]);
#            print "$i: NECorPt: $necorner[$i][0],$necorner[$i][1]\n";

          }
          $rtpoly->addPt($vertne[$i][0],$vertne[$i][1]);
#          print "$i: NEPt: $vertne[$i][0],$vertne[$i][1]\n";
          $im->filledPolygon($rtpoly,$mapcol[$i]);
        }
        if ($vertsw[$i][0] == $xleft || $vertnw[$i][1] == $ybot)
        {
          last; 
        }
        else
        {       
#	   print "Vertices: $vertsw[$i][0],$vertsw[$i][1],$vertsw[$i+1][0],$vertsw[$i+1][1],$vertnw[$i+1][0],$vertnw[$i+1][1],$vertnw[$i][0],$vertne[$i][1]\n";
          my $rtpoly = new GD::Polygon;
          $rtpoly->addPt($vertsw[$i][0],$vertsw[$i][1]);
#          print "$i: SWPt: $vertsw[$i][0],$vertsw[$i][1]\n";
          if (@{$swcorner[$i]})
          {
            $rtpoly->addPt($swcorner[$i][0],$swcorner[$i][1]);
#            print "$i: SWCorPt: $swcorner[$i][0],$swcorner[$i][1]\n";
          }
          $rtpoly->addPt($vertsw[$i+1][0],$vertsw[$i+1][1]);
#          print "$i: SWPt: $vertsw[$i+1][0],$vertsw[$i+1][1]\n";
          $rtpoly->addPt($vertnw[$i+1][0],$vertnw[$i+1][1]);
#          print "$i: NWPt: $vertnw[$i+1][0],$vertnw[$i+1][1]\n";
          if (@{$nwcorner[$i]})
          {
            $rtpoly->addPt($nwcorner[$i][0],$nwcorner[$i][1]);
#            print "$i: NWCorPt: $nwcorner[$i][0],$nwcorner[$i][1]\n";
          }
          $rtpoly->addPt($vertnw[$i][0],$vertnw[$i][1]);
#          print "$i: NWPt: $vertnw[$i][0],$vertnw[$i][1]\n";
          $im->filledPolygon($rtpoly,$mapcol[$i]);
        }
      }
      $im->line($vertne[0][0],$vertne[0][1],$vertse[0][0],$vertse[0][1],$green);
    }
  }
  

# make sure we are writing to a binary stream
  binmode STDOUT;

# Convert the image to JPEG and print it on standard output
  print FILE $im->jpeg;
  close(FILE);

  my @sortedimgid = reverse sort keys %imgid;
  for (my $k=0; $k<@sortedimgid; $k++)
  {
#    print "Rate is $sortedimgid[$k], rank is $k+1, image is $imgid{$sortedimgid[$k]}\n";
    $rank[$imgid{$sortedimgid[$k]}] = $k+1;
  }
  my $imagename = "sp_rate".$j.".jpg";
  $output .= qq| 
<rankresponse max="6" randomize="yes">
<startouttext />
<table>
<tr>
<td>
<img src="../images/$imagename" />
</td>
</tr>
</table>
<br/>
The image above shows maps of six different areas of the seafloor adjacent to a spreading ridge. Each map includes the spreading ridge location (shown in yellow) and striping (in black and white) that depicts the pattern of magnetic reversals preserved in oceanic crust.  A distance scale is provided at the top of the image, and a magnetic reversal time scale is provided at the bottom. Periods when the earth's magnetic field had the same polarity as today are black; periods when the field was reversed are white.<br/><br/>
Rank the spreading rates for each of the spreading ridges - (a) through (f) - with the fastest spreading ranked as 1, and the slowest spreading ranked as 6.<endouttext />
<foilgroup>
<foil location="random" value="$rank[0]" name="foila"><startouttext />(a)<endouttext /></foil>
<foil location="random" value="$rank[1]" name="foilb"><startouttext />(b)<endouttext /></foil>
<foil location="random" value="$rank[2]" name="foilc"><startouttext />(c)<endouttext /></foil>
<foil location="random" value="$rank[3]" name="foild"><startouttext />(d)<endouttext /></foil>
<foil location="random" value="$rank[4]" name="foile"><startouttext />(e)<endouttext /></foil>
<foil location="random" value="$rank[5]" name="foilf"><startouttext />(f)<endouttext /></foil>
    </foilgroup>
</rankresponse>
  |;
}
$output .= "</randomlist>
</problem>";
print $output;
exit;


--raeburn1063207917--