Diff for /loncom/homework/imageresponse.pm between versions 1.39 and 1.40

version 1.39, 2003/10/30 20:52:54 version 1.40, 2003/11/10 23:29:27
Line 29 Line 29
 #currently  #currently
   
 package Apache::imageresponse;  package Apache::imageresponse;
 use Apache::randomlylabel;  
 use strict;  use strict;
 use Image::Magick;  use Image::Magick;
 use GD;  use Apache::randomlylabel;
   use Apache::Constants qw(:common :http);
   
 BEGIN {  BEGIN {
     &Apache::lonxml::register('Apache::imageresponse',('imageresponse'));      &Apache::lonxml::register('Apache::imageresponse',('imageresponse'));
Line 103  sub whichfoils { Line 103  sub whichfoils {
     return @whichopt;      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 {  sub displayfoils {
     my ($target,@whichopt) = @_;      my ($target,@whichopt) = @_;
     my $result ='';      my $result ='';
Line 114  sub displayfoils { Line 152  sub displayfoils {
  if ($target eq 'tex') {$result.="\\vskip 0 mm \n";} else {$result.="<br />\n";}   if ($target eq 'tex') {$result.="\\vskip 0 mm \n";} else {$result.="<br />\n";}
  my $image=$Apache::response::foilgroup{"$name.image"};   my $image=$Apache::response::foilgroup{"$name.image"};
  &Apache::lonxml::debug("image is $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 ( &Apache::response::show_answer() ) {
     if ($target eq 'tex') {      if ($target eq 'tex') {
  $result.=$Apache::response::foilgroup{"$name.image"}."\\vskip 0 mm \n";   $result.=$Apache::response::foilgroup{"$name.image"}."\\vskip 0 mm \n";
     } else {      } else {
  $result.="<img src=\"$image\"/> <br />\n";   my $token=&prep_image($image);
    $result.="<img src=\"/adm/randomlabel.png?token=$token\" /><br />\n";
     }      }
  } else {   } else {
     if ($target eq 'tex') {      if ($target eq 'tex') {
  $result.=$Apache::response::foilgroup{"$name.image"}."\\vskip 0 mm \n";   $result.=$Apache::response::foilgroup{"$name.image"}."\\vskip 0 mm \n";
     } else {      } else {
  $result.="<input type=\"image\" name=\"HWVAL_$Apache::inputtags::response['-1']:$temp\" src=\"$image\"/> <br />\n";   my $id=$Apache::inputtags::response['-1'];
    my $token=&prep_image($image);
    my $temp=1;
    $result.="<input type=\"image\" name=\"HWVAL_$id:$temp\" ".
       "src=\"/adm/randomlabel.png?token=$token\" /><br />\n";
     }      }
  }   }
  $temp++;   $temp++;
Line 315  sub end_image { Line 365  sub end_image {
     if ($target eq 'web') {      if ($target eq 'web') {
  my $image = &Apache::lonxml::endredirection;   my $image = &Apache::lonxml::endredirection;
  &Apache::lonxml::debug("original image is $image");   &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;  
  }  
  &Apache::lonxml::debug("out image is $image");  
  if ( $Apache::imageresponse::conceptgroup   if ( $Apache::imageresponse::conceptgroup
      && !&Apache::response::showallfoils()) {       && !&Apache::response::showallfoils()) {
     $Apache::response::conceptgroup{"$name.image"} = $image;      $Apache::response::conceptgroup{"$name.image"} = $image;

Removed from v.1.39  
changed lines
  Added in v.1.40


FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>