[Bio] / WebApplication / WebComponent / Plot.pm Repository:
ViewVC logotype

Annotation of /WebApplication/WebComponent/Plot.pm

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.1 - (view) (download) (as text)

1 : paczian 1.1 package WebComponent::Plot;
2 :    
3 :     # Plot - component to do a x/y plot
4 :    
5 :     use strict;
6 :     use warnings;
7 :    
8 :     use base qw( WebComponent );
9 :    
10 :     1;
11 :    
12 :     use GD;
13 :     use GD::Polyline;
14 :     use Math::Trig;
15 :     use WebComponent::WebGD;
16 :     use WebColors;
17 :    
18 :     use constant PI => 4 * atan2 1, 1;
19 :     use constant RAD => 2 * PI / 360;
20 :    
21 :     =pod
22 :    
23 :     =head1 NAME
24 :    
25 :     PieChart - component to create pie charts
26 :    
27 :     =head1 DESCRIPTION
28 :    
29 :     Creates an inline image for a pie chart with mouseover/onlick regions
30 :    
31 :     =head1 METHODS
32 :    
33 :     =over 4
34 :    
35 :    
36 :     =item * B<new> ()
37 :    
38 :     Called when the object is initialized. Expands SUPER::new.
39 :    
40 :     =cut
41 :    
42 :     sub new {
43 :    
44 :     my $self = shift->SUPER::new(@_);
45 :    
46 :     $self->{color_set} = [ @{WebColors::get_palette('special')}, @{WebColors::get_palette('many')} ];
47 :     $self->{colors} = [];
48 :     $self->{image} = undef;
49 :     $self->{height} = 700;
50 :     $self->{width} = 900;
51 :     $self->{data} = undef;
52 :     $self->{max_x} = 0;
53 :     $self->{max_y} = 0;
54 :     $self->{name_x} = "";
55 :     $self->{name_y} = "";
56 :    
57 :     return $self;
58 :     }
59 :    
60 :     =item * B<output> ()
61 :    
62 :     Returns the html output of the BarChart component.
63 :    
64 :     =cut
65 :    
66 :     sub output {
67 :     my ($self) = @_;
68 :    
69 :     my $data = $self->data();
70 :    
71 :     unless (defined($data) && scalar(@$data)) {
72 :     return "Plot called without data";
73 :     }
74 :    
75 :     my $x_padding = 100;
76 :     my $y_padding = 50;
77 :     my $height = $self->height();
78 :     my $width = $self->width();
79 :     my $im = $self->image();
80 :     my $colors = $self->colors();
81 :     my $white = $colors->[0];
82 :     my $black = $colors->[1];
83 :    
84 :     # precalculate values
85 :     my $num_bars = scalar(@$data);
86 :     my $bar_padding = 2;
87 :     my $pane_width = $width - $x_padding;
88 :     my $pane_height = $height - $y_padding;
89 :     my $bar_width = int($pane_width / $num_bars);
90 :     my $max_y = $self->max_y;
91 :     my $max_x = $self->max_x;
92 :     my $y_factor = $pane_height / $max_y;
93 :     my $x_factor = $pane_width / $max_x;
94 :    
95 :     # draw grid
96 :     $im->line($x_padding,0,$x_padding,$height - $y_padding,$black);
97 :     $im->line($x_padding,$height - $y_padding,$width,$height - $y_padding,$black);
98 :    
99 :     # draw scales
100 :     # y-lines
101 :     my $h = 2;
102 :     my $num_y_scales = int(($height - $y_padding) / 15) + 1;
103 :     for (my $i = 0; $i < $num_y_scales; $i++) {
104 :     $im->line($x_padding - (5 * $h),$height - $y_padding - (15 * $i), $x_padding, $height - $y_padding - (15 * $i), $black);
105 :     if ($h == 1) {
106 :     $h = 2;
107 :     } else {
108 :     $h = 1;
109 :     $im->string(gdSmallFont, 30, $height - $y_padding - (15 * $i) - 7, int($max_y / $num_y_scales * $i), $black);
110 :     }
111 :     }
112 :     $im->stringUp(gdMediumBoldFont, 5, ($height - $y_padding) / 2 + (5 * (length($self->name_y) / 2)), $self->name_y, $black);
113 :    
114 :     # x-lines
115 :     $h = 2;
116 :     my $num_x_scales = int(($width - $x_padding) / 50) + 1;
117 :     for (my $i = 0; $i < $num_x_scales; $i++) {
118 :     $im->line($x_padding + (50 * $i), $height - $y_padding + (5 * $h), $x_padding + (50 * $i), $height - $y_padding, $black);
119 :    
120 :     if ($h == 1) {
121 :     $h = 2;
122 :     } else {
123 :     $h = 1;
124 :     $im->string(gdSmallFont, $x_padding + (50 * $i), $height - $y_padding + 10, int($max_x / $num_x_scales * $i), $black);
125 :     }
126 :     }
127 :     $im->string(gdMediumBoldFont, $x_padding + (($width - $x_padding) / 2) - ((length($self->name_x) / 2) * 5), $height - $y_padding + 30, $self->name_x, $black);
128 :    
129 :     # draw data
130 :     my $color = $colors->[3];
131 :     foreach my $val (@$data) {
132 :     $im->setPixel(($val->[0] * $x_factor) + $x_padding, $height - ($val->[1] * $y_factor) - $y_padding, $color)
133 :     }
134 :    
135 :     # create html
136 :     my $chart = qq~<img src="~ . $self->image->image_src() . qq~" id="dotplot">~;
137 :    
138 :     # return html
139 :     return $chart;
140 :     }
141 :    
142 :     sub sum {
143 :     my $array = shift;
144 :    
145 :     my $sum = 0;
146 :     foreach (@$array) {
147 :     $sum += $_;
148 :     }
149 :    
150 :     return $sum;
151 :     }
152 :    
153 :     sub width {
154 :     my ($self, $width) = @_;
155 :    
156 :     if (defined($width)) {
157 :     $self->{width} = $width;
158 :     }
159 :    
160 :     return $self->{width};
161 :     }
162 :    
163 :     sub height {
164 :     my ($self, $height) = @_;
165 :    
166 :     if (defined($height)) {
167 :     $self->{height} = $height;
168 :     }
169 :    
170 :     return $self->{height};
171 :     }
172 :    
173 :     sub image {
174 :     my ($self) = @_;
175 :    
176 :     unless (defined($self->{image})) {
177 :     $self->{image} = new WebGD($self->width(), $self->height());
178 :     foreach my $triplet (@{$self->color_set}) {
179 :     push(@{$self->colors}, $self->image->colorResolve($triplet->[0], $triplet->[1], $triplet->[2]));
180 :     }
181 :     }
182 :    
183 :     return $self->{image};
184 :     }
185 :    
186 :     sub data {
187 :     my ($self, $data) = @_;
188 :    
189 :     if (defined($data)) {
190 :     $self->{data} = $data;
191 :     }
192 :    
193 :     return $self->{data};
194 :     }
195 :    
196 :     sub colors {
197 :     my ($self, $colors) = @_;
198 :    
199 :     if (defined($colors)) {
200 :     $self->{colors} = $colors;
201 :     }
202 :    
203 :     return $self->{colors};
204 :     }
205 :    
206 :     sub color_set {
207 :     my ($self, $color_set) = @_;
208 :    
209 :     if (defined($color_set)) {
210 :     $self->{color_set} = $color_set;
211 :     }
212 :    
213 :     return $self->{color_set};
214 :     }
215 :    
216 :     sub max_y {
217 :     my ($self, $max) = @_;
218 :    
219 :     if (defined($max)) {
220 :     $self->{max_y} = $max;
221 :     }
222 :    
223 :     return $self->{max_y};
224 :     }
225 :    
226 :     sub max_x {
227 :     my ($self, $max) = @_;
228 :    
229 :     if (defined($max)) {
230 :     $self->{max_x} = $max;
231 :     }
232 :    
233 :     return $self->{max_x};
234 :     }
235 :    
236 :     sub name_x {
237 :     my ($self, $name) = @_;
238 :    
239 :     if (defined($name)) {
240 :     $self->{name_x} = $name;
241 :     }
242 :    
243 :     return $self->{name_x};
244 :     }
245 :    
246 :     sub name_y {
247 :     my ($self, $name) = @_;
248 :    
249 :     if (defined($name)) {
250 :     $self->{name_y} = $name;
251 :     }
252 :    
253 :     return $self->{name_y};
254 :     }

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3