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

1.1     ! albertel    1: # $Id: imagechoice.pl,v 1.4 2003/05/10 22:59:04 www 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>