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

Diff for /loncom/homework/imageresponse.pm between versions 1.86 and 1.97

version 1.86, 2007/09/25 23:45:33 version 1.97, 2008/12/19 14:28:14
Line 1 Line 1
   #
 # The LearningOnline Network with CAPA  # The LearningOnline Network with CAPA
 # image click response style  # image click response style
 #  #
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 59  sub start_imageresponse { Line 140  sub start_imageresponse {
  $result=&Apache::response::meta_package_write('imageresponse');   $result=&Apache::response::meta_package_write('imageresponse');
     } elsif ($target eq 'analyze') {      } elsif ($target eq 'analyze') {
  my $part_id="$Apache::inputtags::part.$id";   my $part_id="$Apache::inputtags::part.$id";
           $Apache::lonhomework::analyze{"$part_id.type"} = 'imageresponse';
  push (@{ $Apache::lonhomework::analyze{"parts"} },$part_id);   push (@{ $Apache::lonhomework::analyze{"parts"} },$part_id);
  push (@{ $Apache::lonhomework::analyze{"$part_id.bubble_lines"} },   push (@{ $Apache::lonhomework::analyze{"$part_id.bubble_lines"} },
       1);        1);
       } elsif ( $target eq 'edit' ) {
    $result .= &Apache::edit::tag_start($target,$token).
       &Apache::edit::text_arg('Max Number Of Shown Foils:',
       'max',$token,'4').
       &Apache::edit::end_row().
       &Apache::edit::start_spanning_row();
       } elsif ( $target eq 'modified' ) {
    my $constructtag=
       &Apache::edit::get_new_args($token,$parstack,$safeeval,'max');
    if ($constructtag) { $result = &Apache::edit::rebuild_tag($token); }
     }      }
     return $result;      return $result;
 }  }
Line 69  sub start_imageresponse { Line 161  sub start_imageresponse {
 sub end_imageresponse {  sub end_imageresponse {
     my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_;      my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_;
   
       my $part_id     = $Apache::inputtags::part;
       my $response_id = $Apache::inputtags::response[-1]; 
   
     pop(@Apache::lonxml::namespace);      pop(@Apache::lonxml::namespace);
     &Apache::lonxml::deregister('Apache::imageresponse',('foilgroup','foil','text','image','rectangle','conceptgroup'));      &Apache::lonxml::deregister('Apache::imageresponse',('foilgroup','foil','text','image','rectangle','conceptgroup'));
   
Line 84  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());   &Apache::lonxml::increment_counter(&Apache::response::repetition(), 
      "$part_id.$response_id");
    if ($target eq 'analyze') {
       &Apache::lonhomework::set_bubble_lines();
    }
   
     }      }
     &Apache::response::end_response();      &Apache::response::end_response();
   
Line 105  sub getfoilcounts { Line 205  sub getfoilcounts {
     my $max = &Apache::lonxml::get_param('max',$parstack,$safeeval,'-2');      my $max = &Apache::lonxml::get_param('max',$parstack,$safeeval,'-2');
     # +1 since instructors will count from 1      # +1 since instructors will count from 1
     my $count = $#{ $Apache::response::foilgroup{'names'} }+1;      my $count = $#{ $Apache::response::foilgroup{'names'} }+1;
     #if (&Apache::response::showallfoils()) { $max=$count; }      if (&Apache::response::showallfoils()) { $max=$count; }
     return ($count,$max);      return ($count,$max);
 }  }
   
 sub whichfoils {  sub whichfoils {
     my ($max)=@_;      my ($max)=@_;
     if (!defined(@{ $Apache::response::foilgroup{'names'} })) { return; }      return if (!defined(@{ $Apache::response::foilgroup{'names'} }));
     my @names = @{ $Apache::response::foilgroup{'names'} };      my @names = @{ $Apache::response::foilgroup{'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");
  my $aopt;   my $aopt;
 # if (&Apache::response::showallfoils()) {   if (&Apache::response::showallfoils()) {
 #    $aopt=0;      $aopt=0;
 # } else {   } else {
     $aopt=int(&Math::Random::random_uniform() * ($#names+1));      $aopt=int(&Math::Random::random_uniform() * ($#names+1));
 # }   }
  &Apache::lonxml::debug("From $#names elms, picking $aopt");   &Apache::lonxml::debug("From $#names elms, picking $aopt");
  $aopt=splice(@names,$aopt,1);   $aopt=splice(@names,$aopt,1);
  &Apache::lonxml::debug("Picked $aopt");   &Apache::lonxml::debug("Picked $aopt");
  push (@whichopt,$aopt);   push(@whichopt,$aopt);
     }      }
     return @whichopt;      return @whichopt;
 }  }
Line 204  sub draw_image { Line 304  sub draw_image {
     }      }
  }   }
     }      }
     &Apache::lonnet::appenv(%x);      &Apache::lonnet::appenv(\%x);
     return $id;      return $id;
 }  }
   
Line 219  sub displayfoils { Line 319  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:/ ) {   if ( ($target eq 'web' || $target eq 'answer') 
        && $image !~ /^https?\:/ ) {
     $image=&clean_up_image($image);      $image=&clean_up_image($image);
  }   }
  push(@images,$image);   push(@images,$image);
Line 237  sub displayfoils { Line 338  sub displayfoils {
     } else {      } else {
  my $respid=$Apache::inputtags::response['-1'];   my $respid=$Apache::inputtags::response['-1'];
  my $token=&prep_image($image,'submission',$name);   my $token=&prep_image($image,'submission',$name);
  my $id = "HWVAL_$respid:$temp";   my $input_id = "HWVAL_$respid:$temp";
    my $id = $env{'form.request.prefix'}.$input_id;
  $result.='<img onclick="image_response_click(\''.$id.'\',event);"   $result.='<img onclick="image_response_click(\''.$id.'\',event);"
                        src="/adm/randomlabel.png?token='.$token.'"                          src="/adm/randomlabel.png?token='.$token.'" 
                                id="imageresponse_'.$id.'"                                 id="'.$id.'_imageresponse"
                                 />'.                                  />'.
        '<br />'.         '<br />'.
        '<input type="hidden" name="token_'.$id.'" value="'.$token.'" />'.         '<input type="hidden" name="'.$input_id.'_token" value="'.$token.'" />'.
        '<input type="hidden" name="'.$id.'" value="'.         '<input type="hidden" name="'.$input_id.'" value="'.
        join(':',&get_submission($name)).'" />';         join(':',&get_submission($name)).'" />';
     }      }
  }   }
Line 279  sub format_prior_response { Line 381  sub format_prior_response {
 sub display_answers {  sub display_answers {
     my ($target,$whichopt)=@_;      my ($target,$whichopt)=@_;
   
     my $result;      my $result=&Apache::response::answer_header('imageresponse');
     foreach my $name (@$whichopt) {      foreach my $name (@$whichopt) {
  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:/ ) {   if ( ($target eq 'web' || $target eq 'answer')
        && $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);
   
  $result.=&Apache::response::answer_header('imageresponse');  
  $result.=&Apache::response::answer_part('imageresponse',"<img src=\"/adm/randomlabel.png?token=$token\" /><br />\n");   $result.=&Apache::response::answer_part('imageresponse',"<img src=\"/adm/randomlabel.png?token=$token\" /><br />\n");
  $result.=&Apache::response::answer_footer('imageresponse');  
     }      }
       $result.=&Apache::response::answer_footer('imageresponse');
     return $result;      return $result;
 }  }
   
Line 299  sub clean_up_image { Line 401  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 346  sub gradefoils { Line 448  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 473  sub start_foil { Line 575  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
      #&& !&Apache::response::showallfoils()       && !&Apache::response::showallfoils()
      ) {       ) {
     push(@{ $Apache::response::conceptgroup{'names'} }, $name);      push(@{ $Apache::response::conceptgroup{'names'} }, $name);
  } else {   } else {
Line 534  sub end_text { Line 637  sub end_text {
  || $target eq 'answer') {   || $target eq 'answer') {
  my $name = $Apache::imageresponse::curname;   my $name = $Apache::imageresponse::curname;
  if ( $Apache::imageresponse::conceptgroup   if ( $Apache::imageresponse::conceptgroup
      #&& !&Apache::response::showallfoils()       && !&Apache::response::showallfoils()
      ) {       ) {
     $Apache::response::conceptgroup{"$name.text"} = &Apache::lonxml::endredirection;      $Apache::response::conceptgroup{"$name.text"} = &Apache::lonxml::endredirection;
  } else {   } else {
Line 577  sub end_image { Line 680  sub end_image {
  my $image = &Apache::lonxml::endredirection();   my $image = &Apache::lonxml::endredirection();
  &Apache::lonxml::debug("original image is $image");   &Apache::lonxml::debug("original 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;
  } else {   } else {
Line 586  sub end_image { Line 689  sub end_image {
     } elsif ($target eq 'analyze') {      } elsif ($target eq 'analyze') {
  my $image = &Apache::lonxml::endredirection();   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;
  } else {   } else {
Line 666  sub end_rectangle { Line 769  sub end_rectangle {
  $area=~s/\s//g;   $area=~s/\s//g;
  &Apache::lonxml::debug("out is $area for $name");   &Apache::lonxml::debug("out is $area for $name");
  if ( $Apache::imageresponse::conceptgroup   if ( $Apache::imageresponse::conceptgroup
      #&& !&Apache::response::showallfoils()       && !&Apache::response::showallfoils()
      ) {       ) {
     push @{ $Apache::response::conceptgroup{"$name.area"} },"rectangle:$area";      push @{ $Apache::response::conceptgroup{"$name.area"} },"rectangle:$area";
  } else {   } else {
Line 747  sub end_polygon { Line 850  sub end_polygon {
  $area=~s/\s*//g;   $area=~s/\s*//g;
  &Apache::lonxml::debug("out is $area for $name");   &Apache::lonxml::debug("out is $area for $name");
  if ( $Apache::imageresponse::conceptgroup   if ( $Apache::imageresponse::conceptgroup
      #&& !&Apache::response::showallfoils()       && !&Apache::response::showallfoils()
      ) {       ) {
     push @{ $Apache::response::conceptgroup{"$name.area"} },"polygon:$area";      push @{ $Apache::response::conceptgroup{"$name.area"} },"polygon:$area";
  } else {   } else {
Removed from v.1.86  
changed lines
  Added in v.1.97

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