--- loncom/homework/imageresponse.pm 2001/03/01 01:19:50 1.4 +++ loncom/homework/imageresponse.pm 2002/01/17 12:23:31 1.16 @@ -1,61 +1,85 @@ # The LearningOnline Network with CAPA -# iimage click response style +# image click response style +# +# $Id: imageresponse.pm,v 1.16 2002/01/17 12:23:31 harris41 Exp $ +# +# Copyright Michigan State University Board of Trustees +# +# This file is part of the LearningOnline Network with CAPA (LON-CAPA). +# +# LON-CAPA is free software; you can redistribute it and/or modify +# it under the terms of the GNU General Public License as published by +# the Free Software Foundation; either version 2 of the License, or +# (at your option) any later version. +# +# LON-CAPA is distributed in the hope that it will be useful, +# but WITHOUT ANY WARRANTY; without even the implied warranty of +# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +# GNU General Public License for more details. +# +# You should have received a copy of the GNU General Public License +# along with LON-CAPA; if not, write to the Free Software +# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA +# +# /home/httpd/html/adm/gpl.txt +# +# http://www.lon-capa.org/ +# #FIXME assumes multiple possbile submissions but only one is possible currently package Apache::imageresponse; use strict; -sub BEGIN { +BEGIN { &Apache::lonxml::register('Apache::imageresponse',('imageresponse')); } sub start_imageresponse { - my ($target,$token,$parstack,$parser,$safeeval,$style)=@_; + my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_; + my $result; #when in a radiobutton response use these - &Apache::lonxml::register('Apache::imageresponse',('foilgroup','foil','text','image','rectangle')); + &Apache::lonxml::register('Apache::imageresponse',('foilgroup','foil','text','image','rectangle','conceptgroup')); + push (@Apache::lonxml::namespace,'imageresponse'); my $id = &Apache::response::start_response($parstack,$safeeval); - return ''; + if ($target eq 'meta') { + $result=&Apache::response::meta_package_write('imageresponse'); + } + return $result; } sub end_imageresponse { &Apache::response::end_response; + pop @Apache::lonxml::namespace; + &Apache::lonxml::deregister('Apache::imageresponse',('foilgroup','foil','text','image','rectangle','conceptgroup')); return ''; } %Apache::response::foilgroup={}; sub start_foilgroup { %Apache::response::foilgroup={}; - $Apache::optionresponse::conceptgroup=0; - &setrandomnumber(); - return ''; -} - -sub setrandomnumber { - my $rndseed=&Apache::lonnet::rndseed(); - $rndseed=unpack("%32i",$rndseed); - $rndseed=$rndseed - +&Apache::lonnet::numval($Apache::inputtags::part) - +&Apache::lonnet::numval($Apache::inputtags::response['-1']); - srand($rndseed); + $Apache::imageresponse::conceptgroup=0; + &Apache::response::setrandomnumber(); return ''; } sub getfoilcounts { my ($parstack,$safeeval)=@_; - my $rrargs =''; - if ( $#$parstack > 0 ) { $rrargs=$$parstack['-2']; } - my $max = &Apache::run::run("{$rrargs;".'return $max}',$safeeval); - my $count = $#{ $Apache::response::foilgroup{'names'} }; + + my $max = &Apache::lonxml::get_param('max',$parstack,$safeeval,'-2'); + # +1 since instructors will count from 1 + my $count = $#{ $Apache::response::foilgroup{'names'} }+1; return ($count,$max); } sub whichfoils { my ($max)=@_; + if (!defined(@{ $Apache::response::foilgroup{'names'} })) { return; } my @names = @{ $Apache::response::foilgroup{'names'} }; my @whichopt =(); while ((($#whichopt+1) < $max) && ($#names > -1)) { - my $aopt=int rand $#names; + &Apache::lonxml::debug("Have $#whichopt max is $max"); + my $aopt=int(rand($#names+1)); &Apache::lonxml::debug("From $#names elms, picking $aopt"); $aopt=splice(@names,$aopt,1); &Apache::lonxml::debug("Picked $aopt"); @@ -94,25 +118,27 @@ sub gradefoils { $x=$ENV{"form.HWVAL_$id:$temp.x"}; $y=$ENV{"form.HWVAL_$id:$temp.y"}; &Apache::lonxml::debug("Got a x of $x and a y of $y for $name"); - my @areas = @{ $Apache::response::foilgroup{"$name.area"} }; - my $grade="INCORRECT"; - foreach my $area (@areas) { - &Apache::lonxml::debug("Area is $area for $name"); - $area =~ m/([a-z]*):/; - &Apache::lonxml::debug("Area of type $1"); - if ($1 eq 'rectangle') { - $grade=&grade_rectangle($area,$x,$y); - } else { - &Apache::lonxml::error("Unknown area style $area"); + if (defined(@{ $Apache::response::foilgroup{"$name.area"} })) { + my @areas = @{ $Apache::response::foilgroup{"$name.area"} }; + my $grade="INCORRECT"; + foreach my $area (@areas) { + &Apache::lonxml::debug("Area is $area for $name"); + $area =~ m/([a-z]*):/; + &Apache::lonxml::debug("Area of type $1"); + if ($1 eq 'rectangle') { + $grade=&grade_rectangle($area,$x,$y); + } else { + &Apache::lonxml::error("Unknown area style $area"); + } + &Apache::lonxml::debug("Area said $grade"); + if ($grade eq 'APPROX_ANS') { last; } } - &Apache::lonxml::debug("Area said $grade"); - if ($grade eq 'APPROX_ANS') { last; } + &Apache::lonxml::debug("Foil was $grade"); + if ($grade eq 'INCORRECT') { $result= 'INCORRECT'; } + if (($grade eq 'APPROX_ANS') && ($result ne 'APPROX_ANS')) { $result=$grade; } + &Apache::lonxml::debug("Question is $result"); + $temp++; } - &Apache::lonxml::debug("Foil was $grade"); - if ($grade eq 'INCORRECT') { $result= 'INCORRECT'; } - if (($grade eq 'APPROX_ANS') && ($result ne 'APPROX_ANS')) { $result=$grade; } - &Apache::lonxml::debug("Question is $result"); - $temp++; } $Apache::lonhomework::results{"resource.$Apache::inputtags::part.$id.submission"}="$x:$y"; $Apache::lonhomework::results{"resource.$Apache::inputtags::part.$id.awarddetail"}=$result; @@ -120,7 +146,7 @@ sub gradefoils { } sub end_foilgroup { - my ($target,$token,$parstack,$parser,$safeeval,$style)=@_; + my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_; my $result=''; my @whichopt; if ($target eq 'web' || $target eq 'grade') { @@ -141,84 +167,96 @@ sub end_foilgroup { } sub start_conceptgroup { - $Apache::optionresponse::conceptgroup=1; + $Apache::imageresponse::conceptgroup=1; %Apache::response::conceptgroup={}; return ''; } sub end_conceptgroup { - my ($target,$token,$parstack,$parser,$safeeval,$style)=@_; - $Apache::optionresponse::conceptgroup=0; + my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_; + $Apache::imageresponse::conceptgroup=0; if ($target eq 'web' || $target eq 'grade') { - my @names = @{ $Apache::response::conceptgroup{'names'} }; - my $pick=int rand $#names+1; - my $name=$names[$pick]; - push @{ $Apache::response::foilgroup{'names'} }, $name; - $Apache::response::foilgroup{"$name.text"} = $Apache::response::conceptgroup{"$name.text"}; - $Apache::response::foilgroup{"$name.image"} = $Apache::response::conceptgroup{"$name.image"}; - push(@{ $Apache::response::foilgroup{"$name.area"} }, @{ $Apache::response::conceptgroup{"$name.area"} }); - my $args; - if ( $#$parstack > -1 ) { $args=$$parstack[$#$parstack]; } - my $concept = &Apache::run::run("{$args;".'return $concept}',$safeeval); - $Apache::response::foilgroup{"$name.concept"} = $concept; - &Apache::lonxml::debug("Selecting $name in $concept"); + if (defined(@{ $Apache::response::conceptgroup{'names'} })) { + my @names = @{ $Apache::response::conceptgroup{'names'} }; + my $pick=int(rand($#names+1)); + my $name=$names[$pick]; + if (defined(@{ $Apache::response::conceptgroup{"$name.area"} })) { + push @{ $Apache::response::foilgroup{'names'} }, $name; + $Apache::response::foilgroup{"$name.text"} = $Apache::response::conceptgroup{"$name.text"}; + $Apache::response::foilgroup{"$name.image"} = $Apache::response::conceptgroup{"$name.image"}; + push(@{ $Apache::response::foilgroup{"$name.area"} }, @{ $Apache::response::conceptgroup{"$name.area"} }); + my $concept = &Apache::lonxml::get_param('concept',$parstack,$safeeval); + $Apache::response::foilgroup{"$name.concept"} = $concept; + &Apache::lonxml::debug("Selecting $name in $concept"); + } + } } return ''; } $Apache::imageresponse::curname=''; sub start_foil { - my ($target,$token,$parstack,$parser,$safeeval,$style)=@_; + my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_; if ($target eq 'web' || $target eq 'grade') { - my $args =''; - if ( $#$parstack > -1 ) { $args=$$parstack[$#$parstack]; } - my $name = &Apache::run::run("{$args;".'return $name}',$safeeval); + my $name = &Apache::lonxml::get_param('name',$parstack,$safeeval); if ($name eq '') { $name=$Apache::lonxml::curdepth; } - push(@{ $Apache::response::foilgroup{'names'} }, $name); + if ( $Apache::imageresponse::conceptgroup ) { + push(@{ $Apache::response::conceptgroup{'names'} }, $name); + } else { + push(@{ $Apache::response::foilgroup{'names'} }, $name); + } $Apache::imageresponse::curname=$name; } return ''; } sub end_foil { - my ($target,$token,$parstack,$parser,$safeeval,$style)=@_; + my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_; return ''; } sub start_text { - my ($target,$token,$parstack,$parser,$safeeval,$style)=@_; + my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_; if ($target eq 'web') { &Apache::lonxml::startredirection; } return ''; } sub end_text { - my ($target,$token,$parstack,$parser,$safeeval,$style)=@_; + my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_; if ($target eq 'web') { my $name = $Apache::imageresponse::curname; - $Apache::response::foilgroup{"$name.text"} = &Apache::lonxml::endredirection; + if ( $Apache::imageresponse::conceptgroup ) { + $Apache::response::conceptgroup{"$name.text"} = &Apache::lonxml::endredirection; + } else { + $Apache::response::foilgroup{"$name.text"} = &Apache::lonxml::endredirection; + } } return ''; } sub start_image { - my ($target,$token,$parstack,$parser,$safeeval,$style)=@_; + my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_; if ($target eq 'web') { &Apache::lonxml::startredirection; } return ''; } sub end_image { - my ($target,$token,$parstack,$parser,$safeeval,$style)=@_; + my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_; if ($target eq 'web') { my $name = $Apache::imageresponse::curname; my $image = &Apache::lonxml::endredirection; &Apache::lonxml::debug("out is $image"); - $Apache::response::foilgroup{"$name.image"} = $image; + if ( $Apache::imageresponse::conceptgroup ) { + $Apache::response::conceptgroup{"$name.image"} = $image; + } else { + $Apache::response::foilgroup{"$name.image"} = $image; + } } return ''; } sub start_rectangle { - my ($target,$token,$parstack,$parser,$safeeval,$style)=@_; + my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_; if ($target eq 'web' || $target eq 'grade') { &Apache::lonxml::startredirection; } return ''; } @@ -239,12 +277,16 @@ sub grade_rectangle { } sub end_rectangle { - my ($target,$token,$parstack,$parser,$safeeval,$style)=@_; + my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_; if ($target eq 'web' || $target eq 'grade') { my $name = $Apache::imageresponse::curname; my $area = &Apache::lonxml::endredirection; &Apache::lonxml::debug("out is $area for $name"); - push @{ $Apache::response::foilgroup{"$name.area"} },"rectangle:$area"; + if ( $Apache::imageresponse::conceptgroup ) { + push @{ $Apache::response::conceptgroup{"$name.area"} },"rectangle:$area"; + } else { + push @{ $Apache::response::foilgroup{"$name.area"} },"rectangle:$area"; + } } return ''; }