Annotation of loncom/homework/imagechoice.pm, revision 1.9

1.9     ! albertel    1: # $Id: imagechoice.pm,v 1.8 2005/04/07 06:56:21 albertel Exp $
1.1       albertel    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);
1.8       albertel   28: use Apache::lonnet;
1.1       albertel   29: 
1.2       albertel   30: sub deletedata {
                     31:     my ($id)=@_;
1.3       albertel   32:     &Apache::lonnet::delenv("imagechoice\\.$id\\.coords");
1.2       albertel   33: }
1.1       albertel   34: 
                     35: sub closewindow {
1.9     ! albertel   36:     my ($r,$output,$filename,$needimage,$display)=@_;
1.4       albertel   37:     if ($needimage) {
                     38: 	$needimage="<img name=\"pickimg\" src=\"$filename\" />";
                     39:     }
1.1       albertel   40:     $r->print(<<"ENDSUBM");
                     41: <html>
                     42: <script>
                     43:     function submitthis() {
                     44: 	$output
                     45: 	self.close();
                     46:     }
                     47: </script>
                     48: <body bgcolor="#FFFFFF" onLoad="submitthis()">
                     49: <h3>Position Selected</h3>
1.9     ! albertel   50: $display
1.4       albertel   51: $needimage
1.1       albertel   52: </body>
                     53: </html>
                     54: ENDSUBM
                     55: }
                     56: 
                     57: sub storedata {
1.3       albertel   58:     my ($r,$type,$filename,$id)=@_;
1.1       albertel   59: 
1.8       albertel   60:     my (undef,@coords)=split(':',$env{"imagechoice.$id.coords"});
1.1       albertel   61: 
1.4       albertel   62:     my ($output,$needimage);
1.1       albertel   63: 
1.8       albertel   64:     if ($env{"imagechoice.$id.formwidth"}) {
                     65: 	$output.='opener.document.forms.'.$env{"imagechoice.$id.formname"}.'.'.$env{"imagechoice.$id.formwidth"}.'.value=document.pickimg.width;';
1.4       albertel   66: 	$needimage=1;
1.1       albertel   67:     }
1.8       albertel   68:     if ($env{"imagechoice.$id.formheight"}) {
                     69: 	$output.='opener.document.forms.'.$env{"imagechoice.$id.formname"}.'.'.$env{"imagechoice.$id.formheight"}.'.value=document.pickimg.height;';
1.4       albertel   70: 	$needimage=1;
1.1       albertel   71:     }
                     72: 
1.9     ! albertel   73:     my $display;
1.4       albertel   74:     if ($type eq 'point') {
1.8       albertel   75: 	my (undef,$x,$y)=split(':',$env{"imagechoice.$id.coords"});
                     76: 	if ($env{"imagechoice.$id.formx"}) {
                     77: 	    $output.='opener.document.forms.'.$env{"imagechoice.$id.formname"}.'.'.$env{"imagechoice.$id.formx"}.'.value='.$x.';';
1.9     ! albertel   78: 	    $display.="<p>The X coordinate is $x</p>\n";
1.1       albertel   79: 	}
1.8       albertel   80: 	if ($env{"imagechoice.$id.formy"}) {
                     81: 	    $output.='opener.document.forms.'.$env{"imagechoice.$id.formname"}.'.'.$env{"imagechoice.$id.formy"}.'.value='.$y.';';
1.9     ! albertel   82: 	    $display.="<p>The Y coordinate is $y</p>\n";
1.1       albertel   83: 	}
1.3       albertel   84:     } elsif ($type eq 'polygon' or $type eq 'box') {
1.1       albertel   85: 	my $coordstr;
                     86: 	while (@coords) {
                     87: 	    $coordstr.='('.shift(@coords).','.shift(@coords).')-';
                     88: 	}
                     89: 	chop($coordstr);
1.9     ! albertel   90: 	$display.="<p>The selected coordinates are <tt>$coordstr</tt></p>\n";
1.8       albertel   91: 	$output.='opener.document.forms.'.$env{"imagechoice.$id.formname"}.'.'.$env{"imagechoice.$id.formcoord"}.'.value="'.$coordstr.'";';
1.1       albertel   92:     }
1.9     ! albertel   93:     if ($display) {
        !            94: 	$display.="<p>If this window fails to close you may need to manually replace the old coordinates with the above value.</p>\n";
        !            95:     }
1.2       albertel   96:     &deletedata($id);
1.9     ! albertel   97:     &closewindow($r,$output,$filename,$needimage,$display);
1.1       albertel   98: }
                     99: 
                    100: sub getcoord {
1.3       albertel  101:     my ($r,$type,$filename,$id)=@_;
1.4       albertel  102:     my $heading='Select Position on Image';
1.1       albertel  103:     my $nextstage='';
1.3       albertel  104:     if ($type eq 'box') {
1.8       albertel  105: 	my (undef,@coords)=split(':',$env{"imagechoice.$id.coords"});
1.3       albertel  106: 	my $step=scalar(@coords)/2;
                    107: 	if ($step == 0) { 
1.4       albertel  108: 	    $heading='Select First Coordinate on Image';
1.3       albertel  109: 	    #$nextstage='<input type="hidden" name="type" value="pairtwo" />';
                    110: 	} elsif ($step == 1) {
1.4       albertel  111: 	    $heading='Select Second Coordinate on Image';
1.3       albertel  112: 	    #$nextstage='<input type="hidden" name="type" value="pairthree" />';
                    113: 	} else {
1.4       albertel  114: 	    $heading='Select Finish to store selection.';
1.3       albertel  115: 	    $nextstage='<input type="submit" name="finish" value="Finish" />';
                    116: 	}
                    117:     } elsif ($type eq 'polygon') {
1.1       albertel  118: 	$heading='Enter Coordinate or click finish to close Polygon';
                    119: 	$nextstage='<input type="submit" name="finish" value="Finish" />';
1.4       albertel  120:     } elsif ($type eq 'point') {
                    121: 	$heading='Click to select a Coordinate or click Finish to store current selection.';
                    122: 	$nextstage='<input type="submit" name="finish" value="Finish" />';
1.1       albertel  123:     }
                    124:     $r->print(<<"END");
                    125: <html>
                    126: <body bgcolor="#FFFFFF">
1.4       albertel  127: <h3>$heading</h3>
1.1       albertel  128: <form method="POST" action="/adm/imagechoice?token=$id">
                    129: $nextstage
1.2       albertel  130: <input type="submit" name="cancel" value="Cancel" />
                    131: <br />
1.1       albertel  132: <input name="image" type="image" src="$filename" />
                    133: </form>
                    134: </body>
                    135: </html>
                    136: END
                    137: }
                    138: 
                    139: sub savecoord {
1.4       albertel  140:     my ($id,$type)=@_;
1.8       albertel  141:     if (defined($env{"form.image.x"}) && defined($env{"form.image.y"})) {
1.4       albertel  142: 	my $data;
                    143: 	if ($type eq 'point') {
1.8       albertel  144: 	    $data=join(':',(undef,$env{"form.image.x"},$env{"form.image.y"}));
1.4       albertel  145: 	} else {
1.8       albertel  146: 	    $data=join(':',($env{"imagechoice.$id.coords"},
                    147: 			    $env{"form.image.x"},$env{"form.image.y"}));
1.4       albertel  148: 	}
1.2       albertel  149: 	&Apache::lonnet::appenv("imagechoice.$id.coords"=>$data);
1.1       albertel  150:     }
1.8       albertel  151:     return int(scalar(split(':',$env{"imagechoice.$id.coords"}))/2);
1.1       albertel  152: }
                    153: 
1.5       albertel  154: sub add_obj {
                    155:     my ($x,$id,$type,$args,$extra)=@_;
                    156: 
                    157:     $$x{"cgi.$id.OBJTYPE"}.=$type.':';
                    158:     my $i=$$x{"cgi.$id.OBJCOUNT"}++;
                    159:     $$x{"cgi.$id.OBJ$i"}=$args;
                    160:     if (defined($extra)) { $$x{"cgi.$id.OBJEXTRA$i"}=$extra; }
                    161: }
                    162: 
1.1       albertel  163: sub drawX {
1.5       albertel  164:     my ($data,$imid,$x,$y)=@_;
1.1       albertel  165:     my $length = 6;
                    166:     my $width = 1;
                    167:     my $extrawidth = 2;
1.5       albertel  168:     &add_obj($data,$imid,'LINE',
                    169: 	     join(':',(($x-$length),($y-$length),($x+$length),($y+$length),
                    170: 		       "FFFFFF",($width+$extrawidth))));
                    171:     &add_obj($data,$imid,'LINE',
1.1       albertel  172: 	join(':',(($x-$length),($y+$length),($x+$length),($y-$length),
1.5       albertel  173: 		  "FFFFFF",($width+$extrawidth))));
                    174:     &add_obj($data,$imid,'LINE',
1.1       albertel  175: 	join(':',(($x-$length),($y-$length),($x+$length),($y+$length),
1.5       albertel  176: 		  "FF0000",($width))));
                    177:     &add_obj($data,$imid,'LINE',
1.1       albertel  178: 	join(':',(($x-$length),($y+$length),($x+$length),($y-$length),
1.5       albertel  179: 		  "FF0000",($width))));
1.1       albertel  180: }
                    181: 
                    182: sub drawPolygon {
1.5       albertel  183:     my ($data,$id,$imid)=@_;
1.8       albertel  184:     my (undef,@coords)=split(':',$env{"imagechoice.$id.coords"});
1.1       albertel  185:     my $coordstr;
                    186:     while (@coords) {
                    187: 	$coordstr.='('.shift(@coords).','.shift(@coords).')-';
                    188:     }
                    189:     chop($coordstr);
                    190:     my $width = 1;
                    191:     my $extrawidth = 2;
1.5       albertel  192:     &add_obj($data,$imid,'POLYGON',
                    193: 	     join(':',("FFFFFF",($width+$extrawidth)),'1'),$coordstr);
                    194:     &add_obj($data,$imid,'POLYGON',
                    195: 	     join(':',("00FF00",($width)),'1'),$coordstr);
1.1       albertel  196: }
                    197: 
1.3       albertel  198: sub drawBox {
1.5       albertel  199:     my ($data,$id,$imid)=@_;
1.8       albertel  200:     my (undef,@coords)=split(':',$env{"imagechoice.$id.coords"});
1.5       albertel  201:     if (scalar(@coords) < 4) { return ''; }
1.3       albertel  202:     my $width = 1;
                    203:     my $extrawidth = 2;
1.5       albertel  204:     &add_obj($data,$imid,'RECTANGLE',
                    205: 	     join(':',(@coords,"FFFFFF",($width+$extrawidth))));
                    206:     &add_obj($data,$imid,'RECTANGLE',join(':',(@coords,"00FF00",$width)));
1.3       albertel  207: }
                    208: 
1.1       albertel  209: sub drawimage {
1.3       albertel  210:     my ($r,$type,$filename,$id)=@_;
1.1       albertel  211:     my $imid=&Apache::loncommon::get_cgi_id();
1.8       albertel  212:     my (undef,@coords)=split(':',$env{"imagechoice.$id.coords"});
1.2       albertel  213:     if (scalar(@coords) < 2) { return &Apache::lonnet::hreflocation('',$filename); }
1.1       albertel  214:     my %data;
                    215:     $data{"cgi.$imid.BGIMG"}=$filename;
1.3       albertel  216:     my $x=$coords[-2];
                    217:     my $y=$coords[-1];
1.5       albertel  218:     &drawX(\%data,$imid,$x,$y);
                    219:     if ($type eq "polygon") { &drawPolygon(\%data,$id,$imid); }
                    220:     if ($type eq "box") { &drawBox(\%data,$id,$imid); }
1.1       albertel  221:     &Apache::lonnet::appenv(%data);
                    222:     return "/adm/randomlabel.png?token=$imid"
                    223: }
                    224: 
                    225: sub handler {
                    226:     my ($r)=@_;
1.7       albertel  227:     &Apache::loncommon::content_type($r,'text/html');
                    228:     $r->send_http_header;
1.1       albertel  229:     my %data;
                    230:     my (undef,$id) = split(/=/,$ENV{'QUERY_STRING'});
1.8       albertel  231:     my $filename = &Apache::lonnet::unescape($env{"imagechoice.$id.file"});
                    232:     my $formname = $env{"imagechoice.$id.formname"};
                    233:     if ($env{'form.cancel'} eq 'Cancel') {
1.2       albertel  234: 	&deletedata($id);
                    235: 	&closewindow($r,'',$filename);
1.3       albertel  236: 	return OK;
1.2       albertel  237:     }
1.8       albertel  238:     my $type=$env{"imagechoice.$id.type"};
                    239:     if (defined($env{'form.type'})) { $type=$env{'form.type'}; }
1.4       albertel  240:     my $numcoords=&savecoord($id,$type);
1.3       albertel  241:     my $imurl=&drawimage($r,$type,$filename,$id);
1.8       albertel  242:     if (($env{'form.finish'} eq 'Finish')) {
1.3       albertel  243: 	&storedata($r,$type,$imurl,$id);
                    244:     } else {
                    245: 	&getcoord($r,$type,$imurl,$id);
1.1       albertel  246:     }
                    247:     return OK;
                    248: }
                    249: 
                    250: 1;
                    251: 
                    252: __END__
                    253: 
                    254: 

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