File Coverage

blib/lib/Chart/Mountain.pm
Criterion Covered Total %
statement 1 3 33.3
branch n/a
condition n/a
subroutine 1 1 100.0
pod n/a
total 2 4 50.0


line stmt bran cond sub pod time code
1             ## @file
2             # Implementation of Chart::Mountain
3             #
4             # written by david bonner
5             # dbonner@cs.bu.edu
6             #
7             # maintained by
8             # @author Chart Group at Geodetic Fundamental Station Wettzell (Chart@fs.wettzell.de)
9             # @date 2015-03-01
10             # @version 2.4.10
11             #
12             # Updated for
13             # compatibility with
14             # changes to Chart::Base
15             # by peter clark
16             # ninjaz@webexpress.com
17             #
18             # Copyright 1998, 1999 by James F. Miner.
19             # All rights reserved.
20             # This program is free software; you can redistribute it
21             # and/or modify it under the same terms as Perl itself.
22             #
23              
24             ## @class Chart::Mountain
25             # @brief Mountain class derived class for Chart to implement mountain type of plots
26             #
27             # Some Mountain chart details:
28             #
29             # The effective y data value for a given x point and dataset
30             # is the sum of the actual y data values of that dataset and
31             # all datasets "below" it (i.e., with higher dataset indexes).
32             #
33             # If the y data value in any dataset is undef or negative for
34             # a given x, then all datasets are treated as missing for that x.
35             #
36             # The y minimum is always forced to zero.
37             #
38             # To avoid a dataset area "cutting into" the area of the dataset below
39             # it, the y pixel for each dataset point will never be below the y pixel for
40             # the same point in the dataset below the dataset.
41              
42             # This probably should have a custom legend method, because each
43             # dataset is identified by the fill color (and optional pattern)
44             # of its area, not just a line color. So the legend shou a square
45             # of the color and pattern for each dataset.
46              
47             package Chart::Mountain;
48              
49 4     4   4491 use Chart::Base '2.4.10';
  0            
  0            
50             use GD;
51             use Carp;
52             use strict;
53              
54             @Chart::Mountain::ISA = qw ( Chart::Base );
55             $Chart::Mountain::VERSION = '2.4.10';
56              
57             #===================#
58             # private methods #
59             #===================#
60              
61             ## @fn private array _find_y_range()
62             # Find minimum and maximum value of y data sets.
63             #
64             # @return ( min, max, flag_all_integers )
65             sub _find_y_range
66             {
67             my $self = shift;
68              
69             # This finds the maximum point-sum over all x points,
70             # where the point-sum is the sum of the dataset values at that point.
71             # If the y value in any dataset is undef for a given x, then all datasets
72             # are treated as missing for that x.
73              
74             my $data = $self->{'dataref'};
75             my $max = undef;
76             for my $i ( 0 .. $#{ $data->[0] } )
77             {
78             my $y_sum = $data->[1]->[$i];
79             if ( defined $y_sum && $y_sum >= 0 )
80             {
81             for my $dataset ( @$data[ 2 .. $#$data ] )
82             { # order not important
83             my $datum = $dataset->[$i];
84             if ( defined $datum && $datum >= 0 )
85             {
86             $y_sum += $datum;
87             }
88             else
89             { # undef or negative, treat all at same x as missing.
90             $y_sum = undef;
91             last;
92             }
93             }
94             }
95             if ( defined $y_sum )
96             {
97             $max = $y_sum unless defined $max && $y_sum <= $max;
98             }
99             }
100              
101             ( 0, $max );
102             }
103              
104             ## @fn private _draw_data
105             # draw the data
106             sub _draw_data
107             {
108             my $self = shift;
109             my $data = $self->{'dataref'};
110              
111             my @patterns = @{ $self->{'patterns'} || [] };
112              
113             # Calculate array of x pixel positions (@x).
114             my $x_step =
115             ( $self->{'curr_x_max'} - $self->{'curr_x_min'} ) / ( $self->{'num_datapoints'} > 0 ? $self->{'num_datapoints'} : 1 );
116             my $x_min = $self->{'curr_x_min'} + $x_step / 2;
117             my $x_max = $self->{'curr_x_max'} - $x_step / 2;
118             my @x = map { $_ * $x_step + $x_min } 0 .. $self->{'num_datapoints'} - 1;
119             my ( $t_x_min, $t_x_max, $t_y_min, $t_y_max, $abs_x_max, $abs_y_max );
120             my $repair_top_flag = 0;
121              
122             # Calculate array of y pixel positions for upper boundary each dataset (@y).
123              
124             my $map =
125             ( $self->{'max_val'} )
126             ? ( $self->{'curr_y_max'} - $self->{'curr_y_min'} ) / $self->{'max_val'}
127             : ( $self->{'curr_y_max'} - $self->{'curr_y_min'} ) / 10;
128              
129             my $y_max = $self->{'curr_y_max'}; # max pixel point (lower y values)
130              
131             my @y;
132             for my $j ( 0 .. $#{ $data->[0] } )
133             {
134             my $sum = 0;
135             for my $i ( reverse 1 .. $#{$data} )
136             { # bottom to top of chart
137             my $datum = $data->[$i][$j];
138              
139             #set the repair flag, if the datum is out of the borders of the chart
140             if ( defined $datum && $datum > $self->{'max_val'} ) { $repair_top_flag = 1; }
141              
142             if ( defined $datum && $datum >= 0 )
143             {
144             $sum += $datum;
145             $y[ $i - 1 ][$j] = $y_max - $map * $sum;
146             }
147             else
148             { # missing value, force all to undefined
149             foreach my $k ( 1 .. $#{$data} ) { $y[ $k - 1 ][$j] = undef }
150             last;
151             }
152             }
153             }
154              
155             # Find first and last x where y is defined in the bottom dataset.
156             my $x_begin = 0;
157             my $x_end = $self->{'num_datapoints'} - 1;
158             while ( $x_begin <= $x_end && !defined $y[-1]->[$x_begin] ) { $x_begin++ }
159             while ( $x_begin <= $x_end && !defined $y[-1]->[$x_end] ) { $x_end-- }
160              
161             if ( $x_begin > $x_end ) { croak "Internal error: x_begin > x_end ($x_begin > $x_end)"; }
162              
163             # For each dataset, generate a polygon for the dataset's area of the chart,
164             # and fill the polygon with the dataset's color/pattern.
165              
166             my $poly = GD::Polygon->new;
167             $poly->addPt( $x[$x_end], $y_max ); # right end of x axis
168             $poly->addPt( $x[$x_begin], $y_max ); # left end of x axis (right-to-left)
169              
170             for my $dataset ( reverse 0 .. @y - 1 )
171             {
172             my $y_ref = $y[$dataset];
173              
174             # Append points for this dataset to polygon, direction depends on $dataset % 2.
175             my $last_vertex_count = $poly->length;
176             if ( ( @y - 1 - $dataset ) % 2 )
177             { # right-to-left
178             for ( reverse $x_begin .. $x_end )
179             {
180             $poly->addPt( $x[$_], $y_ref->[$_] ) if defined $y_ref->[$_];
181             }
182             }
183             else
184             { # left-to-right
185             for ( $x_begin .. $x_end )
186             {
187             $poly->addPt( $x[$_], $y_ref->[$_] ) if defined $y_ref->[$_];
188             }
189             }
190              
191             # draw the polygon
192             my $color = $self->_color_role_to_index( 'dataset' . $dataset );
193             if ( $patterns[$dataset] )
194             {
195             $self->{'gd_obj'}->filledPolygon( $poly, $color ) if $patterns[$dataset]->transparent >= 0;
196             $self->{'gd_obj'}->setTile( $patterns[$dataset] );
197             $self->{'gd_obj'}->filledPolygon( $poly, gdTiled );
198             }
199             else
200             {
201             $self->{'gd_obj'}->filledPolygon( $poly, $color );
202             }
203              
204             # delete previous dataset's points from the polygon, update $last_vertex_count.
205             unless ( $dataset == 0 )
206             { # don't bother do delete points after last area
207             while ($last_vertex_count) { $poly->deletePt(0); $last_vertex_count-- }
208             }
209             }
210              
211             # Enclose the plots
212             $self->{'gd_obj'}->rectangle( $self->{'curr_x_min'}, $self->{'curr_y_min'}, $self->{'curr_x_max'}, $self->{'curr_y_max'},
213             $self->_color_role_to_index('misc') );
214              
215             #get the width and the heigth of the complete picture
216             ( $abs_x_max, $abs_y_max ) = $self->{'gd_obj'}->getBounds();
217              
218             #repair the chart, if the lines are out of the borders of the chart
219             if ($repair_top_flag)
220             {
221              
222             #overwrite the ugly mistakes
223             $self->{'gd_obj'}->filledRectangle(
224             $self->{'curr_x_min'}, 0, $self->{'curr_x_max'},
225             $self->{'curr_y_min'} - 1,
226             $self->_color_role_to_index('background')
227             );
228              
229             #save the actual x and y values
230             $t_x_min = $self->{'curr_x_min'};
231             $t_x_max = $self->{'curr_x_max'};
232             $t_y_min = $self->{'curr_y_min'};
233             $t_y_max = $self->{'curr_y_max'};
234              
235             #get back to the point, where everything began
236             $self->{'curr_x_min'} = 0;
237             $self->{'curr_y_min'} = 0;
238             $self->{'curr_x_max'} = $abs_x_max;
239             $self->{'curr_y_max'} = $abs_y_max;
240              
241             #draw the title again
242             if ( $self->{'title'} )
243             {
244             $self->_draw_title();
245             }
246              
247             #draw the sub title again
248             if ( $self->{'sub_title'} )
249             {
250             $self->_draw_sub_title();
251             }
252              
253             #draw the top legend again
254             if ( $self->{'legend'} =~ /^top$/i )
255             {
256             $self->_draw_top_legend();
257             }
258              
259             #reset the actual values
260             $self->{'curr_x_min'} = $t_x_min;
261             $self->{'curr_x_max'} = $t_x_max;
262             $self->{'curr_y_min'} = $t_y_min;
263             $self->{'curr_y_max'} = $t_y_max;
264             }
265             }
266              
267             ###############################################################
268              
269             ### Fix a bug in GD::Polygon.
270             ### A patch has been submitted to Lincoln Stein.
271              
272             require GD;
273             unless ( defined &GD::Polygon::deletePt )
274             {
275             *GD::Polygon::deletePt = sub {
276             my ( $self, $index ) = @_;
277             unless ( ( $index >= 0 ) && ( $index < @{ $self->{'points'} } ) )
278             {
279             warn "Attempt to set an undefined polygon vertex";
280             return undef;
281             }
282             my ($vertex) = splice( @{ $self->{'points'} }, $index, 1 );
283             $self->{'length'}--;
284             return @$vertex;
285             }
286             }
287              
288             ###############################################################
289              
290             1;