[BACK]Return to imageresponse.pm CVS log [TXT] [DIR] Up to [LON-CAPA] / loncom / homework

Diff for /loncom/homework/imageresponse.pm between versions 1.36 and 1.42.2.1

version 1.36, 2003/09/24 19:20:58 version 1.42.2.1, 2004/01/15 22:25:31
Line 25 Line 25
 #  #
 # http://www.lon-capa.org/  # http://www.lon-capa.org/
 #  #
 # July,August 2003 H. K. Ng  
 #  
 #FIXME LATER assumes multiple possible submissions but only one is possible   #FIXME LATER assumes multiple possible submissions but only one is possible 
 #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 49  sub start_imageresponse { Line 47  sub start_imageresponse {
     my $id = &Apache::response::start_response($parstack,$safeeval);      my $id = &Apache::response::start_response($parstack,$safeeval);
     if ($target eq 'meta') {      if ($target eq 'meta') {
  $result=&Apache::response::meta_package_write('imageresponse');   $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;      return $result;
 }  }
Line 102  sub whichfoils { Line 103  sub whichfoils {
     return @whichopt;      return @whichopt;
 }  }
   
   sub prep_image {
       my ($image,$mode,$name)=@_;
       my $part=$Apache::inputtags::part;
       my $respid=$Apache::inputtags::response['-1'];
       my $id=&Apache::loncommon::get_cgi_id();
       my %x;
       $x{"cgi.$id.BGIMG"}=$image;
       my ($x,$y)=split(/:/,$Apache::lonhomework::history{"resource.$part.$respid.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)) {
    $x{"cgi.$id.LINECOUNT"}=4;
    my $length = 6;
    my $width = 1;
    my $extrawidth = 2;
    $x{"cgi.$id.LINE0"}=
       join(':',(($x-$length),($y-$length),($x+$length),($y+$length),
         "FFFFFF",($width+$extrawidth)));
    $x{"cgi.$id.LINE1"}=
       join(':',(($x-$length),($y+$length),($x+$length),($y-$length),
         "FFFFFF",($width+$extrawidth)));
    $x{"cgi.$id.LINE2"}=
       join(':',(($x-$length),($y-$length),($x+$length),($y+$length),
         "FF0000",($width)));
    $x{"cgi.$id.LINE3"}=
       join(':',(($x-$length),($y+$length),($x+$length),($y-$length),
         "FF0000",($width)));
       }
       if ($mode eq 'answer') {
    my $width = 1;
    my $extrawidth = 2;
    my @areas = @{ $Apache::response::foilgroup{"$name.area"} };
    foreach my $area (@areas) {
       my ($x1,$y1,$x2,$y2)=
    ($area=~m/rectangle:\(([0-9]+),([0-9]+)\)\-\(([0-9]+),([0-9]+)\)/);
       my $i=$x{"cgi.$id.BOXCOUNT"}++;
       $x{"cgi.$id.BOX$i"}=join(':',($x1,$y1,$x2,$y2,"FFFFFF",
     ($width+$extrawidth)));
       $i=$x{"cgi.$id.BOXCOUNT"}++;
       $x{"cgi.$id.BOX$i"}=join(':',($x1,$y1,$x2,$y2,"00FF00",$width));
    }
       }
       &Apache::lonnet::appenv(%x);
       return $id;
   }
   
 sub displayfoils {  sub displayfoils {
     my ($target,@whichopt) = @_;      my ($target,@whichopt) = @_;
     my $result ='';      my $result ='';
Line 113  sub displayfoils { Line 160  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,'answer',$name);
    $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 174  sub end_foilgroup { Line 233  sub end_foilgroup {
     my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_;      my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_;
     my $result='';      my $result='';
     my @whichopt;      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);   my ($count,$max) = &getfoilcounts($parstack,$safeeval);
  if ($count>$max) { $count=$max }   if ($count>$max) { $count=$max }
  &Apache::lonxml::debug("Count is $count from $max");   &Apache::lonxml::debug("Count is $count from $max");
Line 183  sub end_foilgroup { Line 243  sub end_foilgroup {
     $result=&displayfoils($target,@whichopt);      $result=&displayfoils($target,@whichopt);
  } elsif ($target eq 'grade') {   } elsif ($target eq 'grade') {
     if ( defined $ENV{'form.submitted'}) { &gradefoils(@whichopt); }      if ( defined $ENV{'form.submitted'}) { &gradefoils(@whichopt); }
  }    } elsif ( $target eq 'analyze') {
       &Apache::response::analyze_store_foilgroup(\@whichopt,
         ['text','image','area']);
    }
     } elsif ($target eq 'edit') {      } elsif ($target eq 'edit') {
  $result=&Apache::edit::end_table();   $result=&Apache::edit::end_table();
     }      }
Line 200  sub end_conceptgroup { Line 263  sub end_conceptgroup {
     my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_;      my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_;
     $Apache::imageresponse::conceptgroup=0;      $Apache::imageresponse::conceptgroup=0;
     my $result;      my $result;
     if ($target eq 'web' || $target eq 'grade' || $target eq 'tex') {      if ($target eq 'web' || $target eq 'grade' || $target eq 'tex' ||
  if (defined(@{ $Apache::response::conceptgroup{'names'} })) {   $target eq 'analyze') {
     my @names = @{ $Apache::response::conceptgroup{'names'} };   &Apache::response::pick_foil_for_concept($target,
     my $pick=int(&Math::Random::random_uniform() * ($#names+1));   ['area','text','image'],
     my $name=$names[$pick];   \%Apache::hint::image,
     if (defined(@{ $Apache::response::conceptgroup{"$name.area"} })) {   $parstack,$safeeval);
  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");  
     }  
  }  
     } elsif ($target eq 'edit') {      } elsif ($target eq 'edit') {
  $result=&Apache::edit::end_table();   $result=&Apache::edit::end_table();
     }      }
Line 234  sub insert_foil { Line 288  sub insert_foil {
 $Apache::imageresponse::curname='';  $Apache::imageresponse::curname='';
 sub start_foil {  sub start_foil {
     my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_;      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);   my $name = &Apache::lonxml::get_param('name',$parstack,$safeeval);
  if ($name eq '') { $name=$Apache::lonxml::curdepth; }   if ($name eq '') { $name=$Apache::lonxml::curdepth; }
  if ( $Apache::imageresponse::conceptgroup   if ( $Apache::imageresponse::conceptgroup
Line 260  sub end_foil { Line 315  sub end_foil {
 sub start_text {  sub start_text {
     my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_;      my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_;
     my $result='';      my $result='';
     if ($target eq 'web' || $target eq 'tex') {       if ($target eq 'web' || $target eq 'tex' || $target eq 'analyze') { 
  &Apache::lonxml::startredirection;    &Apache::lonxml::startredirection; 
     } elsif ($target eq 'edit') {      } elsif ($target eq 'edit') {
  my $descr=&Apache::lonxml::get_all_text('/text',$parser);   my $descr=&Apache::lonxml::get_all_text('/text',$parser);
Line 268  sub start_text { Line 323  sub start_text {
     &Apache::edit::editfield($token->[1],$descr,'Text',60,2).      &Apache::edit::editfield($token->[1],$descr,'Text',60,2).
     &Apache::edit::end_row();      &Apache::edit::end_row();
     } elsif ($target eq "modified") {      } elsif ($target eq "modified") {
  my $descr=&Apache::lonxml::get_all_text('/text',$parser);   $result=$token->[4].&Apache::edit::modifiedfield('/text',$parser);
  $result=$token->[4].&Apache::edit::modifiedfield($token);  
  &Apache::lonxml::debug($result);  
     }      }
     return $result;      return $result;
 }  }
Line 278  sub start_text { Line 331  sub start_text {
 sub end_text {  sub end_text {
     my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_;      my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_;
     my $result;      my $result;
     if ($target eq 'web' || $target eq 'tex') {      if ($target eq 'web' || $target eq 'tex' || $target eq 'analyze') {
  my $name = $Apache::imageresponse::curname;   my $name = $Apache::imageresponse::curname;
  if ( $Apache::imageresponse::conceptgroup   if ( $Apache::imageresponse::conceptgroup
      && !&Apache::response::showallfoils() ) {       && !&Apache::response::showallfoils() ) {
Line 295  sub end_text { Line 348  sub end_text {
 sub start_image {  sub start_image {
     my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_;      my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_;
     my $result='';      my $result='';
     if ($target eq 'web' || $target eq 'tex') {       if ($target eq 'web' || $target eq 'tex' || $target eq 'analyze') { 
  &Apache::lonxml::startredirection;    &Apache::lonxml::startredirection; 
     } elsif ($target eq 'edit') {      } elsif ($target eq 'edit') {
  my $bgimg=&Apache::lonxml::get_all_text('/image',$parser);   my $bgimg=&Apache::lonxml::get_all_text('/image',$parser);
Line 308  sub start_image { Line 361  sub start_image {
  $result.=&Apache::edit::search(undef,'textnode').   $result.=&Apache::edit::search(undef,'textnode').
     &Apache::edit::end_row();      &Apache::edit::end_row();
     } elsif ($target eq "modified") {      } elsif ($target eq "modified") {
  my $bgimg=&Apache::lonxml::get_all_text('/image',$parser);   $result=$token->[4].&Apache::edit::modifiedfield('/image',$parser);
  $result=$token->[4].&Apache::edit::modifiedfield($token);  
  &Apache::lonxml::debug($result);  
     }      }
     return $result;      return $result;
 }  }
Line 322  sub end_image { Line 373  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'];   if ( $Apache::imageresponse::conceptgroup
  my $temp=1;       && !&Apache::response::showallfoils()) {
  my $x=$ENV{"form.HWVAL_$id:$temp.x"};      $Apache::response::conceptgroup{"$name.image"} = $image;
  my $y=$ENV{"form.HWVAL_$id:$temp.y"};   } else {
  if (defined ($x) && defined ($y)) {      $Apache::response::foilgroup{"$name.image"} = $image;
     &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");      } elsif ($target eq 'analyze') {
    my $image = &Apache::lonxml::endredirection;
  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;
Line 430  sub end_image { Line 459  sub end_image {
     my $filename = "/home/httpd/prtspool/$ENV{'user.name'}_$ENV{'user.domain'}_printout.dat";      my $filename = "/home/httpd/prtspool/$ENV{'user.name'}_$ENV{'user.domain'}_printout.dat";
     $temp_file = Apache::File->new('>>'.$filename);       $temp_file = Apache::File->new('>>'.$filename); 
     print $temp_file "$src\n";      print $temp_file "$src\n";
     $Apache::response::foilgroup{"$name.image"} ='\vskip 0 mm \graphicspath{{/home/httpd/prtspool/}}\includegraphics[width='.$width_param.' mm]{'.$file.'} ';      $newsrc=~s/\/home\/httpd\/html\/res//;
       $newsrc=~s/\/home\/([^\/]*)\/public_html\//\/$1\//;
       $newsrc=~s/\/\.\//\//;
       $newsrc=~s/\/([^\/]+)\.(ps|eps)/\//;
       $Apache::response::foilgroup{"$name.image"} ='\vskip 0 mm \graphicspath{{/home/httpd/prtspool'.$newsrc.'}}\includegraphics[width='.$width_param.' mm]{'.$file.'} ';
  }   }
     }       } 
     return $result;      return $result;
Line 439  sub end_image { Line 472  sub end_image {
 sub start_rectangle {  sub start_rectangle {
     my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_;      my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_;
     my $result='';      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;    &Apache::lonxml::startredirection; 
     } elsif ($target eq 'edit') {      } elsif ($target eq 'edit') {
  my $coords=&Apache::lonxml::get_all_text('/rectangle',$parser);   my $coords=&Apache::lonxml::get_all_text('/rectangle',$parser);
Line 448  sub start_rectangle { Line 482  sub start_rectangle {
     &Apache::edit::entercoordpair(undef,'textnode').      &Apache::edit::entercoordpair(undef,'textnode').
     &Apache::edit::end_row();      &Apache::edit::end_row();
     } elsif ($target eq "modified") {      } elsif ($target eq "modified") {
  my $coords=&Apache::lonxml::get_all_text('/rectangle',$parser);   $result=$token->[4].&Apache::edit::modifiedfield('/rectangle',$parser);
  $result=$token->[4].&Apache::edit::modifiedfield($token);  
  &Apache::lonxml::debug($result);  
     }      }
     return $result;      return $result;
 }  }
Line 475  sub grade_rectangle { Line 507  sub grade_rectangle {
 sub end_rectangle {  sub end_rectangle {
     my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_;      my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_;
     my $result;      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 $name = $Apache::imageresponse::curname;
  my $area = &Apache::lonxml::endredirection;   my $area = &Apache::lonxml::endredirection;
  &Apache::lonxml::debug("out is $area for $name");   &Apache::lonxml::debug("out is $area for $name");
Removed from v.1.36  
changed lines
  Added in v.1.42.2.1

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