Return to imagechoice.pm CVS log

Up to [LON-CAPA] / loncom / homework

- Starting with lonnet.pm rev 1.981, default for &lonnet::delenv() has been to \Q escape arg in regexp used to identify items in environment to delete.
  - No longer need to escape special characters in arg passed to lonnet::delenv().
- Call to lonnet::delenv() in rat/lonuserstate now includes second arg, because in this case first arg is to be treated as a regexp (so \Q escape is not wanted).

    1: # $Id: imagechoice.pm,v 1.16 2009/02/18 07:06:12 raeburn Exp $
    2: #
    3: # Copyright Michigan State University Board of Trustees
    4: #
    5: # This file is part of the LearningOnline Network with CAPA (LON-CAPA).
    6: #
    7: # LON-CAPA is free software; you can redistribute it and/or modify
    8: # it under the terms of the GNU General Public License as published by
    9: # the Free Software Foundation; either version 2 of the License, or
   10: # (at your option) any later version.
   11: #
   12: # LON-CAPA is distributed in the hope that it will be useful,
   13: # but WITHOUT ANY WARRANTY; without even the implied warranty of
   14: # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
   15: # GNU General Public License for more details.
   16: #
   17: # You should have received a copy of the GNU General Public License
   18: # along with LON-CAPA; if not, write to the Free Software
   19: # Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
   20: #
   21: # /home/httpd/cgi-bin/plot.gif
   22: #
   23: # http://www.lon-capa.org/
   24: #
   25: package Apache::imagechoice;
   26: use strict;
   27: use Apache::Constants qw(:common :http);
   28: use Apache::lonnet;
   29: use Apache::lonlocal;
   30: use LONCAPA;
   31:  
   32: 
   33: sub deletedata {
   34:     my ($id)=@_;
   35:     &Apache::lonnet::delenv('imagechoice.'.$id.'.coords');
   36: }
   37: 
   38: sub closewindow {
   39:     my ($r,$output,$filename,$needimage,$display)=@_;
   40:     if ($needimage) {
   41: 	$needimage="<img name=\"pickimg\" src=\"$filename\" />";
   42:     }
   43:     my $js=<<"ENDSUBM";
   44: <script type="text/javascript">
   45:     function submitthis() {
   46: 	$output
   47: 	self.close();
   48:     }
   49: </script>
   50: ENDSUBM
   51: 
   52:     my $start_page =
   53:         &Apache::loncommon::start_page('Close Window',$js,
   54: 				       {'bgcolor'     => '#FFFFFF',
   55: 					'only_body'   => 1,
   56: 					'add_entries' => {
   57: 					    onload => 'submitthis();'},});
   58: 
   59:     my $end_page =
   60:         &Apache::loncommon::end_page();
   61: 
   62:     $r->print(<<"ENDSUBM");
   63: $start_page
   64: <h3>Position Selected</h3>
   65: $display
   66: $needimage
   67: $end_page
   68: ENDSUBM
   69: }
   70: 
   71: sub storedata {
   72:     my ($r,$type,$filename,$id)=@_;
   73: 
   74:     my (undef,@coords)=split(':',$env{"imagechoice.$id.coords"});
   75: 
   76:     my ($output,$needimage);
   77: 
   78:     if ($env{"imagechoice.$id.formwidth"}) {
   79: 	$output.='opener.document.forms.'.$env{"imagechoice.$id.formname"}.'.'.$env{"imagechoice.$id.formwidth"}.'.value=document.pickimg.width;';
   80: 	$needimage=1;
   81:     }
   82:     if ($env{"imagechoice.$id.formheight"}) {
   83: 	$output.='opener.document.forms.'.$env{"imagechoice.$id.formname"}.'.'.$env{"imagechoice.$id.formheight"}.'.value=document.pickimg.height;';
   84: 	$needimage=1;
   85:     }
   86: 
   87:     my $display;
   88:     if ($type eq 'point') {
   89: 	my (undef,$x,$y)=split(':',$env{"imagechoice.$id.coords"});
   90: 	if ($env{"imagechoice.$id.formx"}) {
   91: 	    $output.='opener.document.forms.'.$env{"imagechoice.$id.formname"}.'.'.$env{"imagechoice.$id.formx"}.'.value='.$x.';';
   92: 	    $display.="<p>The X coordinate is $x</p>\n";
   93: 	}
   94: 	if ($env{"imagechoice.$id.formy"}) {
   95: 	    $output.='opener.document.forms.'.$env{"imagechoice.$id.formname"}.'.'.$env{"imagechoice.$id.formy"}.'.value='.$y.';';
   96: 	    $display.="<p>The Y coordinate is $y</p>\n";
   97: 	}
   98:     } elsif ($type eq 'polygon' or $type eq 'box') {
   99: 	my $coordstr;
  100: 	while (@coords) {
  101: 	    $coordstr.='('.shift(@coords).','.shift(@coords).')-';
  102: 	}
  103: 	chop($coordstr);
  104: 	$display.="<p>The selected coordinates are <tt>$coordstr</tt></p>\n";
  105: 	$output.='opener.document.forms.'.$env{"imagechoice.$id.formname"}.'.'.$env{"imagechoice.$id.formcoord"}.'.value="'.$coordstr.'";';
  106:     }
  107:     if ($display) {
  108: 	$display.="<p>If this window fails to close you may need to manually replace the old coordinates with the above value.</p>\n";
  109:     }
  110:     &deletedata($id);
  111:     &closewindow($r,$output,$filename,$needimage,$display);
  112: }
  113: 
  114: sub getcoord {
  115:     my ($r,$type,$filename,$id)=@_;
  116:     my $heading=&mt('Select Position on Image');
  117:     my $nextstage='';
  118:     if ($type eq 'box') {
  119: 	my (undef,@coords)=split(':',$env{"imagechoice.$id.coords"});
  120: 	my $step=scalar(@coords)/2;
  121: 	if ($step == 0) { 
  122: 	    $heading=&mt('Select First Coordinate on Image');
  123: 	    #$nextstage='<input type="hidden" name="type" value="pairtwo" />';
  124: 	} elsif ($step == 1) {
  125: 	    $heading=&mt('Select Second Coordinate on Image');
  126: 	    #$nextstage='<input type="hidden" name="type" value="pairthree" />';
  127: 	} else {
  128: 	    $heading=&mt('Select Finish to save selection');
  129: 	    $nextstage='<input type="submit" name="finish" value="'.&mt('Finish').'" />';
  130: 	}
  131:     } elsif ($type eq 'polygon') {
  132: 	$heading=&mt('Enter Coordinate or click finish to close Polygon');
  133: 	$nextstage='<input type="submit" name="finish" value="'.&mt('Finish').'" />';
  134:     } elsif ($type eq 'point') {
  135: 	$heading=&mt('Click to select a Coordinate or click Finish to save current selection');
  136: 	$nextstage='<input type="submit" name="finish" value="'.&mt('Finish').'" />';
  137:     }
  138: 
  139:     my $start_page =
  140:         &Apache::loncommon::start_page('Get Coordinates',undef,
  141: 				       {'bgcolor'     => '#FFFFFF',
  142: 					'only_body'   => 1,});
  143: 
  144:     my $end_page =
  145:         &Apache::loncommon::end_page();
  146:     my $canceltext=&mt('Cancel');
  147:     $r->print(<<"END");
  148: $start_page
  149: <h3>$heading</h3>
  150: <form method="POST" action="/adm/imagechoice?token=$id">
  151: $nextstage
  152: <input type="submit" name="cancel" value="$canceltext" />
  153: <br />
  154: <input name="image" type="image" src="$filename" />
  155: </form>
  156: $end_page
  157: END
  158: }
  159: 
  160: sub savecoord {
  161:     my ($id,$type)=@_;
  162:     if (defined($env{"form.image.x"}) && defined($env{"form.image.y"})) {
  163: 	my $data;
  164: 	if ($type eq 'point') {
  165: 	    $data=join(':',(undef,$env{"form.image.x"},$env{"form.image.y"}));
  166: 	} else {
  167: 	    $data=join(':',($env{"imagechoice.$id.coords"},
  168: 			    $env{"form.image.x"},$env{"form.image.y"}));
  169: 	}
  170: 	&Apache::lonnet::appenv({"imagechoice.$id.coords"=>$data});
  171:     }
  172:     return int(scalar(split(':',$env{"imagechoice.$id.coords"}))/2);
  173: }
  174: 
  175: sub add_obj {
  176:     my ($x,$id,$type,$args,$extra)=@_;
  177: 
  178:     $$x{"cgi.$id.OBJTYPE"}.=$type.':';
  179:     my $i=$$x{"cgi.$id.OBJCOUNT"}++;
  180:     $$x{"cgi.$id.OBJ$i"}=$args;
  181:     if (defined($extra)) { $$x{"cgi.$id.OBJEXTRA$i"}=$extra; }
  182: }
  183: 
  184: sub drawX {
  185:     my ($data,$imid,$x,$y)=@_;
  186:     my $length = 6;
  187:     my $width = 1;
  188:     my $extrawidth = 2;
  189:     &add_obj($data,$imid,'LINE',
  190: 	     join(':',(($x-$length),($y-$length),($x+$length),($y+$length),
  191: 		       "FFFFFF",($width+$extrawidth))));
  192:     &add_obj($data,$imid,'LINE',
  193: 	join(':',(($x-$length),($y+$length),($x+$length),($y-$length),
  194: 		  "FFFFFF",($width+$extrawidth))));
  195:     &add_obj($data,$imid,'LINE',
  196: 	join(':',(($x-$length),($y-$length),($x+$length),($y+$length),
  197: 		  "FF0000",($width))));
  198:     &add_obj($data,$imid,'LINE',
  199: 	join(':',(($x-$length),($y+$length),($x+$length),($y-$length),
  200: 		  "FF0000",($width))));
  201: }
  202: 
  203: sub drawPolygon {
  204:     my ($data,$id,$imid)=@_;
  205:     my (undef,@coords)=split(':',$env{"imagechoice.$id.coords"});
  206:     my $coordstr;
  207:     while (@coords) {
  208: 	$coordstr.='('.shift(@coords).','.shift(@coords).')-';
  209:     }
  210:     chop($coordstr);
  211:     my $width = 1;
  212:     my $extrawidth = 2;
  213:     &add_obj($data,$imid,'POLYGON',
  214: 	     join(':',("FFFFFF",($width+$extrawidth)),'1'),$coordstr);
  215:     &add_obj($data,$imid,'POLYGON',
  216: 	     join(':',("00FF00",($width)),'1'),$coordstr);
  217: }
  218: 
  219: sub drawBox {
  220:     my ($data,$id,$imid)=@_;
  221:     my (undef,@coords)=split(':',$env{"imagechoice.$id.coords"});
  222:     if (scalar(@coords) < 4) { return ''; }
  223:     my $width = 1;
  224:     my $extrawidth = 2;
  225:     &add_obj($data,$imid,'RECTANGLE',
  226: 	     join(':',(@coords,"FFFFFF",($width+$extrawidth))));
  227:     &add_obj($data,$imid,'RECTANGLE',join(':',(@coords,"00FF00",$width)));
  228: }
  229: 
  230: sub drawimage {
  231:     my ($r,$type,$filename,$id)=@_;
  232:     my $imid=&Apache::loncommon::get_cgi_id();
  233:     my (undef,@coords)=split(':',$env{"imagechoice.$id.coords"});
  234:     if (scalar(@coords) < 2) { return &Apache::lonnet::hreflocation('',$filename); }
  235:     my %data;
  236:     $data{"cgi.$imid.BGIMG"}=$filename;
  237:     my $x=$coords[-2];
  238:     my $y=$coords[-1];
  239:     &drawX(\%data,$imid,$x,$y);
  240:     if ($type eq "polygon") { &drawPolygon(\%data,$id,$imid); }
  241:     if ($type eq "box") { &drawBox(\%data,$id,$imid); }
  242:     &Apache::lonnet::appenv(\%data);
  243:     return "/adm/randomlabel.png?token=$imid"
  244: }
  245: 
  246: sub handler {
  247:     my ($r)=@_;
  248:     &Apache::loncommon::content_type($r,'text/html');
  249:     $r->send_http_header;
  250:     my %data;
  251:     my (undef,$id) = split(/=/,$ENV{'QUERY_STRING'});
  252:     my $filename = &unescape($env{"imagechoice.$id.file"});
  253:     my $formname = $env{"imagechoice.$id.formname"};
  254:     if ($env{'form.cancel'} eq &mt('Cancel')) {
  255: 	&deletedata($id);
  256: 	&closewindow($r,'',$filename);
  257: 	return OK;
  258:     }
  259:     my $type=$env{"imagechoice.$id.type"};
  260:     if (defined($env{'form.type'})) { $type=$env{'form.type'}; }
  261:     my $numcoords=&savecoord($id,$type);
  262:     my $imurl=&drawimage($r,$type,$filename,$id);
  263:     if ($env{'form.finish'} eq &mt('Finish')) {
  264: 	&storedata($r,$type,$imurl,$id);
  265:     } else {
  266: 	&getcoord($r,$type,$imurl,$id);
  267:     }
  268:     return OK;
  269: }
  270: 
  271: 1;
  272: 
  273: __END__
  274: 
  275: