File Coverage

lib/Graphics/Fig/Compound.pm
Criterion Covered Total %
statement 18 127 14.1
branch 0 18 0.0
condition 0 3 0.0
subroutine 6 12 50.0
pod 0 6 0.0
total 24 166 14.4


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::Compound;
18             our $VERSION = 'v1.0.8';
19              
20 12     12   77 use strict;
  12         18  
  12         325  
21 12     12   52 use warnings;
  12         23  
  12         288  
22 12     12   44 use utf8;
  12         21  
  12         63  
23 12     12   193 use Carp;
  12         18  
  12         737  
24 12     12   66 use POSIX qw(floor ceil);
  12         30  
  12         117  
25 12     12   16864 use Graphics::Fig::Parameters;
  12         20  
  12         8655  
26              
27             #
28             # Graphics::Fig::Compound::new
29             # $proto: class prototype
30             # $fig: Fig instance
31             # $objects: objects to group
32             # $parameters: compound parameters
33             #
34             sub new {
35 0     0 0   my $proto = shift;
36 0           my $fig = shift;
37 0           my $objects = shift;
38 0           my $parameters = shift;
39              
40 0           my $stack = ${$fig}{"stack"};
  0            
41 0           my $tos = ${$stack}[$#{$stack}];
  0            
  0            
42              
43             my $self = {
44 0           grid => ${$parameters}{"grid"},
  0            
45             objects => $objects,
46             };
47 0   0       my $class = ref($proto) || $proto;
48 0           bless($self, $class);
49 0           push(@{${$tos}{"objects"}}, $self);
  0            
  0            
50 0           return $self;
51             }
52              
53             #
54             # Graphics::Fig::Compound::translate
55             # $self: object
56             # $parameters: reference to parameter hash
57             #
58             sub translate {
59 0     0 0   my $self = shift;
60 0           my $parameters = shift;
61              
62 0           foreach my $object (@{${$self}{"objects"}}) {
  0            
  0            
63 0           $object->translate($parameters);
64             }
65 0           return 1;
66             }
67              
68             #
69             # Graphics::Fig::Compound::rotate
70             # $self: object
71             # $parameters: reference to parameter hash
72             #
73             sub rotate {
74 0     0 0   my $self = shift;
75 0           my $parameters = shift;
76              
77 0           foreach my $object (@{${$self}{"objects"}}) {
  0            
  0            
78 0           $object->rotate($parameters);
79             }
80 0           return 1;
81             }
82              
83             #
84             # Graphics::Fig::Compound::scale
85             # $self: object
86             # $parameters: reference to parameter hash
87             #
88             sub scale {
89 0     0 0   my $self = shift;
90 0           my $parameters = shift;
91              
92 0           foreach my $object (@{${$self}{"objects"}}) {
  0            
  0            
93 0           $object->scale($parameters);
94             }
95 0           return 1;
96             }
97              
98             #
99             # Graphics::Fig::Compound::getbbox: return [[xmin, ymin], [xmax, ymax]]
100             # $self: object
101             # $parameters: parameters to getbbox
102             #
103             sub getbbox {
104 0     0 0   my $self = shift;
105 0           my $parameters = shift;
106              
107 0           my ($x_min, $y_min, $x_max, $y_max);
108              
109             #
110             # Find the bounding box for all contained objects.
111             #
112 0           foreach my $object (@{${$self}{"objects"}}) {
  0            
  0            
113 0           my $bbox = $object->getbbox();
114 0 0         if (!defined($x_min)) {
115 0           $x_min = ${$bbox}[0][0];
  0            
116 0           $y_min = ${$bbox}[0][1];
  0            
117 0           $x_max = ${$bbox}[1][0];
  0            
118 0           $y_max = ${$bbox}[1][1];
  0            
119 0           next;
120             }
121 0 0         if (${$bbox}[0][0] < $x_min) {
  0            
122 0           $x_min = ${$bbox}[0][0];
  0            
123             }
124 0 0         if (${$bbox}[0][1] < $y_min) {
  0            
125 0           $y_min = ${$bbox}[0][1];
  0            
126             }
127 0 0         if (${$bbox}[1][0] > $x_max) {
  0            
128 0           $x_max = ${$bbox}[1][0];
  0            
129             }
130 0 0         if (${$bbox}[1][1] > $y_max) {
  0            
131 0           $y_max = ${$bbox}[1][1];
  0            
132             }
133             }
134              
135             #
136             # If there are contained objects, snap the corners to the grid.
137             #
138 0 0         if (defined($x_min)) {
139 0           my $grid;
140              
141             #
142             # If grid is not given, default to 0.1 inches if imperial
143             # or 0.25 cm if metric.
144             #
145 0 0         if (!defined($grid = ${$self}{"grid"})) {
  0            
146 0 0         if (${$parameters}{"units"}[1] eq "Metric") {
  0            
147 0           $grid = 2.54 * 0.25;
148             } else {
149 0           $grid = 0.1;
150             }
151             }
152             #
153             # Snap the corners to the given grid.
154             #
155 0 0         if ($grid > 0) {
156 0           $x_min = $grid * floor($x_min / $grid);
157 0           $y_min = $grid * floor($y_min / $grid);
158 0           $x_max = $grid * ceil($x_max / $grid);
159 0           $y_max = $grid * ceil($y_max / $grid);
160             }
161              
162             #
163             # Otherwise, create an empty group at the current position.
164             #
165             } else {
166 0           $x_min = ${$parameters}{"position"}[0];
  0            
167 0           $y_min = ${$parameters}{"position"}[1];
  0            
168 0           $x_max = ${$parameters}{"position"}[0];
  0            
169 0           $y_max = ${$parameters}{"position"}[1];
  0            
170             }
171 0           return [ [ $x_min, $y_min ], [ $x_max, $y_max ] ];
172             }
173              
174             #
175             # Graphics::Fig::Compound::print
176             # $self: object
177             # $fh: reference to output file handle
178             # $parameters: save parameters
179             #
180             sub print {
181 0     0 0   my $self = shift;
182 0           my $fh = shift;
183 0           my $parameters = shift;
184              
185 0           my $bbox = $self->getbbox($parameters);
186 0           my $figPerInch = Graphics::Fig::_figPerInch($parameters);
187              
188             printf $fh ("6 %.0f %.0f %.0f %.0f\n",
189 0           ${$bbox}[0][0] * $figPerInch,
190 0           ${$bbox}[0][1] * $figPerInch,
191 0           ${$bbox}[1][0] * $figPerInch,
192 0           ${$bbox}[1][1] * $figPerInch);
  0            
193              
194 0           foreach my $object (@{${$self}{"objects"}}) {
  0            
  0            
195 0           $object->print($fh, $parameters);
196             }
197              
198 0           printf $fh ("-6\n");
199              
200 0           return 1;
201             }
202              
203             1;