File Coverage

blib/lib/Image/BoxModel/Text.pm
Criterion Covered Total %
statement 9 59 15.2
branch 0 34 0.0
condition 0 23 0.0
subroutine 3 5 60.0
pod 2 2 100.0
total 14 123 11.3


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