Return to imageresponse.pm CVS log

Up to [LON-CAPA] / loncom / homework

-<conceptgroup>

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