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

1.14    ! raeburn     1: # $Id: imagechoice.pm,v 1.13 2007/05/02 01:33:02 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);
1.8       albertel   28: use Apache::lonnet;
1.11      www        29: use LONCAPA;
                     30:  
1.1       albertel   31: 
1.2       albertel   32: sub deletedata {
                     33:     my ($id)=@_;
1.3       albertel   34:     &Apache::lonnet::delenv("imagechoice\\.$id\\.coords");
1.2       albertel   35: }
1.1       albertel   36: 
                     37: sub closewindow {
1.9       albertel   38:     my ($r,$output,$filename,$needimage,$display)=@_;
1.4       albertel   39:     if ($needimage) {
                     40: 	$needimage="<img name=\"pickimg\" src=\"$filename\" />";
                     41:     }
1.10      albertel   42:     my $js=<<"ENDSUBM";
                     43: <script type="text/javascript">
1.1       albertel   44:     function submitthis() {
                     45: 	$output
                     46: 	self.close();
                     47:     }
                     48: </script>
1.10      albertel   49: ENDSUBM
                     50: 
                     51:     my $start_page =
                     52:         &Apache::loncommon::start_page('Close Window',$js,
                     53: 				       {'bgcolor'     => '#FFFFFF',
                     54: 					'only_body'   => 1,
                     55: 					'add_entries' => {
                     56: 					    onload => 'submitthis();'},});
                     57: 
                     58:     my $end_page =
                     59:         &Apache::loncommon::end_page();
                     60: 
1.12      albertel   61:     $r->print(<<"ENDSUBM");
1.10      albertel   62: $start_page
1.1       albertel   63: <h3>Position Selected</h3>
1.9       albertel   64: $display
1.4       albertel   65: $needimage
1.10      albertel   66: $end_page
1.1       albertel   67: ENDSUBM
                     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.9       albertel   91: 	    $display.="<p>The X coordinate is $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.9       albertel   95: 	    $display.="<p>The Y coordinate is $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.9       albertel  103: 	$display.="<p>The selected coordinates are <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) {
                    107: 	$display.="<p>If this window fails to close you may need to manually replace the old coordinates with the above value.</p>\n";
                    108:     }
1.2       albertel  109:     &deletedata($id);
1.9       albertel  110:     &closewindow($r,$output,$filename,$needimage,$display);
1.1       albertel  111: }
                    112: 
                    113: sub getcoord {
1.3       albertel  114:     my ($r,$type,$filename,$id)=@_;
1.4       albertel  115:     my $heading='Select Position on Image';
1.1       albertel  116:     my $nextstage='';
1.3       albertel  117:     if ($type eq 'box') {
1.8       albertel  118: 	my (undef,@coords)=split(':',$env{"imagechoice.$id.coords"});
1.3       albertel  119: 	my $step=scalar(@coords)/2;
                    120: 	if ($step == 0) { 
1.4       albertel  121: 	    $heading='Select First Coordinate on Image';
1.3       albertel  122: 	    #$nextstage='<input type="hidden" name="type" value="pairtwo" />';
                    123: 	} elsif ($step == 1) {
1.4       albertel  124: 	    $heading='Select Second Coordinate on Image';
1.3       albertel  125: 	    #$nextstage='<input type="hidden" name="type" value="pairthree" />';
                    126: 	} else {
1.13      albertel  127: 	    $heading='Select Finish to save selection.';
1.3       albertel  128: 	    $nextstage='<input type="submit" name="finish" value="Finish" />';
                    129: 	}
                    130:     } elsif ($type eq 'polygon') {
1.1       albertel  131: 	$heading='Enter Coordinate or click finish to close Polygon';
                    132: 	$nextstage='<input type="submit" name="finish" value="Finish" />';
1.4       albertel  133:     } elsif ($type eq 'point') {
1.13      albertel  134: 	$heading='Click to select a Coordinate or click Finish to save current selection.';
1.4       albertel  135: 	$nextstage='<input type="submit" name="finish" value="Finish" />';
1.1       albertel  136:     }
1.10      albertel  137: 
                    138:     my $start_page =
                    139:         &Apache::loncommon::start_page('Get Coordinates',undef,
                    140: 				       {'bgcolor'     => '#FFFFFF',
                    141: 					'only_body'   => 1,});
                    142: 
                    143:     my $end_page =
                    144:         &Apache::loncommon::end_page();
1.1       albertel  145:     $r->print(<<"END");
1.10      albertel  146: $start_page
1.4       albertel  147: <h3>$heading</h3>
1.1       albertel  148: <form method="POST" action="/adm/imagechoice?token=$id">
                    149: $nextstage
1.2       albertel  150: <input type="submit" name="cancel" value="Cancel" />
                    151: <br />
1.1       albertel  152: <input name="image" type="image" src="$filename" />
                    153: </form>
1.10      albertel  154: $end_page
1.1       albertel  155: END
                    156: }
                    157: 
                    158: sub savecoord {
1.4       albertel  159:     my ($id,$type)=@_;
1.8       albertel  160:     if (defined($env{"form.image.x"}) && defined($env{"form.image.y"})) {
1.4       albertel  161: 	my $data;
                    162: 	if ($type eq 'point') {
1.8       albertel  163: 	    $data=join(':',(undef,$env{"form.image.x"},$env{"form.image.y"}));
1.4       albertel  164: 	} else {
1.8       albertel  165: 	    $data=join(':',($env{"imagechoice.$id.coords"},
                    166: 			    $env{"form.image.x"},$env{"form.image.y"}));
1.4       albertel  167: 	}
1.14    ! raeburn   168: 	&Apache::lonnet::appenv({"imagechoice.$id.coords"=>$data});
1.1       albertel  169:     }
1.8       albertel  170:     return int(scalar(split(':',$env{"imagechoice.$id.coords"}))/2);
1.1       albertel  171: }
                    172: 
1.5       albertel  173: sub add_obj {
                    174:     my ($x,$id,$type,$args,$extra)=@_;
                    175: 
                    176:     $$x{"cgi.$id.OBJTYPE"}.=$type.':';
                    177:     my $i=$$x{"cgi.$id.OBJCOUNT"}++;
                    178:     $$x{"cgi.$id.OBJ$i"}=$args;
                    179:     if (defined($extra)) { $$x{"cgi.$id.OBJEXTRA$i"}=$extra; }
                    180: }
                    181: 
1.1       albertel  182: sub drawX {
1.5       albertel  183:     my ($data,$imid,$x,$y)=@_;
1.1       albertel  184:     my $length = 6;
                    185:     my $width = 1;
                    186:     my $extrawidth = 2;
1.5       albertel  187:     &add_obj($data,$imid,'LINE',
                    188: 	     join(':',(($x-$length),($y-$length),($x+$length),($y+$length),
                    189: 		       "FFFFFF",($width+$extrawidth))));
                    190:     &add_obj($data,$imid,'LINE',
1.1       albertel  191: 	join(':',(($x-$length),($y+$length),($x+$length),($y-$length),
1.5       albertel  192: 		  "FFFFFF",($width+$extrawidth))));
                    193:     &add_obj($data,$imid,'LINE',
1.1       albertel  194: 	join(':',(($x-$length),($y-$length),($x+$length),($y+$length),
1.5       albertel  195: 		  "FF0000",($width))));
                    196:     &add_obj($data,$imid,'LINE',
1.1       albertel  197: 	join(':',(($x-$length),($y+$length),($x+$length),($y-$length),
1.5       albertel  198: 		  "FF0000",($width))));
1.1       albertel  199: }
                    200: 
                    201: sub drawPolygon {
1.5       albertel  202:     my ($data,$id,$imid)=@_;
1.8       albertel  203:     my (undef,@coords)=split(':',$env{"imagechoice.$id.coords"});
1.1       albertel  204:     my $coordstr;
                    205:     while (@coords) {
                    206: 	$coordstr.='('.shift(@coords).','.shift(@coords).')-';
                    207:     }
                    208:     chop($coordstr);
                    209:     my $width = 1;
                    210:     my $extrawidth = 2;
1.5       albertel  211:     &add_obj($data,$imid,'POLYGON',
                    212: 	     join(':',("FFFFFF",($width+$extrawidth)),'1'),$coordstr);
                    213:     &add_obj($data,$imid,'POLYGON',
                    214: 	     join(':',("00FF00",($width)),'1'),$coordstr);
1.1       albertel  215: }
                    216: 
1.3       albertel  217: sub drawBox {
1.5       albertel  218:     my ($data,$id,$imid)=@_;
1.8       albertel  219:     my (undef,@coords)=split(':',$env{"imagechoice.$id.coords"});
1.5       albertel  220:     if (scalar(@coords) < 4) { return ''; }
1.3       albertel  221:     my $width = 1;
                    222:     my $extrawidth = 2;
1.5       albertel  223:     &add_obj($data,$imid,'RECTANGLE',
                    224: 	     join(':',(@coords,"FFFFFF",($width+$extrawidth))));
                    225:     &add_obj($data,$imid,'RECTANGLE',join(':',(@coords,"00FF00",$width)));
1.3       albertel  226: }
                    227: 
1.1       albertel  228: sub drawimage {
1.3       albertel  229:     my ($r,$type,$filename,$id)=@_;
1.1       albertel  230:     my $imid=&Apache::loncommon::get_cgi_id();
1.8       albertel  231:     my (undef,@coords)=split(':',$env{"imagechoice.$id.coords"});
1.2       albertel  232:     if (scalar(@coords) < 2) { return &Apache::lonnet::hreflocation('',$filename); }
1.1       albertel  233:     my %data;
                    234:     $data{"cgi.$imid.BGIMG"}=$filename;
1.3       albertel  235:     my $x=$coords[-2];
                    236:     my $y=$coords[-1];
1.5       albertel  237:     &drawX(\%data,$imid,$x,$y);
                    238:     if ($type eq "polygon") { &drawPolygon(\%data,$id,$imid); }
                    239:     if ($type eq "box") { &drawBox(\%data,$id,$imid); }
1.14    ! raeburn   240:     &Apache::lonnet::appenv(\%data);
1.1       albertel  241:     return "/adm/randomlabel.png?token=$imid"
                    242: }
                    243: 
                    244: sub handler {
                    245:     my ($r)=@_;
1.7       albertel  246:     &Apache::loncommon::content_type($r,'text/html');
                    247:     $r->send_http_header;
1.1       albertel  248:     my %data;
                    249:     my (undef,$id) = split(/=/,$ENV{'QUERY_STRING'});
1.11      www       250:     my $filename = &unescape($env{"imagechoice.$id.file"});
1.8       albertel  251:     my $formname = $env{"imagechoice.$id.formname"};
                    252:     if ($env{'form.cancel'} eq 'Cancel') {
1.2       albertel  253: 	&deletedata($id);
                    254: 	&closewindow($r,'',$filename);
1.3       albertel  255: 	return OK;
1.2       albertel  256:     }
1.8       albertel  257:     my $type=$env{"imagechoice.$id.type"};
                    258:     if (defined($env{'form.type'})) { $type=$env{'form.type'}; }
1.4       albertel  259:     my $numcoords=&savecoord($id,$type);
1.3       albertel  260:     my $imurl=&drawimage($r,$type,$filename,$id);
1.8       albertel  261:     if (($env{'form.finish'} eq 'Finish')) {
1.3       albertel  262: 	&storedata($r,$type,$imurl,$id);
                    263:     } else {
                    264: 	&getcoord($r,$type,$imurl,$id);
1.1       albertel  265:     }
                    266:     return OK;
                    267: }
                    268: 
                    269: 1;
                    270: 
                    271: __END__
                    272: 
                    273: 

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