--- loncom/homework/randomlabel.pm 2004/12/04 01:15:41 1.63 +++ loncom/homework/randomlabel.pm 2007/10/17 22:11:55 1.90 @@ -1,7 +1,7 @@ # The LearningOnline Network with CAPA # random labelling tool # -# $Id: randomlabel.pm,v 1.63 2004/12/04 01:15:41 albertel Exp $ +# $Id: randomlabel.pm,v 1.90 2007/10/17 22:11:55 albertel Exp $ # # Copyright Michigan State University Board of Trustees # @@ -25,9 +25,6 @@ # # http://www.lon-capa.org/ # -# 7/20/2001 Isaac Tsai, initial syntax -# 8/10/2001 Isaac Tsai, -# 8/30/2001 Isaac Tsai, # SYNTAX: # # @@ -62,14 +59,24 @@ use strict; use Apache::edit; use Apache::File(); use Apache::Constants qw(:common :http); +use Image::Magick; +use Apache::lonplot; +use LONCAPA; + my %args; my $cgi_id; +my $scale_factor; # image scale factor. +my $label_xscale; # Label scale factor (needed for gnuplot). +my $label_yscale; +my $dirty_width_adjust = 5; # Width adjustment for e.g. gnuplot images. BEGIN { &Apache::lonxml::register('Apache::randomlabel',('randomlabel','labelgroup','location','label','bgimg')); } + + sub check_int { # utility function to do error checking on a integer. my ($num,$default) = @_; @@ -82,14 +89,50 @@ sub check_int { return $num; } +# Get width/height from an image tag... +# +# Parameters: +# tag - tag potentially containing height/width attributes. +# def_width - Default width. +# def_height - Default height. +# Returns: +# list containing width/height. +# +sub extract_tag_sizes { + my ($tag, $dw, $dh) = @_; + $tag =~ s/\s+/ /g; # Collapse whitespace. + $tag =~ s/\s*=\s*/=/g; # kill space around ='s. + $tag =~ s/[<>\"]//g; # Get rid of the <">'s too. + + &Apache::lonxml::debug("Compressed tag: $tag"); + my @taglist = split(/ /,$tag); + foreach my $attribute (@taglist) { + if ($attribute =~ /^width/i) { + my ($e, $s)= split(/=/,$attribute); + $dw = $s; + } + if ($attribute =~ /^height/i) { + my ($e, $s) = split(/=/,$attribute); + $dh = $s; + } + } + return($dw, $dh); + +} + +my ($height_param,$width_param); sub start_randomlabel { + my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_; my $result=''; push (@Apache::lonxml::namespace,'randomlabel'); + ($height_param,$width_param)=(0,0); + $label_xscale = 1.0; # Assume image size not overridden. + $label_yscale = 1.0; my $bgimg= &Apache::lonxml::get_param('bgimg',$parstack,$safeeval); if ( defined($bgimg) && $bgimg !~ /^http:/ ) { $bgimg=&Apache::lonnet::filelocation($Apache::lonxml::pwd[-1],$bgimg); - if (&Apache::lonnet::repcopy($bgimg) ne OK) { + if (&Apache::lonnet::repcopy($bgimg) ne 'ok') { $bgimg='/home/httpd/html/adm/lonKaputt/lonlogo_broken.gif'; } } @@ -97,20 +140,19 @@ sub start_randomlabel { if ($target eq 'web') { $cgi_id=&Apache::loncommon::get_cgi_id(); %args=(); - $args{"cgi.$cgi_id.BGIMG"}=&Apache::lonnet::escape($bgimg); - } elsif ($target eq 'tex') { - my $w= &check_int(&Apache::lonxml::get_param('width',$parstack,$safeeval)); - my $h= &check_int(&Apache::lonxml::get_param('height',$parstack,$safeeval)); - my $texwidth=&adjust_textwidth(&Apache::lonxml::get_param('texwidth',$parstack,$safeeval,undef,1)); - if (!$texwidth) { $texwidth=90; } - $result.=&make_eps_image($bgimg,$texwidth,$h,$w); + $args{"cgi.$cgi_id.BGIMG"}=&escape($bgimg); + $height_param = &Apache::lonxml::get_param('height',$parstack, $safeeval); + $width_param = &Apache::lonxml::get_param('width', $parstack, $safeeval); + } elsif ($target eq 'tex' && defined($bgimg)) { + $result.=&make_eps_image($bgimg,$parstack,$safeeval); } elsif ($target eq 'edit') { + my $only = join(',',&Apache::loncommon::filecategorytypes('Pictures')); $result.=&Apache::edit::tag_start($target,$token); $Apache::edit::bgimgsrc= &Apache::lonxml::get_param('bgimg',$parstack,$safeeval); $Apache::edit::bgimgsrccurdepth=$Apache::lonxml::curdepth; $result.=&Apache::edit::text_arg('Image:','bgimg',$token,75).' '; - $result.=&Apache::edit::browse('bgimg').' '; + $result.=&Apache::edit::browse('bgimg',undef,undef,$only).' '; $result.=&Apache::edit::search('bgimg').'
'. &Apache::edit::text_arg('Width(pixel):' ,'width' ,$token,6). &Apache::edit::text_arg('Height(pixel):','height' ,$token,6). @@ -122,7 +164,6 @@ sub start_randomlabel { 'height','texwidth'); if ($constructtag) { $result = &Apache::edit::rebuild_tag($token); - $result.=&Apache::edit::handle_insert(); } } return $result; @@ -140,24 +181,19 @@ sub end_randomlabel { &Apache::lonnet::appenv(%args); } elsif ($target eq 'tex') { $result='\end{picture}\\\\'; - my $height=&Apache::lonxml::get_param('height',$parstack,$safeeval); - my $width=&Apache::lonxml::get_param('width',$parstack,$safeeval); - my $texwidth=&adjust_textwidth(&Apache::lonxml::get_param('texwidth',$parstack,$safeeval,undef,1)); - if (!$texwidth) { $texwidth=90; } - # what if width is undefined? - my $howtoskipback = $texwidth*$height/$width; - $result.= ' \vskip -'.$howtoskipback.' mm } \\\\ '; + $result.= ' \vskip -'.$height_param.' mm } \\\\ '; } elsif ($target eq 'edit') { $result.=&Apache::edit::end_table; } return $result; } + sub start_bgimg { my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_; my $result=''; if ($target eq 'web' || $target eq 'tex' || $target eq 'analyze') { - &Apache::lonxml::startredirection; + &Apache::lonxml::startredirection(); } return $result; } @@ -166,63 +202,117 @@ sub end_bgimg { my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_; my $result=''; if ($target eq 'web' || $target eq 'tex' || $target eq 'analyze') { - my $bgimg=&Apache::lonxml::endredirection; + my $bgimg=&Apache::lonxml::endredirection(); if ($target eq 'web') { + + # If the tag produced has sizes, they override ours. + # (for now anyway). + # + &Apache::lonxml::debug("Base sizes: $width_param x $height_param"); + + my ($plot_x, $plot_y) = &extract_tag_sizes($bgimg, + $width_param, + $height_param); + &Apache::lonxml::debug("Extracted sizes: $plot_x x $plot_y"); + if ($width_param) { + $label_xscale = $plot_x / $width_param; + } + if ($height_param) { + $label_yscale = $plot_y / $height_param; + } + &Apache::lonxml::debug("Scale factors: $label_xscale $label_yscale"); + + &Apache::lonxml::debug("Image: $bgimg"); $bgimg=&Apache::imageresponse::clean_up_image($bgimg); - $args{"cgi.$cgi_id.BGIMG"}=&Apache::lonnet::escape($bgimg); + &Apache::lonxml::debug("Cleaned image: $bgimg"); + $args{"cgi.$cgi_id.BGIMG"}=&escape($bgimg); } elsif ($target eq 'tex') { - my $w=&check_int(&Apache::lonxml::get_param('width',$parstack,$safeeval,-2)); - my $h=&check_int(&Apache::lonxml::get_param('height',$parstack,$safeeval,-2)); - my $texwidth=&adjust_textwidth(&Apache::lonxml::get_param('texwidth',$parstack,$safeeval,undef,-2)); - if (!$texwidth) { $texwidth=90; } - $result.=&make_eps_image($bgimg,$texwidth,$h,$w); - } - } - return $result; -} + # Some bg images can create latex for us... e.g. gnuplot. + # If it looks like we have some latex use that, + # otherwise, assume this is a resource name that must + # be converted into the latex to create an eps insertion. + # + my $src = $bgimg; + $src =~ s/\s+$//s; + $src =~ s/^\s+//s; + + #If this is a dynamically generated image, it will + #be in latex already, with a comment header that + #describes the dimensions: + + if($src =~ /^%DYNAMICIMAGE:/) { + $Apache::lonxml::debug = 0; + &Apache::lonxml::debug("Dynamic image"); + my ($commentline, $junk) = split(/\n/, $src); + &Apache::lonxml::debug("Comment line was: $commentline"); + my $trash; + my $initial_width; + ($trash, $initial_width, $height_param, $width_param) = + split(/:/,$commentline); + &Apache::lonxml::debug("internal web Width/height: $initial_width $height_param"); + &Apache::lonxml::debug("Texwitdh: $width_param"); + if($initial_width == 0) { + $initial_width = $width_param; + } + # strip off the comments since output does not always + # preserve \n's: + # + $src =~ s/$commentline//; + $scale_factor = $width_param / $initial_width; + $height_param = $height_param*$scale_factor; + + $label_xscale = 1.0; # $scale_factor; + $label_yscale = 1.0; # $scale_factor; + + &Apache::lonxml::debug("height $height_param"); + &Apache::lonxml::debug("Width $width_param"); + &Apache::lonxml::debug("Scale factors: $label_xscale $label_yscale"); + my $dirty_width = $width_param + $dirty_width_adjust; + my $x_offset = -$dirty_width_adjust/2.0; + # + # Somewhere here it looks like height_param and + # width_param got backwards... + # + $result .= '\parbox{'.$dirty_width.'mm}{'; + $result .= " $src \n"; + $result .= '\setlength{\unitlength}{1mm}'."\n"; + $result .= '\begin{picture}('."$width_param,$height_param)"; + $result .= "($x_offset,-$height_param)"; + $result .= "\n"; + $Apache::lonxml::debug = 0; -sub make_eps_image { - my ($bgimg,$texwidth,$h,$w)=@_; - my $newbgimg = $bgimg; - $bgimg=~s/\.(gif|jpg|png|jpeg)$/\.eps/i; - $bgimg= &Apache::lonnet::filelocation($bgimg); - $bgimg=~s|http:/[^/]*|/home/httpd/html|; - $bgimg=~s|/$||; - #if no eps file try to replicate it - if (not-e $bgimg) { - if (&Apache::lonnet::repcopy($bgimg) ne OK ) { - #if replication failed try to find ps file - $bgimg=~s/\.eps$/\.ps/; - #if no ps file try to replicate it - if (not -e $bgimg && - &Apache::lonnet::repcopy($bgimg) ne OK) { - #if replication failed try to produce eps file dynamically - $bgimg=~s/\.ps$/\.eps/; - my $temp_file; - my $filename = "/home/httpd/prtspool/$ENV{'user.name'}_$ENV{'user.domain'}_printout.dat"; - $temp_file = Apache::File->new('>>'.$filename); - $newbgimg =~ s|(.*)/res/|/home/httpd/html/res/|; - print $temp_file "$newbgimg\n"; - $bgimg=~s|/home/httpd/html/res|/home/httpd/prtspool|; - $bgimg=~s|/home/([^/]*)/public_html/|/home/httpd/prtspool/$1/|; + } else { + $result.=&make_eps_image($bgimg,$parstack,$safeeval,-2); } } } - $bgimg=~s|/$||; - my $dirtywidth=$texwidth+5; - my $result.='\vspace*{2mm}\noindent \parbox{'.$dirtywidth. - ' mm}{ \noindent \epsfxsize='.$texwidth.' mm \epsffile{'.$bgimg. - '}\setlength{\unitlength}{1mm} \begin{picture}('. - $texwidth.','.$texwidth*$h/$w.')(0,-'.$texwidth*$h/$w.')'; return $result; } - -sub adjust_textwidth { - my $texwidth=shift; - my $pagewidth=$ENV{'form.textwidth'}; - $pagewidth=~s/\s*mm\s*$//; - if ($texwidth>$pagewidth) {$texwidth=$pagewidth;} - return $texwidth; +sub make_eps_image { + my ($bgimg,$parstack,$safeeval,$depth)=@_; + &Apache::lonxml::debug("image prior to get_eps_image: $bgimg"); + my ($path,$file) = &Apache::londefdef::get_eps_image($bgimg); + &Apache::lonxml::debug("image after: $bgimg"); + ($height_param,$width_param)= + &Apache::londefdef::image_size($bgimg,0.3,$parstack,$safeeval, + $depth,1); + + &Apache::lonxml::debug("Image size: $height_param x $width_param"); + + my $dirtywidth=$width_param+5; + + my $result ="\n".'\vspace*{2mm}\noindent'."\n". + '\parbox{'.$dirtywidth. + ' mm}{ \noindent \epsfxsize='.$width_param. + ' mm \epsffile{'.$path.$file. + '}\setlength{\unitlength}{1mm}'."\n".' \begin{picture}('. + $width_param.','.$height_param.')(0,-'.$height_param.')'."\n"; + my $magick = Image::Magick->new; + $magick->Read($bgimg); + my $initial_width = $magick->Get('width'); + &Apache::lonxml::debug("ImageMagick thinks width is; $initial_width"); + $scale_factor = $width_param / $initial_width; + return $result; } sub start_labelgroup { @@ -242,7 +332,7 @@ sub start_labelgroup { @Apache::randomlabel::ycoord = (); @Apache::randomlabel::value = (); @Apache::randomlabel::label_arr = (); - @Apache::randomlabel::decription = (); + @Apache::randomlabel::description = (); } elsif ($target eq 'edit') { $result.=&Apache::edit::tag_start($target,$token); $result.=&Apache::edit::text_arg('Name:','name',$token). @@ -263,12 +353,44 @@ sub start_labelgroup { 'TeXsize'); if ($constructtag) { $result = &Apache::edit::rebuild_tag($token); - $result.=&Apache::edit::handle_insert(); } } return $result; } +# +# Utility sub to compute the width of a label. +# +sub get_label_width { + my $label = shift; + &Apache::lonxml::debug("image label = $label"); + if (-e $label) { + &Apache::lonxml::debug("$label exists"); + } else { + &Apache::lonxml::debug("$label does not exist"); + } + my $magick = Image::Magick->new; + $magick->Read($label); + my $pixel_width = $magick->Get('width'); + return $pixel_width * $scale_factor; + + +} + +sub get_label_height { + my $label = shift; + &Apache::lonxml::debug("image label = $label"); + if (-e $label) { + &Apache::lonxml::debug("$label exists"); + } else { + &Apache::lonxml::debug("$label does not exist"); + } + my $magick = Image::Magick->new; + $magick->Read($label); + my $pixel_height = $magick->Get('height'); + return $pixel_height * $scale_factor; +} + sub add_vars { my ($name,$order,$label,$labelorder,$value,$image,$safeeval) = @_; if (!defined($name) || $name eq '') { return; } @@ -307,13 +429,13 @@ sub end_labelgroup { my $i=$Apache::randomlabel::obj_cnt++; if( $type eq 'text') { &add_vars($gname,$_,$label,$idx_arr[$_],$value,'',$safeeval); - $str = join(':',$x,$y,&Apache::lonnet::escape($label)); + $str = join(':',$x,$y,&escape($label)); $args{"cgi.$cgi_id.OBJTYPE"}.='LABEL:'; } elsif ( $type eq 'image') { &add_vars($gname,$_, $Apache::randomlabel::description[$idx_arr[$_]], $idx_arr[$_],$value,$label,$safeeval); - $str = join(':',$x,$y,&Apache::lonnet::escape($label)); + $str = join(':',$x,$y,&escape($label)); $args{"cgi.$cgi_id.OBJTYPE"}.='IMAGE:'; } else { &Apache::lonxml::error('Unknown type of label :'.$type.':'); @@ -325,33 +447,53 @@ sub end_labelgroup { my $WY1=0; # Web y-coord. of (ULC) my $wwidth=&Apache::lonxml::get_param('width',$parstack,$safeeval,-2); my $wheight=&Apache::lonxml::get_param('height',$parstack,$safeeval,-2); - my $texwidth=&adjust_textwidth(&Apache::lonxml::get_param('texwidth',$parstack,$safeeval,-2,1)); my $TeXsize=&Apache::lonxml::get_param('TeXsize',$parstack,$safeeval); if (!defined($TeXsize)) { $TeXsize='\\normalsize'; } - if (!$texwidth) { $texwidth=90; } - my $texheight=$texwidth*($wheight/$wwidth); my @idx_arr = (0 .. $#Apache::randomlabel::label_arr); &Apache::structuretags::shuffle(\@idx_arr); &Apache::lonxml::debug("Array is:".$#Apache::randomlabel::label_arr.":"); + $Apache::lonxml::debug = 0; for(my $i=0;$i <= $#Apache::randomlabel::label_arr; $i++) { my $label = "$Apache::randomlabel::label_arr[ $idx_arr[$i] ]"; my $x = $Apache::randomlabel::xcoord[$i]; - # FIXME the 3.5 here is the 'height' of the letter in TeX - my $y = $Apache::randomlabel::ycoord[$i]-3.5; + my $y = $Apache::randomlabel::ycoord[$i]; + if ( $type eq 'text' ) { + # FIXME the 3.5 here is the 'height' of the letter in TeX + $y=$y-3.5; + } + &Apache::lonxml::debug("initially: x= $x y= $y"); my $value = $Apache::randomlabel::value[$i]; #x latex coordinate - my $tcX=($x)*($texwidth/$wwidth); + my $tcX=($x)*($width_param/$wwidth); + &Apache::lonxml::debug("wparam = $width_param wwidth = $wwidth, texx = $tcX"); #y latex coordinate # my $ratio=($wwidth > 0 ? $wheight/$wwidth : 1 ); - my $tcY=$texheight-$y*($texheight/$wheight); + my $tcY=$height_param-$y*($height_param/$wheight); + if ( $type eq 'image') { + my $label_height = &get_label_height($label); + $tcY=$tcY-$label_height; + } + + &Apache::lonxml::debug("hparam = $height_param wheight = $wheight texy = $tcY"); $tcX=sprintf('%.2f',$tcX); $tcY=sprintf('%.2f',$tcY); - $result.='\put('.$tcX.','.$tcY.'){'.$TeXsize.' \bf '.$label.'}'."\n"; + $result .= '\put('.$tcX.','.$tcY.'){'; if( $type eq 'text') { + $result.= $TeXsize.' \bf '.$label."}\n"; &add_vars($gname,$i,$label,$idx_arr[$i],$value,'',$safeeval); } elsif ( $type eq 'image') { + my ($path,$file) = &Apache::londefdef::get_eps_image($label); + my $image_name = $path.$file; + # + # Note that spaces in e.. \includegraphics cause problems for Latex + # so they get replaced by _'s by lonprintout/printout and us: + # + my $label_width = &get_label_width($label); + + $result .= '\includegraphics[width='.$label_width.'mm]{' + .$image_name."}}\n"; &add_vars($gname,$i, $Apache::randomlabel::description[$idx_arr[$i]], $idx_arr[$i],$value,$label,$safeeval); @@ -359,6 +501,7 @@ sub end_labelgroup { &Apache::lonxml::error('Unknown type of label :'.$type.':'); } } + $Apache::lonxml::debug =0; } elsif ($target eq 'edit') { $result.=&Apache::edit::end_table; } @@ -367,9 +510,16 @@ sub end_labelgroup { # sub start_location { + $Apache::lonxml::debug = 0; my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_; my $x= &check_int(&Apache::lonxml::get_param('x',$parstack,$safeeval),50); my $y= &check_int(&Apache::lonxml::get_param('y',$parstack,$safeeval),50); + &Apache::lonxml::debug("x = $x y = $y"); + $x = $x*$label_xscale; + $y = $y*$label_yscale; + &Apache::lonxml::debug(" H = $height_param W = $width_param"); + &Apache::lonxml::debug(" XS = $label_xscale YS = $label_yscale"); + &Apache::lonxml::debug(" X = $x Y = $y"); my $value= &Apache::lonxml::get_param('value',$parstack,$safeeval); my $result=''; push(@Apache::randomlabel::xcoord,$x); @@ -388,9 +538,9 @@ sub start_location { $safeeval,'x','y','value'); if ($constructtag) { $result = &Apache::edit::rebuild_tag($token); - $result.=&Apache::edit::handle_insert(); } } + $Apache::lonxml::debug = 0; return $result; } @@ -402,6 +552,14 @@ sub end_location { } # +sub insert_label { + my ($after) = @_; + my $depth = scalar(@Apache::lonxml::depthcounter); + $depth-- if ($after); + my $inset = "\t"x$depth; + return "\n$inset"; +} + sub start_label { my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_; my $result=''; @@ -411,7 +569,7 @@ sub start_label { &Apache::lonxml::startredirection; } elsif ($target eq 'edit') { $result.=&Apache::edit::tag_start($target,$token,"$type Label"); - my $text=&Apache::lonxml::get_all_text("/label",$parser); + my $text=&Apache::lonxml::get_all_text("/label",$parser,$style); if ($type eq 'image') { $result.=&Apache::edit::end_row(). &Apache::edit::start_spanning_row(); @@ -449,6 +607,15 @@ sub end_label { my $type = &Apache::lonxml::get_param('type',$parstack,$safeeval,-2); my $ltext=&Apache::lonxml::endredirection; if ($type eq 'image') { + if ($target eq 'tex') { + # For tex targets, our image url has been potentially corrupted + # by prepending \'s in front of special latex symbols. + # For now we only worry about the _ case (most common?) + # There's a whole host of theim in lonxml::latex_special_symbols + # that could potentially have to be re-done. + + $ltext =~ s/\\_/_/g; + } &Apache::lonxml::debug("Turning $ltext, $Apache::lonxml::pwd[-1]"); $ltext=&Apache::imageresponse::clean_up_image($ltext); # $ltext=&Apache::lonnet::filelocation($Apache::lonxml::pwd[-1], 500 Internal Server Error

Internal Server Error

The server encountered an internal error or misconfiguration and was unable to complete your request.

Please contact the server administrator at root@localhost to inform them of the time this error occurred, and the actions you performed just before this error.

More information about this error may be available in the server error log.