File Coverage

blib/lib/Chart/Plot/Canvas.pm
Criterion Covered Total %
statement 10 61 16.3
branch 0 16 0.0
condition n/a
subroutine 4 8 50.0
pod n/a
total 14 85 16.4


line stmt bran cond sub pod time code
1            
2             package Chart::Plot::Canvas;
3            
4             our $VERSION = '0.04';
5            
6 1     1   44782 use strict;
  1         3  
  1         262  
7 1     1   7 use warnings;
  1         2  
  1         41  
8            
9 1     1   6 use base qw(Chart::Plot);
  1         2  
  1         2035  
10            
11             #==================#
12             # class variables #
13             #==================#
14            
15             # list of image types supported by GD, currently jpeg, png or gif,
16             # depending on GD version; initialized in _init()
17             my @_image_types = ();
18            
19             #==================#
20             # public methods #
21             #==================#
22            
23             sub image_type {
24 0 0   0     return (wantarray ? @_image_types : $_image_types[0]);
25             }
26            
27             sub draw {
28 0     0     my $self = shift;
29            
30 0           $self->_init_gd();
31            
32             # draw stuff in the GD object
33 0 0         $self->_getMinMax() unless $self->{'_validMinMax'};
34 0 0         $self->_drawTitle() if $self->{'_title'}; # vert offset may be increased
35 0           $self->_drawAxes();
36 0           $self->_drawData();
37            
38             # construct the image and return it.
39             # $_image_types[0] is the supported GD format, gif or png or jpeg
40             # Damien says no good way around this temp variable
41 0 0         if ($_[0]) { # image type argument
42 0 0         unless ( $self->{'_im'}->can($_[0]) ) {
43 0           $self->{'_errorMessage'} = "The image format $_[0] is not supported by this version $GD::VERSION of GD";
44 0           return undef;
45             }
46            
47 0           $_ = $_[0]; # forgot these in ver 0.10
48 0           return $self->{'_im'}->$_(); # an embarrassment
49            
50             }
51             else {
52 0           $_ = $_image_types[0];
53 0           return $self->{'_im'}->$_();
54             }
55             }
56            
57             sub canvas {
58 0     0     my $self = shift;
59            
60 0           $self->_init_cv(@_);
61            
62             # draw stuff in the GD object
63 0 0         $self->_getMinMax() unless $self->{'_validMinMax'};
64 0 0         $self->_createTitle() if $self->{'_title'}; # vert offset may be increased
65 0           $self->_createAxes();
66 0           $self->_createData();
67            
68 0           return $self->{'_cv'};
69             }
70            
71             #===================#
72             # private methods #
73             #===================#
74            
75             # initialization
76             # this contains a record of all private data except class variables, up top
77             sub _init {
78 0     0     my $self = shift;
79            
80             # create an image object
81 0 0         if ($#_ == 1) {
82 0           $self->{'_imx'} = $_[0];
83 0           $self->{'_imy'} = $_[1];
84             }
85             else {
86 0           $self->{'_imx'} = 400;
87 0           $self->{'_imy'} = 300;
88             }
89            
90             # set graph offset; graph will be centered this many pixels within image
91 0           $self->{'_horGraphOffset'} = 50;
92 0           $self->{'_vertGraphOffset'} = 50;
93            
94             # create an empty hash for the datsets
95             # data sets and their styles are hashes whose keys are 1 ... _numDataSets
96             # and values are refs to flat data arrays or style strings, respectively
97 0           $self->{'_data'} = {};
98 0           $self->{'_dataStyle'} = {};
99 0           $self->{'_numDataSets'} = 0;
100            
101             # calculated by _getMinMax and used in translating _data2pxl()
102 0           $self->{'_xmin'} = 0; $self->{'_xmax'} = 0; # among all datasets
  0            
103 0           $self->{'_ymin'} = 0; $self->{'_ymax'} = 0;
  0            
104 0           $self->{'_xslope'} = 0; $self->{'_yslope'} = 0; # for _data2pxl()
  0            
105 0           $self->{'_ax'} = 0; $self->{'_ay'} = 0;
  0            
106 0           $self->{'_omx'} = 0; $self->{'_omy'} = 0; # for axis ticks
  0            
107 0           $self->{'_validMinMax'} = 0; # last calculated min and max still valid
108            
109             # initialize text
110 0           ($self->{'_horAxisLabel'}, $self->{'_vertAxisLabel'}) = (q{},q{});
111 0           $self->{'_title'} = q{};
112 0           $self->{'_errorMessage'} = q{};
113            
114             # initialize custom tick labels
115 0           ($self->{'_xTickLabels'}, $self->{'_yTickLabels'}) = (0,0);
116            
117             # undocumented: in script, use as $plotObject->{'_debugging'} = 1;
118 0           $self->{'_debugging'} = 0;
119             }
120            
121             sub _init_gd {
122             my $self = shift;
123            
124 1     1   428 use GD;
  0            
  0            
125            
126             # create an image object
127             $self->{'_im'} = new GD::Image($self->{'_imx'}, $self->{'_imy'});
128            
129             # find format(s) supported by GD
130             unless (@_image_types) {
131             for ( qw(png gif jpeg) ) {
132             push @_image_types, $_ if $self->{'_im'}->can($_);
133             }
134             }
135            
136             # allocate some colors
137             $self->{'_white'} = $self->{'_im'}->colorAllocate(255,255,255);
138             $self->{'_black'} = $self->{'_im'}->colorAllocate(0,0,0);
139             $self->{'_red'} = $self->{'_im'}->colorAllocate(255,0,0);
140             $self->{'_blue'} = $self->{'_im'}->colorAllocate(0,0,255);
141             $self->{'_green'} = $self->{'_im'}->colorAllocate(0,255,0);
142            
143             # make the background transparent and interlaced
144             $self->{'_im'}->transparent($self->{'_white'});
145             $self->{'_im'}->interlaced('true');
146            
147             # Put a black frame around the picture
148             $self->{'_im'}->rectangle( 0, 0,
149             $self->{'_imx'}-1, $self->{'_imy'}-1,
150             $self->{'_black'});
151             }
152            
153             sub _init_cv {
154             my $self = shift;
155            
156             use Tk;
157             my($widget) = @_;
158            
159             # create an canvas object
160             $self->{'_cv'} = $widget->Canvas(
161             -width => $self->{'_imx'},
162             -height => $self->{'_imy'},
163             );
164            
165             # make the background white
166             $self->{'_cv'}->configure(
167             -background => 'white',
168             );
169            
170             # some fonts
171             if ($^O eq 'MSWin32') {
172             $self->{'_MediumBoldFont'} = "{MS Sans serif} 8 bold";
173             $self->{'_SmallFont'} = "Tahoma 8";
174             $self->{'_TinyFont'} = "{Small Fonts} 6";
175             }
176             else {
177             $self->{'_MediumBoldFont'} = '7x13bold';
178             $self->{'_SmallFont'} = '6x12';
179             $self->{'_TinyFont'} = '5x8';
180             }
181             }
182            
183             # draws all the datasets in $self->{'_data'}
184             # usage: $self->_createData()
185             sub _createData {
186             my $self = shift;
187             my ($i, $num, $px, $py, $prevpx, $prevpy, $dataSetLabel, $color);
188            
189             foreach $dataSetLabel (keys %{$self->{'_data'}}) {
190            
191             # get color
192             if ( $self->{'_dataStyle'}->{$dataSetLabel} =~ /((red)|(blue)|(green))/i ) {
193             $color = $1;
194             $color =~ tr/A-Z/a-z/;
195             }
196             else {
197             $color = 'black';
198             }
199            
200             # draw the first point
201             ($px, $py) = $self->_data2pxl (
202             $self->{'_data'}->{$dataSetLabel} [0],
203             $self->{'_data'}->{$dataSetLabel} [1]
204             );
205             $self->{'_cv'}->createOval($px-2, $py-2, $px+2, $py+2, -fill => $color, -outline => $color)
206             unless $self->{'_dataStyle'}->{$dataSetLabel} =~ /nopoint/i;
207            
208             ($prevpx, $prevpy) = ($px, $py);
209            
210             # debugging
211             if ($self->{'_debugging'}) {
212             print STDERR "pxldata: 0 ($px, $py)";
213             }
214            
215             # draw the rest of the points and lines
216             $num = @{ $self->{'_data'}->{$dataSetLabel} };
217             for ($i=2; $i<$num; $i+=2) {
218            
219             # get next point
220             ($px, $py) = $self->_data2pxl (
221             $self->{'_data'}->{$dataSetLabel}[$i],
222             $self->{'_data'}->{$dataSetLabel}[$i+1]
223             );
224            
225             # draw point, maybe
226             $self->{'_cv'}->createOval($px-2, $py-2, $px+2, $py+2, -fill => $color, -outline => $color)
227             unless $self->{'_dataStyle'}->{$dataSetLabel} =~ /nopoint/i;
228            
229             # draw line from previous point, maybe
230             if ($self->{'_dataStyle'}->{$dataSetLabel} =~ /dashed/) {
231             # $self->{'_cv'}->createLine($prevpx, $prevpy, $px, $py, -width => 1, -dash => [6,6], -fill => $color);
232             $self->{'_cv'}->createLine($prevpx, $prevpy, $px, $py, -dash => ',', -fill => $color);
233             }
234             elsif ($self->{'_dataStyle'}->{$dataSetLabel} =~ /noline/i) {
235             next;
236             }
237             else { # default to solid line
238             $self->{'_cv'}->createLine($prevpx, $prevpy, $px, $py, -fill => $color);
239             }
240            
241             ($prevpx, $prevpy) = ($px, $py);
242            
243             # debugging
244             if ($self->{'_debugging'}) {
245             print STDERR "$i ($px, $py)";
246             }
247             }
248             }
249             }
250            
251             # draw the axes, axis labels, ticks and tick labels
252             # usage: $self->_createAxes
253             sub _createAxes {
254             # axes run from data points: x -- ($xmin,0) ($xmax,0);
255             # y -- (0,$ymin) (0,$ymax);
256             # these mins and maxes are decimal orders of magnitude bounding the data
257            
258             my $self = shift;
259             my ($w,$h) = (6, 12);
260            
261             ### horizontal axis
262             my ($p1x, $p1y) = $self->_data2pxl ($self->{'_xmin'}, 0);
263             my ($p2x, $p2y) = $self->_data2pxl ($self->{'_xmax'}, 0);
264             $self->{'_cv'}->createLine($p1x, $p1y, $p2x, $p2y, -fill => 'black');
265            
266             ### axis label
267             my $len = $w * length ($self->{'_horAxisLabel'});
268             my $xStart = ($p2x+$len/2 > $self->{'_imx'}-10) # center under right end of axis
269             ? ($self->{'_imx'}-10-$len) : ($p2x-$len/2); # or right justify
270             $self->{'_cv'}->createText($xStart, $p2y+3*$h/2,
271             -font => $self->{'_SmallFont'},
272             -anchor => 'nw',
273             -text => $self->{'_horAxisLabel'},
274             -fill => 'black');
275            
276             print STDERR "\nHor: p1 ($p1x, $p1y) p2 ($p2x, $p2y)\n"
277             if $self->{'_debugging'};
278            
279             ### vertical axis
280             ($p1x, $p1y) = $self->_data2pxl (0, $self->{'_ymin'});
281             ($p2x, $p2y) = $self->_data2pxl (0, $self->{'_ymax'});
282             $self->{'_cv'}->createLine($p1x, $p1y, $p2x, $p2y, -fill => 'black');
283            
284             ### axis label
285             $xStart = $p2x - length ($self->{'_vertAxisLabel'}) * $w / 2;
286             $self->{'_cv'}->createText(($xStart>10 ? $xStart : 10), $p2y - 2*$h,
287             -font => $self->{'_SmallFont'},
288             -anchor => 'nw',
289             -text => $self->{'_vertAxisLabel'},
290             -fill => 'black');
291            
292             print STDERR "Ver: p1 ($p1x, $p1y) p2 ($p2x, $p2y)\n"
293             if $self->{'_debugging'};
294            
295             ###
296             ### draw axis ticks and tick labels
297             ###
298             my ($i,$px,$py, $step);
299            
300            
301             ###
302             ### horizontal
303             ###
304             # if horizontal custom tick labels
305             if ($self->{'_xTickLabels'}) {
306            
307             # a hashref with horizontal data point and label
308             # example: %{$self->{'_xTickLabels'} = (10 => 'Ten', 20 => 'Twenty', ...)
309             foreach ( keys %{$self->{'_xTickLabels'}} ) {
310            
311             ($px,$py) = $self->_data2pxl($_, 0);
312             $self->{'_cv'}->createLine($px, $py-2, $px, $py+2, -fill => 'black');
313             $self->{'_cv'}->createText($px, $py+3,
314             -font => $self->{'_SmallFont'},
315             -anchor => 'n',
316             -text => ${$self->{'_xTickLabels'}}{$_},
317             -fill => 'black');
318             }
319            
320             }
321             else {
322            
323             # horizontal step calculation
324             $step = $self->{'_omx'};
325             # step too large
326             $step /= 2 if ($self->{'_xmax'} - $self->{'_xmin'}) / $step < 6;
327             # once again. A poor hack for case om = max.
328             $step /= 2 if ($self->{'_xmax'} - $self->{'_xmin'}) / $step < 6;
329             # step too small. As long as we are doing poor hacks
330             $step *= 2 if ($self->{'_xmax'} - $self->{'_xmin'}) / $step > 12;
331            
332             for ($i=$self->{'_xmin'}; $i <= $self->{'_xmax'}; $i+=$step ) {
333             ($px,$py) = $self->_data2pxl($i, 0);
334             $self->{'_cv'}->createLine($px, $py-2, $px, $py+2, -fill => 'black');
335             $self->{'_cv'}->createText($px, $py+3,
336             -font => $self->{'_SmallFont'},
337             -anchor => 'n',
338             -text => $i,
339             -fill => 'black') unless $i == 0;
340             }
341             print STDERR "Horstep: $step ($self->{'_xmax'} - $self->{'_xmin'})/$self->{'_omx'})\n"
342             if $self->{'_debugging'};
343             }
344            
345             ###
346             ### vertical
347             ###
348             if ($self->{'_yTickLabels'}) {
349             foreach ( keys %{$self->{'_yTickLabels'}} ) {
350             ($px,$py) = $self->_data2pxl(0, $_);
351             $self->{'_cv'}->createLine($px-2, $py, $px+2, $py, -fill => 'black');
352             $self->{'_cv'}->createText($px-5, $py,
353             -font => $self->{'_SmallFont'},
354             -anchor => 'e',
355             -text => ${$self->{'_yTickLabels'}}{$_},
356             -fill => 'black');
357             }
358             }
359             else {
360             $step = $self->{'_omy'};
361             $step /= 2 if ($self->{'_ymax'} - $self->{'_ymin'}) / $step < 6;
362             $step /= 2 if ($self->{'_ymax'} - $self->{'_ymin'}) / $step < 6;
363             $step *= 2 if ($self->{'_ymax'} - $self->{'_ymin'}) / $step > 12;
364            
365             for ($i=$self->{'_ymin'}; $i <= $self->{'_ymax'}; $i+=$step ) {
366             ($px,$py) = $self->_data2pxl (0, $i);
367             $self->{'_cv'}->createLine($px-2, $py, $px+2, $py, -fill => 'black');
368             $self->{'_cv'}->createText($px-5, $py,
369             -font => $self->{'_SmallFont'},
370             -anchor => 'e',
371             -text => $i,
372             -fill => 'black') unless $i == 0;
373             }
374             print STDERR "Verstep: $step ($self->{'_ymax'} - $self->{'_ymin'})/$self->{'_omy'})\n"
375             if $self->{'_debugging'};
376             }
377             }
378            
379             sub _createTitle {
380             my $self = shift;
381             my ($w,$h) = (7, 13);
382            
383             # increase vert offset and recalculate conversion constants for _data2pxl()
384             $self->{'_vertGraphOffset'} += 2*$h;
385            
386             $self->{'_xslope'} = ($self->{'_imx'} - 2 * $self->{'_horGraphOffset'})
387             / ($self->{'_xmax'} - $self->{'_xmin'});
388             $self->{'_yslope'} = ($self->{'_imy'} - 2 * $self->{'_vertGraphOffset'})
389             / ($self->{'_ymax'} - $self->{'_ymin'});
390            
391             $self->{'_ax'} = $self->{'_horGraphOffset'};
392             $self->{'_ay'} = $self->{'_imy'} - $self->{'_vertGraphOffset'};
393            
394            
395             # centered below chart
396             my ($px,$py) = ($self->{'_imx'}/2, # $self->{'_vertGraphOffset'}/2);
397             $self->{'_imy'} - $self->{'_vertGraphOffset'}/2);
398            
399             $self->{'_cv'}->createText($px, $py,
400             -font => $self->{'_MediumBoldFont'},
401             -anchor => 'center',
402             -text => $self->{'_title'},
403             -fill => 'black');
404             }
405            
406             1;
407            
408             __END__