Return to imageresponse.pm CVS log

Up to [LON-CAPA] / loncom / homework

-added package notation for all remaining response styles

    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:   my $result;
   16:   #when in a radiobutton response use these
   17:   &Apache::lonxml::register('Apache::imageresponse',('foilgroup','foil','text','image','rectangle','conceptgroup'));
   18:   push (@Apache::lonxml::namespace,'imageresponse');
   19:   my $id = &Apache::response::start_response($parstack,$safeeval);
   20:   if ($target eq 'meta') {
   21:     $result=&Apache::response::meta_package_write('imageresponse');
   22:   }
   23:   return $result;
   24: }
   25: 
   26: sub end_imageresponse {
   27:   &Apache::response::end_response;
   28:   pop @Apache::lonxml::namespace;
   29:   return '';
   30: }
   31: 
   32: %Apache::response::foilgroup={};
   33: sub start_foilgroup {
   34:   %Apache::response::foilgroup={};
   35:   $Apache::imageresponse::conceptgroup=0;
   36:   &Apache::response::setrandomnumber();
   37:   return '';
   38: }
   39: 
   40: sub getfoilcounts {
   41:   my ($parstack,$safeeval)=@_;
   42: 
   43:   my $max = &Apache::lonxml::get_param('max',$parstack,$safeeval,'-2');
   44:   # +1 since instructors will count from 1
   45:   my $count = $#{ $Apache::response::foilgroup{'names'} }+1;
   46:   return ($count,$max);
   47: }
   48: 
   49: sub whichfoils {
   50:   my ($max)=@_;
   51:   if (!defined(@{ $Apache::response::foilgroup{'names'} })) { return; }
   52:   my @names = @{ $Apache::response::foilgroup{'names'} };
   53:   my @whichopt =();
   54:   while ((($#whichopt+1) < $max) && ($#names > -1)) {
   55:     &Apache::lonxml::debug("Have $#whichopt max is $max");
   56:     my $aopt=int(rand($#names+1));
   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:     if (defined(@{ $Apache::response::foilgroup{"$name.area"} })) {
   96:       my @areas = @{ $Apache::response::foilgroup{"$name.area"} };
   97:       my $grade="INCORRECT";
   98:       foreach my $area (@areas) {
   99: 	&Apache::lonxml::debug("Area is $area for $name");
  100: 	$area =~ m/([a-z]*):/;
  101: 	&Apache::lonxml::debug("Area of type $1");
  102: 	if ($1 eq 'rectangle') {
  103: 	  $grade=&grade_rectangle($area,$x,$y);
  104: 	} else {
  105: 	  &Apache::lonxml::error("Unknown area style $area");
  106: 	}
  107: 	&Apache::lonxml::debug("Area said $grade");
  108: 	if ($grade eq 'APPROX_ANS') { last; }
  109:       }
  110:       &Apache::lonxml::debug("Foil was $grade");
  111:       if ($grade eq 'INCORRECT') { $result= 'INCORRECT'; }
  112:       if (($grade eq 'APPROX_ANS') && ($result ne 'APPROX_ANS')) { $result=$grade; }
  113:       &Apache::lonxml::debug("Question is $result");
  114:       $temp++;
  115:     }
  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,$tagstack,$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::imageresponse::conceptgroup=1;
  145:   %Apache::response::conceptgroup={};
  146:   return '';
  147: }
  148: 
  149: sub end_conceptgroup {
  150:   my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_;
  151:   $Apache::imageresponse::conceptgroup=0;  
  152:   if ($target eq 'web' || $target eq 'grade') {
  153:     if (defined(@{ $Apache::response::conceptgroup{'names'} })) {
  154:       my @names = @{ $Apache::response::conceptgroup{'names'} };
  155:       my $pick=int(rand($#names+1));
  156:       my $name=$names[$pick];
  157:       if (defined(@{ $Apache::response::conceptgroup{"$name.area"} })) {
  158: 	push @{ $Apache::response::foilgroup{'names'} }, $name;
  159: 	$Apache::response::foilgroup{"$name.text"} = $Apache::response::conceptgroup{"$name.text"};
  160: 	$Apache::response::foilgroup{"$name.image"} = $Apache::response::conceptgroup{"$name.image"};
  161: 	push(@{ $Apache::response::foilgroup{"$name.area"} }, @{ $Apache::response::conceptgroup{"$name.area"} });
  162: 	my $concept = &Apache::lonxml::get_param('concept',$parstack,$safeeval);
  163: 	$Apache::response::foilgroup{"$name.concept"} = $concept;
  164: 	&Apache::lonxml::debug("Selecting $name in $concept");
  165:       }
  166:     }
  167:   }
  168:   return '';
  169: }
  170: 
  171: $Apache::imageresponse::curname='';
  172: sub start_foil {
  173:   my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_;
  174:   if ($target eq 'web' || $target eq 'grade') {
  175:     my $name = &Apache::lonxml::get_param('name',$parstack,$safeeval);
  176:     if ($name eq '') { $name=$Apache::lonxml::curdepth; }
  177:     if ( $Apache::imageresponse::conceptgroup ) {
  178:       push(@{ $Apache::response::conceptgroup{'names'} }, $name);
  179:     } else {
  180:       push(@{ $Apache::response::foilgroup{'names'} }, $name);
  181:     }
  182:     $Apache::imageresponse::curname=$name;
  183:   }
  184:   return '';
  185: }
  186: 
  187: sub end_foil {
  188:   my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_;
  189:   return '';
  190: }
  191: 
  192: sub start_text {
  193:   my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_;
  194:   if ($target eq 'web') { &Apache::lonxml::startredirection; }
  195:   return '';
  196: }
  197: 
  198: sub end_text {
  199:   my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_;
  200:   if ($target eq 'web') {
  201:     my $name = $Apache::imageresponse::curname;
  202:     if ( $Apache::imageresponse::conceptgroup ) {
  203:       $Apache::response::conceptgroup{"$name.text"} = &Apache::lonxml::endredirection;
  204:     } else {
  205:       $Apache::response::foilgroup{"$name.text"} = &Apache::lonxml::endredirection;
  206:     }
  207:   }
  208:   return '';
  209: }
  210: 
  211: sub start_image {
  212:   my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_;
  213:   if ($target eq 'web') { &Apache::lonxml::startredirection; }
  214:   return '';
  215: }
  216: 
  217: sub end_image {
  218:   my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_;
  219:   if ($target eq 'web') {
  220:     my $name = $Apache::imageresponse::curname;
  221:     my $image = &Apache::lonxml::endredirection;
  222:     &Apache::lonxml::debug("out is $image");
  223:     if ( $Apache::imageresponse::conceptgroup ) {
  224:       $Apache::response::conceptgroup{"$name.image"} = $image;
  225:     } else {
  226:       $Apache::response::foilgroup{"$name.image"} = $image;
  227:     }
  228:   }
  229:   return '';
  230: }
  231: 
  232: sub start_rectangle {
  233:   my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_;
  234:   if ($target eq 'web' || $target eq 'grade') { &Apache::lonxml::startredirection; }
  235:   return '';
  236: }
  237: 
  238: sub grade_rectangle {
  239:   my ($spec,$x,$y) = @_;
  240:   &Apache::lonxml::debug("Spec is $spec");
  241:   $spec=~m/rectangle:\(([0-9]+),([0-9]+)\)\-\(([0-9]+),([0-9]+)\)/;
  242:   my $x1=$1;
  243:   my $y1=$2;
  244:   my $x2=$3;
  245:   my $y2=$4;
  246:   &Apache::lonxml::debug("Point $x1,$y1,$x2,$y2");
  247:   if ($x1 > $x2) { my $temp=$x1;$x1=$x2;$x2=$temp; }
  248:   if ($y1 > $y2) { my $temp=$y1;$y1=$y2;$y2=$temp; }
  249:   if ($x => $x1) { if ($x <= $x2) { if ($y => $y1) { if ($y <= $y2) { return 'APPROX_ANS'; } } } }
  250:   return 'INCORRECT';
  251: }
  252: 
  253: sub end_rectangle {
  254:   my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_;
  255:   if ($target eq 'web' || $target eq 'grade') {
  256:     my $name = $Apache::imageresponse::curname;
  257:     my $area = &Apache::lonxml::endredirection;
  258:     &Apache::lonxml::debug("out is $area for $name");
  259:     if ( $Apache::imageresponse::conceptgroup ) {
  260:       push @{ $Apache::response::conceptgroup{"$name.area"} },"rectangle:$area";
  261:     } else {
  262:       push @{ $Apache::response::foilgroup{"$name.area"} },"rectangle:$area";
  263:     }
  264:   }
  265:   return '';
  266: }
  267: 1;
  268: __END__
  269: