Annotation of loncom/homework/drawimage.pm, revision 1.9

1.1       albertel    1: # The LearningOnline Network with CAPA
                      2: # programatic image drawing
                      3: #
1.9     ! www         4: # $Id: drawimage.pm,v 1.8 2004/09/09 07:34:48 albertel Exp $
1.1       albertel    5: #
                      6: # Copyright Michigan State University Board of Trustees
                      7: #
                      8: # This file is part of the LearningOnline Network with CAPA (LON-CAPA).
                      9: #
                     10: # LON-CAPA is free software; you can redistribute it and/or modify
                     11: # it under the terms of the GNU General Public License as published by
                     12: # the Free Software Foundation; either version 2 of the License, or
                     13: # (at your option) any later version.
                     14: #
                     15: # LON-CAPA is distributed in the hope that it will be useful,
                     16: # but WITHOUT ANY WARRANTY; without even the implied warranty of
                     17: # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
                     18: # GNU General Public License for more details.
                     19: #
                     20: # You should have received a copy of the GNU General Public License
                     21: # along with LON-CAPA; if not, write to the Free Software
                     22: # Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
                     23: #
                     24: # /home/httpd/html/adm/gpl.txt
                     25: #
                     26: # http://www.lon-capa.org/
                     27: #
                     28: 
                     29: package Apache::drawimage;
                     30: use strict;
                     31: use Apache::loncommon;
1.9     ! www        32: use lib '/home/httpd/lib/perl/';
        !            33: use LONCAPA;
        !            34:  
1.1       albertel   35: 
                     36: my %args;
                     37: my $cgi_id;
1.7       albertel   38: my @cgi_ids;
1.1       albertel   39: BEGIN {
                     40:     &Apache::lonxml::register('Apache::drawimage',('drawimage'));
                     41: }
                     42: 
                     43: sub start_drawimage {
                     44:     my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_;
1.7       albertel   45:     &Apache::lonxml::register('Apache::drawimage',('text','line','rectangle','arc','fill','polygon','image'));
1.1       albertel   46:     if ($target eq 'web' || $target eq 'tex') {
1.7       albertel   47: 	my $new_id=&Apache::loncommon::get_cgi_id();
                     48: 	if ($cgi_id) { push(@cgi_ids,$cgi_id); } else { undef(%args); }
                     49: 	$cgi_id=$new_id;
1.1       albertel   50:     }
1.7       albertel   51:     return '';
1.1       albertel   52: }
                     53: 
                     54: sub end_drawimage {
                     55:     my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_;
                     56:     my $result;
                     57:     if ($target eq 'web' || $target eq 'tex') {
1.7       albertel   58: 	my $width = &Apache::lonxml::get_param('width',$parstack,$safeeval);
                     59: 	my $height =&Apache::lonxml::get_param('height',$parstack,$safeeval);
                     60: 	my $bgcolor =&Apache::lonxml::get_param('bgcolor',$parstack,$safeeval);
                     61: 	if (!$width) { $width=300; }
                     62: 	if (!$height) { $height=300; }
                     63: 	$result.="<img width='$width' height='$height'
1.1       albertel   64:                            src='/adm/randomlabel.png?token=$cgi_id' />\n";
1.7       albertel   65: 	$args{"cgi.$cgi_id.SIZE"}=join(':',($width,$height));
                     66: 	$args{"cgi.$cgi_id.BGCOLOR"}=join(':',($bgcolor));
                     67: 	&Apache::lonnet::appenv(%args);
                     68: 	if (@cgi_ids) {
                     69: 	    $cgi_id=pop(@cgi_ids);
                     70: 	} else {
                     71: 	    undef($cgi_id);
1.1       albertel   72: 	}
1.7       albertel   73:     } elsif ($target eq 'edit') {
                     74:     } elsif ($target eq 'modified') {
1.1       albertel   75:     }
1.7       albertel   76:     
                     77:     &Apache::lonxml::register('Apache::drawimage',
                     78: 			      ('text','line','rectangle','arc','fill',
                     79: 			       'polygon'));
1.4       matthew    80:     return $result;
                     81: }
                     82: 
1.5       albertel   83: sub start_text {
1.4       matthew    84:     my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_;
                     85:     my $result;
                     86:     if ($target eq 'web' || $target eq 'tex') {
1.6       albertel   87: 	&Apache::lonxml::startredirection();
                     88:     }
                     89:     return $result;
                     90: }
                     91: 
                     92: sub end_text {
                     93:     my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_;
                     94:     my $result;
                     95:     if ($target eq 'web' || $target eq 'tex') {
1.4       matthew    96:         my $x     = &Apache::lonxml::get_param('x',$parstack,$safeeval);
                     97:         my $y     = &Apache::lonxml::get_param('y',$parstack,$safeeval);
                     98:         my $font  = &Apache::lonxml::get_param('font',$parstack,$safeeval);
                     99:         my $color = &Apache::lonxml::get_param('color',$parstack,$safeeval);
1.5       albertel  100:         my $direction = &Apache::lonxml::get_param('direction',$parstack,$safeeval);
1.6       albertel  101: 	my $text  = &Apache::lonxml::endredirection();
1.9     ! www       102:         $text = &escape($text);
1.4       matthew   103:         $args{"cgi.$cgi_id.OBJTYPE"}.='LABEL:';
                    104: 	my $i=$args{"cgi.$cgi_id.OBJCOUNT"}++;
1.5       albertel  105: 	$args{"cgi.$cgi_id.OBJ$i"}=join(':',($x,$y,$text,$font,$color,$direction));
1.4       matthew   106:     }
1.1       albertel  107:     return $result;
                    108: }
                    109: 
                    110: sub start_line {
                    111:     my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_;
                    112:     my $result;
                    113:     if ($target eq 'web' || $target eq 'tex') {
                    114: 	my $x1 = &Apache::lonxml::get_param('x1',$parstack,$safeeval);
                    115: 	my $y1 = &Apache::lonxml::get_param('y1',$parstack,$safeeval);
                    116: 	my $x2 = &Apache::lonxml::get_param('x2',$parstack,$safeeval);
                    117: 	my $y2 = &Apache::lonxml::get_param('y2',$parstack,$safeeval);
                    118: 	my $color = &Apache::lonxml::get_param('color',$parstack,$safeeval);
                    119: 	my $thickness = &Apache::lonxml::get_param('thickness',$parstack,$safeeval);
1.3       albertel  120: 	my $i=$args{"cgi.$cgi_id.OBJCOUNT"}++;
1.1       albertel  121: 	$args{"cgi.$cgi_id.OBJ$i"}=join(':',($x1,$y1,$x2,$y2,$color,$thickness));
                    122: 	$args{"cgi.$cgi_id.OBJTYPE"}.='LINE:';
                    123:     }
                    124:     return $result;
                    125: }
                    126: 
                    127: sub end_line {
                    128:     my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_;
                    129:     my $result;
                    130:     return $result;
                    131: }
                    132: 
                    133: sub start_rectangle {
                    134:     my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_;
                    135:     my $result;
                    136:     if ($target eq 'web' || $target eq 'tex') {
                    137: 	my $x1 = &Apache::lonxml::get_param('x1',$parstack,$safeeval);
                    138: 	my $y1 = &Apache::lonxml::get_param('y1',$parstack,$safeeval);
                    139: 	my $x2 = &Apache::lonxml::get_param('x2',$parstack,$safeeval);
                    140: 	my $y2 = &Apache::lonxml::get_param('y2',$parstack,$safeeval);
                    141: 	my $color = &Apache::lonxml::get_param('color',$parstack,$safeeval);
                    142: 	my $thickness = &Apache::lonxml::get_param('thickness',$parstack,
                    143: 						   $safeeval);
                    144: 	my $filled = &Apache::lonxml::get_param('filled',$parstack,
                    145: 						$safeeval);
1.3       albertel  146: 	my $i=$args{"cgi.$cgi_id.OBJCOUNT"}++;
1.1       albertel  147: 	$args{"cgi.$cgi_id.OBJ$i"}=
                    148: 	    join(':',($x1,$y1,$x2,$y2,$color,$thickness,$filled));
                    149: 	$args{"cgi.$cgi_id.OBJTYPE"}.='RECTANGLE:';
                    150:     }
                    151:     return $result;
                    152: }
                    153: 
                    154: sub end_rectangle {
                    155:     my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_;
                    156:     my $result;
                    157:     return $result;
                    158: }
                    159: 
                    160: sub start_arc {
                    161:     my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_;
                    162:     my $result;
                    163:     if ($target eq 'web' || $target eq 'tex') {
                    164: 	my $x = &Apache::lonxml::get_param('x',$parstack,$safeeval);
                    165: 	my $y = &Apache::lonxml::get_param('y',$parstack,$safeeval);
                    166: 	my $width = &Apache::lonxml::get_param('width',$parstack,$safeeval);
                    167: 	my $height = &Apache::lonxml::get_param('height',$parstack,$safeeval);
                    168: 	my $start = &Apache::lonxml::get_param('start',$parstack,$safeeval);
                    169: 	my $end = &Apache::lonxml::get_param('end',$parstack,$safeeval);
                    170: 	my $color = &Apache::lonxml::get_param('color',$parstack,$safeeval);
                    171: 	my $thickness = &Apache::lonxml::get_param('thickness',$parstack,$safeeval);
                    172: 	my $filled = &Apache::lonxml::get_param('filled',$parstack,$safeeval);
1.3       albertel  173: 	my $i=$args{"cgi.$cgi_id.OBJCOUNT"}++;
1.1       albertel  174: 	$args{"cgi.$cgi_id.OBJ$i"}=
                    175: 	    join(':',($x,$y,$width,$height,$start,$end,$color,$thickness,
                    176: 		      $filled));
                    177: 	$args{"cgi.$cgi_id.OBJTYPE"}.='ARC:';
                    178:     }
                    179:     return $result;
                    180: }
                    181: 
                    182: sub end_arc {
                    183:     my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_;
                    184:     my $result;
                    185:     return $result;
                    186: }
                    187: 
1.2       albertel  188: sub start_fill {
1.1       albertel  189:     my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_;
                    190:     my $result;
                    191:     if ($target eq 'web' || $target eq 'tex') {
                    192: 	my $x = &Apache::lonxml::get_param('x',$parstack,$safeeval);
                    193: 	my $y = &Apache::lonxml::get_param('y',$parstack,$safeeval);
                    194: 	my $color = &Apache::lonxml::get_param('color',$parstack,$safeeval);
1.3       albertel  195: 	my $i=$args{"cgi.$cgi_id.OBJCOUNT"}++;
1.1       albertel  196: 	$args{"cgi.$cgi_id.OBJ$i"}=join(':',($x,$y,$color));
                    197: 	$args{"cgi.$cgi_id.OBJTYPE"}.='FILL:';
                    198:     }
                    199:     return $result;
                    200: }
                    201: 
1.2       albertel  202: sub end_fill {
1.1       albertel  203:     my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_;
                    204:     my $result;
                    205:     return $result;
                    206: }
                    207: 
1.7       albertel  208: my @polygon;
                    209: sub start_polygon {
                    210:     my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_;
                    211:     my $result;
                    212:     &Apache::lonxml::register('Apache::drawimage',('point'));
                    213:     if ($target eq 'web') {
                    214: 	undef(@polygon);
                    215:     }
                    216:     return $result;
                    217: }
                    218: 
                    219: sub end_polygon {
                    220:     my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_;
                    221:     my $result;    
                    222:     if ($target eq 'web') {
                    223: 	my $color=&Apache::lonxml::get_param('color',$parstack,$safeeval);
                    224: 	my $filled=&Apache::lonxml::get_param('filled',$parstack,$safeeval);
                    225: 	my $open=&Apache::lonxml::get_param('open',$parstack,$safeeval);
                    226: 	my $thickness = &Apache::lonxml::get_param('thickness',$parstack,
                    227: 						   $safeeval);
                    228: 	my $i=$args{"cgi.$cgi_id.OBJCOUNT"}++;
                    229: 	$args{"cgi.$cgi_id.OBJTYPE"}.='POLYGON:';
                    230: 	$args{"cgi.$cgi_id.OBJ$i"}=join(':',($color,$thickness,$open,$filled));
                    231: 	$args{"cgi.$cgi_id.OBJEXTRA$i"}=join('-',@polygon);
                    232:     }
                    233:     &Apache::lonxml::deregister('Apache::drawimage',('point'));
                    234:     return $result;
                    235: }
                    236: 
                    237: sub start_point {
                    238:     my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_;
                    239:     my $result;
                    240:     if ($target eq 'web') {
                    241: 	my $x = &Apache::lonxml::get_param('x',$parstack,$safeeval);
                    242:         my $y = &Apache::lonxml::get_param('y',$parstack,$safeeval);
                    243: 	push (@polygon,"($x,$y)");
                    244:     }
                    245:     return $result;
                    246: }
                    247: 
                    248: sub end_point {
                    249:     my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_;
                    250:     my $result;
                    251:     return $result;
                    252: }
                    253: 
                    254: sub start_image {
                    255:     my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_;
                    256:     my $result;
                    257:     if ($target eq 'web' || $target eq 'tex') {
                    258: 	&Apache::lonxml::startredirection();
                    259:     }
                    260:     return $result;
                    261: }
1.1       albertel  262: 
1.7       albertel  263: sub end_image {
                    264:     my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_;
                    265:     my $result;
                    266:     if ($target eq 'web' || $target eq 'tex') {
                    267: 	my $bgimg=&Apache::lonxml::endredirection();
                    268: 	my $x = &Apache::lonxml::get_param('x',$parstack,$safeeval);
                    269:         my $y = &Apache::lonxml::get_param('y',$parstack,$safeeval);
                    270: 	my $clipx = &Apache::lonxml::get_param('clipx',$parstack,$safeeval);
                    271:         my $clipy = &Apache::lonxml::get_param('clipy',$parstack,$safeeval);
                    272: 	my $clipwidth = 
                    273: 	    &Apache::lonxml::get_param('clipwidth',$parstack,$safeeval);
                    274:         my $clipheight = 
                    275: 	    &Apache::lonxml::get_param('clipheight',$parstack,$safeeval);
                    276: 	my $scaledwidth = 
                    277: 	    &Apache::lonxml::get_param('scaledwidth',$parstack,$safeeval);
                    278:         my $scaledheight = 
                    279: 	    &Apache::lonxml::get_param('scaledheight',$parstack,$safeeval);
                    280: 	my $transparent = 
                    281: 	    &Apache::lonxml::get_param('transparent',$parstack,$safeeval);
                    282: 	$bgimg=&Apache::imageresponse::clean_up_image($bgimg);
                    283: 	my $i=$args{"cgi.$cgi_id.OBJCOUNT"}++;
                    284: 	$args{"cgi.$cgi_id.OBJTYPE"}.='IMAGE:';
                    285: 	$args{"cgi.$cgi_id.OBJ$i"} = 
1.9     ! www       286: 	    join(':',($x,$y,&escape($bgimg),$transparent,
1.7       albertel  287: 		      $clipx,$clipy,$scaledwidth,$scaledheight,$clipwidth,$clipheight));
                    288:     }
                    289:     return $result;
                    290: }
1.1       albertel  291: 1;
                    292: __END__

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