Annotation of loncom/homework/drawimage.pm, revision 1.13
1.1 albertel 1: # The LearningOnline Network with CAPA
2: # programatic image drawing
3: #
1.13 ! raeburn 4: # $Id: drawimage.pm,v 1.12 2024/04/05 04:05:08 raeburn 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.12 raeburn 32: use Apache::lonnet;
33: use Apache::lonxml;
1.9 www 34: use lib '/home/httpd/lib/perl/';
1.12 raeburn 35: use Time::HiRes qw(gettimeofday);
1.9 www 36: use LONCAPA;
37:
1.1 albertel 38:
39: my %args;
40: my $cgi_id;
1.7 albertel 41: my @cgi_ids;
1.1 albertel 42: BEGIN {
43: &Apache::lonxml::register('Apache::drawimage',('drawimage'));
44: }
45:
46: sub start_drawimage {
47: my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_;
1.7 albertel 48: &Apache::lonxml::register('Apache::drawimage',('text','line','rectangle','arc','fill','polygon','image'));
1.1 albertel 49: if ($target eq 'web' || $target eq 'tex') {
1.7 albertel 50: my $new_id=&Apache::loncommon::get_cgi_id();
51: if ($cgi_id) { push(@cgi_ids,$cgi_id); } else { undef(%args); }
52: $cgi_id=$new_id;
1.1 albertel 53: }
1.7 albertel 54: return '';
1.1 albertel 55: }
56:
57: sub end_drawimage {
58: my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_;
59: my $result;
1.12 raeburn 60: # need to call rand everytime start_script would evaluate, as the
61: # safe space rand number generator and the global rand generator
62: # are not separate
63: my $randnumber;
64: if ($target eq 'web' || $target eq 'tex' || $target eq 'grade' ||
65: $target eq 'answer') {
66: $randnumber=int(rand(1000));
67: }
1.1 albertel 68: if ($target eq 'web' || $target eq 'tex') {
1.7 albertel 69: my $width = &Apache::lonxml::get_param('width',$parstack,$safeeval);
70: my $height =&Apache::lonxml::get_param('height',$parstack,$safeeval);
71: my $bgcolor =&Apache::lonxml::get_param('bgcolor',$parstack,$safeeval);
72: if (!$width) { $width=300; }
73: if (!$height) { $height=300; }
1.12 raeburn 74: $args{"cgi.$cgi_id.BGCOLOR"}=join(':',($bgcolor));
75: if ($target eq 'tex') {
76: my $texwidth=&Apache::lonxml::get_param('texwidth',$parstack,$safeeval,undef,1);
77: if (!$texwidth) { $texwidth='90'; }
78: $args{"cgi.$cgi_id.SIZE"}=join(':',($width,$height,$texwidth));
79: my $tmpdir = LONCAPA::tempdir(); # Where temporary files live:
80: ## Determine filename
81: my ($seconds, $microseconds) = gettimeofday;
82: my $filename = $env{'user.name'}.'_'.$env{'user.domain'}.
83: '_'.$seconds.'_'.$microseconds.'_'.$$.$randnumber.'_drawimage.eps';
84: $args{"cgi.$cgi_id.EPSFILE"} = $env{'user.name'}.'_'.$env{'user.domain'}.
85: '_'.$seconds.'_'.$microseconds.'_'.$$.$randnumber.
86: '_drawimage.eps';
87: $result = "%DYNAMICIMAGE:$width:$height:$texwidth\n";
88: $result .= '\graphicspath{{'.$tmpdir.'}}'."\n";
89: $result .= '\includegraphics[width='.$texwidth.' mm]{'.$filename.'}';
90: &Apache::lonxml::register_ssi('/adm/randomlabel.png?token='.$cgi_id);
91: } else {
92: $args{"cgi.$cgi_id.SIZE"}=join(':',($width,$height));
93: $result.="<img width='$width' height='$height'
1.1 albertel 94: src='/adm/randomlabel.png?token=$cgi_id' />\n";
1.12 raeburn 95: }
1.10 raeburn 96: &Apache::lonnet::appenv(\%args);
1.7 albertel 97: if (@cgi_ids) {
98: $cgi_id=pop(@cgi_ids);
99: } else {
100: undef($cgi_id);
1.1 albertel 101: }
1.7 albertel 102: } elsif ($target eq 'edit') {
103: } elsif ($target eq 'modified') {
1.1 albertel 104: }
1.7 albertel 105:
106: &Apache::lonxml::register('Apache::drawimage',
107: ('text','line','rectangle','arc','fill',
108: 'polygon'));
1.4 matthew 109: return $result;
110: }
111:
1.5 albertel 112: sub start_text {
1.4 matthew 113: my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_;
114: my $result;
115: if ($target eq 'web' || $target eq 'tex') {
1.6 albertel 116: &Apache::lonxml::startredirection();
117: }
118: return $result;
119: }
120:
121: sub end_text {
122: my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_;
123: my $result;
124: if ($target eq 'web' || $target eq 'tex') {
1.4 matthew 125: my $x = &Apache::lonxml::get_param('x',$parstack,$safeeval);
126: my $y = &Apache::lonxml::get_param('y',$parstack,$safeeval);
127: my $font = &Apache::lonxml::get_param('font',$parstack,$safeeval);
128: my $color = &Apache::lonxml::get_param('color',$parstack,$safeeval);
1.5 albertel 129: my $direction = &Apache::lonxml::get_param('direction',$parstack,$safeeval);
1.11 raeburn 130: my $rotation = &Apache::lonxml::get_param('rotation',$parstack,$safeeval);
1.6 albertel 131: my $text = &Apache::lonxml::endredirection();
1.9 www 132: $text = &escape($text);
1.4 matthew 133: $args{"cgi.$cgi_id.OBJTYPE"}.='LABEL:';
134: my $i=$args{"cgi.$cgi_id.OBJCOUNT"}++;
1.11 raeburn 135: $args{"cgi.$cgi_id.OBJ$i"}=join(':',($x,$y,$text,$font,$color,$direction,$rotation));
1.4 matthew 136: }
1.1 albertel 137: return $result;
138: }
139:
140: sub start_line {
141: my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_;
142: my $result;
143: if ($target eq 'web' || $target eq 'tex') {
144: my $x1 = &Apache::lonxml::get_param('x1',$parstack,$safeeval);
145: my $y1 = &Apache::lonxml::get_param('y1',$parstack,$safeeval);
146: my $x2 = &Apache::lonxml::get_param('x2',$parstack,$safeeval);
147: my $y2 = &Apache::lonxml::get_param('y2',$parstack,$safeeval);
148: my $color = &Apache::lonxml::get_param('color',$parstack,$safeeval);
149: my $thickness = &Apache::lonxml::get_param('thickness',$parstack,$safeeval);
1.3 albertel 150: my $i=$args{"cgi.$cgi_id.OBJCOUNT"}++;
1.1 albertel 151: $args{"cgi.$cgi_id.OBJ$i"}=join(':',($x1,$y1,$x2,$y2,$color,$thickness));
152: $args{"cgi.$cgi_id.OBJTYPE"}.='LINE:';
153: }
154: return $result;
155: }
156:
157: sub end_line {
158: my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_;
159: my $result;
160: return $result;
161: }
162:
163: sub start_rectangle {
164: my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_;
165: my $result;
166: if ($target eq 'web' || $target eq 'tex') {
167: my $x1 = &Apache::lonxml::get_param('x1',$parstack,$safeeval);
168: my $y1 = &Apache::lonxml::get_param('y1',$parstack,$safeeval);
169: my $x2 = &Apache::lonxml::get_param('x2',$parstack,$safeeval);
170: my $y2 = &Apache::lonxml::get_param('y2',$parstack,$safeeval);
171: my $color = &Apache::lonxml::get_param('color',$parstack,$safeeval);
172: my $thickness = &Apache::lonxml::get_param('thickness',$parstack,
173: $safeeval);
174: my $filled = &Apache::lonxml::get_param('filled',$parstack,
175: $safeeval);
1.3 albertel 176: my $i=$args{"cgi.$cgi_id.OBJCOUNT"}++;
1.1 albertel 177: $args{"cgi.$cgi_id.OBJ$i"}=
178: join(':',($x1,$y1,$x2,$y2,$color,$thickness,$filled));
179: $args{"cgi.$cgi_id.OBJTYPE"}.='RECTANGLE:';
180: }
181: return $result;
182: }
183:
184: sub end_rectangle {
185: my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_;
186: my $result;
187: return $result;
188: }
189:
190: sub start_arc {
191: my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_;
192: my $result;
193: if ($target eq 'web' || $target eq 'tex') {
194: my $x = &Apache::lonxml::get_param('x',$parstack,$safeeval);
195: my $y = &Apache::lonxml::get_param('y',$parstack,$safeeval);
196: my $width = &Apache::lonxml::get_param('width',$parstack,$safeeval);
197: my $height = &Apache::lonxml::get_param('height',$parstack,$safeeval);
198: my $start = &Apache::lonxml::get_param('start',$parstack,$safeeval);
199: my $end = &Apache::lonxml::get_param('end',$parstack,$safeeval);
200: my $color = &Apache::lonxml::get_param('color',$parstack,$safeeval);
201: my $thickness = &Apache::lonxml::get_param('thickness',$parstack,$safeeval);
202: my $filled = &Apache::lonxml::get_param('filled',$parstack,$safeeval);
1.3 albertel 203: my $i=$args{"cgi.$cgi_id.OBJCOUNT"}++;
1.1 albertel 204: $args{"cgi.$cgi_id.OBJ$i"}=
205: join(':',($x,$y,$width,$height,$start,$end,$color,$thickness,
206: $filled));
207: $args{"cgi.$cgi_id.OBJTYPE"}.='ARC:';
208: }
209: return $result;
210: }
211:
212: sub end_arc {
213: my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_;
214: my $result;
215: return $result;
216: }
217:
1.2 albertel 218: sub start_fill {
1.1 albertel 219: my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_;
220: my $result;
221: if ($target eq 'web' || $target eq 'tex') {
222: my $x = &Apache::lonxml::get_param('x',$parstack,$safeeval);
223: my $y = &Apache::lonxml::get_param('y',$parstack,$safeeval);
224: my $color = &Apache::lonxml::get_param('color',$parstack,$safeeval);
1.3 albertel 225: my $i=$args{"cgi.$cgi_id.OBJCOUNT"}++;
1.1 albertel 226: $args{"cgi.$cgi_id.OBJ$i"}=join(':',($x,$y,$color));
227: $args{"cgi.$cgi_id.OBJTYPE"}.='FILL:';
228: }
229: return $result;
230: }
231:
1.2 albertel 232: sub end_fill {
1.1 albertel 233: my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_;
234: my $result;
235: return $result;
236: }
237:
1.7 albertel 238: my @polygon;
239: sub start_polygon {
240: my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_;
241: my $result;
242: &Apache::lonxml::register('Apache::drawimage',('point'));
1.13 ! raeburn 243: if ($target eq 'web' || $target eq 'tex') {
1.7 albertel 244: undef(@polygon);
245: }
246: return $result;
247: }
248:
249: sub end_polygon {
250: my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_;
251: my $result;
1.13 ! raeburn 252: if ($target eq 'web' || $target eq 'tex') {
1.7 albertel 253: my $color=&Apache::lonxml::get_param('color',$parstack,$safeeval);
254: my $filled=&Apache::lonxml::get_param('filled',$parstack,$safeeval);
255: my $open=&Apache::lonxml::get_param('open',$parstack,$safeeval);
256: my $thickness = &Apache::lonxml::get_param('thickness',$parstack,
257: $safeeval);
258: my $i=$args{"cgi.$cgi_id.OBJCOUNT"}++;
259: $args{"cgi.$cgi_id.OBJTYPE"}.='POLYGON:';
260: $args{"cgi.$cgi_id.OBJ$i"}=join(':',($color,$thickness,$open,$filled));
261: $args{"cgi.$cgi_id.OBJEXTRA$i"}=join('-',@polygon);
262: }
263: &Apache::lonxml::deregister('Apache::drawimage',('point'));
264: return $result;
265: }
266:
267: sub start_point {
268: my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_;
269: my $result;
1.13 ! raeburn 270: if ($target eq 'web' || $target eq 'tex') {
1.7 albertel 271: my $x = &Apache::lonxml::get_param('x',$parstack,$safeeval);
272: my $y = &Apache::lonxml::get_param('y',$parstack,$safeeval);
273: push (@polygon,"($x,$y)");
274: }
275: return $result;
276: }
277:
278: sub end_point {
279: my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_;
280: my $result;
281: return $result;
282: }
283:
284: sub start_image {
285: my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_;
286: my $result;
287: if ($target eq 'web' || $target eq 'tex') {
288: &Apache::lonxml::startredirection();
289: }
290: return $result;
291: }
1.1 albertel 292:
1.7 albertel 293: sub end_image {
294: my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_;
295: my $result;
296: if ($target eq 'web' || $target eq 'tex') {
297: my $bgimg=&Apache::lonxml::endredirection();
298: my $x = &Apache::lonxml::get_param('x',$parstack,$safeeval);
299: my $y = &Apache::lonxml::get_param('y',$parstack,$safeeval);
300: my $clipx = &Apache::lonxml::get_param('clipx',$parstack,$safeeval);
301: my $clipy = &Apache::lonxml::get_param('clipy',$parstack,$safeeval);
302: my $clipwidth =
303: &Apache::lonxml::get_param('clipwidth',$parstack,$safeeval);
304: my $clipheight =
305: &Apache::lonxml::get_param('clipheight',$parstack,$safeeval);
306: my $scaledwidth =
307: &Apache::lonxml::get_param('scaledwidth',$parstack,$safeeval);
308: my $scaledheight =
309: &Apache::lonxml::get_param('scaledheight',$parstack,$safeeval);
310: my $transparent =
311: &Apache::lonxml::get_param('transparent',$parstack,$safeeval);
312: $bgimg=&Apache::imageresponse::clean_up_image($bgimg);
313: my $i=$args{"cgi.$cgi_id.OBJCOUNT"}++;
314: $args{"cgi.$cgi_id.OBJTYPE"}.='IMAGE:';
315: $args{"cgi.$cgi_id.OBJ$i"} =
1.9 www 316: join(':',($x,$y,&escape($bgimg),$transparent,
1.7 albertel 317: $clipx,$clipy,$scaledwidth,$scaledheight,$clipwidth,$clipheight));
318: }
319: return $result;
320: }
1.1 albertel 321: 1;
322: __END__
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>
![[BACK]](/icons/back.gif){kind=icon}
Return to drawimage.pm CVS log ![[TXT]](/icons/text.gif){kind=icon}
![[DIR]](/icons/dir.gif){kind=icon}
Up to [LON-CAPA] / loncom / homework