File Coverage

lib/Graphics/Fig.pm
Criterion Covered Total %
statement 344 444 77.4
branch 43 98 43.8
condition 1 9 11.1
subroutine 38 40 95.0
pod 24 25 96.0
total 450 616 73.0


line stmt bran cond sub pod time code
1             #
2             # XFig Drawing Library
3             #
4             # Copyright (c) 2017 D Scott Guthridge
5             #
6             # This program is free software: you can redistribute it and/or modify it under
7             # the terms of the Artistic License as published by the Perl Foundation, either
8             # version 2.0 of the License, or (at your option) any later version.
9             #
10             # This program is distributed in the hope that it will be useful, but WITHOUT
11             # ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
12             # FOR A PARTICULAR PURPOSE. See the Artistic License for more details.
13             #
14             # You should have received a copy of the Artistic License along with this
15             # program. If not, see .
16             #
17             package Graphics::Fig;
18             our $VERSION = 'v1.0.7';
19              
20 12     12   1678944 use strict;
  12         131  
  12         375  
21 12     12   76 use warnings;
  12         23  
  12         335  
22 12     12   55 use Carp;
  12         39  
  12         712  
23 12     12   67 use File::Temp qw/ tempfile /;
  12         17  
  12         498  
24 12     12   5596 use Graphics::Fig::Color;
  12         29  
  12         437  
25 12     12   5253 use Graphics::Fig::Matrix;
  12         27  
  12         352  
26 12     12   6342 use Graphics::Fig::Parameters;
  12         58  
  12         544  
27 12     12   6710 use Graphics::Fig::Arc;
  12         31  
  12         379  
28 12     12   5411 use Graphics::Fig::Compound;
  12         32  
  12         421  
29 12     12   76 use Graphics::Fig::Ellipse;
  12         20  
  12         242  
30 12     12   5994 use Graphics::Fig::Polyline;
  12         67  
  12         466  
31 12     12   5542 use Graphics::Fig::Spline;
  12         32  
  12         510  
32 12     12   5296 use Graphics::Fig::Text;
  12         27  
  12         58707  
33              
34             my $FIG2DEV = "fig2dev";
35              
36             #
37             # Graphics::Fig::_figPerInch return fig units per inch
38             # $parameters
39             #
40             sub _figPerInch {
41 304     304   347 my $parameters = shift;
42 304         314 my $unitSystem = ${$parameters}{"units"}[1];
  304         560  
43              
44 304 100       597 if ($unitSystem eq "Metric") {
45 24         50 return 1143.0; # 450 fig units/cm
46             } else {
47 280         640 return 1200.0; # 1200 fig units/in
48             }
49             }
50              
51             #
52             # Graphics::Fig::convertEndAction
53             # $fig: Fig instance
54             # $prefix: error message prefix
55             # $value: end action
56             # $context: parameter context
57             #
58             sub convertEndAction {
59 0     0 0 0 my $fig = shift;
60 0         0 my $prefix = shift;
61 0         0 my $value = shift;
62 0         0 my $context = shift;
63              
64 0 0 0     0 if ($value eq "merge" || $value eq "group" || $value eq "discard") {
      0        
65 0         0 return $value;
66             }
67 0         0 croak("${prefix}: ${value}: error: expected Landscape or Portrait");
68             }
69              
70             #
71             # Global Parameters
72             #
73             my %GlobalParameterTemplate = (
74             positional => {
75             },
76             named => [
77             \%Graphics::Fig::Parameters::UnitsParameter, # must be first
78             \%Graphics::Fig::Parameters::PositionParameter, # must be second
79             @Graphics::Fig::Parameters::ArrowParameters,
80             \%Graphics::Fig::Parameters::CapStyleParameter,
81             \%Graphics::Fig::Parameters::ColorParameter,
82             \%Graphics::Fig::Parameters::CornerRadiusParameter,
83             \%Graphics::Fig::Parameters::DepthParameter,
84             \%Graphics::Fig::Parameters::DetachedLinetoParameter,
85             @Graphics::Fig::Parameters::ExportParameters,
86             @Graphics::Fig::Parameters::FillParameters,
87             \%Graphics::Fig::Parameters::GridParameter,
88             \%Graphics::Fig::Parameters::JoinStyleParameter,
89             @Graphics::Fig::Parameters::LineParameters,
90             @Graphics::Fig::Parameters::SaveParameters,
91             \%Graphics::Fig::Parameters::SplineSubtypeParameter,
92             @Graphics::Fig::Parameters::TextParameters,
93             ],
94             );
95              
96             #
97             # Export Parameters
98             #
99             my %ExportParameterTemplate = (
100             positional => {
101             "." => [ "filename" ],
102             },
103             named => [
104             \%Graphics::Fig::Parameters::UnitsParameter, # must be first
105             \%Graphics::Fig::Parameters::PositionParameter, # must be second
106             @Graphics::Fig::Parameters::SaveParameters,
107             {
108             name => "filename",
109             },
110             {
111             name => "exportFormat", # duplicated for alias
112             aliases => [ "format" ],
113             },
114             {
115             name => "exportOptions", # duplicated for alias
116             aliases => [ "options" ],
117             convert => \&Graphics::Fig::Parameters::convertExportOptions,
118             },
119             ],
120             );
121              
122             #
123             # Move Parameters
124             #
125             my %MovetoParameterTemplate = (
126             positional => {
127             "@" => [ "point" ],
128             ".." => [ "distance", "heading" ],
129             },
130             named => [
131             \%Graphics::Fig::Parameters::UnitsParameter, # must be first
132             \%Graphics::Fig::Parameters::PositionParameter, # must be second
133             \%Graphics::Fig::Parameters::PointParameter,
134             {
135             name => "distance",
136             convert => \&Graphics::Fig::Parameters::convertLength,
137             },
138             {
139             name => "heading",
140             convert => \&Graphics::Fig::Parameters::convertAngle,
141             },
142             ],
143             );
144              
145             #
146             # Translate Parameters
147             #
148             my %TranslateParameterTemplate = (
149             positional => {
150             "@" => [ "offset" ],
151             },
152             named => [
153             \%Graphics::Fig::Parameters::UnitsParameter, # must be first
154             \%Graphics::Fig::Parameters::OffsetParameter,
155             ],
156             );
157              
158             #
159             # Rotate Parameters
160             #
161             my %RotateParameterTemplate = (
162             positional => {
163             "." => [ "rotation" ],
164             },
165             named => [
166             \%Graphics::Fig::Parameters::UnitsParameter, # must be first
167             \%Graphics::Fig::Parameters::PositionParameter, # must be second
168             \%Graphics::Fig::Parameters::CenterParameter,
169             \%Graphics::Fig::Parameters::RotationParameter,
170             ],
171             );
172              
173             #
174             # Scale Parameters
175             #
176             my %ScaleParameterTemplate = (
177             positional => {
178             "." => [ "scale" ],
179             "@" => [ "scale" ],
180             },
181             named => [
182             \%Graphics::Fig::Parameters::UnitsParameter, # must be first
183             \%Graphics::Fig::Parameters::PositionParameter, # must be second
184             \%Graphics::Fig::Parameters::CenterParameter,
185             \%Graphics::Fig::Parameters::ScaleParameter,
186             ],
187             );
188              
189             #
190             # End Parameters
191             #
192             my %EndParameterTemplate = (
193             positional => {
194             "." => [ "action" ],
195             },
196             named => [
197             \%Graphics::Fig::Parameters::UnitsParameter, # must be first
198             \%Graphics::Fig::Parameters::PositionParameter, # must be second
199             \%Graphics::Fig::Parameters::GridParameter,
200             {
201             name => "action",
202             convert => \&convertEndAction,
203             default => "merge",
204             },
205             ],
206             );
207              
208             ##
209             ## Load Parameters
210             ##
211             #my %LoadParameterTemplate = (
212             # positional => {
213             # "." => [ "filename" ],
214             # },
215             # named => [
216             # {
217             # name => "filename",
218             # },
219             # ],
220             #);
221              
222             #
223             # Save Parameters
224             #
225             my %SaveParameterTemplate = (
226             positional => {
227             "." => [ "filename" ],
228             },
229             named => [
230             \%Graphics::Fig::Parameters::UnitsParameter, # must be first
231             \%Graphics::Fig::Parameters::PositionParameter, # must be second
232             @Graphics::Fig::Parameters::SaveParameters,
233             {
234             name => "filename",
235             },
236             ],
237             );
238              
239             #
240             # Get Position and Get Bounding Box Parameters
241             #
242             my %UnitsOnlyParameterTemplate = (
243             positional => {
244             },
245             named => [
246             \%Graphics::Fig::Parameters::UnitsParameter, # must be first
247             ],
248             );
249              
250             #
251             # Graphics::Fig::new: constructor
252             # $proto: prototype
253             # [ { option1=value1, option2=value2, ... } ]
254             #
255             sub new {
256 64     64 1 114674 my $proto = shift;
257 64   33     346 my $class = ref($proto) || $proto;
258              
259 64         362 my $self = {
260             colors => Graphics::Fig::Color->new(),
261             stack => [
262             {
263             options => { },
264             objects => [ ],
265             openLineto => undef,
266             openSplineto => undef,
267             },
268             ],
269             };
270 64         129 bless($self, $class);
271 64         230 $self->options({});
272              
273             #
274             # Process global options.
275             #
276 64         125 my $stack = ${$self}{"stack"};
  64         111  
277 64         101 my $tos = ${$stack}[$#{$stack}];
  64         104  
  64         94  
278 64         96 eval {
279             Graphics::Fig::Parameters::parse($self, "Graphics::Fig::new",
280             \%GlobalParameterTemplate,
281 64         112 undef, ${$tos}{"options"}, @_);
  64         178  
282             };
283 64 50       162 if ($@) {
284 0         0 $@ =~ s/ at [^\s]* line \d+\.\n//;
285 0         0 croak("$@");
286             }
287              
288 64         197 return $self;
289             }
290              
291             #
292             # Graphics::Fig::options: change global options
293             # $self: class instance
294             # [ { option1=value1, option2=value2, ... } ]
295             #
296             sub options {
297 65     65 1 100 my $self = shift;
298 65         159 my $stack = ${$self}{"stack"};
  65         179  
299 65         84 my $tos = ${$stack}[$#{$stack}];
  65         133  
  65         123  
300              
301 65         109 eval {
302             Graphics::Fig::Parameters::parse($self, "options",
303             \%GlobalParameterTemplate,
304 65         101 ${$tos}{"options"},
305 65         118 ${$tos}{"options"}, @_);
  65         260  
306             };
307 65 50       152 if ($@) {
308 0         0 $@ =~ s/ at [^\s]* line \d+\.\n//;
309 0         0 croak("$@");
310             }
311 65         103 return 1;
312             }
313              
314             #
315             # Graphics::Fig::moveto move to a new position
316             # $self: class instance
317             # moveto options...
318             #
319             sub moveto {
320 4     4 1 23 my $self = shift;
321 4         4 my $stack = ${$self}{"stack"};
  4         8  
322 4         30 my $tos = ${$stack}[$#{$stack}];
  4         8  
  4         7  
323 4         6 my $options = ${$tos}{"options"};
  4         6  
324 4         8 my %parameters;
325             my $newPosition;
326              
327 4         6 eval {
328 4         12 Graphics::Fig::Parameters::parse($self, "moveto",
329             \%MovetoParameterTemplate, $options,
330             \%parameters, @_);
331             };
332 4 50       12 if ($@) {
333 0         0 $@ =~ s/ at [^\s]* line \d+\.\n//;
334 0         0 croak("$@");
335             }
336 4 50       14 if (defined($parameters{"point"})) {
    0          
    0          
337 4 50       11 if (defined($parameters{"distance"})) {
338 0         0 croak("moveto error: point and distance cannot be given together");
339             }
340 4 50       8 if (defined($parameters{"heading"})) {
341 0         0 croak("moveto error: point and heading cannot be given together");
342             }
343 4         9 $newPosition = $parameters{"point"};
344              
345             } elsif (defined(my $r = $parameters{"distance"})) {
346 0         0 my $theta = $parameters{"heading"};
347 0 0       0 if (!defined($theta)) {
348 0         0 croak("moveto error: expected point, or distance and heading");
349             }
350             $newPosition = [ $parameters{"position"}[0] + $r * cos($theta),
351 0         0 $parameters{"position"}[1] - $r * sin($theta) ];
352              
353             } elsif (defined($parameters{"position"})) {
354 0         0 $newPosition = $parameters{"position"};
355              
356             } else {
357 0         0 croak("moveto error: point and distance cannot be given together");
358             }
359 4         6 ${$options}{"position"} = $newPosition;
  4         7  
360              
361 4         10 return 1;
362             }
363              
364             #
365             # Graphics::Fig::getposition: return the current position
366             # $self: class instance
367             #
368             sub getposition {
369 5     5 1 28 my $self = shift;
370 5         5 my $stack = ${$self}{"stack"};
  5         9  
371 5         6 my $tos = ${$stack}[$#{$stack}];
  5         6  
  5         9  
372 5         6 my $options = ${$tos}{"options"};
  5         6  
373 5         11 my %parameters;
374             my $position;
375 5         0 my $scale;
376              
377 5         7 eval {
378 5         13 Graphics::Fig::Parameters::parse($self, "getposition",
379             \%UnitsOnlyParameterTemplate, $options, \%parameters, @_);
380             };
381 5 50       14 if ($@) {
382 0         0 $@ =~ s/ at [^\s]* line \d+\.\n//;
383 0         0 croak("$@");
384             }
385 5         8 $scale = $parameters{"units"}[0];
386 5         14 $position = ${$options}{"position"};
  5         7  
387 5         6 return [ ${$position}[0] / $scale, ${$position}[1] / $scale ];
  5         8  
  5         19  
388             }
389              
390             #
391             # Graphics::Fig::begin: begin a sub-environment
392             # $self: class instance
393             # [ { } ]
394             #
395             sub begin {
396 8     8 1 54 my $self = shift;
397 8         12 my $stack = ${$self}{"stack"};
  8         13  
398 8         9 my $tos = ${$stack}[$#{$stack}];
  8         16  
  8         11  
399 8         10 my %parameters;
400              
401 8         10 eval {
402             Graphics::Fig::Parameters::parse($self, "begin",
403             \%GlobalParameterTemplate,
404 8         11 ${$tos}{"options"},
  8         21  
405             \%parameters, @_);
406             };
407 8 50       20 if ($@) {
408 0         0 $@ =~ s/ at [^\s]* line \d+\.\n//;
409 0         0 croak("$@");
410             }
411 8         55 push(@{$stack}, {
  8         35  
412             options => \%parameters,
413             objects => [ ],
414             openLineto => undef,
415             openSplineto => undef,
416             });
417              
418 8         20 return 1;
419             }
420              
421             #
422             # Graphics::Fig::end: end a sub-environment
423             # $self: class instance
424             # [ [ action ] { action={merge|group|discard} }
425             #
426             sub end {
427 8     8 1 32 my $self = shift;
428 8         11 my %parameters;
429              
430 8         11 my $stack = ${$self}{"stack"};
  8         15  
431 8         10 my $oldTos = pop(@{$stack});
  8         18  
432 8         11 my $tos = ${$stack}[$#{$stack}];
  8         15  
  8         13  
433              
434              
435 8         12 eval {
436             Graphics::Fig::Parameters::parse($self, "end", \%EndParameterTemplate,
437 8         12 ${$tos}{"options"}, \%parameters,
  8         35  
438             @_);
439             };
440 8 50       28 if ($@) {
441 0         0 $@ =~ s/ at [^\s]* line \d+\.\n//;
442 0         0 croak("$@");
443             }
444 8 50       20 if ($parameters{"action"} eq "merge") {
    0          
445 8         11 push(@{${$tos}{"objects"}}, @{${$oldTos}{"objects"}});
  8         9  
  8         15  
  8         10  
  8         15  
446              
447             } elsif ($parameters{"action"} eq "group") {
448 0         0 my $objects = ${$oldTos}{"objects"};
  0         0  
449 0         0 Graphics::Fig::Compound->new($self, $objects, \%parameters);
450             }
451 8         59 return 1;
452             }
453              
454             #
455             # Graphics::Fig::arc draw an arc
456             # $self: class instance
457             # arc parameters...
458             #
459             sub arc {
460 11     11 1 111 my $self = shift;
461 11         15 my $obj = eval {
462 11         78 return Graphics::Fig::Arc->arc($self, @_);
463             };
464 11 50       23 if ($@) {
465 0         0 $@ =~ s/ at [^\s]* line \d+\.\n//;
466 0         0 croak("$@");
467             }
468 11         24 return $obj;
469             }
470              
471             #
472             # Graphics::Fig::arc draw an arc
473             # $self: class instance
474             # arc parameters...
475             #
476             sub arcto {
477 14     14 1 103 my $self = shift;
478 14         18 my $obj = eval {
479 14         64 return Graphics::Fig::Arc->arcto($self, @_);
480             };
481 14 50       28 if ($@) {
482 0         0 $@ =~ s/ at [^\s]* line \d+\.\n//;
483 0         0 croak("$@");
484             }
485 14         27 return $obj;
486             }
487              
488             #
489             # Graphics::Fig::circle: draw a circle
490             # $self: class instance
491             # circle parameters...
492             #
493             sub circle {
494 8     8 1 86 my $self = shift;
495 8         14 my $obj = eval {
496 8         69 return Graphics::Fig::Ellipse->circle($self, @_);
497             };
498 8 50       22 if ($@) {
499 0         0 $@ =~ s/ at [^\s]* line \d+\.\n//;
500 0         0 croak("$@");
501             }
502 8         17 return $obj;
503             }
504              
505             #
506             # Graphics::Fig::ellipse: draw an ellipse
507             # $self: class instance
508             # ellipse parameters...
509             #
510             sub ellipse {
511 7     7 1 80 my $self = shift;
512 7         13 my $obj = eval {
513 7         82 return Graphics::Fig::Ellipse->ellipse($self, @_);
514             };
515 7 50       21 if ($@) {
516 0         0 $@ =~ s/ at [^\s]* line \d+\.\n//;
517 0         0 croak("$@");
518             }
519 7         19 return $obj;
520             }
521              
522             #
523             # Graphics::Fig::polyline: draw a polyline object
524             # $self: class instance
525             # polyline parameters...
526             #
527             sub polyline {
528 11     11 1 151 my $self = shift;
529 11         17 my $obj = eval {
530 11         61 return Graphics::Fig::Polyline->polyline($self, @_);
531             };
532 11 50       1208 if ($@) {
533 0         0 $@ =~ s/ at [^\s]* line \d+\.\n//;
534 0         0 croak("$@");
535             }
536 11         25 return $obj;
537             }
538              
539             #
540             # Graphics::Fig::lineto: draw a line from position to the given point(s)
541             # $self: class instance
542             # polyline parameters...
543             #
544             sub lineto {
545 29     29 1 189 my $self = shift;
546 29         42 my $obj = eval {
547 29         101 return Graphics::Fig::Polyline->lineto($self, @_);
548             };
549 29 50       51 if ($@) {
550 0         0 $@ =~ s/ at [^\s]* line \d+\.\n//;
551 0         0 croak("$@");
552             }
553 29         71 return $obj;
554             }
555              
556             #
557             # Graphics::Fig::box draw a box object
558             # $self: class instance
559             # box parameters...
560             #
561             sub box {
562 17     17 1 133 my $self = shift;
563 17         24 my $obj = eval {
564 17         102 return Graphics::Fig::Polyline->box($self, @_);
565             };
566 17 50       47 if ($@) {
567 0         0 $@ =~ s/ at [^\s]* line \d+\.\n//;
568 0         0 croak("$@");
569             }
570 17         40 return $obj;
571             }
572              
573             #
574             # Graphics::Fig::polygon draw a polygon object
575             # $self: class instance
576             # polygon parameters...
577             #
578             sub polygon {
579 7     7 1 79 my $self = shift;
580 7         14 my $obj = eval {
581 7         35 return Graphics::Fig::Polyline->polygon($self, @_);
582             };
583 7 50       16 if ($@) {
584 0         0 $@ =~ s/ at [^\s]* line \d+\.\n//;
585 0         0 croak("$@");
586             }
587 7         15 return $obj;
588             }
589              
590             #
591             # Graphics::Fig::picture embed a picture
592             # $self: class instance
593             # picture parameters...
594             #
595             sub picture {
596 19     19 1 171 my $self = shift;
597 19         22 my $obj = eval {
598 19         100 return Graphics::Fig::Polyline->picture($self, @_);
599             };
600 19 50       38 if ($@) {
601 0         0 $@ =~ s/ at [^\s]* line \d+\.\n//;
602 0         0 croak("$@");
603             }
604 19         57 return $obj;
605             }
606              
607             #
608             # Graphics::Fig::spline: draw a spline
609             # $self: class instance
610             # picture parameters...
611             #
612             sub spline {
613 13     13 1 104 my $self = shift;
614 13         18 my $obj = eval {
615 13         43 return Graphics::Fig::Spline->spline($self, @_);
616             };
617 13 50       23 if ($@) {
618 0         0 $@ =~ s/ at [^\s]* line \d+\.\n//;
619 0         0 croak("$@");
620             }
621 13         26 return $obj;
622             }
623              
624             #
625             # Graphics::Fig::splineto: draw a spline from current point
626             # $self: class instance
627             # picture parameters...
628             #
629             sub splineto {
630 6     6 1 37 my $self = shift;
631 6         8 my $obj = eval {
632 6         22 return Graphics::Fig::Spline->splineto($self, @_);
633             };
634 6 50       14 if ($@) {
635 0         0 $@ =~ s/ at [^\s]* line \d+\.\n//;
636 0         0 croak("$@");
637             }
638 6         10 return $obj;
639             }
640              
641             #
642             # Graphics::Fig::text add text
643             # $self: class instance
644             # text parameters...
645             #
646             sub text {
647 1     1 1 7 my $self = shift;
648 1         2 my $obj = eval {
649 1         8 return Graphics::Fig::Text->text($self, @_);
650             };
651 1 50       10 if ($@) {
652 0         0 $@ =~ s/ at [^\s]* line \d+\.\n//;
653 0         0 croak("$@");
654             }
655 1         3 return $obj;
656             }
657              
658             #
659             # Graphics::Fig::translate: translate all objects
660             # $self: class instance
661             # translate parameters...
662             #
663             sub translate {
664 9     9 1 76 my $self = shift;
665              
666 9         9 my $stack = ${$self}{"stack"};
  9         16  
667 9         11 my $tos = ${$stack}[$#{$stack}];
  9         17  
  9         15  
668 9         13 my %parameters;
669 9         17 eval {
670             Graphics::Fig::Parameters::parse($self, "translate",
671             \%TranslateParameterTemplate,
672 9         18 ${$tos}{"options"}, \%parameters, @_);
  9         27  
673             };
674 9 50       38 if ($@) {
675 0         0 $@ =~ s/ at [^\s]* line \d+\.\n//;
676 0         0 croak("$@");
677             }
678 9         19 foreach my $object (@{${$tos}{"objects"}}) {
  9         12  
  9         25  
679 23         91 $object->translate(\%parameters);
680             }
681             }
682              
683             #
684             # Graphics::Fig::rotate: rotate all objects
685             # $self: class instance
686             # rotate parameters...
687             #
688             sub rotate {
689 10     10 1 105 my $self = shift;
690              
691 10         13 my $stack = ${$self}{"stack"};
  10         19  
692 10         26 my $tos = ${$stack}[$#{$stack}];
  10         16  
  10         19  
693 10         17 my %parameters;
694 10         16 eval {
695             Graphics::Fig::Parameters::parse($self, "translate",
696             \%RotateParameterTemplate,
697 10         19 ${$tos}{"options"}, \%parameters, @_);
  10         28  
698             };
699 10 50       58 if ($@) {
700 0         0 $@ =~ s/ at [^\s]* line \d+\.\n//;
701 0         0 croak("$@");
702             }
703 10         18 foreach my $object (@{${$tos}{"objects"}}) {
  10         16  
  10         24  
704 24         86 $object->rotate(\%parameters);
705             }
706             }
707              
708             #
709             # Graphics::Fig::scale: scale all objects
710             # $self: class instance
711             # scale parameters...
712             #
713             sub scale {
714 7     7 1 43 my $self = shift;
715              
716 7         13 my $stack = ${$self}{"stack"};
  7         16  
717 7         23 my $tos = ${$stack}[$#{$stack}];
  7         12  
  7         13  
718 7         18 my %parameters;
719 7         12 eval {
720             Graphics::Fig::Parameters::parse($self, "translate",
721             \%ScaleParameterTemplate,
722 7         13 ${$tos}{"options"}, \%parameters, @_);
  7         23  
723             };
724 7 50       24 if ($@) {
725 0         0 $@ =~ s/ at [^\s]* line \d+\.\n//;
726 0         0 croak("$@");
727             }
728 7         12 foreach my $object (@{${$tos}{"objects"}}) {
  7         12  
  7         20  
729 8         34 $object->scale(\%parameters);
730             }
731             }
732              
733             #
734             # Graphics::Fig::getbbox return the bounding box of all objects
735             # $self: class instance
736             # bbox parameters...
737             #
738             sub getbbox {
739 6     6 1 33 my $self = shift;
740              
741 6         10 my $stack = ${$self}{"stack"};
  6         13  
742 6         9 my $tos = ${$stack}[$#{$stack}];
  6         11  
  6         10  
743 6         9 my $options = ${$tos}{"options"};
  6         10  
744 6         20 my %parameters;
745             my $scale;
746 6         0 my ($x_min, $y_min, $x_max, $y_max);
747 6         10 eval {
748 6         20 Graphics::Fig::Parameters::parse($self, "getbbox",
749             \%UnitsOnlyParameterTemplate, $options, \%parameters, @_);
750             };
751 6 50       19 if ($@) {
752 0         0 $@ =~ s/ at [^\s]* line \d+\.\n//;
753 0         0 croak("$@");
754             }
755 6         9 foreach my $object (@{${$tos}{"objects"}}) {
  6         136  
  6         20  
756 32         317 my $bbox = $object->getbbox(\%parameters);
757 32 100       72 if (!defined($x_min)) {
758 6         9 $x_min = ${$bbox}[0][0];
  6         12  
759 6         8 $y_min = ${$bbox}[0][1];
  6         11  
760 6         7 $x_max = ${$bbox}[1][0];
  6         8  
761 6         10 $y_max = ${$bbox}[1][1];
  6         8  
762 6         16 next;
763             }
764 26 100       24 if (${$bbox}[0][0] < $x_min) {
  26         54  
765 8         15 $x_min = ${$bbox}[0][0];
  8         10  
766             }
767 26 100       30 if (${$bbox}[0][1] < $y_min) {
  26         40  
768 11         11 $y_min = ${$bbox}[0][1];
  11         13  
769             }
770 26 100       30 if (${$bbox}[1][0] > $x_max) {
  26         40  
771 7         9 $x_max = ${$bbox}[1][0];
  7         8  
772             }
773 26 100       29 if (${$bbox}[1][1] > $y_max) {
  26         53  
774 5         5 $y_max = ${$bbox}[1][1];
  5         11  
775             }
776             }
777 6         13 $scale = $parameters{"units"}[0];
778 6         41 return [ [ $x_min / $scale, $y_min / $scale ],
779             [ $x_max / $scale, $y_max / $scale ] ];
780             }
781              
782             # TODO: Implement load.
783             #
784             # Load would allow you to incorporate existing figures, manipulate
785             # them using translate, rotate and scale, form groups around them
786             # and superimpose new objects over them.
787             #
788             # Notes:
789             # - Some older formats should be accepted. Documented versions are: 1.3, 1.4,
790             # 1.5 1.6, 2.0, 2.1, 3.0, 3.1 and 3.2. Version 1.4 was the first to have a
791             # #FIG line. Versions 1.5 and 1.6 seem to have been a dead-end side
792             # development path.
793             #
794             # These are the preambles to a few formats:
795             #
796             # 1.3:
797             # [no #FIG line]
798             # resolution in pixels per inch
799             # origin: 2
800             # canvas width (pixels)
801             # canvas height (pixels)
802             #
803             # 1.4:
804             # #FIG line was added in this version
805             # resolution
806             # coordinate_system: 2
807             #
808             # 2.0:
809             # resolution
810             # coordinate_system: 2
811             #
812             # 3.1:
813             # resolution: 1200
814             # orientation: Landscape or Portrait
815             # justification: Center or Flush Left
816             # units: Metric or Inches
817             # coordinate_system: 2
818             #
819             # 3.2:
820             # orientation: Landscape or Portrait
821             # justification: Center or Flush Left
822             # units: Metric or Inches
823             # papersize: Letter Legal Ledger Tabloid A B C D E A4 A3 A2 A1 A0 B5
824             # magnification:
825             # multiple-page: Single or Multiple
826             # transparent color:
827             # resolution coordinate_system: 1200 2
828             #
829             # - One approach would be to load the file into the current drawing
830             # environment, mapping any new custom colors to new values. Another approach
831             # would be to construct a new Graphics::Fig object and provide a "merge"
832             # function that merges one Fig object into another. The later has the
833             # benefit of providing merge, which may be useful in itself. Like load,
834             # merge also has to reassign color map entries.
835             #
836             ## Graphics::Fig::load: load a .fig file into the current drawing environment
837             ## $self: class instance
838             ## load parameters...
839             ##
840             #sub load {
841             # my $self = shift;
842             #
843             # my $stack = ${$self}{"stack"};
844             # my $tos = ${$stack}[$#{$stack}];
845             # my %parameters;
846             # eval {
847             # Graphics::Fig::Parameters::parse($self, "load", \%LoadParameterTemplate,
848             # ${$tos}{"options"}, \%parameters, @_);
849             # };
850             # if ($@) {
851             # $@ =~ s/ at [^\s]* line \d+\.\n//;
852             # croak("$@");
853             # }
854             #
855             # my $filename = $parameters{"filename"};
856             # if (!defined($filename)) {
857             # croak("load: error: expected filename");
858             # }
859             # my $fh;
860             # open($fh, "<", $filename) || croak("save: $filename: $!");
861             #
862             # if (!<$fh>) {
863             # close($fh):
864             # croak("load: error: can't read header line");
865             # }
866             # if (!/^#FIG (.*)/) {
867             # close($fh):
868             # croak("load: error: exepected FIG file format");
869             # }
870             #
871             # HERE
872             #
873             # close($fh);
874             #}
875              
876             #
877             # Graphics::Fig::_saveCommon: common code for save and export
878             # $self: class instance
879             # $tos: top of drawing stack
880             # $parameters: reference to parameter hash
881             # $fh: open filehandle to the output file
882             #
883             sub _saveCommon {
884 64     64   126 my $self = shift;
885 64         104 my $tos = shift;
886 64         98 my $parameters = shift;
887 64         110 my $fh = shift;
888              
889 64         226 my $figPerInch = _figPerInch($parameters);
890 64         141 my $comment = ${$parameters}{"comment"};
  64         125  
891 64 50       165 if ($comment ne "") {
892 0         0 $comment =~ s/^/# /gm;
893 0 0       0 if (!($comment =~ m/\n$/)) {
894 0         0 $comment .= "\n";
895             }
896             }
897 64         842 printf $fh ("#FIG 3.2 Produced by Graphics::Fig\n");
898 64         177 printf $fh ("%s\n", ${$parameters}{"orientation"});
  64         233  
899 64         126 printf $fh ("%s\n", ${$parameters}{"pageJustification"});
  64         162  
900 64         132 printf $fh ("%s\n", ${$parameters}{"units"}[1]);
  64         149  
901 64         120 printf $fh ("%s\n", ${$parameters}{"paperSize"});
  64         132  
902 64         100 printf $fh ("%.2f\n", ${$parameters}{"magnification"});
  64         911  
903 64         122 printf $fh ("%s\n", ${$parameters}{"multiplePage"});
  64         132  
904 64         117 printf $fh ("%d\n", ${$parameters}{"transparentColor"});
  64         151  
905 64 50       206 if ($comment ne "") {
906 0         0 printf $fh ("%s", $comment);
907             }
908             #
909             # In the imperial unit system, 1200 is the number of fig units per
910             # inch. In metric, it's the number of fig units in 400/381 inches.
911             # In other words, 1200 means 450 fig units per cm or exactly 1143
912             # fig units per inch.
913             #
914 64         148 printf $fh ("1200 2\n");
915              
916             #
917             # Add custom colors.
918             #
919 64         216 my $customHex = $self->{"colors"}->{"customHex"};
920 64         135 for (my $i = 0; $i < scalar(@{$customHex}); ++$i) {
  69         198  
921 5         11 printf $fh ("0 %d %s\n", 32 + $i, ${$customHex}[$i]);
  5         17  
922             }
923              
924             #
925             # Add objects.
926             #
927 64         90 foreach my $object (@{${$tos}{"objects"}}) {
  64         85  
  64         180  
928 128         426 $object->print($fh, $parameters);
929             }
930             }
931              
932             #
933             # Graphics::Fig::save: save the .fig file
934             # $self: class instance
935             # save parameters...
936             #
937             sub save {
938 64     64 1 536 my $self = shift;
939              
940 64         111 my $stack = ${$self}{"stack"};
  64         115  
941 64         95 my $tos = ${$stack}[$#{$stack}];
  64         107  
  64         100  
942 64         91 my %parameters;
943 64         95 eval {
944             Graphics::Fig::Parameters::parse($self, "save", \%SaveParameterTemplate,
945 64         112 ${$tos}{"options"}, \%parameters, @_);
  64         229  
946             };
947 64 50       187 if ($@) {
948 0         0 $@ =~ s/ at [^\s]* line \d+\.\n//;
949 0         0 croak("$@");
950             }
951              
952 64         154 my $filename = $parameters{"filename"};
953 64 50       143 if (!defined($filename)) {
954 0         0 croak("save: error: expected filename");
955             }
956 64 50       6219 open(my $fh, ">", $filename) || croak("save: $filename: $!");
957 64         432 &_saveCommon($self, $tos, \%parameters, $fh);
958 64         3155 close($fh);
959             }
960              
961              
962             #
963             # Graphics::Fig::export: export the drawing to the given format
964             # $self: class instance
965             # save parameters...
966             #
967             sub export {
968 0     0 1   my $self = shift;
969              
970 0           my $stack = ${$self}{"stack"};
  0            
971 0           my $tos = ${$stack}[$#{$stack}];
  0            
  0            
972 0           my %parameters;
973 0           eval {
974             Graphics::Fig::Parameters::parse($self, "export",
975             \%ExportParameterTemplate,
976 0           ${$tos}{"options"}, \%parameters, @_);
  0            
977             };
978 0 0         if ($@) {
979 0           $@ =~ s/ at [^\s]* line \d+\.\n//;
980 0           croak("$@");
981             }
982              
983             #
984             # Validate parameters. Determine the output format either from the
985             # type argument or the filename extension.
986             #
987 0           my $outputFilename = $parameters{"filename"};
988 0 0         if (!defined($outputFilename)) {
989 0           croak("export: error: expected filename");
990             }
991 0           my $type;
992 0 0         if (defined($parameters{"type"})) {
    0          
993 0           $type = $parameters{"type"};
994             } elsif ($outputFilename =~ m/\.([^.]+)$/) {
995 0           $type = $1;
996             } else {
997 0           croak("export: error: cannot determine output file type");
998             }
999              
1000             #
1001             # Save the drawing to a temporary file.
1002             #
1003 0           my ($fh, $tempFilename) = tempfile();
1004 0           &_saveCommon($self, $tos, \%parameters, $fh);
1005 0           close($fh);
1006              
1007             #
1008             # Build the argument list and run fig2dev.
1009             #
1010 0           my @Args = ($FIG2DEV, "-L", $type);
1011 0 0         if (defined($parameters{"options"})) {
1012 0           push(@Args, @{$parameters{"options"}});
  0            
1013             }
1014 0           push(@Args, $tempFilename, $outputFilename);
1015 0 0         if ((system @Args) != 0) {
1016 0           croak("export: error: $!\n");
1017             }
1018             }
1019              
1020             1;
1021              
1022             __END__