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

1.2     ! albertel    1: # $Id: imagechoice.pm,v 1.1 2004/01/09 23:22:19 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);
                     28: 
                     29: 
1.2     ! albertel   30: sub deletedata {
        !            31:     my ($id)=@_;
        !            32:     &Apache::lonnet::delenv("imagechoice\\.$id");
        !            33: }
1.1       albertel   34: 
                     35: sub closewindow {
                     36:     my ($r,$output,$filename)=@_;
                     37:     $r->print(<<"ENDSUBM");
                     38: <html>
                     39: <script>
                     40:     function submitthis() {
                     41: 	$output
                     42: 	self.close();
                     43:     }
                     44: </script>
                     45: <body bgcolor="#FFFFFF" onLoad="submitthis()">
                     46: <h3>Position Selected</h3>
1.2     ! albertel   47: <!--<img name="pickimg" src="$filename" />-->
1.1       albertel   48: </body>
                     49: </html>
                     50: ENDSUBM
                     51: }
                     52: 
                     53: sub storedata {
                     54:     my ($r,$mode,$filename,$id)=@_;
                     55: 
1.2     ! albertel   56:     my (undef,@coords)=split(':',$ENV{"imagechoice.$id.coords"});
1.1       albertel   57: 
                     58:     my $output;
                     59: 
1.2     ! albertel   60:     if ($ENV{"imagechoice.$id.formwidth"}) {
        !            61: 	$output.='opener.document.forms.'.$ENV{"imagechoice.$id.formname"}.'.'.$ENV{"imagechoice.$id.formwidth"}.'.value=document.pickimg.width;';
1.1       albertel   62:     }
1.2     ! albertel   63:     if ($ENV{"imagechoice.$id.formheight"}) {
        !            64: 	$output.='opener.document.forms.'.$ENV{"imagechoice.$id.formname"}.'.'.$ENV{"imagechoice.$id.formheight"}.'.value=document.pickimg.height;';
1.1       albertel   65:     }
                     66: 
1.2     ! albertel   67:     if ((defined($ENV{"imagechoice.$id.x"})) && (defined($ENV{"imagechoice.$id.y"})) && 
1.1       albertel   68: 	($mode ne 'pairtwo') && ($mode ne 'pairthree')) {
                     69: 	my $output='';
1.2     ! albertel   70: 	if ($ENV{"imagechoice.$id.formx"}) {
        !            71: 	    $output.='opener.document.forms.'.$ENV{"imagechoice.$id.formname"}.'.'.$ENV{"imagechoice.$id.formx"}.
        !            72: 		'.value='.$ENV{"imagechoice.$id.x"}.';';
1.1       albertel   73: 	}
1.2     ! albertel   74: 	if ($ENV{"imagechoice.$id.formy"}) {
        !            75: 	    $output.='opener.document.forms.'.$ENV{"imagechoice.$id.formname"}.'.'.$ENV{"imagechoice.$id.formy"}.
        !            76: 		'.value='.$ENV{"imagechoice.$id.y"}.';';
1.1       albertel   77: 	}
                     78:     } elsif ($mode eq 'pairthree') {
                     79: 	my $output='';
1.2     ! albertel   80: 	my $outputpair='('.$ENV{"imagechoice.$id.selx"}.','.$ENV{"imagechoice.$id.sely"}.')-('.$ENV{"imagechoice.$id.x"}.','.$ENV{"imagechoice.$id.y"}.')';
1.1       albertel   81: 
1.2     ! albertel   82: 	if ($ENV{"imagechoice.$id.formcoord"}) {
        !            83: 	    $output.='opener.document.forms.'.$ENV{"imagechoice.$id.formname"}.'.'.$ENV{"imagechoice.$id.formcoord"}.
1.1       albertel   84: 		'.value="'.$outputpair.'";';
                     85: 	}
                     86:     } elsif ($mode eq 'polygon') {
                     87: 	my $coordstr;
                     88: 	while (@coords) {
                     89: 	    $coordstr.='('.shift(@coords).','.shift(@coords).')-';
                     90: 	}
                     91: 	chop($coordstr);
1.2     ! albertel   92: 	$output.='opener.document.forms.'.$ENV{"imagechoice.$id.formname"}.'.'.$ENV{"imagechoice.$id.formcoord"}.'.value="'.$coordstr.'";';
1.1       albertel   93:     }
1.2     ! albertel   94:     &deletedata($id);
1.1       albertel   95:     &closewindow($r,$output,$filename);
                     96: }
                     97: 
                     98: sub getcoord {
                     99:     my ($r,$mode,$filename,$id)=@_;
                    100:     my $heading='Position';
                    101:     my $nextstage='';
                    102:     if ($mode eq 'pair') {
                    103: 	$heading='First Coordinate';
                    104: 	$nextstage='<input type="hidden" name="mode" value="pairtwo" />';
                    105:     } elsif ($mode eq 'pairtwo') {
                    106: 	$heading='Second Coordinate';
                    107: 	$nextstage='<input type="hidden" name="mode" value="pairthree" />';
                    108:     } elsif ($mode eq 'polygon') {
                    109: 	$heading='Enter Coordinate or click finish to close Polygon';
                    110: 	$nextstage='<input type="submit" name="finish" value="Finish" />';
                    111:     }
                    112:     $r->print(<<"END");
                    113: <html>
                    114: <body bgcolor="#FFFFFF">
                    115: <h3>Select $heading on Image</h3>
                    116: <form method="POST" action="/adm/imagechoice?token=$id">
                    117: $nextstage
1.2     ! albertel  118: <input type="submit" name="cancel" value="Cancel" />
        !           119: <br />
1.1       albertel  120: <input name="image" type="image" src="$filename" />
                    121: </form>
                    122: </body>
                    123: </html>
                    124: END
                    125: }
                    126: 
                    127: sub savecoord {
                    128:     my ($id)=@_;
                    129:     if (defined($ENV{"form.image.x"}) && defined($ENV{"form.image.y"})) {
1.2     ! albertel  130: 	my $data=join(':',($ENV{"imagechoice.$id.coords"},$ENV{"form.image.x"},
1.1       albertel  131: 			   $ENV{"form.image.y"}));
1.2     ! albertel  132: 	&Apache::lonnet::appenv("imagechoice.$id.coords"=>$data);
1.1       albertel  133:     }
                    134: }
                    135: 
                    136: sub drawX {
                    137:     my ($imid,$x,$y)=@_;
                    138:     my %x;
                    139:     $x{"cgi.$imid.LINECOUNT"}=4;
                    140:     my $length = 6;
                    141:     my $width = 1;
                    142:     my $extrawidth = 2;
                    143:     $x{"cgi.$imid.LINE0"}=
                    144: 	join(':',(($x-$length),($y-$length),($x+$length),($y+$length),
                    145: 		  "FFFFFF",($width+$extrawidth)));
                    146:     $x{"cgi.$imid.LINE1"}=
                    147: 	join(':',(($x-$length),($y+$length),($x+$length),($y-$length),
                    148: 		  "FFFFFF",($width+$extrawidth)));
                    149:     $x{"cgi.$imid.LINE2"}=
                    150: 	join(':',(($x-$length),($y-$length),($x+$length),($y+$length),
                    151: 		  "FF0000",($width)));
                    152:     $x{"cgi.$imid.LINE3"}=
                    153: 	join(':',(($x-$length),($y+$length),($x+$length),($y-$length),
                    154: 		  "FF0000",($width)));
                    155:     return %x;
                    156: }
                    157: 
                    158: sub drawPolygon {
                    159:     my ($id,$imid)=@_;
1.2     ! albertel  160:     my (undef,@coords)=split(':',$ENV{"imagechoice.$id.coords"});
1.1       albertel  161:     my $coordstr;
                    162:     while (@coords) {
                    163: 	$coordstr.='('.shift(@coords).','.shift(@coords).')-';
                    164:     }
                    165:     chop($coordstr);
                    166:     my %x;
                    167:     my $width = 1;
                    168:     my $extrawidth = 2;
                    169:     my $i=$x{"cgi.$imid.POLYCOUNT"}++;
                    170:     $x{"cgi.$imid.POLYOPT$i"}=join(':',("FFFFFF",($width+$extrawidth)),'1');
                    171:     $x{"cgi.$imid.POLY$i"}=$coordstr;
                    172:     $i=$x{"cgi.$imid.POLYCOUNT"}++;
                    173:     $x{"cgi.$imid.POLYOPT$i"}=join(':',("00FF00",$width),'1');
                    174:     $x{"cgi.$imid.POLY$i"}=$coordstr;
                    175:     return %x;
                    176: }
                    177: 
                    178: sub drawimage {
                    179:     my ($r,$mode,$filename,$id)=@_;
                    180:     my $imid=&Apache::loncommon::get_cgi_id();
1.2     ! albertel  181:     my (undef,@coords)=split(':',$ENV{"imagechoice.$id.coords"});
        !           182:     if (scalar(@coords) < 2) { return &Apache::lonnet::hreflocation('',$filename); }
1.1       albertel  183:     my %data;
                    184:     $data{"cgi.$imid.BGIMG"}=$filename;
                    185:     my $x=@coords[-2];
                    186:     my $y=@coords[-1];
                    187:     %data=(%data,&drawX($imid,$x,$y));
                    188:     if ($mode eq "polygon") { %data=(%data,&drawPolygon($id,$imid)); }
                    189:     &Apache::lonnet::appenv(%data);
                    190:     return "/adm/randomlabel.png?token=$imid"
                    191: }
                    192: 
                    193: sub handler {
                    194:     my ($r)=@_;
                    195:     $r->content_type('text/html');
                    196:     my %data;
                    197:     my (undef,$id) = split(/=/,$ENV{'QUERY_STRING'});
1.2     ! albertel  198:     my $filename = &Apache::lonnet::unescape($ENV{"imagechoice.$id.file"});
        !           199:     my $formname = $ENV{"imagechoice.$id.formname"};
        !           200:     my $mode=$ENV{"imagechoice.$id.mode"};
        !           201:     if ($ENV{'form.cancel'} eq 'Cancel') {
        !           202: 	&deletedata($id);
        !           203: 	&closewindow($r,'',$filename);
        !           204:     }
1.1       albertel  205:     &savecoord($id);
                    206:     my $imurl=&drawimage($r,$mode,$filename,$id);
                    207:     if ($ENV{'form.finish'} eq 'Finish') {
                    208: 	&storedata($r,$mode,$imurl,$id);
                    209:     }
                    210:     &getcoord($r,$mode,$imurl,$id);
                    211:     return OK;
                    212: }
                    213: 
                    214: 1;
                    215: 
                    216: __END__
                    217: 
                    218: 

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