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

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

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