File Coverage

blib/lib/GD/Graph/lines.pm
Criterion Covered Total %
statement 4 6 66.6
branch n/a
condition n/a
subroutine 2 2 100.0
pod n/a
total 6 8 75.0


line stmt bran cond sub pod time code
1             #==========================================================================
2             # Copyright (c) 1995-1998 Martien Verbruggen
3             #--------------------------------------------------------------------------
4             #
5             # Name:
6             # GD::Graph::lines.pm
7             #
8             # $Id: lines.pm,v 1.15 2005/12/14 04:13:00 ben Exp $
9             #
10             #==========================================================================
11              
12             package GD::Graph::lines;
13              
14             ($GD::Graph::lines::VERSION) = '$Revision: 1.15 $' =~ /\s([\d.]+)/;
15              
16 2     2   680 use strict;
  2         3  
  2         57  
17            
18 2     2   482 use GD;
  0            
  0            
19             use GD::Graph::axestype;
20              
21             @GD::Graph::lines::ISA = qw( GD::Graph::axestype );
22              
23             # PRIVATE
24              
25             sub draw_data_set
26             {
27             my $self = shift;
28             my $ds = shift;
29              
30             my @values = $self->{_data}->y_values($ds) or
31             return $self->_set_error("Impossible illegal data set: $ds",
32             $self->{_data}->error);
33              
34             my $dsci = $self->set_clr($self->pick_data_clr($ds) );
35             my $type = $self->pick_line_type($ds);
36              
37             my ($xb, $yb);
38             if (defined $values[0])
39             {
40             if (defined($self->{x_min_value}) && defined($self->{x_max_value}))
41             {
42             ($xb, $yb) =
43             $self->val_to_pixel($self->{_data}->get_x(0), $values[0], $ds);
44             }
45             else
46             {
47             ($xb, $yb) = $self->val_to_pixel(1, $values[0], $ds);
48             }
49             }
50              
51             for (my $i = 0; $i < @values; $i++)
52             {
53             if (!defined $values[$i])
54             {
55             ($xb, $yb) = () if $self->{skip_undef};
56             next;
57             }
58              
59             my ($xe, $ye);
60              
61             if (defined($self->{x_min_value}) && defined($self->{x_max_value}))
62             {
63             ($xe, $ye) = $self->val_to_pixel(
64             $self->{_data}->get_x($i), $values[$i], $ds);
65             }
66             else
67             {
68             ($xe, $ye) = $self->val_to_pixel($i+1, $values[$i], $ds);
69             }
70              
71             if (defined $xb)
72             {
73             $self->draw_line($xb, $yb, $xe, $ye, $type, $dsci)
74             if defined $dsci;
75             $self->{_hotspots}->[$ds]->[$i] =
76             ['line', $xb, $yb, $xe, $ye, $self->{line_width}];
77             }
78             ($xb, $yb) = ($xe, $ye);
79             }
80              
81             return $ds;
82             }
83              
84             sub pick_line_type
85             {
86             my $self = shift;
87             my $num = shift;
88              
89             ref $self->{line_types} ?
90             $self->{line_types}[ $num % (1 + $#{$self->{line_types}}) - 1 ] :
91             $num % 4 ? $num % 4 : 4
92             }
93              
94             sub draw_line # ($xs, $ys, $xe, $ye, $type, $colour_index)
95             {
96             my $self = shift;
97             my ($xs, $ys, $xe, $ye, $type, $clr) = @_;
98              
99             my $lw = $self->{line_width};
100             my $lts = $self->{line_type_scale};
101              
102             my $style = gdStyled;
103             my @pattern = ();
104              
105             LINE: {
106              
107             ($type == 2) && do {
108             # dashed
109              
110             for (1 .. $lts) { push @pattern, $clr }
111             for (1 .. $lts) { push @pattern, gdTransparent }
112              
113             $self->{graph}->setStyle(@pattern);
114              
115             last LINE;
116             };
117              
118             ($type == 3) && do {
119             # dotted,
120              
121             for (1 .. 2) { push @pattern, $clr }
122             for (1 .. 2) { push @pattern, gdTransparent }
123              
124             $self->{graph}->setStyle(@pattern);
125              
126             last LINE;
127             };
128              
129             ($type == 4) && do {
130             # dashed and dotted
131              
132             for (1 .. $lts) { push @pattern, $clr }
133             for (1 .. 2) { push @pattern, gdTransparent }
134             for (1 .. 2) { push @pattern, $clr }
135             for (1 .. 2) { push @pattern, gdTransparent }
136              
137             $self->{graph}->setStyle(@pattern);
138              
139             last LINE;
140             };
141              
142             # default: solid
143             $style = $clr;
144             }
145              
146             # Tried the line_width thing with setBrush, ugly results
147             # TODO: This loop probably should be around the datasets
148             # for nicer results
149             my $i;
150             for $i (1..$lw)
151             {
152             my $yslw = $ys + int($lw/2) - $i;
153             my $yelw = $ye + int($lw/2) - $i;
154              
155             # Need the setstyle to reset
156             $self->{graph}->setStyle(@pattern) if (@pattern);
157             $self->{graph}->line( $xs, $yslw, $xe, $yelw, $style );
158             }
159             }
160              
161             sub draw_legend_marker # (data_set_number, x, y)
162             {
163             my $self = shift;
164             my ($n, $x, $y) = @_;
165              
166             my $ci = $self->set_clr($self->pick_data_clr($n));
167             return unless defined $ci;
168             my $type = $self->pick_line_type($n);
169              
170             $y += int($self->{lg_el_height}/2);
171              
172             # Joe Smith
173             local($self->{line_width}) = 2; # Make these show up better
174              
175             $self->draw_line(
176             $x, $y,
177             $x + $self->{legend_marker_width}, $y,
178             $type, $ci
179             );
180             }
181              
182             "Just another true value";