loncom/homework/imagechoice.pm - view

File: [LON-CAPA] / loncom / homework / imagechoice.pm
Revision 1.1: download - view: text, annotated - select for diffs
Fri Jan 9 23:22:19 2004 UTC (20 years, 4 months ago) by albertel
Branches: MAIN
CVS tags: HEAD

- polygonal correct areas in an image now allowed
- imagechoice.pl changed to imagechoice.pm (while I converted the code for handling the box and single point case I haven;'t tested them and I haven't yet converted the edit code to try to use it, maybe later tonight unless I do some woodworking instead)
- imagechoice now shows you were you have clicked on the image when doing polygonal selection,

1: # $Id: imagechoice.pm,v 1.1 2004/01/09 23:22:19 albertel 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: 29: # 30: # Single coordinate, defined - store it 31: # 32: 33: 34: sub closewindow { 35: my ($r,$output,$filename)=@_; 36: $r->print(<<"ENDSUBM"); 37: <html> 38: <script> 39: function submitthis() { 40: $output 41: self.close(); 42: } 43: </script> 44: <body bgcolor="#FFFFFF" onLoad="submitthis()"> 45: <h3>Position Selected</h3> 46: <img name="pickimg" src="$filename" /> 47: </body> 48: </html> 49: ENDSUBM 50: } 51: 52: sub storedata { 53: my ($r,$mode,$filename,$id)=@_; 54: 55: my (undef,@coords)=split(':',$ENV{"cgi.$id.coords"}); 56: 57: my $output; 58: 59: if ($ENV{"cgi.$id.formwidth"}) { 60: $output.='opener.document.forms.'.$ENV{"cgi.$id.formname"}.'.'.$ENV{"cgi.$id.formwidth"}.'.value=document.pickimg.width;'; 61: } 62: if ($ENV{"cgi.$id.formheight"}) { 63: $output.='opener.document.forms.'.$ENV{"cgi.$id.formname"}.'.'.$ENV{"cgi.$id.formheight"}.'.value=document.pickimg.height;'; 64: } 65: 66: if ((defined($ENV{"cgi.$id.x"})) && (defined($ENV{"cgi.$id.y"})) && 67: ($mode ne 'pairtwo') && ($mode ne 'pairthree')) { 68: my $output=''; 69: if ($ENV{"cgi.$id.formx"}) { 70: $output.='opener.document.forms.'.$ENV{"cgi.$id.formname"}.'.'.$ENV{"cgi.$id.formx"}. 71: '.value='.$ENV{"cgi.$id.x"}.';'; 72: } 73: if ($ENV{"cgi.$id.formy"}) { 74: $output.='opener.document.forms.'.$ENV{"cgi.$id.formname"}.'.'.$ENV{"cgi.$id.formy"}. 75: '.value='.$ENV{"cgi.$id.y"}.';'; 76: } 77: } elsif ($mode eq 'pairthree') { 78: my $output=''; 79: my $outputpair='('.$ENV{"cgi.$id.selx"}.','.$ENV{"cgi.$id.sely"}.')-('.$ENV{"cgi.$id.x"}.','.$ENV{"cgi.$id.y"}.')'; 80: 81: if ($ENV{"cgi.$id.formcoord"}) { 82: $output.='opener.document.forms.'.$ENV{"cgi.$id.formname"}.'.'.$ENV{"cgi.$id.formcoord"}. 83: '.value="'.$outputpair.'";'; 84: } 85: } elsif ($mode eq 'polygon') { 86: my $coordstr; 87: while (@coords) { 88: $coordstr.='('.shift(@coords).','.shift(@coords).')-'; 89: } 90: chop($coordstr); 91: $output.='opener.document.forms.'.$ENV{"cgi.$id.formname"}.'.'.$ENV{"cgi.$id.formcoord"}.'.value="'.$coordstr.'";'; 92: } 93: &closewindow($r,$output,$filename); 94: } 95: 96: sub getcoord { 97: my ($r,$mode,$filename,$id)=@_; 98: my $heading='Position'; 99: my $nextstage=''; 100: if ($mode eq 'pair') { 101: $heading='First Coordinate'; 102: $nextstage='<input type="hidden" name="mode" value="pairtwo" />'; 103: } elsif ($mode eq 'pairtwo') { 104: $heading='Second Coordinate'; 105: $nextstage='<input type="hidden" name="mode" value="pairthree" />'; 106: } elsif ($mode eq 'polygon') { 107: $heading='Enter Coordinate or click finish to close Polygon'; 108: $nextstage='<input type="submit" name="finish" value="Finish" />'; 109: } 110: $r->print(<<"END"); 111: <html> 112: <body bgcolor="#FFFFFF"> 113: <h3>Select $heading on Image</h3> 114: <form method="POST" action="/adm/imagechoice?token=$id"> 115: $nextstage 116: <input name="image" type="image" src="$filename" /> 117: </form> 118: </body> 119: </html> 120: END 121: } 122: 123: sub savecoord { 124: my ($id)=@_; 125: if (defined($ENV{"form.image.x"}) && defined($ENV{"form.image.y"})) { 126: my $data=join(':',($ENV{"cgi.$id.coords"},$ENV{"form.image.x"}, 127: $ENV{"form.image.y"})); 128: &Apache::lonnet::appenv("cgi.$id.coords"=>$data); 129: } 130: } 131: 132: sub drawX { 133: my ($imid,$x,$y)=@_; 134: my %x; 135: $x{"cgi.$imid.LINECOUNT"}=4; 136: my $length = 6; 137: my $width = 1; 138: my $extrawidth = 2; 139: $x{"cgi.$imid.LINE0"}= 140: join(':',(($x-$length),($y-$length),($x+$length),($y+$length), 141: "FFFFFF",($width+$extrawidth))); 142: $x{"cgi.$imid.LINE1"}= 143: join(':',(($x-$length),($y+$length),($x+$length),($y-$length), 144: "FFFFFF",($width+$extrawidth))); 145: $x{"cgi.$imid.LINE2"}= 146: join(':',(($x-$length),($y-$length),($x+$length),($y+$length), 147: "FF0000",($width))); 148: $x{"cgi.$imid.LINE3"}= 149: join(':',(($x-$length),($y+$length),($x+$length),($y-$length), 150: "FF0000",($width))); 151: return %x; 152: } 153: 154: sub drawPolygon { 155: my ($id,$imid)=@_; 156: my (undef,@coords)=split(':',$ENV{"cgi.$id.coords"}); 157: my $coordstr; 158: while (@coords) { 159: $coordstr.='('.shift(@coords).','.shift(@coords).')-'; 160: } 161: chop($coordstr); 162: my %x; 163: my $width = 1; 164: my $extrawidth = 2; 165: my $i=$x{"cgi.$imid.POLYCOUNT"}++; 166: $x{"cgi.$imid.POLYOPT$i"}=join(':',("FFFFFF",($width+$extrawidth)),'1'); 167: $x{"cgi.$imid.POLY$i"}=$coordstr; 168: $i=$x{"cgi.$imid.POLYCOUNT"}++; 169: $x{"cgi.$imid.POLYOPT$i"}=join(':',("00FF00",$width),'1'); 170: $x{"cgi.$imid.POLY$i"}=$coordstr; 171: return %x; 172: } 173: 174: sub drawimage { 175: my ($r,$mode,$filename,$id)=@_; 176: my $imid=&Apache::loncommon::get_cgi_id(); 177: my (undef,@coords)=split(':',$ENV{"cgi.$id.coords"}); 178: if (scalar(@coords) < 2) { return $filename; } 179: $filename=&Apache::lonnet::filelocation('',$filename); 180: my %data; 181: $data{"cgi.$imid.BGIMG"}=$filename; 182: my $x=@coords[-2]; 183: my $y=@coords[-1]; 184: %data=(%data,&drawX($imid,$x,$y)); 185: if ($mode eq "polygon") { %data=(%data,&drawPolygon($id,$imid)); } 186: &Apache::lonnet::appenv(%data); 187: return "/adm/randomlabel.png?token=$imid" 188: } 189: 190: sub handler { 191: my ($r)=@_; 192: $r->content_type('text/html'); 193: my %data; 194: my (undef,$id) = split(/=/,$ENV{'QUERY_STRING'}); 195: my $filename = $ENV{"cgi.$id.file"}; 196: my $formname = $ENV{"cgi.$id.formname"}; 197: my $mode=$ENV{"cgi.$id.mode"}; 198: $filename=&Apache::lonnet::unescape($filename); 199: &savecoord($id); 200: my $imurl=&drawimage($r,$mode,$filename,$id); 201: if ($ENV{'form.finish'} eq 'Finish') { 202: &storedata($r,$mode,$imurl,$id); 203: } 204: &getcoord($r,$mode,$imurl,$id); 205: return OK; 206: } 207: 208: 1; 209: 210: __END__ 211: 212: