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

Diff for /loncom/homework/imageresponse.pm between versions 1.93 and 1.104

version 1.93, 2008/03/12 02:46:53 version 1.104, 2012/10/12 12:45:46
Line 29 Line 29
 #FIXME LATER assumes multiple possible submissions but only one is possible   #FIXME LATER assumes multiple possible submissions but only one is possible 
 #currently  #currently
   
   
   =head1 NAME
   
   Apache::imageresponse
   
   =head1 SYNOPSIS
   
   Coordinates the response to clicking an image.
   
   This is part of the LearningOnline Network with CAPA project
   described at http://www.lon-capa.org.
   
   =head1 SUBROUTINES
   
   =over
   
   =item start_imageresponse()
   
   =item end_imageresponse()
   
   =item start_foilgroup()
   
   =item getfoilcounts()
   
   =item whichfoils()
   
   =item prep_image()
   
   =item draw_image()
   
   =item displayfoils()
   
   =item format_prior_response()
   
   =item display_answers()
   
   =item clean_up_image()
   
   =item gradefoils()
   
   =item stringify_submission()
   
   =item get_submission()
   
   =item end_foilgroup()
   
   =item start_conceptgroup()
   
   =item end_conceptgroup()
   
   =item insert_foil()
   
   =item start_foil()
   
   =item end_foil()
   
   =item start_text()
   
   =item end_text()
   
   =item start_image()
   
   =item end_image()
   
   =item start_rectangle()
   
   =item grade_rectangle()
   
   =item end_rectangle()
   
   =item start_polygon()
   
   =item grade_polygon()
   
   =item end_polygon()
   
   =back
   
   =cut
   
   
 package Apache::imageresponse;  package Apache::imageresponse;
 use strict;  use strict;
 use Image::Magick();  use Image::Magick();
Line 98  sub end_imageresponse { Line 179  sub end_imageresponse {
           
     if ($target eq 'grade' || $target eq 'web' || $target eq 'answer' ||       if ($target eq 'grade' || $target eq 'web' || $target eq 'answer' || 
  $target eq 'tex' || $target eq 'analyze') {   $target eq 'tex' || $target eq 'analyze') {
  &Apache::lonxml::increment_counter(&Apache::response::repetition(),           my $repetition = &Apache::response::repetition();
    &Apache::lonxml::increment_counter($repetition, 
    "$part_id.$response_id");     "$part_id.$response_id");
  if ($target eq 'analyze') {   if ($target eq 'analyze') {
     &Apache::lonhomework::set_bubble_lines();      &Apache::lonhomework::set_bubble_lines();
Line 106  sub end_imageresponse { Line 188  sub end_imageresponse {
   
     }      }
     &Apache::response::end_response();      &Apache::response::end_response();
   
     return $result;      return $result;
 }  }
   
 %Apache::response::foilgroup=();  %Apache::response::foilgroup=();
 sub start_foilgroup {  sub start_foilgroup {
       my ($target) = @_;
     %Apache::response::foilgroup=();      %Apache::response::foilgroup=();
     $Apache::imageresponse::conceptgroup=0;      $Apache::imageresponse::conceptgroup=0;
     &Apache::response::pushrandomnumber();      &Apache::response::pushrandomnumber(undef,$target);
     return '';      return '';
 }  }
   
Line 130  sub getfoilcounts { Line 212  sub getfoilcounts {
   
 sub whichfoils {  sub whichfoils {
     my ($max)=@_;      my ($max)=@_;
     return if (!defined(@{ $Apache::response::foilgroup{'names'} }));      my @names;
     my @names = @{ $Apache::response::foilgroup{'names'} };      if (ref($Apache::response::foilgroup{'names'}) eq 'ARRAY') {
           @names = @{ $Apache::response::foilgroup{'names'} };
       }
       return if (!@names);
     my @whichopt;      my @whichopt;
     while ((($#whichopt+1) < $max) && ($#names > -1)) {      while ((($#whichopt+1) < $max) && ($#names > -1)) {
  &Apache::lonxml::debug("Have $#whichopt max is $max");   &Apache::lonxml::debug("Have $#whichopt max is $max");
Line 239  sub displayfoils { Line 324  sub displayfoils {
  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' || $target eq 'answer')    if ( ($target eq 'web' || $target eq 'answer') 
      && $image !~ /^http:/ ) {       && $image !~ /^https?\:/ ) {
     $image=&clean_up_image($image);      $image=&clean_up_image($image);
  }   }
  push(@images,$image);   push(@images,$image);
Line 272  sub displayfoils { Line 357  sub displayfoils {
  $temp++;   $temp++;
     }      }
     if ($target eq 'web') {      if ($target eq 'web') {
  &Apache::response::setup_prior_tries_hash(\&format_prior_response,          &get_prior_options(\@images,\@whichopt);
   [\@images,\@whichopt]);  
     }      }
     return $result;      return $result;
 }  }
   
   sub get_prior_options {
       my ($currimages,$curropt) = @_;
       return unless((ref($curropt) eq 'ARRAY') && 
                     (ref($currimages) eq 'ARRAY'));
       my $part = $Apache::inputtags::part;
       my $respid   = $Apache::inputtags::response[-1];
       foreach my $i (1..$Apache::lonhomework::history{'version'}) {
           my $partprefix = "$i:resource.$part";
           my $sub_key = "$partprefix.$respid.submission";
           next if (!exists($Apache::lonhomework::history{$sub_key}));
           my $type_key = "$partprefix.type";
           my @whichopt = ();
           my @images = ();
           if ($Apache::lonhomework::history{$type_key} eq 'randomizetry') {
               my $order_key = "$partprefix.$respid.foilorder";
               @whichopt = &Apache::lonnet::str2array($Apache::lonhomework::history{$order_key});
               if (@whichopt > 0) {
                   foreach my $name (@whichopt) {
                       my $image=$Apache::response::foilgroup{"$name.image"};
                       if ($image !~ /^https?\:/ ) {
                           $image=&clean_up_image($image);
                       }
                       push(@images,$image);
                   }
               }
           } else {
               @whichopt = @{$curropt};
               @images = @{$currimages};
           }
           my $submission = $Apache::lonhomework::history{$sub_key};
           my $output =  &format_prior_response('grade',$submission,
                                                [\@images,\@whichopt]);
           if (defined($output)) {
               $Apache::inputtags::submission_display{$sub_key} = $output;
           }
       }
   }
   
 sub format_prior_response {  sub format_prior_response {
     my ($mode,$answer,$other_data) = @_;      my ($mode,$answer,$other_data) = @_;
           
Line 305  sub display_answers { Line 427  sub display_answers {
  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' || $target eq 'answer')   if ( ($target eq 'web' || $target eq 'answer')
      && $image !~ /^http:/ ) {       && $image !~ /^https?\:/ ) {
     $image = &clean_up_image($image);      $image = &clean_up_image($image);
  }    } 
  my $token=&prep_image($image,'answeronly',$name);   my $token=&prep_image($image,'answeronly',$name);
Line 320  sub clean_up_image { Line 442  sub clean_up_image {
     my ($image)=@_;      my ($image)=@_;
     if ($image =~ /\s*<img\s*/) {      if ($image =~ /\s*<img\s*/) {
  ($image) = ($image =~ /src\s*=\s*[\"\']([^\"\']+)[\"\']/i);   ($image) = ($image =~ /src\s*=\s*[\"\']([^\"\']+)[\"\']/i);
  if ($image !~ /^http:/) {   if ($image !~ /^https?\:/) {
     $image=&Apache::lonnet::hreflocation('',$image);      $image=&Apache::lonnet::hreflocation('',$image);
  }   }
  if (!$image) {   if (!$image) {
Line 354  sub gradefoils { Line 476  sub gradefoils {
  my ($x,$y) = split(':',$env{"form.HWVAL_$id:$temp"});   my ($x,$y) = split(':',$env{"form.HWVAL_$id:$temp"});
  $response{$name} = $env{"form.HWVAL_$id:$temp"};   $response{$name} = $env{"form.HWVAL_$id:$temp"};
  &Apache::lonxml::debug("Got a x of $x and a y of $y for $name");   &Apache::lonxml::debug("Got a x of $x and a y of $y for $name");
  if (defined($x) && defined($y) &&          my @areas; 
     defined(@{ $Apache::response::foilgroup{"$name.area"} })) {          if (ref($Apache::response::foilgroup{"$name.area"}) eq 'ARRAY') {
     my @areas = @{ $Apache::response::foilgroup{"$name.area"} };              @areas = @{ $Apache::response::foilgroup{"$name.area"} };
           }
    if (defined($x) && defined($y) && @areas) {
     my $grade="INCORRECT";      my $grade="INCORRECT";
     foreach my $area (@areas) {      foreach my $area (@areas) {
  &Apache::lonxml::debug("Area is $area for $name");   &Apache::lonxml::debug("Area is $area for $name");
Line 367  sub gradefoils { Line 491  sub gradefoils {
  } elsif ($1 eq 'polygon') {   } elsif ($1 eq 'polygon') {
     $grade=&grade_polygon($area,$x,$y);      $grade=&grade_polygon($area,$x,$y);
  } else {   } else {
     &Apache::lonxml::error("Unknown area style $area");      &Apache::lonxml::error(&mt('Unknown area style [_1]',$area));
  }   }
  &Apache::lonxml::debug("Area said $grade");   &Apache::lonxml::debug("Area said $grade");
  if ($grade eq 'APPROX_ANS') { last; }   if ($grade eq 'APPROX_ANS') { last; }
Line 379  sub gradefoils { Line 503  sub gradefoils {
  }   }
  $temp++;   $temp++;
     }      }
       if ($Apache::lonhomework::type eq 'randomizetry') {
           $Apache::lonhomework::results{"resource.$partid.$id.foilorder"} = &Apache::lonnet::array2str(@whichopt);
       }
     my ($result) = &Apache::inputtags::finalizeawards(\@results,[]);      my ($result) = &Apache::inputtags::finalizeawards(\@results,[]);
     &Apache::lonxml::debug("Question is $result");      &Apache::lonxml::debug("Question is $result");
   
Line 386  sub gradefoils { Line 513  sub gradefoils {
     my %previous=      my %previous=
  &Apache::response::check_for_previous(&stringify_submission(\%response),   &Apache::response::check_for_previous(&stringify_submission(\%response),
       $part,$id);        $part,$id);
     if ($result       if ($result) { 
  && $Apache::lonhomework::type eq 'survey') { $result='SUBMITTED'; }   if ($Apache::lonhomework::type eq 'survey') { 
               $result='SUBMITTED';
           } elsif ($Apache::lonhomework::type eq 'surveycred') { 
               $result='SUBMITTED_CREDIT'; 
           } elsif ($Apache::lonhomework::type eq 'anonsurvey') { 
               $result='ANONYMOUS'; 
           } elsif ($Apache::lonhomework::type eq 'anonsurveycred') { 
               $result='ANONYMOUS_CREDIT'; 
           }
       }
   
     &Apache::response::handle_previous(\%previous,$result);      &Apache::response::handle_previous(\%previous,$result);
     $Apache::lonhomework::results{"resource.$part.$id.submission"}=      $Apache::lonhomework::results{"resource.$part.$id.submission"}=
  &stringify_submission(\%response);   &stringify_submission(\%response);
Line 398  sub gradefoils { Line 535  sub gradefoils {
 sub stringify_submission {  sub stringify_submission {
     my ($response) = @_;      my ($response) = @_;
     return &Apache::lonnet::hash2str(%{ $response });      return &Apache::lonnet::hash2str(%{ $response });
   
       
 }  }
   
 sub get_submission {  sub get_submission {
Line 436  sub end_foilgroup { Line 571  sub end_foilgroup {
   
  if ($target eq 'web' || $target eq 'tex') {   if ($target eq 'web' || $target eq 'tex') {
     $result=&displayfoils($target,@whichopt);      $result=&displayfoils($target,@whichopt);
               if ($Apache::lonhomework::type eq 'randomizetry') {
                   if ($target eq 'web') {
                       &get_prior_options($target,@whichopt);
                   }
               }
     $Apache::lonxml::post_evaluate=0;      $Apache::lonxml::post_evaluate=0;
  } elsif ($target eq 'grade') {   } elsif ($target eq 'grade') {
     if ( defined $env{'form.submitted'}) { &gradefoils(@whichopt); }      if ( defined $env{'form.submitted'}) { &gradefoils(@whichopt); }
Line 494  sub start_foil { Line 634  sub start_foil {
  $target eq 'analyze' || $target eq 'answer') {   $target eq 'analyze' || $target eq 'answer') {
  my $name = &Apache::lonxml::get_param('name',$parstack,$safeeval);   my $name = &Apache::lonxml::get_param('name',$parstack,$safeeval);
  if ($name eq "") {   if ($name eq "") {
     &Apache::lonxml::warning("Foils without names exist. This can cause problems to malfunction.");      &Apache::lonxml::warning(&mt('Foils without names exist. This can cause problems to malfunction.'));
     $name=$Apache::lonxml::curdepth;      $name=$Apache::lonxml::curdepth;
  }   }
  if (defined($Apache::response::foilnames{$name})) {   if (defined($Apache::response::foilnames{$name})) {
     &Apache::lonxml::error(&mt("Foil name <b><tt>[_1]</tt></b> appears more than once. Foil names need to be unique.",$name));      &Apache::lonxml::error(&mt("Foil name [_1] appears more than once. Foil names need to be unique."
                                         ,'<b><tt>'.$name.'</tt></b>'));
  }   }
  $Apache::response::foilnames{$name}++;   $Apache::response::foilnames{$name}++;
  if ( $Apache::imageresponse::conceptgroup   if ( $Apache::imageresponse::conceptgroup
Line 634  sub end_image { Line 775  sub end_image {
     my ($commentline, $restofstuff) = split(/\n/, $src);      my ($commentline, $restofstuff) = split(/\n/, $src);
     $graphinclude = $src;      $graphinclude = $src;
     $graphinclude =~ s/^$commentline//;      $graphinclude =~ s/^$commentline//;
  } else {   } elsif (!($src =~ /\\/)) {
     my ($path,$file) = &Apache::londefdef::get_eps_image($src);      my ($path,$file) = &Apache::londefdef::get_eps_image($src);
     my ($height_param,$width_param)=      my ($height_param,$width_param)=
  &Apache::londefdef::image_size($src,0.3,$parstack,$safeeval);   &Apache::londefdef::image_size($src,0.3,$parstack,$safeeval);
     $graphinclude = '\graphicspath{{'.$path.'}}\includegraphics[width='.$width_param.' mm]{'.$file.'}';      $graphinclude = '\graphicspath{{'.$path.'}}\includegraphics[width='.$width_param.' mm]{'.$file.'}';
    } else {
       $graphinclude = $src;   # Already fully formed.
  }   }
  $Apache::response::foilgroup{"$name.image"} ='\vskip 0 mm \noindent '.$graphinclude;   $Apache::response::foilgroup{"$name.image"} ='\vskip 0 mm \noindent '.$graphinclude;
     }       } 
Removed from v.1.93  
changed lines
  Added in v.1.104

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