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, 5 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:
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>