line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
package Image::BoxModel::Text; |
2
|
|
|
|
|
|
|
|
3
|
1
|
|
|
1
|
|
5
|
use warnings; |
|
1
|
|
|
|
|
3
|
|
|
1
|
|
|
|
|
57
|
|
4
|
1
|
|
|
1
|
|
5
|
use strict; |
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
37
|
|
5
|
|
|
|
|
|
|
|
6
|
1
|
|
|
1
|
|
6
|
use POSIX; |
|
1
|
|
|
|
|
1
|
|
|
1
|
|
|
|
|
7
|
|
7
|
|
|
|
|
|
|
|
8
|
|
|
|
|
|
|
=head1 NAME |
9
|
|
|
|
|
|
|
|
10
|
|
|
|
|
|
|
Image::BoxModel::Text - Text function for Image::BoxModel |
11
|
|
|
|
|
|
|
|
12
|
|
|
|
|
|
|
=head1 SYNOPSIS |
13
|
|
|
|
|
|
|
|
14
|
|
|
|
|
|
|
For an example and general information see Image::BoxModel.pm |
15
|
|
|
|
|
|
|
|
16
|
|
|
|
|
|
|
=head1 DESCRIPTION |
17
|
|
|
|
|
|
|
|
18
|
|
|
|
|
|
|
Image::BoxModel::Text implements direct inserting of text. It has the following method 'Annotate' which a Image::BoxModel object inherits. |
19
|
|
|
|
|
|
|
|
20
|
|
|
|
|
|
|
It uses Image::BoxModel::Lowlevel for defining boxes and drawing text. See there for more information. |
21
|
|
|
|
|
|
|
|
22
|
|
|
|
|
|
|
'Annotate' will guarantee that every text lives in its own box and avoids many possible bugs, like text being overwritten by other texts in the same box, to small boxes.. |
23
|
|
|
|
|
|
|
|
24
|
|
|
|
|
|
|
Anyway, if you have a good reason, feel free to use the methods from ::Lowlevel directly. This can end in completely non-box-model-style images. |
25
|
|
|
|
|
|
|
|
26
|
|
|
|
|
|
|
=head2 Method |
27
|
|
|
|
|
|
|
|
28
|
|
|
|
|
|
|
=head3 Annotate |
29
|
|
|
|
|
|
|
|
30
|
|
|
|
|
|
|
$name_of_box = $image -> Annotate ( |
31
|
|
|
|
|
|
|
text => $text # mandatory |
32
|
|
|
|
|
|
|
name => $name_of_box |
33
|
|
|
|
|
|
|
position => [top|bottom|right|left], |
34
|
|
|
|
|
|
|
textsize => $size, |
35
|
|
|
|
|
|
|
font => $font, |
36
|
|
|
|
|
|
|
rotate => [in degrees, may be negative as well], |
37
|
|
|
|
|
|
|
align => [Center|Left|Right], # align is how multiline-text is aligned |
38
|
|
|
|
|
|
|
text_position => [Center # position is how text will be positioned inside its box |
39
|
|
|
|
|
|
|
NorthWest| |
40
|
|
|
|
|
|
|
North| |
41
|
|
|
|
|
|
|
NorthEast| |
42
|
|
|
|
|
|
|
West| |
43
|
|
|
|
|
|
|
SoutEast| |
44
|
|
|
|
|
|
|
South| |
45
|
|
|
|
|
|
|
SouthWest| |
46
|
|
|
|
|
|
|
West], |
47
|
|
|
|
|
|
|
background => (color), |
48
|
|
|
|
|
|
|
padding_right => [number], |
49
|
|
|
|
|
|
|
padding_left => [number], |
50
|
|
|
|
|
|
|
padding_top => [number], |
51
|
|
|
|
|
|
|
padding_bottom => [number], |
52
|
|
|
|
|
|
|
) |
53
|
|
|
|
|
|
|
|
54
|
|
|
|
|
|
|
All parameters except "text" are preset with defaults. These are the first value above or generally "0" for numbers (except "12" for textsize), and "white" for colors. |
55
|
|
|
|
|
|
|
|
56
|
|
|
|
|
|
|
$name_of_box is a number, starting from 1. |
57
|
|
|
|
|
|
|
|
58
|
|
|
|
|
|
|
=cut |
59
|
|
|
|
|
|
|
|
60
|
|
|
|
|
|
|
sub Annotate{ |
61
|
0
|
|
|
0
|
1
|
|
my $image = shift; |
62
|
0
|
|
|
|
|
|
my %p = ( |
63
|
|
|
|
|
|
|
position=>"top", |
64
|
|
|
|
|
|
|
textsize => 12, |
65
|
|
|
|
|
|
|
rotate => 0, |
66
|
|
|
|
|
|
|
align => "Center", |
67
|
|
|
|
|
|
|
padding_right => 0, |
68
|
|
|
|
|
|
|
padding_left => 0, |
69
|
|
|
|
|
|
|
padding_top => 0, |
70
|
|
|
|
|
|
|
padding_bottom => 0, |
71
|
|
|
|
|
|
|
color => 'black', |
72
|
|
|
|
|
|
|
@_ |
73
|
|
|
|
|
|
|
); |
74
|
|
|
|
|
|
|
|
75
|
0
|
0
|
0
|
|
|
|
die __PACKAGE__, " Mandatory parameter 'text' missing. Die" unless (exists $p{text} and $p{text}); |
76
|
|
|
|
|
|
|
|
77
|
0
|
|
0
|
|
|
|
my $resize = $p{resize} || 'free'; |
78
|
|
|
|
|
|
|
|
79
|
0
|
|
|
|
|
|
my $box_position = "top"; |
80
|
0
|
|
|
|
|
|
my $text_position = "Center"; |
81
|
|
|
|
|
|
|
|
82
|
0
|
0
|
|
|
|
|
$box_position = $p{box_position} if (exists $p{box_position}); |
83
|
0
|
0
|
|
|
|
|
$text_position = $p{text_position} if (exists $p{text_position}); |
84
|
|
|
|
|
|
|
|
85
|
|
|
|
|
|
|
#autogenerated boxes are numbered, starting with 1 |
86
|
0
|
|
|
|
|
|
my $e = 1; |
87
|
0
|
0
|
|
|
|
|
if (exists $p{name}){ # Anyway, if you give it a name, then you want it to call it that way ;-) |
88
|
0
|
|
|
|
|
|
$e = $p{name}; |
89
|
|
|
|
|
|
|
} |
90
|
|
|
|
|
|
|
else{ # autogenerate name: find a previously unused number |
91
|
0
|
|
|
|
|
|
$e++ while (exists $image -> {$e}); |
92
|
|
|
|
|
|
|
} |
93
|
|
|
|
|
|
|
|
94
|
0
|
|
|
|
|
|
my ($width, $height) = $image -> GetTextSize( |
95
|
|
|
|
|
|
|
text => $p{text}, |
96
|
|
|
|
|
|
|
textsize => $p{textsize}, |
97
|
|
|
|
|
|
|
rotate => $p{rotate}, |
98
|
|
|
|
|
|
|
font => $p{font} |
99
|
|
|
|
|
|
|
); |
100
|
|
|
|
|
|
|
|
101
|
0
|
|
|
|
|
|
$image -> Box( |
102
|
|
|
|
|
|
|
resize => $resize, |
103
|
|
|
|
|
|
|
position =>$box_position, |
104
|
|
|
|
|
|
|
width=> $width+$p{padding_right}+$p{padding_left}, |
105
|
|
|
|
|
|
|
height => $height+$p{padding_top}+$p{padding_bottom}, |
106
|
|
|
|
|
|
|
name=> $e, |
107
|
|
|
|
|
|
|
background => $p{background} |
108
|
|
|
|
|
|
|
); |
109
|
|
|
|
|
|
|
|
110
|
|
|
|
|
|
|
#if there is some padding, little empty boxes are added: |
111
|
0
|
|
|
|
|
|
foreach ("padding_top", "padding_bottom", "padding_left", "padding_right"){ |
112
|
0
|
|
|
|
|
|
(my $position = $_) =~ s/.+_//; |
113
|
|
|
|
|
|
|
|
114
|
0
|
0
|
|
|
|
|
$image-> Box( |
115
|
|
|
|
|
|
|
resize=> $e, |
116
|
|
|
|
|
|
|
position =>$position, |
117
|
|
|
|
|
|
|
width=> $p{$_}-1, |
118
|
|
|
|
|
|
|
height => $p{$_}-1, |
119
|
|
|
|
|
|
|
name => $e.$_, |
120
|
|
|
|
|
|
|
background => $p{background} |
121
|
|
|
|
|
|
|
) if ($p{$_} > 0); |
122
|
|
|
|
|
|
|
} |
123
|
|
|
|
|
|
|
|
124
|
|
|
|
|
|
|
$image -> Text( |
125
|
0
|
|
|
|
|
|
box => $e, |
126
|
|
|
|
|
|
|
text=> $p{text}, |
127
|
|
|
|
|
|
|
font => $p{font}, |
128
|
|
|
|
|
|
|
textsize => $p{textsize}, |
129
|
|
|
|
|
|
|
align=>$p{align}, |
130
|
|
|
|
|
|
|
position=> $text_position, |
131
|
|
|
|
|
|
|
rotate => $p{rotate}, |
132
|
|
|
|
|
|
|
color => $p{color} |
133
|
|
|
|
|
|
|
); |
134
|
|
|
|
|
|
|
|
135
|
0
|
|
|
|
|
|
return $e; |
136
|
|
|
|
|
|
|
} |
137
|
|
|
|
|
|
|
|
138
|
|
|
|
|
|
|
=head3 ArrayBox |
139
|
|
|
|
|
|
|
|
140
|
|
|
|
|
|
|
$image -> ArrayBox ( |
141
|
|
|
|
|
|
|
values => \@array, #holds the texts |
142
|
|
|
|
|
|
|
textsize => [number], |
143
|
|
|
|
|
|
|
rotate => [degree], |
144
|
|
|
|
|
|
|
resize => [name of box], |
145
|
|
|
|
|
|
|
position => [top | bottom | right | left], |
146
|
|
|
|
|
|
|
name => [name of new box], |
147
|
|
|
|
|
|
|
background => [color] #optional |
148
|
|
|
|
|
|
|
); |
149
|
|
|
|
|
|
|
|
150
|
|
|
|
|
|
|
Creates a exactly fitting box for an simple array of values. It does not understand what to do with arrays of arrays or the like. |
151
|
|
|
|
|
|
|
The new box is directly stored into the $image object. |
152
|
|
|
|
|
|
|
|
153
|
|
|
|
|
|
|
It returns nothing. |
154
|
|
|
|
|
|
|
|
155
|
|
|
|
|
|
|
Can only be used from Image::BoxModel::Chart objects at the moment. Or manually add Image::BoxModel::Chart::Data to your @ISA and use() it. |
156
|
|
|
|
|
|
|
|
157
|
|
|
|
|
|
|
If the new box is positioned top or bottom, ArrayBox assumes that the user wants to draw the values side by side, if the position is left or right, that the values are "piled" bottom up or top down. |
158
|
|
|
|
|
|
|
|
159
|
|
|
|
|
|
|
=cut |
160
|
|
|
|
|
|
|
|
161
|
|
|
|
|
|
|
sub ArrayBox{ |
162
|
0
|
|
|
0
|
1
|
|
my $image = shift; |
163
|
0
|
|
|
|
|
|
my %p = ( |
164
|
|
|
|
|
|
|
resize => 'free', |
165
|
|
|
|
|
|
|
@_ |
166
|
|
|
|
|
|
|
); |
167
|
|
|
|
|
|
|
|
168
|
0
|
0
|
|
|
|
|
$p{skip} = 1 unless ($p{skip}); #assure that $p{skip} cannot become 0; |
169
|
|
|
|
|
|
|
|
170
|
0
|
|
|
|
|
|
my $width = 0; |
171
|
0
|
|
|
|
|
|
my $height = 0; |
172
|
|
|
|
|
|
|
|
173
|
0
|
|
|
|
|
|
my $orientation; |
174
|
|
|
|
|
|
|
|
175
|
0
|
0
|
0
|
|
|
|
unless (exists $p{name} and $p{name}){ |
176
|
|
|
|
|
|
|
#autogenerated boxes are numbered, starting with 1 |
177
|
0
|
|
|
|
|
|
$p{name} = 1; |
178
|
0
|
|
|
|
|
|
$p{name}++ while (exists $image -> {$p{name}}); |
179
|
|
|
|
|
|
|
} |
180
|
|
|
|
|
|
|
|
181
|
|
|
|
|
|
|
#~ print "Name in ArrayBox: $p{name}\n"; |
182
|
|
|
|
|
|
|
|
183
|
0
|
0
|
0
|
|
|
|
if (exists $p{orientation} and ($p{orientation} eq 'vertical' or $p{orientation} eq 'horizontal')){ |
|
|
0
|
0
|
|
|
|
|
|
|
0
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
184
|
0
|
|
|
|
|
|
$orientation = $p{orientation}; |
185
|
|
|
|
|
|
|
} |
186
|
|
|
|
|
|
|
elsif ($p{position} =~ /right/i or $p{position} =~ /left/i){#guessed that this is desired unless otherwise specified.. |
187
|
0
|
|
|
|
|
|
$orientation = 'vertical'; |
188
|
|
|
|
|
|
|
} |
189
|
|
|
|
|
|
|
elsif ($p{position} =~ /top/i or $p{position} =~ /bottom/i){ |
190
|
0
|
|
|
|
|
|
$orientation = 'horizontal'; |
191
|
|
|
|
|
|
|
} |
192
|
|
|
|
|
|
|
else{ |
193
|
0
|
|
|
|
|
|
die __PACKAGE__, " :parameter $p{orientation} invalid. Valid are 'vertical' and 'horizontal'\n"; |
194
|
|
|
|
|
|
|
} |
195
|
|
|
|
|
|
|
|
196
|
|
|
|
|
|
|
#~ print "$p{name}: Orientation: $orientation\n"; |
197
|
|
|
|
|
|
|
|
198
|
0
|
|
|
|
|
|
my $c = -1; |
199
|
|
|
|
|
|
|
|
200
|
0
|
|
|
|
|
|
foreach (@{$p{values_ref}}){ |
|
0
|
|
|
|
|
|
|
201
|
0
|
|
|
|
|
|
$c++; |
202
|
0
|
0
|
|
|
|
|
next unless ($c % $p{skip} == 0); |
203
|
|
|
|
|
|
|
|
204
|
0
|
|
|
|
|
|
my ($w, $h) = $image -> GetTextSize(text => $_, font => $p{font}, textsize => $p{textsize}, rotate => $p{rotate}); |
205
|
0
|
0
|
|
|
|
|
if ($orientation eq 'vertical'){ #the values are then printed one upon each other |
|
|
0
|
|
|
|
|
|
206
|
0
|
0
|
|
|
|
|
$width = $w if ($w > $width); #..then the longest string determines the size of the box |
207
|
0
|
|
|
|
|
|
$height += $h; #height is the sum of the heights of each value |
208
|
0
|
|
|
|
|
|
$height ++; #even I shouldn't guess after I've been writing this module by myself, I guess Box needs 1 "pixel" more than the texts size |
209
|
|
|
|
|
|
|
} |
210
|
|
|
|
|
|
|
elsif ($orientation eq 'horizontal'){#the values are printed side to side |
211
|
0
|
|
|
|
|
|
$width += $w; #width is the sum.. |
212
|
0
|
0
|
|
|
|
|
$height = $h if ($h > $height); #height is determined by the highest string (see above) |
213
|
0
|
|
|
|
|
|
$width ++; #see my guess above. |
214
|
|
|
|
|
|
|
} |
215
|
|
|
|
|
|
|
} |
216
|
|
|
|
|
|
|
|
217
|
|
|
|
|
|
|
# Box only needs width if positioned left or right. - $width is possibly too wide, which is no problem. So we set it = 1 usw. |
218
|
0
|
0
|
|
|
|
|
$width = 1 if ($orientation eq 'horizontal'); |
219
|
|
|
|
|
|
|
#~ $height= 1 if ($orientation eq 'vertical'); |
220
|
|
|
|
|
|
|
|
221
|
0
|
0
|
0
|
|
|
|
unless (exists $p{no_box} and $p{no_box}){ |
222
|
0
|
|
|
|
|
|
$image -> Box( |
223
|
|
|
|
|
|
|
resize => $p{resize}, |
224
|
|
|
|
|
|
|
position =>$p{position}, |
225
|
|
|
|
|
|
|
width=> (ceil ($width)), |
226
|
|
|
|
|
|
|
height => (ceil ($height)), #the good thing is, Box only uses the value it needs. if it makes a new box on the left, height is ignored. |
227
|
|
|
|
|
|
|
name=> "$p{name}", |
228
|
|
|
|
|
|
|
background => $p{background}, |
229
|
|
|
|
|
|
|
); |
230
|
|
|
|
|
|
|
} |
231
|
|
|
|
|
|
|
|
232
|
|
|
|
|
|
|
#~ print "In Text::ArrayBox: width: $width, height: $height\n"; |
233
|
0
|
|
|
|
|
|
return $width, $height; |
234
|
|
|
|
|
|
|
} |
235
|
|
|
|
|
|
|
|
236
|
|
|
|
|
|
|
1 |