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

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

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