Return to imageresponse.pm CVS log

Up to [LON-CAPA] / loncom / homework

- redid random number generator for <i/rb/o/response> tags
     - should be unstable in preview mode and more random in normal mode

    1: # The LearningOnline Network with CAPA
    2: # iimage click response style
    3: 
    4: #FIXME assumes multiple possbile submissions but only one is possible currently
    5: 
    6: package Apache::imageresponse;
    7: use strict;
    8: 
    9: sub BEGIN {
   10:   &Apache::lonxml::register('Apache::imageresponse',('imageresponse'));
   11: }
   12: 
   13: sub start_imageresponse {
   14:   my ($target,$token,$parstack,$parser,$safeeval,$style)=@_;
   15:   #when in a radiobutton response use these
   16:   &Apache::lonxml::register('Apache::imageresponse',('foilgroup','foil','text','image','rectangle'));
   17:   my $id = &Apache::response::start_response($parstack,$safeeval);
   18:   return '';
   19: }
   20: 
   21: sub end_imageresponse {
   22:   &Apache::response::end_response;
   23:   return '';
   24: }
   25: 
   26: %Apache::response::foilgroup={};
   27: sub start_foilgroup {
   28:   %Apache::response::foilgroup={};
   29:   $Apache::optionresponse::conceptgroup=0;
   30:   &Apache::response::setrandomnumber();
   31:   return '';
   32: }
   33: 
   34: sub getfoilcounts {
   35:   my ($parstack,$safeeval)=@_;
   36:   my $rrargs ='';
   37:   if ( $#$parstack > 0 ) { $rrargs=$$parstack['-2']; }
   38:   my $max = &Apache::run::run("{$rrargs;".'return $max}',$safeeval);
   39:   my $count = $#{ $Apache::response::foilgroup{'names'} };
   40:   return ($count,$max);
   41: }
   42: 
   43: sub whichfoils {
   44:   my ($max)=@_;
   45:   my @names = @{ $Apache::response::foilgroup{'names'} };
   46:   my @whichopt =();
   47:   while ((($#whichopt) < $max) && ($#names > -1)) {
   48:     my $aopt=int rand $#names;
   49:     &Apache::lonxml::debug("From $#names elms, picking $aopt");
   50:     $aopt=splice(@names,$aopt,1);
   51:     &Apache::lonxml::debug("Picked $aopt");
   52:     push (@whichopt,$aopt);
   53:   }
   54:   return @whichopt;
   55: }
   56: 
   57: sub displayfoils {
   58:   my (@whichopt) = @_;
   59:   my $result ='';
   60:   my $name;
   61:   my $temp=1;
   62:   foreach $name (@whichopt) {
   63:     $result.=$Apache::response::foilgroup{"$name.text"}."<br />\n";
   64:     my $image=$Apache::response::foilgroup{"$name.image"};
   65:     if ($Apache::lonhomework::history{"resource.$Apache::inputtags::part.solved"} =~ /^correct/ ) {
   66:       $result.="<img src=\"$image\"/> <br />\n";
   67:     } else {
   68:       $result.="<input type=\"image\" name=\"HWVAL_$Apache::inputtags::response['-1']:$temp\" src=\"$image\"/> <br />\n";
   69:     }
   70:     $temp++;
   71:   }
   72:   return $result;
   73: }
   74: 
   75: sub gradefoils {
   76:   my (@whichopt) = @_;
   77:   my $result='';
   78:   my $x;
   79:   my $y;
   80:   my $result;
   81:   my $id=$Apache::inputtags::response['-1'];
   82:   my $temp=1;
   83:   foreach my $name (@whichopt) {
   84:     $x=$ENV{"form.HWVAL_$id:$temp.x"};
   85:     $y=$ENV{"form.HWVAL_$id:$temp.y"};
   86:     &Apache::lonxml::debug("Got a x of $x and a y of $y for $name");
   87:     my @areas = @{ $Apache::response::foilgroup{"$name.area"} };
   88:     my $grade="INCORRECT";
   89:     foreach my $area (@areas) {
   90:       &Apache::lonxml::debug("Area is $area for $name");
   91:       $area =~ m/([a-z]*):/;
   92:       &Apache::lonxml::debug("Area of type $1");
   93:       if ($1 eq 'rectangle') {
   94: 	$grade=&grade_rectangle($area,$x,$y);
   95:       } else {
   96: 	&Apache::lonxml::error("Unknown area style $area");
   97:       }
   98:       &Apache::lonxml::debug("Area said $grade");
   99:       if ($grade eq 'APPROX_ANS') { last; }
  100:     }
  101:     &Apache::lonxml::debug("Foil was $grade");
  102:     if ($grade eq 'INCORRECT') { $result= 'INCORRECT'; }
  103:     if (($grade eq 'APPROX_ANS') && ($result ne 'APPROX_ANS')) { $result=$grade; }
  104:     &Apache::lonxml::debug("Question is $result");
  105:     $temp++;
  106:   }
  107:   $Apache::lonhomework::results{"resource.$Apache::inputtags::part.$id.submission"}="$x:$y";
  108:   $Apache::lonhomework::results{"resource.$Apache::inputtags::part.$id.awarddetail"}=$result;
  109:   return '';
  110: }
  111: 
  112: sub end_foilgroup {
  113:   my ($target,$token,$parstack,$parser,$safeeval,$style)=@_;
  114:   my $result='';
  115:   my @whichopt;
  116:   if ($target eq 'web' || $target eq 'grade') {
  117:     my ($count,$max) = &getfoilcounts($parstack,$safeeval);
  118:     if ($count>$max) { $count=$max }
  119:     &Apache::lonxml::debug("Count is $count from $max");
  120:     @whichopt = &whichfoils($max);
  121:   }
  122:   if ($target eq 'web') {
  123:     $result=&displayfoils(@whichopt);
  124:   }
  125:   if ($target eq 'grade') {
  126:     if ( defined $ENV{'form.submitted'}) {
  127:       &gradefoils(@whichopt);
  128:     }
  129:   }
  130:   return $result;
  131: }
  132: 
  133: sub start_conceptgroup {
  134:   $Apache::optionresponse::conceptgroup=1;  
  135:   %Apache::response::conceptgroup={};
  136:   return '';
  137: }
  138: 
  139: sub end_conceptgroup {
  140:   my ($target,$token,$parstack,$parser,$safeeval,$style)=@_;
  141:   $Apache::optionresponse::conceptgroup=0;  
  142:   if ($target eq 'web' || $target eq 'grade') {
  143:     my @names = @{ $Apache::response::conceptgroup{'names'} };
  144:     my $pick=int rand $#names+1;
  145:     my $name=$names[$pick];
  146:     push @{ $Apache::response::foilgroup{'names'} }, $name;
  147:     $Apache::response::foilgroup{"$name.text"} = $Apache::response::conceptgroup{"$name.text"};
  148:     $Apache::response::foilgroup{"$name.image"} = $Apache::response::conceptgroup{"$name.image"};
  149:     push(@{ $Apache::response::foilgroup{"$name.area"} }, @{ $Apache::response::conceptgroup{"$name.area"} });
  150:     my $args;
  151:     if ( $#$parstack > -1 ) { $args=$$parstack[$#$parstack]; }
  152:     my $concept = &Apache::run::run("{$args;".'return $concept}',$safeeval);
  153:     $Apache::response::foilgroup{"$name.concept"} = $concept;
  154:     &Apache::lonxml::debug("Selecting $name in $concept");
  155:   }
  156:   return '';
  157: }
  158: 
  159: $Apache::imageresponse::curname='';
  160: sub start_foil {
  161:   my ($target,$token,$parstack,$parser,$safeeval,$style)=@_;
  162:   if ($target eq 'web' || $target eq 'grade') {
  163:     my $args ='';
  164:     if ( $#$parstack > -1 ) { $args=$$parstack[$#$parstack]; }
  165:     my $name = &Apache::run::run("{$args;".'return $name}',$safeeval);
  166:     if ($name eq '') { $name=$Apache::lonxml::curdepth; }
  167:     push(@{ $Apache::response::foilgroup{'names'} }, $name);
  168:     $Apache::imageresponse::curname=$name;
  169:   }
  170:   return '';
  171: }
  172: 
  173: sub end_foil {
  174:   my ($target,$token,$parstack,$parser,$safeeval,$style)=@_;
  175:   return '';
  176: }
  177: 
  178: sub start_text {
  179:   my ($target,$token,$parstack,$parser,$safeeval,$style)=@_;
  180:   if ($target eq 'web') { &Apache::lonxml::startredirection; }
  181:   return '';
  182: }
  183: 
  184: sub end_text {
  185:   my ($target,$token,$parstack,$parser,$safeeval,$style)=@_;
  186:   if ($target eq 'web') {
  187:     my $name = $Apache::imageresponse::curname;
  188:     $Apache::response::foilgroup{"$name.text"} = &Apache::lonxml::endredirection;
  189:   }
  190:   return '';
  191: }
  192: 
  193: sub start_image {
  194:   my ($target,$token,$parstack,$parser,$safeeval,$style)=@_;
  195:   if ($target eq 'web') { &Apache::lonxml::startredirection; }
  196:   return '';
  197: }
  198: 
  199: sub end_image {
  200:   my ($target,$token,$parstack,$parser,$safeeval,$style)=@_;
  201:   if ($target eq 'web') {
  202:     my $name = $Apache::imageresponse::curname;
  203:     my $image = &Apache::lonxml::endredirection;
  204:     &Apache::lonxml::debug("out is $image");
  205:     $Apache::response::foilgroup{"$name.image"} = $image;
  206:   }
  207:   return '';
  208: }
  209: 
  210: sub start_rectangle {
  211:   my ($target,$token,$parstack,$parser,$safeeval,$style)=@_;
  212:   if ($target eq 'web' || $target eq 'grade') { &Apache::lonxml::startredirection; }
  213:   return '';
  214: }
  215: 
  216: sub grade_rectangle {
  217:   my ($spec,$x,$y) = @_;
  218:   &Apache::lonxml::debug("Spec is $spec");
  219:   $spec=~m/rectangle:\(([0-9]+),([0-9]+)\)\-\(([0-9]+),([0-9]+)\)/;
  220:   my $x1=$1;
  221:   my $y1=$2;
  222:   my $x2=$3;
  223:   my $y2=$4;
  224:   &Apache::lonxml::debug("Point $x1,$y1,$x2,$y2");
  225:   if ($x1 > $x2) { my $temp=$x1;$x1=$x2;$x2=$temp; }
  226:   if ($y1 > $y2) { my $temp=$y1;$y1=$y2;$y2=$temp; }
  227:   if ($x => $x1) { if ($x <= $x2) { if ($y => $y1) { if ($y <= $y2) { return 'APPROX_ANS'; } } } }
  228:   return 'INCORRECT';
  229: }
  230: 
  231: sub end_rectangle {
  232:   my ($target,$token,$parstack,$parser,$safeeval,$style)=@_;
  233:   if ($target eq 'web' || $target eq 'grade') {
  234:     my $name = $Apache::imageresponse::curname;
  235:     my $area = &Apache::lonxml::endredirection;
  236:     &Apache::lonxml::debug("out is $area for $name");
  237:     push @{ $Apache::response::foilgroup{"$name.area"} },"rectangle:$area";
  238:   }
  239:   return '';
  240: }
  241: 1;
  242: __END__
  243: