Return to imageresponse.pm CVS log

Up to [LON-CAPA] / loncom / homework

- changes to allow tag namespaces

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