File Coverage

lib/Graphics/Fig/Text.pm
Criterion Covered Total %
statement 127 162 78.4
branch 8 18 44.4
condition 2 6 33.3
subroutine 13 14 92.8
pod 0 7 0.0
total 150 207 72.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::Text;
18             our $VERSION = 'v1.0.7';
19              
20 12     12   84 use strict;
  12         22  
  12         380  
21 12     12   56 use warnings;
  12         21  
  12         301  
22 12     12   57 use Carp;
  12         18  
  12         654  
23 12     12   65 use Math::Trig;
  12         29  
  12         2007  
24 12     12   82 use Image::Info qw(image_info);
  12         25  
  12         517  
25 12     12   82 use Graphics::Fig::Color;
  12         24  
  12         326  
26 12     12   72 use Graphics::Fig::Parameters;
  12         29  
  12         15368  
27              
28              
29             #
30             # Text Parameters
31             #
32             my %TextParameterTemplate = (
33             positional => {
34             "." => [ "text" ],
35             },
36             named => [
37             \%Graphics::Fig::Parameters::UnitsParameter, # must be first
38             \%Graphics::Fig::Parameters::PositionParameter, # must be second
39             \%Graphics::Fig::Parameters::ColorParameter,
40             \%Graphics::Fig::Parameters::DepthParameter,
41             \%Graphics::Fig::Parameters::RotationParameter,
42             @Graphics::Fig::Parameters::TextParameters,
43             {
44             name => "text",
45             convert => \&Graphics::Fig::Parameters::convertText,
46             },
47             ],
48             );
49              
50             #
51             # Graphics::Fig::Text::setTextSize: compute the length and height of text
52             #
53             sub setTextSize {
54 1     1 0 2 my $self = shift;
55 1         1 my $pointSize = ${$self}{"fontSize"};
  1         2  
56 1         2 my $text = ${$self}{"text"};
  1         2  
57              
58             #
59             # TODO: This calculation is only an approximation. It should determine
60             # the height and length of the text based on the given font and size.
61             #
62 1         4 my $height = $pointSize / 72.0;
63 1         4 my $length = $height * length($text) / 2.0;
64 1         2 ${$self}{"length"} = $length;
  1         1  
65 1         2 ${$self}{"height"} = $height;
  1         1092  
66             }
67              
68             #
69             # Graphics::Fig::Text::text constructor
70             # $proto: prototype
71             # $fig: parent object
72             # @parameters: spline parameters
73             #
74             sub text {
75 1     1 0 2 my $proto = shift;
76 1         2 my $fig = shift;
77 1         3 my $text;
78             my $rotation;
79              
80             #
81             # Parse parameters.
82             #
83 1         0 my %parameters;
84 1         2 my $stack = ${$fig}{"stack"};
  1         2  
85 1         2 my $tos = ${$stack}[$#{$stack}];
  1         1  
  1         2  
86 1         2 eval {
87             Graphics::Fig::Parameters::parse($fig, "spline",
88             \%TextParameterTemplate,
89 1         15 ${$tos}{"options"}, \%parameters, @_);
  1         6  
90             };
91 1 50       4 if ($@) {
92 0         0 $@ =~ s/ at [^\s]* line \d+\.\n//;
93 0         0 croak("$@");
94             }
95              
96 1 50       14 if (!defined($text = $parameters{"text"})) {
97 0         0 croak("text: no text string given");
98             }
99 1 50       5 if (!defined($rotation = $parameters{"rotation"})) {
100 1         3 $rotation = 0;
101             }
102              
103             #
104             # Construct the object.
105             #
106             my $self = {
107             justification => $parameters{"textJustification"},
108             penColor => $parameters{"penColor"},
109             depth => $parameters{"depth"},
110             fontName => $parameters{"fontName"}[1],
111             fontSize => $parameters{"fontSize"},
112             fontFlags => $parameters{"fontName"}[0],
113             rotation => $rotation,
114             length => undef,
115             height => undef,
116 1         10 points => [ $parameters{"position"} ],
117             text => $text,
118             };
119 1   33     5 my $class = ref($proto) || $proto;
120 1         3 bless($self, $class);
121              
122             #
123             # Apply font flags and calculate the text size.
124             #
125 1         1 ${$self}{"fontFlags"} |= $parameters{"fontFlags"} & ~4;
  1         11  
126 1         6 $self->setTextSize();
127              
128 1         3 push(@{${$tos}{"objects"}}, $self);
  1         3  
  1         5  
129 1         9 return $self;
130             }
131              
132             #
133             # Graphics::Fig::Text::translate
134             # $self: object
135             # $parameters: reference to parameter hash
136             #
137             sub translate {
138 1     1 0 4 my $self = shift;
139 1         2 my $parameters = shift;
140              
141 1         2 @{${$self}{"points"}} = Graphics::Fig::Parameters::translatePoints(
  1         3  
142 1         2 $parameters, @{${$self}{"points"}});
  1         1  
  1         3  
143              
144 1         2 return 1;
145             }
146              
147             #
148             # Graphics::Fig::Text::rotate
149             # $self: object
150             # $parameters: reference to parameter hash
151             #
152             sub rotate {
153 1     1 0 1 my $self = shift;
154 1         12 my $parameters = shift;
155 1         2 my $rotation = ${$parameters}{"rotation"};
  1         3  
156              
157 1         7 @{${$self}{"points"}} = Graphics::Fig::Parameters::rotatePoints(
  1         3  
158 1         2 $parameters, @{${$self}{"points"}});
  1         1  
  1         4  
159 1         2 ${$self}{"rotation"} += $rotation;
  1         3  
160              
161 1         2 return 1;
162             }
163              
164             #
165             # Graphics::Fig::Text::scale
166             # $self: object
167             # $parameters: reference to parameter hash
168             #
169             sub scale {
170 0     0 0 0 my $self = shift;
171 0         0 my $parameters = shift;
172 0         0 my $scale = ${$parameters}{"scale"};
  0         0  
173 0 0       0 die unless defined($scale);
174 0         0 my $u = ${$scale}[0];
  0         0  
175 0         0 my $v = ${$scale}[1];
  0         0  
176              
177 0         0 @{${$self}{"points"}} = Graphics::Fig::Parameters::scalePoints(
  0         0  
178 0         0 $parameters, @{${$self}{"points"}});
  0         0  
  0         0  
179 0         0 ${$self}{"length"} *= $u;
  0         0  
180 0         0 ${$self}{"height"} *= $v;
  0         0  
181              
182 0         0 return 1;
183             }
184              
185             #
186             # Graphics::Fig::Text::getbbox
187             # $self: object
188             # $parameters: getbbox parameters
189             #
190             # Return [[xmin, ymin], [xmax, ymax]]
191             #
192             sub getbbox {
193 3     3 0 6 my $self = shift;
194 3         4 my $parameters = shift;
195 3         3 my $justification = ${$self}{"justification"};
  3         5  
196 3         4 my $position = ${$self}{"points"}[0];
  3         5  
197 3         3 my $height = ${$self}{"height"};
  3         5  
198 3         4 my $length = ${$self}{"length"};
  3         4  
199 3         4 my ($xmin, $ymin, $xmax, $ymax);
200              
201             #
202             # TODO: We need width and height (see setTextSize). Additionally, we need
203             # to know the distance between the lowest part of the text, e.g. bottom of
204             # "y" or "g" and the baseline.
205             #
206 3         6 my $shift = $height / 3.0;
207              
208 3 50       12 if ($justification == 2) {
    50          
209 0         0 $xmin = ${$position}[0] - $length;
  0         0  
210 0         0 $xmax = ${$position}[0];
  0         0  
211             } elsif ($justification == 1) {
212 3         3 $xmin = ${$position}[0] - $length / 2.0;
  3         6  
213 3         3 $xmax = ${$position}[0] + $length / 2.0;
  3         8  
214             } else {
215 0         0 $xmin = ${$position}[0];
  0         0  
216 0         0 $xmax = ${$position}[0] + $length;
  0         0  
217             }
218 3         3 $ymin = $shift + ${$position}[1];
  3         4  
219 3         3 $ymax = $shift + ${$position}[1] - $height;
  3         4  
220              
221 3         10 return [ [ $xmin, $ymin ], [ $xmax, $ymax ] ];
222             }
223              
224             #
225             # Graphics::Fig::Text::print
226             # $self: object
227             # $fh: reference to output file handle
228             # $parameters: save parameters
229             #
230             sub print {
231 1     1 0 3 my $self = shift;
232 1         4 my $fh = shift;
233 1         1 my $parameters = shift;
234 1         2 my $text_in = ${$self}{"text"};
  1         4  
235 1         4 my $text_out = "";
236              
237             #
238             # Encode bytes above 127 with octal escapes.
239             #
240 1         4 utf8::encode($text_in);
241 1         6 for (my $i = 0; $i < length($text_in); ++$i) {
242 12         16 my $c = substr($text_in, $i, 1);
243 12         12 my $n = ord($c);
244 12 50 33     33 die if $n < 0 || $n > 255; # otherwise, utf8::encode didn't work
245 12 50       30 if ($n == 0x5C) { # '\'
246 0         0 $text_out .= '\\';
247 0         0 $text_out .= $c;
248 0         0 next;
249             }
250 12 50       16 if ($n > 127) {
251 0         0 $text_out .= sprintf("\\%03o", $n);
252 0         0 next;
253             }
254 12         22 $text_out .= $c;
255             }
256              
257             #
258             # Print
259             #
260 1         14 my $figPerInch = Graphics::Fig::_figPerInch($parameters);
261             printf $fh ("4 %d %d %d -1 %d %.0f %.4f %u %.0f %.0f %d %d %s\\001\n",
262 1         2 ${$self}{"justification"},
263 1         2 ${$self}{"penColor"},
264 1         2 ${$self}{"depth"},
265 1         1 ${$self}{"fontName"},
266 1         2 ${$self}{"fontSize"},
267 1         3 ${$self}{"rotation"},
268 1         1 ${$self}{"fontFlags"},
269 1         3 ${$self}{"height"} * $figPerInch,
270 1         1 ${$self}{"length"} * $figPerInch,
271 1         2 ${$self}{"points"}[0][0] * $figPerInch,
272 1         4 ${$self}{"points"}[0][1] * $figPerInch,
  1         21  
273             $text_out);
274             }
275              
276             1;