--- loncom/homework/imageresponse.pm 2003/09/24 19:20:58 1.36 +++ loncom/homework/imageresponse.pm 2003/11/10 23:29:27 1.40 @@ -1,7 +1,7 @@ # The LearningOnline Network with CAPA # image click response style # -# $Id: imageresponse.pm,v 1.36 2003/09/24 19:20:58 albertel Exp $ +# $Id: imageresponse.pm,v 1.40 2003/11/10 23:29:27 albertel Exp $ # # Copyright Michigan State University Board of Trustees # @@ -25,16 +25,14 @@ # # http://www.lon-capa.org/ # -# July,August 2003 H. K. Ng -# #FIXME LATER assumes multiple possible submissions but only one is possible #currently package Apache::imageresponse; -use Apache::randomlylabel; use strict; use Image::Magick; -use GD; +use Apache::randomlylabel; +use Apache::Constants qw(:common :http); BEGIN { &Apache::lonxml::register('Apache::imageresponse',('imageresponse')); @@ -49,6 +47,9 @@ sub start_imageresponse { my $id = &Apache::response::start_response($parstack,$safeeval); if ($target eq 'meta') { $result=&Apache::response::meta_package_write('imageresponse'); + } elsif ($target eq 'analyze') { + my $part_id="$Apache::inputtags::part.$id"; + push (@{ $Apache::lonhomework::analyze{"parts"} },$part_id); } return $result; } @@ -102,6 +103,44 @@ sub whichfoils { return @whichopt; } +sub prep_image { + my ($image)=@_; + my $part=$Apache::inputtags::part; + my $id=$Apache::inputtags::response['-1']; + my $token=$Apache::lonxml::curdepth.'_'.$$; + my $args="BGIMG=".$image; + &Apache::lonxml::debug("args is $args image is $image"); + my ($x,$y)=split(/:/,$Apache::lonhomework::history{"resource.$part.$id.submission"}); + #draws 2 xs on the image at the clicked location + #one in white and then one in red on top of the one in white + if (defined($x) && defined($y)) { + $args.="&LINECOUNT=4"; + my $length = 6; + my $width = 1; + my $extrawidth = 2; + $args.="&LINEW0=".($width+$extrawidth); + $args.="&LINEC0=FFFFFF"; + $args.="&LINEX10=".($x-$length)."&LINEY10=".($y-$length); + $args.="&LINEX20=".($x+$length)."&LINEY20=".($y+$length); + $args.="&LINEW1=".($width+$extrawidth); + $args.="&LINEC1=FFFFFF"; + $args.="&LINEX11=".($x-$length)."&LINEY11=".($y+$length); + $args.="&LINEX21=".($x+$length)."&LINEY21=".($y-$length); + $args.="&LINEW2=$width"; + $args.="&LINEC2=FF0000"; + $args.="&LINEX12=".($x-$length)."&LINEY12=".($y-$length); + $args.="&LINEX22=".($x+$length)."&LINEY22=".($y+$length); + $args.="&LINEW3=$width"; + $args.="&LINEC3=FF0000"; + $args.="&LINEX13=".($x-$length)."&LINEY13=".($y+$length); + $args.="&LINEX23=".($x+$length)."&LINEY23=".($y-$length); + } + &Apache::lonxml::debug("args is $args image is $image"); + &Apache::lonnet::appenv(("imagerequest.$token"=> + &Apache::lonnet::escape($args))); + return $token; +} + sub displayfoils { my ($target,@whichopt) = @_; my $result =''; @@ -113,17 +152,29 @@ sub displayfoils { if ($target eq 'tex') {$result.="\\vskip 0 mm \n";} else {$result.="
\n";} my $image=$Apache::response::foilgroup{"$name.image"}; &Apache::lonxml::debug("image is $image"); + if ( $target eq 'web' && $image !~ /^http:/ ) { + $image=&Apache::lonnet::filelocation($Apache::lonxml::pwd[-1],$image); + if (&Apache::lonnet::repcopy($image) ne OK) { + $image='/home/httpd/html/adm/lonKaputt/lonlogo_broken.gif'; + } + } + &Apache::lonxml::debug("image is $image"); if ( &Apache::response::show_answer() ) { if ($target eq 'tex') { $result.=$Apache::response::foilgroup{"$name.image"}."\\vskip 0 mm \n"; } else { - $result.="
\n"; + my $token=&prep_image($image); + $result.="
\n"; } } else { if ($target eq 'tex') { $result.=$Apache::response::foilgroup{"$name.image"}."\\vskip 0 mm \n"; } else { - $result.="
\n"; + my $id=$Apache::inputtags::response['-1']; + my $token=&prep_image($image); + my $temp=1; + $result.="
\n"; } } $temp++; @@ -174,7 +225,8 @@ sub end_foilgroup { my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_; my $result=''; my @whichopt; - if ($target eq 'web' || $target eq 'grade' || $target eq 'tex') { + if ($target eq 'web' || $target eq 'grade' || $target eq 'tex' || + $target eq 'analyze') { my ($count,$max) = &getfoilcounts($parstack,$safeeval); if ($count>$max) { $count=$max } &Apache::lonxml::debug("Count is $count from $max"); @@ -183,7 +235,10 @@ sub end_foilgroup { $result=&displayfoils($target,@whichopt); } elsif ($target eq 'grade') { if ( defined $ENV{'form.submitted'}) { &gradefoils(@whichopt); } - } + } elsif ( $target eq 'analyze') { + &Apache::response::analyze_store_foilgroup(\@whichopt, + ['text','image','area']); + } } elsif ($target eq 'edit') { $result=&Apache::edit::end_table(); } @@ -200,21 +255,12 @@ sub end_conceptgroup { my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_; $Apache::imageresponse::conceptgroup=0; my $result; - if ($target eq 'web' || $target eq 'grade' || $target eq 'tex') { - if (defined(@{ $Apache::response::conceptgroup{'names'} })) { - my @names = @{ $Apache::response::conceptgroup{'names'} }; - my $pick=int(&Math::Random::random_uniform() * ($#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"); - } - } + if ($target eq 'web' || $target eq 'grade' || $target eq 'tex' || + $target eq 'analyze') { + &Apache::response::pick_foil_for_concept($target, + ['area','text','image'], + \%Apache::hint::image, + $parstack,$safeeval); } elsif ($target eq 'edit') { $result=&Apache::edit::end_table(); } @@ -234,7 +280,8 @@ sub insert_foil { $Apache::imageresponse::curname=''; sub start_foil { my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_; - if ($target eq 'web' || $target eq 'grade' || $target eq 'tex') { + if ($target eq 'web' || $target eq 'grade' || $target eq 'tex' || + $target eq 'analyze') { my $name = &Apache::lonxml::get_param('name',$parstack,$safeeval); if ($name eq '') { $name=$Apache::lonxml::curdepth; } if ( $Apache::imageresponse::conceptgroup @@ -260,7 +307,7 @@ sub end_foil { sub start_text { my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_; my $result=''; - if ($target eq 'web' || $target eq 'tex') { + if ($target eq 'web' || $target eq 'tex' || $target eq 'analyze') { &Apache::lonxml::startredirection; } elsif ($target eq 'edit') { my $descr=&Apache::lonxml::get_all_text('/text',$parser); @@ -268,9 +315,7 @@ sub start_text { &Apache::edit::editfield($token->[1],$descr,'Text',60,2). &Apache::edit::end_row(); } elsif ($target eq "modified") { - my $descr=&Apache::lonxml::get_all_text('/text',$parser); - $result=$token->[4].&Apache::edit::modifiedfield($token); - &Apache::lonxml::debug($result); + $result=$token->[4].&Apache::edit::modifiedfield('/text',$parser); } return $result; } @@ -278,7 +323,7 @@ sub start_text { sub end_text { my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_; my $result; - if ($target eq 'web' || $target eq 'tex') { + if ($target eq 'web' || $target eq 'tex' || $target eq 'analyze') { my $name = $Apache::imageresponse::curname; if ( $Apache::imageresponse::conceptgroup && !&Apache::response::showallfoils() ) { @@ -295,7 +340,7 @@ sub end_text { sub start_image { my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_; my $result=''; - if ($target eq 'web' || $target eq 'tex') { + if ($target eq 'web' || $target eq 'tex' || $target eq 'analyze') { &Apache::lonxml::startredirection; } elsif ($target eq 'edit') { my $bgimg=&Apache::lonxml::get_all_text('/image',$parser); @@ -308,9 +353,7 @@ sub start_image { $result.=&Apache::edit::search(undef,'textnode'). &Apache::edit::end_row(); } elsif ($target eq "modified") { - my $bgimg=&Apache::lonxml::get_all_text('/image',$parser); - $result=$token->[4].&Apache::edit::modifiedfield($token); - &Apache::lonxml::debug($result); + $result=$token->[4].&Apache::edit::modifiedfield('/image',$parser); } return $result; } @@ -322,36 +365,14 @@ sub end_image { if ($target eq 'web') { my $image = &Apache::lonxml::endredirection; &Apache::lonxml::debug("original image is $image"); - my $id=$Apache::inputtags::response['-1']; - my $temp=1; - my $x=$ENV{"form.HWVAL_$id:$temp.x"}; - my $y=$ENV{"form.HWVAL_$id:$temp.y"}; - if (defined ($x) && defined ($y)) { - &Apache::lonxml::debug("x and y defined as $x,$y"); - my $currentImage = &Apache::randomlylabel::get_image('/home/httpd/html'.$image,1); - if (! defined($currentImage)) { - &Apache::lonnet::logthis('Unable to create image object for '.$image); - return ''; - } - my $red; - if (!($red = $currentImage->colorResolve(255,0,0))) { - $red = $currentImage->colorClosestHWB(255,0,0); - } - my $length = 6; - $currentImage->line($x-$length,$y-$length,$x+$length,$y+$length,$red); - $currentImage->line($x-$length,$y+$length,$x+$length,$y-$length,$red); - - my ($nameWOext) = ($image =~ /^.*\/(.*)\..*$/); - &Apache::lonxml::debug("graph name $nameWOext"); - my $webImageName = "/prtspool/$ENV{'user.name'}_$ENV{'user.domain'}_". - $nameWOext.'.png'; #needs to be more random or specific - my $newImageName = '/home/httpd'.$webImageName; - - my $imgfh = Apache::File->new('>'.$newImageName); - print $imgfh $currentImage->png; - $image = $webImageName; + if ( $Apache::imageresponse::conceptgroup + && !&Apache::response::showallfoils()) { + $Apache::response::conceptgroup{"$name.image"} = $image; + } else { + $Apache::response::foilgroup{"$name.image"} = $image; } - &Apache::lonxml::debug("out image is $image"); + } elsif ($target eq 'analyze') { + my $image = &Apache::lonxml::endredirection; if ( $Apache::imageresponse::conceptgroup && !&Apache::response::showallfoils()) { $Apache::response::conceptgroup{"$name.image"} = $image; @@ -439,7 +460,8 @@ sub end_image { sub start_rectangle { my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_; my $result=''; - if ($target eq 'web' || $target eq 'grade' || $target eq 'tex') { + if ($target eq 'web' || $target eq 'grade' || $target eq 'tex' || + $target eq 'analyze') { &Apache::lonxml::startredirection; } elsif ($target eq 'edit') { my $coords=&Apache::lonxml::get_all_text('/rectangle',$parser); @@ -448,9 +470,7 @@ sub start_rectangle { &Apache::edit::entercoordpair(undef,'textnode'). &Apache::edit::end_row(); } elsif ($target eq "modified") { - my $coords=&Apache::lonxml::get_all_text('/rectangle',$parser); - $result=$token->[4].&Apache::edit::modifiedfield($token); - &Apache::lonxml::debug($result); + $result=$token->[4].&Apache::edit::modifiedfield('/rectangle',$parser); } return $result; } @@ -475,7 +495,8 @@ sub grade_rectangle { sub end_rectangle { my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_; my $result; - if ($target eq 'web' || $target eq 'grade' || $target eq 'tex') { + if ($target eq 'web' || $target eq 'grade' || $target eq 'tex' || + $target eq 'analyze') { my $name = $Apache::imageresponse::curname; my $area = &Apache::lonxml::endredirection; &Apache::lonxml::debug("out is $area for $name");