Return to imageresponse.pm CVS log

Up to [LON-CAPA] / loncom / homework

-re asserting my indent style

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