Return to imageresponse.pm CVS log

Up to [LON-CAPA] / loncom / homework

- works, in the stupid simple way

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