Annotation of loncom/homework/imagechoice.pm, revision 1.18
1.18 ! bisitz 1: # $Id: imagechoice.pm,v 1.17 2009/05/11 16:51:22 bisitz 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.15 bisitz 29: use Apache::lonlocal;
1.11 www 30: use LONCAPA;
31:
1.1 albertel 32:
1.2 albertel 33: sub deletedata {
34: my ($id)=@_;
1.16 raeburn 35: &Apache::lonnet::delenv('imagechoice.'.$id.'.coords');
1.2 albertel 36: }
1.1 albertel 37:
38: sub closewindow {
1.9 albertel 39: my ($r,$output,$filename,$needimage,$display)=@_;
1.4 albertel 40: if ($needimage) {
41: $needimage="<img name=\"pickimg\" src=\"$filename\" />";
42: }
1.10 albertel 43: my $js=<<"ENDSUBM";
44: <script type="text/javascript">
1.1 albertel 45: function submitthis() {
46: $output
47: self.close();
48: }
49: </script>
1.10 albertel 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:
1.18 ! bisitz 62: $r->print(
! 63: $start_page
! 64: .'<h1>'.&mt('Position Selected').'</h1>'
! 65: .$display
! 66: .$needimage
! 67: .$end_page);
1.1 albertel 68: }
69:
70: sub storedata {
1.3 albertel 71: my ($r,$type,$filename,$id)=@_;
1.1 albertel 72:
1.8 albertel 73: my (undef,@coords)=split(':',$env{"imagechoice.$id.coords"});
1.1 albertel 74:
1.4 albertel 75: my ($output,$needimage);
1.1 albertel 76:
1.8 albertel 77: if ($env{"imagechoice.$id.formwidth"}) {
78: $output.='opener.document.forms.'.$env{"imagechoice.$id.formname"}.'.'.$env{"imagechoice.$id.formwidth"}.'.value=document.pickimg.width;';
1.4 albertel 79: $needimage=1;
1.1 albertel 80: }
1.8 albertel 81: if ($env{"imagechoice.$id.formheight"}) {
82: $output.='opener.document.forms.'.$env{"imagechoice.$id.formname"}.'.'.$env{"imagechoice.$id.formheight"}.'.value=document.pickimg.height;';
1.4 albertel 83: $needimage=1;
1.1 albertel 84: }
85:
1.9 albertel 86: my $display;
1.4 albertel 87: if ($type eq 'point') {
1.8 albertel 88: my (undef,$x,$y)=split(':',$env{"imagechoice.$id.coords"});
89: if ($env{"imagechoice.$id.formx"}) {
90: $output.='opener.document.forms.'.$env{"imagechoice.$id.formname"}.'.'.$env{"imagechoice.$id.formx"}.'.value='.$x.';';
1.18 ! bisitz 91: $display.='<p>'.&mt('The X coordinate is [_1]',$x)."</p>\n";
1.1 albertel 92: }
1.8 albertel 93: if ($env{"imagechoice.$id.formy"}) {
94: $output.='opener.document.forms.'.$env{"imagechoice.$id.formname"}.'.'.$env{"imagechoice.$id.formy"}.'.value='.$y.';';
1.18 ! bisitz 95: $display.='<p>'.&mt('The Y coordinate is [_1]',$y)."</p>\n";
1.1 albertel 96: }
1.3 albertel 97: } elsif ($type eq 'polygon' or $type eq 'box') {
1.1 albertel 98: my $coordstr;
99: while (@coords) {
100: $coordstr.='('.shift(@coords).','.shift(@coords).')-';
101: }
102: chop($coordstr);
1.18 ! bisitz 103: $display.='<p>'.&mt('The selected coordinates are [_1]',"<tt>$coordstr</tt>")."</p>\n";
1.8 albertel 104: $output.='opener.document.forms.'.$env{"imagechoice.$id.formname"}.'.'.$env{"imagechoice.$id.formcoord"}.'.value="'.$coordstr.'";';
1.1 albertel 105: }
1.9 albertel 106: if ($display) {
1.18 ! bisitz 107: $display.='<p class="LC_info">'
! 108: .&mt('If this window fails to close you may need to manually replace the old coordinates with the above value.')
! 109: ."</p>\n";
1.9 albertel 110: }
1.2 albertel 111: &deletedata($id);
1.9 albertel 112: &closewindow($r,$output,$filename,$needimage,$display);
1.1 albertel 113: }
114:
115: sub getcoord {
1.3 albertel 116: my ($r,$type,$filename,$id)=@_;
1.15 bisitz 117: my $heading=&mt('Select Position on Image');
1.1 albertel 118: my $nextstage='';
1.3 albertel 119: if ($type eq 'box') {
1.8 albertel 120: my (undef,@coords)=split(':',$env{"imagechoice.$id.coords"});
1.3 albertel 121: my $step=scalar(@coords)/2;
122: if ($step == 0) {
1.18 ! bisitz 123: $heading=&mt('Select First Coordinate on Image.');
1.3 albertel 124: #$nextstage='<input type="hidden" name="type" value="pairtwo" />';
125: } elsif ($step == 1) {
1.18 ! bisitz 126: $heading=&mt('Select Second Coordinate on Image.');
1.3 albertel 127: #$nextstage='<input type="hidden" name="type" value="pairthree" />';
128: } else {
1.18 ! bisitz 129: $heading=&mt('Select [_1] to save selection.','"'.&mt('Save').'"');
! 130: $nextstage='<input type="submit" name="finish" value="'.&mt('Save').'" />';
1.3 albertel 131: }
132: } elsif ($type eq 'polygon') {
1.18 ! bisitz 133: $heading=&mt('Click to select a Coordinate or click [_1] to close Polygon.',
! 134: '"'.&mt('Save').'"');
! 135: $nextstage='<input type="submit" name="finish" value="'.&mt('Save').'" />';
1.4 albertel 136: } elsif ($type eq 'point') {
1.18 ! bisitz 137: $heading=&mt('Click to select a Coordinate or click [_1] to save current selection.',
! 138: '"'.&mt('Save').'"');
! 139: $nextstage='<input type="submit" name="finish" value="'.&mt('Save').'" />';
1.1 albertel 140: }
1.10 albertel 141:
1.18 ! bisitz 142: my $headline = 'Get Coordinates';
1.10 albertel 143: my $start_page =
1.18 ! bisitz 144: &Apache::loncommon::start_page($headline,undef,
1.10 albertel 145: {'bgcolor' => '#FFFFFF',
146: 'only_body' => 1,});
147: my $end_page =
148: &Apache::loncommon::end_page();
1.18 ! bisitz 149: $headline = &mt($headline);
1.15 bisitz 150: my $canceltext=&mt('Cancel');
1.1 albertel 151: $r->print(<<"END");
1.10 albertel 152: $start_page
1.18 ! bisitz 153: <h1>$headline</h1>
! 154: <p>$heading</p>
1.17 bisitz 155: <form method="post" action="/adm/imagechoice?token=$id">
1.1 albertel 156: $nextstage
1.15 bisitz 157: <input type="submit" name="cancel" value="$canceltext" />
1.2 albertel 158: <br />
1.1 albertel 159: <input name="image" type="image" src="$filename" />
160: </form>
1.10 albertel 161: $end_page
1.1 albertel 162: END
163: }
164:
165: sub savecoord {
1.4 albertel 166: my ($id,$type)=@_;
1.8 albertel 167: if (defined($env{"form.image.x"}) && defined($env{"form.image.y"})) {
1.4 albertel 168: my $data;
169: if ($type eq 'point') {
1.8 albertel 170: $data=join(':',(undef,$env{"form.image.x"},$env{"form.image.y"}));
1.4 albertel 171: } else {
1.8 albertel 172: $data=join(':',($env{"imagechoice.$id.coords"},
173: $env{"form.image.x"},$env{"form.image.y"}));
1.4 albertel 174: }
1.14 raeburn 175: &Apache::lonnet::appenv({"imagechoice.$id.coords"=>$data});
1.1 albertel 176: }
1.8 albertel 177: return int(scalar(split(':',$env{"imagechoice.$id.coords"}))/2);
1.1 albertel 178: }
179:
1.5 albertel 180: sub add_obj {
181: my ($x,$id,$type,$args,$extra)=@_;
182:
183: $$x{"cgi.$id.OBJTYPE"}.=$type.':';
184: my $i=$$x{"cgi.$id.OBJCOUNT"}++;
185: $$x{"cgi.$id.OBJ$i"}=$args;
186: if (defined($extra)) { $$x{"cgi.$id.OBJEXTRA$i"}=$extra; }
187: }
188:
1.1 albertel 189: sub drawX {
1.5 albertel 190: my ($data,$imid,$x,$y)=@_;
1.1 albertel 191: my $length = 6;
192: my $width = 1;
193: my $extrawidth = 2;
1.5 albertel 194: &add_obj($data,$imid,'LINE',
195: join(':',(($x-$length),($y-$length),($x+$length),($y+$length),
196: "FFFFFF",($width+$extrawidth))));
197: &add_obj($data,$imid,'LINE',
1.1 albertel 198: join(':',(($x-$length),($y+$length),($x+$length),($y-$length),
1.5 albertel 199: "FFFFFF",($width+$extrawidth))));
200: &add_obj($data,$imid,'LINE',
1.1 albertel 201: join(':',(($x-$length),($y-$length),($x+$length),($y+$length),
1.5 albertel 202: "FF0000",($width))));
203: &add_obj($data,$imid,'LINE',
1.1 albertel 204: join(':',(($x-$length),($y+$length),($x+$length),($y-$length),
1.5 albertel 205: "FF0000",($width))));
1.1 albertel 206: }
207:
208: sub drawPolygon {
1.5 albertel 209: my ($data,$id,$imid)=@_;
1.8 albertel 210: my (undef,@coords)=split(':',$env{"imagechoice.$id.coords"});
1.1 albertel 211: my $coordstr;
212: while (@coords) {
213: $coordstr.='('.shift(@coords).','.shift(@coords).')-';
214: }
215: chop($coordstr);
216: my $width = 1;
217: my $extrawidth = 2;
1.5 albertel 218: &add_obj($data,$imid,'POLYGON',
219: join(':',("FFFFFF",($width+$extrawidth)),'1'),$coordstr);
220: &add_obj($data,$imid,'POLYGON',
221: join(':',("00FF00",($width)),'1'),$coordstr);
1.1 albertel 222: }
223:
1.3 albertel 224: sub drawBox {
1.5 albertel 225: my ($data,$id,$imid)=@_;
1.8 albertel 226: my (undef,@coords)=split(':',$env{"imagechoice.$id.coords"});
1.5 albertel 227: if (scalar(@coords) < 4) { return ''; }
1.3 albertel 228: my $width = 1;
229: my $extrawidth = 2;
1.5 albertel 230: &add_obj($data,$imid,'RECTANGLE',
231: join(':',(@coords,"FFFFFF",($width+$extrawidth))));
232: &add_obj($data,$imid,'RECTANGLE',join(':',(@coords,"00FF00",$width)));
1.3 albertel 233: }
234:
1.1 albertel 235: sub drawimage {
1.3 albertel 236: my ($r,$type,$filename,$id)=@_;
1.1 albertel 237: my $imid=&Apache::loncommon::get_cgi_id();
1.8 albertel 238: my (undef,@coords)=split(':',$env{"imagechoice.$id.coords"});
1.2 albertel 239: if (scalar(@coords) < 2) { return &Apache::lonnet::hreflocation('',$filename); }
1.1 albertel 240: my %data;
241: $data{"cgi.$imid.BGIMG"}=$filename;
1.3 albertel 242: my $x=$coords[-2];
243: my $y=$coords[-1];
1.5 albertel 244: &drawX(\%data,$imid,$x,$y);
245: if ($type eq "polygon") { &drawPolygon(\%data,$id,$imid); }
246: if ($type eq "box") { &drawBox(\%data,$id,$imid); }
1.14 raeburn 247: &Apache::lonnet::appenv(\%data);
1.1 albertel 248: return "/adm/randomlabel.png?token=$imid"
249: }
250:
251: sub handler {
252: my ($r)=@_;
1.7 albertel 253: &Apache::loncommon::content_type($r,'text/html');
254: $r->send_http_header;
1.1 albertel 255: my %data;
256: my (undef,$id) = split(/=/,$ENV{'QUERY_STRING'});
1.11 www 257: my $filename = &unescape($env{"imagechoice.$id.file"});
1.8 albertel 258: my $formname = $env{"imagechoice.$id.formname"};
1.18 ! bisitz 259: if ($env{'form.cancel'}) { # eq &mt('Cancel')) {
1.2 albertel 260: &deletedata($id);
261: &closewindow($r,'',$filename);
1.3 albertel 262: return OK;
1.2 albertel 263: }
1.8 albertel 264: my $type=$env{"imagechoice.$id.type"};
265: if (defined($env{'form.type'})) { $type=$env{'form.type'}; }
1.4 albertel 266: my $numcoords=&savecoord($id,$type);
1.3 albertel 267: my $imurl=&drawimage($r,$type,$filename,$id);
1.18 ! bisitz 268: if ($env{'form.finish'}) { # eq &mt('Save')) {
1.3 albertel 269: &storedata($r,$type,$imurl,$id);
270: } else {
271: &getcoord($r,$type,$imurl,$id);
1.1 albertel 272: }
273: return OK;
274: }
275:
276: 1;
277:
278: __END__
279:
280:
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>
![[BACK]](/icons/back.gif){kind=icon}
Return to imagechoice.pm CVS log ![[TXT]](/icons/text.gif){kind=icon}
![[DIR]](/icons/dir.gif){kind=icon}
Up to [LON-CAPA] / loncom / homework