File Coverage

blib/lib/Chart/Gnuplot.pm
Criterion Covered Total %
statement 659 1176 56.0
branch 335 758 44.2
condition 91 183 49.7
subroutine 49 79 62.0
pod 24 26 92.3
total 1158 2222 52.1


line stmt bran cond sub pod time code
1             package Chart::Gnuplot;
2 21     21   394287 use strict;
  21         48  
  21         929  
3 21     21   114 use vars qw($VERSION);
  21         24  
  21         1086  
4 21     21   107 use Carp;
  21         30  
  21         1839  
5 21     21   11799 use File::Copy qw(move);
  21         88897  
  21         1488  
6 21     21   15323 use File::Temp qw(tempdir);
  21         358688  
  21         1366  
7 21     21   7597 use Chart::Gnuplot::Util qw(_lineType _pointType _borderCode _fillStyle _copy);
  21         58  
  21         170705  
8             $VERSION = '0.22';
9              
10             # Constructor
11             sub new
12             {
13 36     36 1 11826 my ($class, %hash) = @_;
14              
15             # Create temporary file to store Gnuplot instructions
16 36 50       132 if (!defined $hash{_multiplot}) # if not in multiplot mode
17             {
18 36         141 my $dirTmp = tempdir(CLEANUP => 1);
19 36 50       1515545 ($^O =~ /MSWin/)? ($dirTmp .= '\\'): ($dirTmp .= '/');
20 36         129 $hash{_script} = $dirTmp . "plot";
21             }
22              
23             # Default terminal: postscript terminal with color drawing elements
24 36 50 33     230 if (!defined $hash{terminal} && !defined $hash{term})
25             {
26 36         64 $hash{terminal} = "postscript enhanced color";
27 36         71 $hash{_terminal} = 'auto';
28             }
29              
30             # Default setting
31 36 50       106 if (defined $hash{output})
32             {
33 36         146 my @a = split(/\./, $hash{output});
34 36         57 my $ext = $a[-1];
35 36 50 33     682 $hash{terminal} .= " eps" if ($hash{terminal} =~ /^post/ &&
36             $ext eq 'eps');
37             }
38              
39 36         66 my $self = \%hash;
40 36         158 return bless($self, $class);
41             }
42              
43              
44             # Generic attribute methods
45             sub AUTOLOAD
46             {
47 47     47   92 my ($self, $key) = @_;
48 47         61 my $attr = our $AUTOLOAD;
49 47         236 $attr =~ s/.*:://;
50 47 50       130 return if ($attr eq 'DESTROY'); # ignore destructor
51 47 50       147 $self->{$attr} = $key if (defined $key);
52 47         141 return($self->{$attr});
53             }
54              
55              
56             # General set method
57             sub set
58             {
59 1     1 1 9 my ($self, %opts) = @_;
60 1         5 foreach my $opt (keys %opts)
61             {
62 3 50       21 ($opts{$opt} eq 'on')? $self->$opt('') : $self->$opt($opts{$opt});
63             }
64 1         6 return($self);
65             }
66              
67              
68             # Add a 2D data set to the chart object
69             # - used with multiplot
70             sub add2d
71             {
72 0     0 1 0 my ($self, @dataSet) = @_;
73 0         0 push(@{$self->{_dataSets2D}}, @dataSet);
  0         0  
74             }
75              
76              
77             # Add a 3D data set to the chart object
78             # - used with multiplot
79             sub add3d
80             {
81 0     0 1 0 my ($self, @dataSet) = @_;
82 0         0 push(@{$self->{_dataSets3D}}, @dataSet);
  0         0  
83             }
84              
85              
86             # Add a 2D data set to the chart object
87             # - redirect to &add2d
88             # - for backward compatibility
89 0     0 0 0 sub add {&add2d(@_);}
90              
91              
92             # Plot 2D graphs
93             # - call _setChart()
94             #
95             # TODO:
96             # - Consider using pipe instead of system call
97             # - support MS time format: %{yyyy}-%{mmm}-%{dd} %{HH}:%{MM}
98             sub plot2d
99             {
100 0     0 1 0 my ($self, @dataSet) = @_;
101 0         0 &_setChart($self, \@dataSet);
102              
103 0         0 my $plotString = join(', ', map {$_->_thaw($self)} @dataSet);
  0         0  
104 0 0       0 open(GPH, ">>$self->{_script}") || confess("Can't write $self->{_script}");
105 0         0 print GPH "\nplot $plotString\n";
106 0         0 close(GPH);
107              
108             # Generate image file
109 0         0 &execute($self);
110 0         0 return($self);
111             }
112              
113              
114             # Plot 3D graphs
115             # - call _setChart()
116             #
117             # TODO:
118             # - Consider using pipe instead of system call
119             # - support MS time format: %{yyyy}-%{mmm}-%{dd} %{HH}:%{MM}
120             sub plot3d
121             {
122 0     0 1 0 my ($self, @dataSet) = @_;
123 0         0 &_setChart($self, \@dataSet);
124              
125 0         0 my $plotString = join(', ', map {$_->_thaw($self)} @dataSet);
  0         0  
126 0 0       0 open(GPH, ">>$self->{_script}") || confess("Can't write $self->{_script}");
127 0         0 print GPH "\nsplot $plotString\n";
128 0         0 close(GPH);
129              
130             # Generate image file
131 0         0 &execute($self);
132 0         0 return($self);
133             }
134              
135              
136             # Plot multiple plots in one single chart
137             sub multiplot
138             {
139 0     0 1 0 my ($self, @charts) = @_;
140 0         0 &_setChart($self);
141 0         0 &_reset($self);
142              
143 0 0       0 open(PLT, ">>$self->{_script}") || confess("Can't write $self->{_script}");
144              
145             # Emulate the title when there is background color fill
146 0 0 0     0 if (defined $self->{title} && defined $self->{bg})
147             {
148 0         0 print PLT "set label \"$self->{title}\" at screen 0.5, screen 1 ".
149             "center offset 0,-1\n";
150             }
151              
152 0 0 0     0 if (scalar(@charts) == 1 && ref($charts[0]) eq 'ARRAY')
153             {
154 0         0 my $nrows = scalar(@{$charts[0]});
  0         0  
155 0         0 my $ncols = scalar(@{$charts[0][0]});
  0         0  
156 0         0 &_setMultiplot($self, $nrows, $ncols);
157            
158 0         0 for (my $r = 0; $r < $nrows; $r++)
159             {
160 0         0 for (my $c = 0; $c < $ncols; $c++)
161             {
162 0         0 my $chart = $charts[0][$r][$c];
163 0         0 $chart->_script($self->{_script});
164 0         0 $chart->_multiplot(1);
165 0         0 delete $chart->{bg};
166              
167 0         0 my $plot;
168             my @dataSet;
169 0 0       0 if (defined $chart->{_dataSets2D})
    0          
170             {
171 0         0 $plot = 'plot';
172 0         0 @dataSet = @{$chart->{_dataSets2D}};
  0         0  
173             }
174             elsif (defined $chart->{_dataSets3D})
175             {
176 0         0 $plot = 'splot';
177 0         0 @dataSet = @{$chart->{_dataSets3D}};
  0         0  
178             }
179              
180 0         0 &_setChart($chart, \@dataSet);
181 0 0       0 open(PLT, ">>$self->{_script}") ||
182             confess("Can't write $self->{_script}");
183 0         0 print PLT "\n$plot ";
184 0         0 print PLT join(', ', map {$_->_thaw($self)} @dataSet), "\n";
  0         0  
185 0         0 close(PLT);
186 0         0 &_reset($chart);
187             }
188             }
189             }
190             else
191             {
192             # Start multi-plot
193 0         0 &_setMultiplot($self);
194              
195 0         0 foreach my $chart (@charts)
196             {
197 0         0 $chart->_script($self->{_script});
198 0         0 $chart->_multiplot(1);
199 0         0 delete $chart->{bg};
200              
201 0         0 my $plot;
202             my @dataSet;
203 0 0       0 if (defined $chart->{_dataSets2D})
    0          
204             {
205 0         0 $plot = 'plot';
206 0         0 @dataSet = @{$chart->{_dataSets2D}};
  0         0  
207             }
208             elsif (defined $chart->{_dataSets3D})
209             {
210 0         0 $plot = 'splot';
211 0         0 @dataSet = @{$chart->{_dataSets3D}};
  0         0  
212             }
213            
214 0         0 &_setChart($chart, \@dataSet);
215 0 0       0 open(PLT, ">>$self->{_script}") ||
216             confess("Can't write $self->{_script}");
217 0         0 print PLT "\n$plot ";
218 0         0 print PLT join(', ', map {$_->_thaw($self)} @dataSet), "\n";
  0         0  
219 0         0 close(PLT);
220 0         0 &_reset($chart);
221             }
222             }
223 0         0 close(PLT);
224              
225             # Generate image file
226 0         0 &execute($self);
227 0         0 return($self);
228             }
229              
230              
231             # Pass generic commands
232             sub command
233             {
234 2     2 1 10 my ($self, $cmd) = @_;
235              
236 2 50       154 open(PLT, ">>$self->{_script}") || confess("Can't write $self->{_script}");
237 2 100       20 (ref($cmd) eq 'ARRAY')?
238             (print PLT join("\n", @$cmd), "\n"):
239             (print PLT "$cmd\n");
240 2         62 close(PLT);
241 2         6 return($self);
242             }
243              
244              
245             # Set how the chart looks like
246             # - call _setTitle(), _setAxisLabel(), _setTics(), _setGrid(), _setBorder(),
247             # _setTimestamp()
248             # - called by plot2d() and plot3d()
249             sub _setChart
250             {
251 38     38   172 my ($self, $dataSets) = @_;
252 38         83 my @sets = ();
253              
254             # Orientation
255 38 100       171 $self->{terminal} .= " $self->{orient}" if (defined $self->{orient});
256              
257             # Set canvas size
258 38 100       111 if (defined $self->{imagesize})
259             {
260 3         14 my ($ws, $hs) = split(/,\s?/, $self->{imagesize});
261 3 50 33     17 if (defined $self->{_terminal} && $self->{_terminal} eq 'auto')
262             {
263             # for post terminal
264 3 100 66     13 if (defined $self->{orient} && $self->{orient} eq 'portrait')
265             {
266 1 50       8 $ws *= 7 if ($ws =~ /^([1-9]\d*)?0?(\.\d+)?$/);
267 1 50       5 $hs *= 10 if ($hs =~ /^([1-9]\d*)?0?(\.\d+)?$/);
268             }
269             else
270             {
271 2 100       15 $ws *= 10 if ($ws =~ /^([1-9]\d*)?0?(\.\d+)?$/);
272 2 100       12 $hs *= 7 if ($hs =~ /^([1-9]\d*)?0?(\.\d+)?$/);
273             }
274             }
275 3         22 $self->{terminal} .= " size $ws,$hs";
276             }
277              
278             # Prevent changing terminal in multiplot mode
279 38 50       89 delete $self->{terminal} if (defined $self->{_multiplot});
280              
281             # Start writing gnuplot script
282 38         63 my $pltTmp = $self->{_script};
283 38 50       2343 open(PLT, ">>$pltTmp") || confess("Can't write gnuplot script $pltTmp");
284              
285             # Set character encoding
286             #
287             # Quote from Gnuplot manual:
288             # "Generally you must set the encoding before setting the terminal type."
289 38 50       183 if (defined $self->{encoding})
290             {
291 0         0 print PLT "set encoding $self->{encoding}\n";
292             }
293              
294             # Chart background color
295 38 100       95 if (defined $self->{bg})
296             {
297 2         3 my $bg = $self->{bg};
298 2 50       5 if (ref($bg) eq 'HASH')
299             {
300 2         16 print PLT "set object rect from screen 0, screen 0 to ".
301             "screen 1, screen 1 fillcolor rgb \"$$bg{color}\"";
302 2 50       19 print PLT " fillstyle solid $$bg{density}" if
303             (defined $$bg{density});
304 2         3 print PLT " behind\n";
305             }
306             else
307             {
308 0         0 print PLT "set object rect from screen 0, screen 0 to ".
309             "screen 1, screen 1 fillcolor rgb \"$bg\" behind\n";
310             }
311 2         5 push(@sets, 'object');
312             }
313              
314             # Plot area background color
315 38 100       116 if (defined $self->{plotbg})
316             {
317 2         3 my $bg = $self->{plotbg};
318 2 50       6 if (ref($bg) eq 'HASH')
319             {
320 2         7 print PLT "set object rect from graph 0, graph 0 to ".
321             "graph 1, graph 1 fillcolor rgb \"$$bg{color}\"";
322 2 50       11 print PLT " fillstyle solid $$bg{density}" if
323             (defined $$bg{density});
324 2         3 print PLT " behind\n";
325             }
326             else
327             {
328 0         0 print PLT "set object rect from graph 0, graph 0 to ".
329             "graph 1, graph 1 fillcolor rgb \"$bg\" behind\n";
330             }
331 2         4 push(@sets, 'object');
332             }
333              
334             # Set date/time data
335             #
336             # For xrange to work for time-sequence, time-axis ("set xdata time")
337             # and timeformat ("set timefmt '%Y-%m-%d'") MUST be set BEFORE
338             # the range command ("set xrange ['2009-01-01','2009-01-07']")
339             #
340             # Thanks to Holyspell
341 38 100       100 if (defined $self->{timeaxis})
342             {
343 2         9 my @axis = split(/,\s?/, $self->{timeaxis});
344 2         5 foreach my $axis (@axis)
345             {
346 2         13 print PLT "set $axis"."data time\n";
347 2         6 push(@sets, $axis."data");
348             }
349              
350 2         4 foreach my $ds (@$dataSets)
351             {
352 2 50       10 if (defined $ds->{timefmt})
353             {
354 2         4 print PLT "set timefmt \"$ds->{timefmt}\"\n";
355 2         3 last;
356             }
357             }
358             }
359              
360             # Parametric plot
361 38         105 foreach my $ds (@$dataSets)
362             {
363             # Determine if there is paramatric plot
364 5 100 100     31 if (defined $ds->{func} && ref($ds->{func}) eq 'HASH')
365             {
366 2         5 $self->{parametric} = '';
367 2         3 last;
368             }
369             }
370              
371 38         54 my $setGrid = 0; # detect whether _setGrid has been run
372              
373             # Loop and process other chart options
374 38         247 foreach my $attr (keys %$self)
375             {
376 210 100 100     2888 if ($attr eq 'output')
    100          
    100          
    100          
    100          
    100          
    100          
    100          
    100          
    100          
    100          
377             {
378 38         181 print PLT "set output \"$self->{output}\"\n";
379             }
380             elsif ($attr eq 'title')
381             {
382 8         26 print PLT "set title ".&_setTitle($self->{title})."\n";
383 8         17 push(@sets, 'title')
384             }
385             elsif ($attr =~ /^((x|y)2?|z)label$/)
386             {
387 6         19 print PLT "set $attr ".&_setAxisLabel($self->{$attr})."\n";
388 6         8 push(@sets, $attr);
389             }
390             elsif ($attr =~ /^((x|y)2?|z|t|u|v)range$/)
391             {
392 7 100       18 if (ref($self->{$attr}) eq 'ARRAY')
    50          
393             {
394             # Deal with ranges from array reference
395 6 50 33     13 if (defined $self->{timeaxis} &&
396             $self->{timeaxis} =~ /(^|,)\s*$1\s*(,|$)/)
397             {
398             # $1-axis is a time axis
399 0         0 print PLT "set $attr ['".join("':'", @{$self->{$attr}}).
  0         0  
400             "']\n";
401             }
402             else
403             {
404 6         8 print PLT "set $attr [".join(":", @{$self->{$attr}})."]\n";
  6         18  
405             }
406             }
407             elsif ($self->{$attr} eq 'reverse')
408             {
409 0         0 print PLT "set $attr [*:*] reverse\n";
410             }
411             else
412             {
413 1         3 print PLT "set $attr $self->{$attr}\n";
414             }
415 7         22 push(@sets, $attr);
416             }
417             elsif ($attr =~ /^(x|y|x2|y2|z)tics$/)
418             {
419 9 50       21 if (defined $self->{$attr})
420             {
421 9         42 my ($axis) = ($attr =~ /^(.+)tics$/);
422 9         35 print PLT "set $attr".&_setTics($self->{$attr})."\n";
423 9 100       28 if (ref($self->{$attr}) eq 'HASH')
424             {
425 6 100       5 if (defined ${$self->{$attr}}{labelfmt})
  6         16  
426             {
427 2         8 print PLT "set format $axis ".
428 2         7 "\"${$self->{$attr}}{labelfmt}\"\n";
429 2         3 push(@sets, 'format');
430             }
431 6 100       7 if (defined ${$self->{$attr}}{minor})
  6         17  
432             {
433 1         1 my $nTics = ${$self->{$attr}}{minor}+1;
  1         4  
434 1         5 print PLT "set m$axis"."tics $nTics\n";
435 1         5 push(@sets, "m$axis"."tics");
436             }
437             }
438 9         27 push(@sets, $attr);
439             }
440             else
441             {
442 0         0 print PLT "unset $attr\n";
443             }
444             }
445             elsif ($attr eq 'legend')
446             {
447 1         4 print PLT "set key".&_setLegend($self->{legend})."\n";
448 1         2 push(@sets, 'key');
449             }
450             elsif ($attr eq 'border')
451             {
452 2 50       4 if (defined $self->{border})
453             {
454 2         3 print PLT "set border";
455 2 100       12 print PLT " ".&_borderCode($self->{border}->{sides}) if
456             (defined $self->{border}->{sides});
457 2         5 print PLT &_setBorder($self->{border})."\n";
458 2         4 push(@sets, 'border');
459             }
460             else
461             {
462 0         0 print PLT "unset border\n";
463             }
464             }
465             elsif ($attr =~ /^(minor)?grid$/)
466             {
467 4 100       9 next if ($setGrid == 1);
468              
469 3         7 print PLT "set grid".&_setGrid($self)."\n";
470 3         4 push(@sets, 'grid');
471 3         4 $setGrid = 1;
472             }
473             elsif ($attr eq 'timestamp')
474             {
475 2         11 print PLT "set timestamp".&_setTimestamp($self->{timestamp})."\n";
476 2         7 push(@sets, 'timestamp');
477             }
478             elsif ($attr eq 'terminal')
479             {
480 38         183 print PLT "set $attr $self->{$attr}\n";
481             }
482             # Non-gnuplot options / options specially treated before
483             elsif (!grep(/^$attr$/, qw(
484             gnuplot
485             convert
486             encoding
487             imagesize
488             orient
489             bg
490             plotbg
491             timeaxis
492             )) &&
493             $attr !~ /^_/)
494             {
495 5 100 66     55 (defined $self->{$attr} && $self->{$attr} ne '')?
496             (print PLT "set $attr $self->{$attr}\n"):
497             (print PLT "set $attr\n");
498 5         9 push(@sets, $attr);
499             }
500             }
501              
502             # Write labels
503 38         72 my $isLabelSet = 0;
504 38         38 foreach my $label (@{$self->{_labels}})
  38         103  
505             {
506 4         7 print PLT "set label"."$label\n";
507 4 100       10 push(@sets, "label") if ($isLabelSet == 0);
508 4         5 $isLabelSet = 1;
509             }
510              
511             # Draw arrows
512 38         48 my $isArrowSet = 0;
513 38         42 foreach my $arrow (@{$self->{_arrows}})
  38         98  
514             {
515 0         0 print PLT "set arrow"."$arrow\n";
516 0 0       0 push(@sets, "arrow") if ($isArrowSet == 0);
517 0         0 $isArrowSet = 1;
518             }
519              
520             # Draw objects
521 38         49 my $isObjectSet = 0;
522 38         39 foreach my $object (@{$self->{_objects}})
  38         103  
523             {
524 0         0 print PLT "set object"."$object\n";
525 0 0       0 push(@sets, "object") if ($isObjectSet == 0);
526 0         0 $isObjectSet = 1;
527             }
528 38         1437 close(PLT);
529              
530 38         319 $self->_sets(\@sets);
531             }
532              
533              
534             # Set the details of the title
535             # - called by _setChart()
536             #
537             # Usage example:
538             # title => {
539             # text => "My title",
540             # font => "arial, 14",
541             # color => "brown",
542             # offset => "0, -1",
543             # },
544             sub _setTitle
545             {
546 8     8   13 my ($title) = @_;
547 8 100       18 if (ref($title))
548             {
549 1         5 my $out = "\"$$title{text}\"";
550 1 50       8 $out .= " offset $$title{offset}" if (defined $$title{offset});
551              
552             # Font and size
553 1         2 my $font;
554 1 50       4 $font = $$title{font} if (defined $$title{font});
555 1 50       3 $font .= ",$$title{fontsize}" if (defined $$title{fontsize});
556 1 50       6 $out .= " font \"$font\"" if (defined $font);
557              
558             # Color
559 1 50       7 $out .= " textcolor rgb \"$$title{color}\"" if (defined $$title{color});
560              
561             # Switch of the enhanced mode. Default: off
562 1 50 33     8 $out .= " noenhanced" if (!defined $$title{enhanced} ||
563             $$title{enhanced} ne 'on');
564 1         5 return($out);
565             }
566             else
567             {
568 7         25 return("\"$title\" noenhanced");
569             }
570             }
571              
572              
573             # Set the details of the axis labels
574             # - called by _setChart()
575             #
576             # Usage example:
577             # xlabel => {
578             # text => "My x-axis label",
579             # font => "arial, 14",
580             # color => "brown",
581             # offset => "0, -1",
582             # rotate => 45,
583             # },
584             #
585             # TODO
586             # - support radian and pi in "rotate"
587             sub _setAxisLabel
588             {
589 6     6   38 my ($label) = @_;
590 6 100       9 if (ref($label))
591             {
592 2         6 my $out = "\"$$label{text}\"";
593              
594             # Location offset
595 2 100       6 $out .= " offset $$label{offset}" if (defined $$label{offset});
596              
597             # Font and size
598 2         2 my $font;
599 2 100       5 $font = $$label{font} if (defined $$label{font});
600 2 50       4 $font .= ",$$label{fontsize}" if (defined $$label{fontsize});
601 2 100       6 $out .= " font \"$font\"" if (defined $font);
602              
603             # Color
604 2 100       6 $out .= " textcolor rgb \"$$label{color}\"" if (defined $$label{color});
605              
606             # Switch of the enhanced mode. Default: off
607 2 100 66     11 $out .= " noenhanced" if (!defined $$label{enhanced} ||
608             $$label{enhanced} ne 'on');
609              
610             # Text rotation
611 2 100       5 $out .= " rotate by $$label{rotate}" if (defined $$label{rotate});
612 2         7 return($out);
613             }
614             else
615             {
616 4         17 return("\"$label\" noenhanced");
617             }
618             }
619              
620              
621             # Set the details of the tics and tic labels
622             # - called by _setChart()
623             #
624             # Usage example:
625             # xtics => {
626             # along => 'border',
627             # labels => [-10, 15, 20, 25],
628             # labelfmt => "%3f",
629             # font => "arial",
630             # fontsize => 14,
631             # fontcolor => "brown",
632             # offset => "0, -1",
633             # start => -10,
634             # incr => 0.2,
635             # end => 2.6,
636             # rotate => 45,
637             # length => "2,1",
638             # along => 'axis',
639             # minor => 3,
640             # mirror => 'off',
641             # },
642             #
643             # TODO
644             # - implement "add" option to add addition tics other than default
645             # - support radian and pi in "rotate"
646             sub _setTics
647             {
648 9     9   26 my ($tic) = @_;
649              
650 9         10 my $out = '';
651 9 100       29 if (ref($tic) eq 'HASH')
    100          
    50          
652             {
653 6 50       14 $out .= " $$tic{along}" if (defined $$tic{along});
654 6 100 66     25 $out .= " nomirror" if (
655             defined $$tic{mirror} && $$tic{mirror} eq 'off'
656             );
657 6 100       18 $out .= " scale $$tic{length}" if (defined $$tic{length});
658 6 100       14 $out .= " rotate by $$tic{rotate}" if (defined $$tic{rotate});
659 6 50       12 $out .= " offset $$tic{offset}" if (defined $$tic{offset});
660            
661             # Tic labels
662 6 100       14 if (defined $$tic{incr})
663             {
664 2         2 my $location = $$tic{incr};
665 2 100       7 if (defined $$tic{start})
666             {
667 1         2 $location = "$$tic{start},$location";
668 1 50       4 $location .= ",$$tic{end}" if (defined $$tic{end});
669             }
670              
671 2 100       5 $location = '0'.$location if ($location =~ /^\-/);
672 2         3 $out .= " $location";
673             }
674 6 100       16 $out .= " (". join(',', @{$$tic{labels}}) . ")" if
  1         23  
675             (defined $$tic{labels});
676              
677             # Font, font size and font color
678 6 100       20 if (defined $$tic{font})
679             {
680 1         2 my $font = $$tic{font};
681 1 50 33     8 $font = "$$tic{font},$$tic{fontsize}" if ($font !~ /\,/ &&
682             defined $$tic{fontsize});
683 1         4 $out .= " font \"$font\"";
684             }
685 6 100       16 $out .= " textcolor rgb \"$$tic{fontcolor}\"" if
686             (defined $$tic{fontcolor});
687             }
688             elsif (ref($tic) eq 'ARRAY')
689             {
690 1         6 $out = " (". join(',', @$tic) . ")";
691             }
692             elsif ($tic ne 'on')
693             {
694 0         0 $out = "\"$tic\"";
695             }
696 9         35 return($out);
697             }
698              
699              
700             # Set the details of the grid lines
701             # - called by _setChart()
702             #
703             # Usage example:
704             # grid => {
705             # type => 'dash, dot', # default: dot
706             # width => 2, # default: 0
707             # color => 'blue', # default: black
708             # xlines => 'on', # default: on
709             # ylines => 'off', # default: on
710             # zlines => 'off', # default:
711             # x2lines => 'off', # default: off
712             # y2lines => 'off', # default: off
713             # layer => 'front', # default: layerdefault
714             # },
715             #
716             # minorgrid => {
717             # width => 1, # default: 0
718             # color => 'gray', # default: black
719             # xlines => 'on', # default: off
720             # ylines => 'on', # default: off
721             # x2lines => 'off', # default: off
722             # y2lines => 'off', # default: off
723             # layer => 'front', # default: layerdefault
724             # }
725             #
726             # # OR
727             #
728             # grid => 'on',
729             #
730             # TODO:
731             # - support polar grid
732             sub _setGrid
733             {
734 3     3   4 my ($self) = @_;
735 3         4 my $grid = $self->{grid};
736 3 100       6 my $mgrid = $self->{minorgrid} if (defined $self->{minorgrid});
737              
738 3         4 my $out = '';
739 3 100 66     11 if (ref($grid) eq 'HASH' || ref($mgrid) eq 'HASH')
740             {
741 2         5 $grid = &_gridString2Hash($grid);
742 2         5 $mgrid = &_gridString2Hash($mgrid);
743              
744             # Set whether the major grid lines are drawn
745 2 50 33     10 (defined $$grid{xlines} && $$grid{xlines} =~ /^off/)?
746             ($out .= " noxtics"): ($out .= " xtics");
747 2 50 33     11 (defined $$grid{ylines} && $$grid{ylines} =~ /^off/)?
748             ($out .= " noytics"): ($out .= " ytics");
749 2 50 33     6 (defined $$grid{zlines} && $$grid{zlines} =~ /^off/)?
750             ($out .= " noztics"): ($out .= " ztics");
751              
752             # Set whether the vertical minor grid lines are drawn
753 2 50 66     19 $out .= " mxtics" if ( (defined $$grid{xlines} &&
      33        
      33        
      66        
754             $$grid{xlines} =~ /,\s?on$/) ||
755             (defined $self->{minorgrid} && (!defined $$mgrid{xlines} ||
756             $$mgrid{xlines} eq 'on')) );
757              
758             # Set whether the horizontal minor grid lines are drawn
759 2 100 33     17 $out .= " mytics" if ( (defined $$grid{ylines} &&
      66        
      33        
      33        
760             $$grid{ylines} =~ /,\s?on$/) ||
761             (defined $mgrid && (!defined $$mgrid{ylines} ||
762             $$mgrid{ylines} eq 'on')) );
763              
764             # Major grid on secondary axes
765 2 50 33     6 $out .= " x2tics" if (defined $$grid{x2lines} &&
766             $$grid{x2lines} eq 'on');
767 2 50 33     6 $out .= " y2tics" if (defined $$grid{y2lines} &&
768             $$grid{y2lines} eq 'on');
769              
770             # Minor grid on secondary axes
771 2 50 33     4 $out .= " mx2tics" if (defined $$mgrid{x2lines} &&
772             $$mgrid{x2lines} eq 'on');
773 2 50 33     6 $out .= " my2tics" if (defined $$mgrid{y2lines} &&
774             $$mgrid{y2lines} eq 'on');
775              
776             # Set the layer
777 2 50       3 $out .= " $$grid{layer}" if (defined $$grid{layer});
778              
779             # Set the line type of the grid lines
780 2         4 my $major = my $minor = '';
781 2         2 my $majorType = my $minorType = 4; # dotted lines
782 2 50       5 if (defined $$grid{linetype})
783             {
784 0         0 $majorType = $minorType = $$grid{linetype};
785 0 0       0 ($majorType, $minorType) = split(/\,\s?/, $$grid{linetype}) if
786             ($$grid{linetype} =~ /\,/);
787             }
788 2 50       4 $minorType = $$mgrid{linetype} if (defined $$mgrid{linetype});
789 2         12 $major .= " linetype ".&_lineType($majorType);
790 2         4 $minor .= " linetype ".&_lineType($minorType);
791            
792             # Set the line width of the grid lines
793 2         3 my $majorWidth = my $minorWidth = 0;
794 2 50       5 if (defined $$grid{width})
795             {
796 2         3 $majorWidth = $minorWidth = $$grid{width};
797 2 100       14 ($majorWidth, $minorWidth) = split(/\,\s?/, $$grid{width}) if
798             ($$grid{width} =~ /\,/);
799             }
800 2 100       5 $minorWidth = $$mgrid{width} if (defined $$mgrid{width});
801 2         4 $major .= " linewidth $majorWidth";
802 2         2 $minor .= " linewidth $minorWidth";
803              
804             # Set the line color of the grid lines
805 2         2 my $majorColor = my $minorColor = 'black';
806 2 50       6 if (defined $$grid{color})
807             {
808 0         0 $majorColor = $minorColor = $$grid{color};
809 0 0       0 ($majorColor, $minorColor) = split(/\,\s?/, $$grid{color}) if
810             ($$grid{color} =~ /\,/);
811             }
812 2 50       4 $minorColor = $$mgrid{color} if (defined $$mgrid{color});
813 2         4 $major .= " linecolor rgb \"$majorColor\"";
814 2         3 $minor .= " linecolor rgb \"$minorColor\"";
815 2 50       5 $out .= "$major" if ($major ne '');
816 2 50       8 $out .= ",$minor" if ($minor ne '');
817             }
818             else
819             {
820 1 50       2 if (defined $grid)
821             {
822 1 50       10 return(" $grid") if ($grid !~ /^(on|off)$/);
823 1 50       3 ($grid eq 'off')? ($out = " noxtics noytics"):
824             ($out = " xtics ytics");
825             }
826 1 50 33     4 $out .= " mxtics mytics" if (defined $mgrid && $mgrid eq 'on');
827             }
828 3         10 return($out);
829             }
830              
831              
832             # Convert grid string to hash
833             # - called by _setGrid
834             sub _gridString2Hash
835             {
836 4     4   4 my ($grid) = @_;
837 4 100       10 return($grid) if (ref($grid) eq 'HASH');
838              
839 1         1 my %out;
840 1         4 $out{xlines} = $out{ylines} = $out{zlines} = $grid;
841 1         2 return(\%out);
842             }
843              
844              
845             # Set the details of the graph border and legend box border
846             # - called by _setChart()
847             #
848             # Usage example:
849             # border => {
850             # linetype => 3, # default: solid
851             # width => 2, # default: 0
852             # color => '#ff00ff', # default: system defined
853             # layer => 'back', # default: front
854             # },
855             #
856             # Remark:
857             # - By default, the color of the axis tics would follow the border unless
858             # specified otherwise.
859             sub _setBorder
860             {
861 2     2   3 my ($border) = @_;
862              
863 2         2 my $out = '';
864 2 50       7 $out .= " $$border{layer}" if (defined $$border{layer});
865 2 50       10 $out .= " linetype ".&_lineType($$border{linetype}) if
866             (defined $$border{linetype});
867 2 50       13 $out .= " linecolor rgb \"$$border{color}\"" if (defined $$border{color});
868 2 50       5 $out .= " linewidth $$border{width}" if (defined $$border{width});
869 2         5 return($out);
870             }
871              
872              
873             # Format the legend (key)
874             #
875             # Usage example:
876             # legend => {
877             # position => "outside bottom",
878             # width => 3,
879             # height => 4,
880             # align => "right",
881             # order => "horizontal reverse",
882             # title => "Title of the legend",
883             # sample => {
884             # length => 3,
885             # position => "left",
886             # spacing => 2,
887             # },
888             # border => {
889             # linetype => 2,
890             # width => 1,
891             # color => "blue",
892             # },
893             # },
894             sub _setLegend
895             {
896 1     1   2 my ($legend) = @_;
897              
898 1         2 my $out = '';
899 1 50       5 if (defined $$legend{position})
900             {
901 1 50       5 ($$legend{position} =~ /\d/)? ($out .= " at $$legend{position}"):
902             ($out .= " $$legend{position}");
903             }
904 1 50       4 $out .= " width $$legend{width}" if (defined $$legend{width});
905 1 50       4 $out .= " height $$legend{height}" if (defined $$legend{height});
906 1 50       2 if (defined $$legend{align})
907             {
908 1 50       3 $out .= " Left" if ($$legend{align} eq 'left');
909 1 50       4 $out .= " Right" if ($$legend{align} eq 'right');
910             }
911 1 50       5 if (defined $$legend{order})
912             {
913 1         2 my $order = $$legend{order};
914 1         4 $order =~ s/reverse/invert/;
915 1         2 $out .= " $order";
916             }
917 1 50       4 if (defined $$legend{title})
918             {
919 1 50       3 if (ref($$legend{title}) eq 'HASH')
920             {
921 0         0 my $title = $$legend{title};
922 0         0 $out .= " title \"$$title{text}\"";
923 0 0 0     0 $out .= " noenhanced" if (!defined $$title{enhanced} ||
924             $$title{enhanced} ne 'on');
925             }
926             else
927             {
928 1         4 $out .= " title \"$$legend{title}\" noenhanced";
929             }
930             }
931 1 50       2 if (defined $$legend{sample})
932             {
933 1 50       5 $out .= " samplen $$legend{sample}{length}" if
934             (defined $$legend{sample}{length});
935 1 50 33     6 $out .= " reverse" if (defined $$legend{sample}{position} ||
936             $$legend{sample}{position} eq "left");
937 1 50       4 $out .= " spacing $$legend{sample}{spacing}" if
938             (defined $$legend{sample}{spacing});
939             }
940 1 50       6 if (defined $$legend{border})
941             {
942 1 50       6 if (ref($$legend{border}) eq 'HASH')
    50          
    50          
943             {
944 0         0 $out .= " box ".&_setBorder($$legend{border});
945             }
946             elsif ($$legend{border} eq "off")
947             {
948 0         0 $out .= " no box";
949             }
950             elsif ($$legend{border} eq "on")
951             {
952 1         1 $out .= " box";
953             }
954             }
955 1         4 return($out);
956             }
957              
958              
959             # Set title and layout of the multiplot
960             sub _setMultiplot
961             {
962 0     0   0 my ($self, $nrows, $ncols) = @_;
963              
964 0 0       0 open(PLT, ">>$self->{_script}") || confess("Can't write $self->{_script}");
965 0         0 print PLT "set multiplot";
966 0 0       0 print PLT " title \"$self->{title}\"" if (defined $self->{title});
967 0 0       0 print PLT " layout $nrows, $ncols" if (defined $nrows);
968 0         0 print PLT "\n";
969 0         0 close(PLT);
970             }
971              
972              
973             # Usage example:
974             # timestamp => {
975             # fmt => '%d/%m/%y %H:%M',
976             # offset => "10,-3"
977             # font => "Helvetica",
978             # },
979             # # OR
980             # timestamp => 'on';
981             sub _setTimestamp
982             {
983 2     2   5 my ($ts) = @_;
984              
985 2         4 my $out = '';
986 2 100       10 if (ref($ts) eq 'HASH')
    50          
987             {
988 1 50       9 $out .= " \"$$ts{fmt}\"" if (defined $$ts{fmt});
989 1 50       8 $out .= " offset $$ts{offset}" if (defined $$ts{offset});
990 1 50       7 $out .= " font \"$$ts{font}\"" if (defined $$ts{font});
991             }
992             elsif ($ts ne 'on')
993             {
994 1         5 return($ts);
995             }
996 1         5 return($out);
997             }
998              
999              
1000             # Call Gnuplot to generate the image file
1001             sub execute
1002             {
1003 0     0 1 0 my ($self) = @_;
1004              
1005             # Try to find the executable of Gnuplot
1006 0         0 my $gnuplot = 'gnuplot';
1007 0 0       0 if (defined $self->{gnuplot})
1008             {
1009 0         0 $gnuplot = $self->{gnuplot};
1010             }
1011             else
1012             {
1013 0 0       0 if ($^O =~ /MSWin/)
1014             {
1015 0         0 my $gnuplotDir = 'C:\Program Files\gnuplot';
1016 0 0       0 $gnuplotDir = 'C:\Program Files (x86)\gnuplot' if (!-e $gnuplotDir);
1017              
1018 0         0 my $binDir = $gnuplotDir.'\bin';
1019 0 0       0 $binDir = $gnuplotDir.'\binary' if (!-e $binDir);
1020              
1021 0         0 $gnuplot = $binDir.'\gnuplot.exe';
1022 0 0       0 if (!-e $gnuplot)
1023             {
1024 0         0 $gnuplot = $binDir.'\wgnuplot.exe';
1025 0 0       0 confess("Gnuplot command not found.") if (!-e $gnuplot);
1026             }
1027             }
1028             }
1029              
1030             # Execute gnuplot
1031 0         0 my $cmd = qq("$gnuplot" "$self->{_script}");
1032 0 0       0 $cmd .= " -" if ($self->{terminal} =~ /^(ggi|pm|windows|wxt|x11)(\s|$)/);
1033 0         0 my $err = `$cmd 2>&1`;
1034             # my $err;
1035             # system("$cmd");
1036              
1037             # Capture and process error message from Gnuplot
1038 0 0 0     0 if (defined $err && $err ne '')
1039             {
1040 0         0 my ($errTmp) = ($err =~ /\", line \d+:\s(.+)/);
1041 0 0       0 die "$errTmp\n" if (defined $errTmp);
1042 0         0 warn "$err\n";
1043             }
1044              
1045             # Convert the image to the user-specified format
1046 0 0 0     0 if (defined $self->{_terminal} && $self->{_terminal} eq 'auto')
1047             {
1048 0         0 my @a = split(/\./, $self->{output});
1049 0         0 my $ext = $a[-1];
1050 0 0       0 &convert($self, $ext) if ($ext !~ /^e?ps$/);
1051             }
1052              
1053 0         0 return($self);
1054             }
1055              
1056              
1057             # Unset the chart properties
1058             # - called by multiplot()
1059             sub _reset
1060             {
1061 0     0   0 my ($self) = @_;
1062 0 0       0 open(PLT, ">>$self->{_script}") || confess("Can't write $self->{_script}");
1063 0         0 foreach my $opt (@{$self->{_sets}})
  0         0  
1064             {
1065 0         0 print PLT "unset $opt\n";
1066              
1067 0 0 0     0 if ($opt =~ /range$/)
    0          
1068             {
1069 0         0 print PLT "set $opt [*:*]\n";
1070             }
1071             elsif (!grep(/^$opt$/, qw(arrow grid label logscale object parametric))
1072             && $opt !~ /tics$/)
1073             {
1074 0         0 print PLT "set $opt\n";
1075             }
1076             }
1077 0         0 close(PLT);
1078             }
1079              
1080              
1081             # Arbitrary labels placed in the chart
1082             #
1083             # Usage example:
1084             # $chart->label(
1085             # text => "This is a label",
1086             # position => "0.2, 3 left",
1087             # offset => "2,2",
1088             # rotate => 45,
1089             # font => "arial, 15",
1090             # fontcolor => "dark-blue",
1091             # pointtype => 3,
1092             # pointsize => 5,
1093             # pointcolor => "blue",
1094             # layer => "front",
1095             # );
1096             sub label
1097             {
1098 4     4 1 38 my ($self, %label) = @_;
1099              
1100 4         11 my $out = " \"$label{text}\"";
1101 4 50       13 $out .= " at $label{position}" if (defined $label{position});
1102 4 100       11 $out .= " offset $label{offset}" if (defined $label{offset});
1103 4 50       10 $out .= " rotate by $label{rotate}" if (defined $label{rotate});
1104 4 50       9 $out .= " font \"$label{font}\"" if (defined $label{font});
1105 4 50       8 $out .= " $label{layer}" if (defined $label{layer});
1106 4 50       9 $out .= " textcolor rgb \"$label{fontcolor}\"" if
1107             (defined $label{fontcolor});
1108 4 50 33     14 $out .= " noenhanced" if (!defined $label{enhanced} ||
1109             $label{enhanced} ne 'on');
1110              
1111 4 50 66     18 if (defined $label{pointtype} || defined $label{pointsize} ||
      66        
1112             defined $label{pointcolor})
1113             {
1114 3         4 $out .= " point";
1115 3 50       13 $out .= " pointtype ".&_pointType($label{pointtype}) if
1116             (defined $label{pointtype});
1117 3 50       12 $out .= " pointsize $label{pointsize}" if (defined $label{pointsize});
1118 3 100       9 $out .= " linecolor rgb \"$label{pointcolor}\"" if
1119             (defined $label{pointcolor});
1120             }
1121              
1122 4         5 push(@{$self->{_labels}}, $out);
  4         21  
1123 4         12 return($self);
1124             }
1125              
1126              
1127             # Arbitrary arrows placed in the chart
1128             #
1129             # Usage example:
1130             # $chart->arrow(
1131             # from => "0,2",
1132             # to => "0.3,0.1",
1133             # linetype => 'dash',
1134             # width => 2,
1135             # color => "dark-blue",
1136             # head => {
1137             # size => 3,
1138             # angle => 30,
1139             # direction => 'back',
1140             # },
1141             # layer => "front",
1142             # );
1143             sub arrow
1144             {
1145 0     0 1 0 my ($self, %arrow) = @_;
1146 0 0       0 confess("Starting position of arrow not found") if (!defined $arrow{from});
1147              
1148 0         0 my $out = " from $arrow{from}";
1149 0 0       0 $out .= " to $arrow{to}" if (defined $arrow{to});
1150 0 0       0 $out .= " rto $arrow{rto}" if (defined $arrow{rto});
1151 0 0       0 $out .= " $arrow{layer}" if (defined $arrow{layer});
1152 0 0       0 $out .= " linetype ".&_lineType($arrow{linetype}) if
1153             (defined $arrow{linetype});
1154 0 0       0 $out .= " linewidth $arrow{width}" if (defined $arrow{width});
1155 0 0       0 $out .= " linecolor rgb \"$arrow{color}\"" if (defined $arrow{color});
1156 0 0       0 $out .= " size $arrow{headsize}" if (defined $arrow{headsize});
1157              
1158             # Set arrow head
1159 0 0       0 $out .= &_setArrowHead($arrow{head}) if (defined $arrow{head});
1160              
1161 0         0 push(@{$self->{_arrows}}, $out);
  0         0  
1162 0         0 return($self);
1163             }
1164              
1165              
1166             # Arbitrary lines placed in the chart
1167             #
1168             # Usage example:
1169             # $chart->line(
1170             # from => "0,2",
1171             # to => "0.3,0.1",
1172             # linetype => 'dash',
1173             # width => 2,
1174             # color => "dark-blue",
1175             # layer => "front",
1176             # );
1177             sub line
1178             {
1179 0     0 1 0 my ($self, %line) = @_;
1180 0 0       0 confess("Starting position of line not found") if (!defined $line{from});
1181              
1182 0         0 my $out = " from $line{from}";
1183 0 0       0 $out .= " to $line{to}" if (defined $line{to});
1184 0 0       0 $out .= " rto $line{rto}" if (defined $line{rto});
1185 0 0       0 $out .= " $line{layer}" if (defined $line{layer});
1186 0 0       0 $out .= " linetype ".&_lineType($line{linetype}) if
1187             (defined $line{linetype});
1188 0 0       0 $out .= " linewidth $line{width}" if (defined $line{width});
1189 0 0       0 $out .= " linecolor rgb \"$line{color}\"" if (defined $line{color});
1190              
1191 0         0 push(@{$self->{_arrows}}, "$out nohead"); # remove arrow head
  0         0  
1192 0         0 return($self);
1193             }
1194              
1195              
1196             # Set the options of arrow head
1197             sub _setArrowHead
1198             {
1199 0     0   0 my ($head) = @_;
1200 0         0 my $out = '';
1201              
1202             # Author's comments:
1203             # - The filling of arrow head does not follow the convention of fill style
1204             # of objects and plotting styles. Perhaps Gnuplot will change this in the
1205             # future.
1206             # - Back-angle is not meaningful if filling is "nofilled". This constraint
1207             # may be removed theoretically.
1208             # - Therefore, "backangle" and "fill" are disabled for the moment.
1209 0 0       0 if (ref($head) eq 'HASH')
1210             {
1211 0 0       0 my $size = (defined $$head{size})? $$head{size} : 0.45;
1212 0 0       0 my $angle = (defined $$head{angle})? $$head{angle} : 15;
1213 0 0       0 confess("arrow head size must be greater than 0") if ($size <= 0);
1214              
1215 0         0 $out .= " size $size";
1216 0 0       0 $out .= ",$angle" if ($size !~ /,/);
1217             # $out .= ",$$head{backangle}" if (defined $$head{backangle});
1218             # $out .= " $$head{fill}" if (defined $$head{fill});
1219 0 0       0 if (defined $$head{direction})
1220             {
1221 0 0       0 if ($$head{direction} eq 'back')
    0          
    0          
1222             {
1223 0         0 $out .= " backhead";
1224             }
1225             elsif ($$head{direction} eq 'both')
1226             {
1227 0         0 $out .= " heads";
1228             }
1229             elsif ($$head{direction} eq 'off')
1230             {
1231 0         0 $out .= " nohead";
1232             }
1233             }
1234             }
1235             else
1236             {
1237 0 0       0 if ($head eq 'off')
    0          
    0          
1238             {
1239 0         0 $out .= " nohead";
1240             }
1241             elsif ($head eq 'back')
1242             {
1243 0         0 $out .= " backhead";
1244             }
1245             elsif ($head eq 'both')
1246             {
1247 0         0 $out .= " heads";
1248             }
1249             }
1250              
1251 0         0 return($out);
1252             }
1253              
1254              
1255             # Arbitrary rectangles placed in the chart
1256             #
1257             # Usage example:
1258             # $chart->rectangle(
1259             # from => "screen 0.2, screen 0.2",
1260             # to => "screen 0.4, screen 0.4",
1261             # fill => {
1262             # density => 0.2,
1263             # color => "#11ff11",
1264             # },
1265             # border => {color => "blue"},
1266             # );
1267             sub rectangle
1268             {
1269 0     0 1 0 my ($self, %rect) = @_;
1270              
1271             # Position and dimension of the rectangle
1272 0         0 my $out = "";
1273 0 0       0 $out .= " $rect{index}" if (defined $rect{index});
1274 0         0 $out .= " rectangle";
1275              
1276 0 0       0 if (defined $rect{from})
    0          
1277             {
1278 0         0 $out .= " from $rect{from}";
1279            
1280 0 0       0 if (defined $rect{to})
    0          
1281             {
1282 0         0 $out .= " to $rect{to}";
1283             }
1284             elsif (defined $rect{rto})
1285             {
1286 0         0 $out .= " rto $rect{rto}";
1287             }
1288             else
1289             {
1290 0         0 confess("Rectangle dimension not complete");
1291             }
1292             }
1293             elsif (defined $rect{width})
1294             {
1295 0 0       0 $rect{at} = $rect{center} if (defined $rect{center});
1296 0 0       0 confess("Rectangle position not complete") if (!defined $rect{at});
1297 0 0 0     0 confess("Rectangle dimension not found") if (!defined $rect{width} ||
1298             !defined $rect{height});
1299              
1300 0         0 $out .= " at $rect{at} size $rect{width},$rect{height}";
1301             }
1302             else
1303             {
1304 0         0 confess("Rectangle position or dimension not complete");
1305             }
1306              
1307             # Process shared object options
1308 0         0 $out .= &_setObjOpt(\%rect);
1309              
1310 0         0 push(@{$self->{_objects}}, $out);
  0         0  
1311 0         0 return($self);
1312             }
1313              
1314              
1315             # Arbitrary ellipses placed in the chart
1316             #
1317             # Usage example:
1318             # $chart->ellipse(
1319             # at => "screen 0.2, screen 0.2",
1320             # width => 0.2,
1321             # height => 0.5
1322             # fill => {
1323             # density => 0.2,
1324             # color => "#11ff11",
1325             # },
1326             # border => {color => "blue"},
1327             # );
1328             sub ellipse
1329             {
1330 0     0 1 0 my ($self, %elli) = @_;
1331              
1332             # - Alias of "at": "center"
1333             # - Check position and dimension information
1334 0 0       0 $elli{at} = $elli{center} if (defined $elli{center});
1335 0 0       0 confess("Ellipse location not found") if (!defined $elli{at});
1336 0 0 0     0 confess("Ellipse dimension not found") if (!defined $elli{width} ||
1337             !defined $elli{height});
1338              
1339 0         0 my $out = "";
1340 0 0       0 $out .= " $elli{index}" if (defined $elli{index});
1341 0         0 $out .= " ellipse at $elli{at} size $elli{width},$elli{height}";
1342 0 0       0 $out .= " units $elli{units}" if (defined $elli{units});
1343              
1344             # Process shared object options
1345 0         0 $out .= &_setObjOpt(\%elli);
1346              
1347 0         0 push(@{$self->{_objects}}, $out);
  0         0  
1348 0         0 return($self);
1349             }
1350              
1351              
1352             # Arbitrary circles placed in the chart
1353             #
1354             # Usage example:
1355             # $chart->circle(
1356             # at => "screen 0.2, screen 0.2",
1357             # size => 0.5
1358             # fill => {
1359             # density => 0.2,
1360             # color => "#11ff11",
1361             # },
1362             # border => {color => "blue"},
1363             # );
1364             sub circle
1365             {
1366 0     0 1 0 my ($self, %cir) = @_;
1367              
1368             # - Alias of "at": "center"
1369             # - Check position and size information
1370 0 0       0 $cir{at} = $cir{center} if (defined $cir{center});
1371 0 0       0 confess("Circle location not found") if (!defined $cir{at});
1372 0 0       0 confess("Circle size not found") if (!defined $cir{size});
1373              
1374 0         0 my $out = "";
1375 0 0       0 $out .= " $cir{index}" if (defined $cir{index});
1376 0         0 $out .= " circle at $cir{at} size $cir{size}";
1377              
1378 0 0       0 if (defined $cir{arc})
1379             {
1380 0         0 (ref($cir{arc}) eq 'ARRAY')?
1381 0 0       0 ($out .= " arc [". join(':', @{$cir{arc}}) . "]"):
1382             ($out .= " arc [$cir{arc}]");
1383             }
1384              
1385             # Process shared object options
1386 0         0 $out .= &_setObjOpt(\%cir);
1387              
1388 0         0 push(@{$self->{_objects}}, $out);
  0         0  
1389 0         0 return($self);
1390             }
1391              
1392              
1393             # Arbitrary polygons placed in the chart
1394             #
1395             # Usage example:
1396             # $chart->polygon(
1397             # vertices => [
1398             # "0, -0.6",
1399             # {rto => "-1, 0.3"},
1400             # {to => [-4, 0.4]},
1401             # ],
1402             # );
1403             sub polygon
1404             {
1405 0     0 1 0 my ($self, %poly) = @_;
1406 0 0       0 confess("Polygon vertices not found") if (!defined $poly{vertices});
1407              
1408 0         0 my $v = $poly{vertices};
1409 0 0       0 confess("Polygon starting vertex not found") if (scalar(@$v) < 0.5);
1410              
1411 0         0 my $out = "";
1412 0 0       0 $out .= " $poly{index}" if (defined $poly{index});
1413 0         0 $out .= " polygon from $$v[0]";
1414              
1415             # Other vertices
1416 0         0 for (my $i = 1; $i < @$v; $i++)
1417             {
1418 0 0       0 if (ref($$v[$i]) eq 'HASH')
1419             {
1420 0         0 my @key = keys(%{$$v[$i]});
  0         0  
1421 0         0 my @val = values(%{$$v[$i]});
  0         0  
1422 0         0 $out .= " $key[0] $val[0]";
1423             }
1424             else
1425             {
1426 0         0 $out .= " to $$v[$i]";
1427             }
1428             }
1429              
1430             # Process shared object options
1431 0         0 $out .= &_setObjOpt(\%poly);
1432              
1433 0         0 push(@{$self->{_objects}}, $out);
  0         0  
1434 0         0 return($self);
1435             }
1436              
1437              
1438             # Set the details common to all objects
1439             sub _setObjOpt
1440             {
1441 0     0   0 my ($obj) = @_;
1442 0         0 my $out = "";
1443 0 0       0 $out .= " $$obj{layer}" if (defined $$obj{layer});
1444 0 0       0 $out .= " linewidth $$obj{linewidth}" if (defined $$obj{linewidth});
1445              
1446             # Set filling color / pattern and border
1447 0 0       0 if (defined $$obj{fill})
    0          
1448             {
1449 0         0 my $fill = $$obj{fill};
1450 0 0       0 $out .= " fillcolor rgb \"$$fill{color}\"" if (defined $$fill{color});
1451 0         0 $out .= " fillstyle". &_fillStyle($fill);
1452              
1453             # Set details of the border
1454 0 0       0 if (defined $$obj{border})
1455             {
1456 0 0       0 if (ref($$obj{border}) eq 'HASH')
    0          
1457             {
1458 0         0 $out .= " border";
1459 0 0       0 $out .= " linecolor rgb \"$$obj{border}{color}\"" if
1460             (defined $$obj{border}{color});
1461             }
1462             elsif ($$obj{border} =~ /^(off|no)$/)
1463             {
1464 0         0 $out .= " noborder";
1465             }
1466             }
1467             }
1468             elsif (defined $$obj{border})
1469             {
1470 0 0       0 if (ref($$obj{border}) eq 'HASH')
    0          
1471             {
1472 0         0 $out .= " fillstyle border";
1473 0 0       0 $out .= " linecolor rgb \"$$obj{border}{color}\"" if
1474             (defined $$obj{border}{color});
1475             }
1476             elsif ($$obj{border} =~ /^(off|no)$/)
1477             {
1478 0         0 $out .= " noborder";
1479             }
1480             }
1481 0         0 return($out);
1482             }
1483              
1484              
1485             # Output a test image for the terminal
1486             #
1487             # Usage example:
1488             # $chart = Chart::Gnuplot->new(output => "test.png");
1489             # $chart->test;
1490             sub test
1491             {
1492 0     0 0 0 my ($self) = @_;
1493              
1494 0         0 my $pltTmp = "$self->{_script}";
1495 0 0       0 open(PLT, ">$pltTmp") || confess("Can't write gnuplot script $pltTmp");
1496 0         0 print PLT "set terminal $self->{terminal}\n";
1497 0         0 print PLT "set output \"$self->{output}\"\n";
1498 0         0 print PLT "test\n";
1499 0         0 close(PLT);
1500              
1501             # Execute gnuplot
1502 0         0 my $gnuplot = 'gnuplot';
1503 0 0       0 $gnuplot = $self->{gnuplot} if (defined $self->{gnuplot});
1504 0         0 system("$gnuplot $pltTmp");
1505              
1506             # Convert the image to the user-specified format
1507 0 0 0     0 if (defined $self->{_terminal} && $self->{_terminal} eq 'auto')
1508             {
1509 0         0 my @a = split(/\./, $self->{output});
1510 0         0 my $ext = $a[-1];
1511 0 0       0 &convert($self, $ext) if ($ext !~ /^e?ps$/);
1512             }
1513 0         0 return($self);
1514             }
1515              
1516              
1517             # Create animated gif
1518             #
1519             # Usage example:
1520             # $chart->animate(
1521             # charts => \@charts, # sequence of chart object
1522             # delay => 10, # delay in units of 0.01 second
1523             # );
1524             sub animate
1525             {
1526 0     0 1 0 my ($self, %animate) = @_;
1527 0         0 my $charts = $animate{charts};
1528              
1529             # Force the terminal to be 'gif'
1530             # - Only the 'gif' terminal supports animation
1531 0 0 0     0 if (defined $self->{_terminal} && $self->{_terminal} eq 'auto')
    0          
1532             {
1533 0         0 $self->{terminal} = $self->{_terminal} = 'gif';
1534             }
1535             elsif ($self->{terminal} !~ /^gif/)
1536             {
1537 0         0 croak "animate() is supported only by the gif terminal";
1538             }
1539 0         0 $self->{terminal} .= " animate";
1540 0 0       0 $self->{terminal} .= " delay $animate{delay}" if (defined $animate{delay});
1541              
1542 0         0 &_setChart($self);
1543              
1544 0 0       0 open(PLT, ">>$self->{_script}") || confess("Can't write $self->{_script}");
1545              
1546 0         0 foreach my $chart (@$charts)
1547             {
1548 0         0 $chart->_script($self->{_script});
1549 0         0 $chart->_multiplot(1);
1550              
1551 0         0 my $plot;
1552             my @dataSet;
1553 0 0       0 if (defined $chart->{_dataSets2D})
    0          
1554             {
1555 0         0 $plot = 'plot';
1556 0         0 @dataSet = @{$chart->{_dataSets2D}};
  0         0  
1557             }
1558             elsif (defined $chart->{_dataSets3D})
1559             {
1560 0         0 $plot = 'splot';
1561 0         0 @dataSet = @{$chart->{_dataSets3D}};
  0         0  
1562             }
1563            
1564 0         0 &_setChart($chart, \@dataSet);
1565 0 0       0 open(PLT, ">>$self->{_script}") ||
1566             confess("Can't write $self->{_script}");
1567 0         0 print PLT "\n$plot ";
1568 0         0 print PLT join(', ', map {$_->_thaw($self)} @dataSet), "\n";
  0         0  
1569 0         0 close(PLT);
1570 0         0 &_reset($chart);
1571             }
1572              
1573             # Generate image file
1574 0         0 &execute($self);
1575 0         0 return($self);
1576             }
1577              
1578              
1579             # Change the image format
1580             # - called by plot2d()
1581             #
1582             # Usage example:
1583             # my $chart = Chart::Gnuplot->new(...);
1584             # my $data = Chart::Gnuplot::DataSet->new(...);
1585             # $chart->plot2d($data);
1586             # $chart->convert('gif');
1587             sub convert
1588             {
1589 0     0 1 0 my ($self, $imgfmt) = @_;
1590 0 0       0 return($self) if (!-e $self->{output});
1591              
1592             # Generate temp file
1593 0         0 my $temp = "$self->{_script}.tmp";
1594 0         0 move($self->{output}, $temp);
1595              
1596             # Execute gnuplot
1597 0         0 my $convert = 'convert';
1598 0 0       0 $convert = $self->{convert} if (defined $self->{convert});
1599              
1600             # Rotate 90 deg for landscape image
1601 0 0 0     0 if (defined $self->{orient} && $self->{orient} eq 'portrait')
1602             {
1603 0         0 my $cmd = qq("$convert" $temp $temp.$imgfmt 2>&1);
1604 0         0 my $err = `$cmd`;
1605 0 0 0     0 if (defined $err && $err ne '')
1606             {
1607 0 0       0 die "Unsupported image format ($imgfmt)\n" if
1608             ($err =~ /^convert: unable to open module file/);
1609              
1610 0         0 my ($errTmp) = ($err =~ /^convert: (.+)/);
1611 0 0       0 die "$errTmp Perhaps the image format is not supported\n" if
1612             (defined $errTmp);
1613 0         0 die "$err\n";
1614             }
1615             }
1616             else
1617             {
1618 0         0 my $cmd = qq("$convert" -rotate 90 $temp $temp.$imgfmt 2>&1);
1619 0         0 my $err = `$cmd`;
1620 0 0 0     0 if (defined $err && $err ne '')
1621             {
1622 0 0       0 die "Unsupported image format ($imgfmt)\n" if
1623             ($err =~ /^convert: unable to open module file/);
1624              
1625 0         0 my ($errTmp) = ($err =~ /^convert: (.+)/);
1626 0 0       0 die "$errTmp Perhaps the image format is not supported\n" if
1627             (defined $errTmp);
1628 0         0 die "$err\n";
1629             }
1630             }
1631              
1632             # Remove the temp file
1633 0         0 move("$temp.$imgfmt", $self->{output});
1634 0         0 unlink($temp);
1635 0         0 return($self);
1636             }
1637              
1638              
1639             # Change the image format to PNG
1640             #
1641             # Usage example:
1642             # my $chart = Chart::Gnuplot->new(...);
1643             # my $data = Chart::Gnuplot::DataSet->new(...);
1644             # $chart->plot2d($data)->png;
1645             sub png
1646             {
1647 0     0 1 0 my $self = shift;
1648 0         0 &convert($self, 'png');
1649 0         0 return($self)
1650             }
1651              
1652              
1653             # Change the image format to GIF
1654             #
1655             # Usage example:
1656             # my $chart = Chart::Gnuplot->new(...);
1657             # my $data = Chart::Gnuplot::DataSet->new(...);
1658             # $chart->plot2d($data)->gif;
1659             sub gif
1660             {
1661 0     0 1 0 my $self = shift;
1662 0         0 &convert($self, 'gif');
1663 0         0 return($self)
1664             }
1665              
1666              
1667             # Change the image format to JPG
1668             #
1669             # Usage example:
1670             # my $chart = Chart::Gnuplot->new(...);
1671             # my $data = Chart::Gnuplot::DataSet->new(...);
1672             # $chart->plot2d($data)->jpg;
1673             sub jpg
1674             {
1675 0     0 1 0 my $self = shift;
1676 0         0 &convert($self, 'jpg');
1677 0         0 return($self)
1678             }
1679              
1680              
1681             # Change the image format to PS
1682             #
1683             # Usage example:
1684             # my $chart = Chart::Gnuplot->new(...);
1685             # my $data = Chart::Gnuplot::DataSet->new(...);
1686             # $chart->plot2d($data)->ps;
1687             sub ps
1688             {
1689 0     0 1 0 my $self = shift;
1690 0         0 &convert($self, 'ps');
1691 0         0 return($self)
1692             }
1693              
1694              
1695             # Change the image format to PDF
1696             #
1697             # Usage example:
1698             # my $chart = Chart::Gnuplot->new(...);
1699             # my $data = Chart::Gnuplot::DataSet->new(...);
1700             # $chart->plot2d($data)->pdf;
1701             sub pdf
1702             {
1703 0     0 1 0 my $self = shift;
1704 0         0 &convert($self, 'pdf');
1705 0         0 return($self)
1706             }
1707              
1708              
1709             # Copy method of the chart object
1710             sub copy
1711             {
1712 2     2 1 9 my ($self, $num) = @_;
1713 2         7 my @clone = &_copy(@_);
1714              
1715 2         3 foreach my $clone (@clone)
1716             {
1717 4         10 my $dirTmp = tempdir(CLEANUP => 1);
1718 4 50       1005 ($^O =~ /MSWin/)? ($dirTmp .= '\\'): ($dirTmp .= '/');
1719 4         12 $clone->{_script} = $dirTmp . "plot";
1720             }
1721 2 100       8 return($clone[0]) if (!defined $num);
1722 1         4 return(@clone);
1723             }
1724              
1725             ################## Chart::Gnuplot::DataSet class ##################
1726              
1727             package Chart::Gnuplot::DataSet;
1728 21     21   234 use strict;
  21         32  
  21         850  
1729 21     21   94 use Carp;
  21         26  
  21         1595  
1730 21     21   164 use File::Temp qw(tempdir);
  21         29  
  21         1051  
1731 21     21   99 use Chart::Gnuplot::Util qw(_lineType _pointType _fillStyle _copy);
  21         28  
  21         122914  
1732              
1733             # Constructor
1734             sub new
1735             {
1736 31     31   13527 my ($class, %hash) = @_;
1737              
1738 31         106 my $dirTmp = tempdir(CLEANUP => 1);
1739 31 50       12506 ($^O =~ /MSWin/)? ($dirTmp .= '\\'): ($dirTmp .= '/');
1740 31         96 $hash{_data} = $dirTmp . "data";
1741              
1742 31         51 my $self = \%hash;
1743 31         160 return bless($self, $class);
1744             }
1745              
1746              
1747             # Generic attribute methods
1748             sub AUTOLOAD
1749             {
1750 4     4   21 my ($self, $key) = @_;
1751 4         5 my $attr = our $AUTOLOAD;
1752 4         10 $attr =~ s/.*:://;
1753 4 50       11 return if ($attr eq 'DESTROY'); # ignore destructor
1754 4 50       8 $self->{$attr} = $key if (defined $key);
1755 4         7 return($self->{$attr});
1756             }
1757              
1758              
1759             # xdata get-set method
1760             sub xdata
1761             {
1762 0     0   0 my ($self, $xdata) = @_;
1763 0 0       0 return($self->{xdata}) if (!defined $xdata);
1764              
1765 0         0 delete $self->{points};
1766 0         0 delete $self->{datafile};
1767 0         0 delete $self->{func};
1768 0         0 $self->{xdata} = $xdata;
1769             }
1770              
1771              
1772             # ydata get-set method
1773             sub ydata
1774             {
1775 1     1   7 my ($self, $ydata) = @_;
1776 1 50       4 return($self->{ydata}) if (!defined $ydata);
1777              
1778 1         3 delete $self->{points};
1779 1         1 delete $self->{datafile};
1780 1         3 delete $self->{func};
1781 1         2 $self->{ydata} = $ydata;
1782             }
1783              
1784              
1785             # zdata get-set method
1786             sub zdata
1787             {
1788 0     0   0 my ($self, $zdata) = @_;
1789 0 0       0 return($self->{zdata}) if (!defined $zdata);
1790              
1791 0         0 delete $self->{points};
1792 0         0 delete $self->{datafile};
1793 0         0 delete $self->{func};
1794 0         0 $self->{zdata} = $zdata;
1795             }
1796              
1797              
1798             # points get-set method
1799             sub points
1800             {
1801 0     0   0 my ($self, $points) = @_;
1802 0 0       0 return($self->{points}) if (!defined $points);
1803              
1804 0         0 delete $self->{xdata};
1805 0         0 delete $self->{ydata};
1806 0         0 delete $self->{zdata};
1807 0         0 delete $self->{datafile};
1808 0         0 delete $self->{func};
1809 0         0 $self->{points} = $points;
1810             }
1811              
1812              
1813             # datafile get-set method
1814             sub datafile
1815             {
1816 0     0   0 my ($self, $datafile) = @_;
1817 0 0       0 return($self->{datafile}) if (!defined $datafile);
1818              
1819 0         0 delete $self->{xdata};
1820 0         0 delete $self->{ydata};
1821 0         0 delete $self->{zdata};
1822 0         0 delete $self->{points};
1823 0         0 delete $self->{func};
1824 0         0 $self->{datafile} = $datafile;
1825             }
1826              
1827              
1828             # func get-set method
1829             sub func
1830             {
1831 1     1   4 my ($self, $func) = @_;
1832 1 50       2 return($self->{func}) if (!defined $func);
1833              
1834 1         2 delete $self->{xdata};
1835 1         2 delete $self->{ydata};
1836 1         1 delete $self->{zdata};
1837 1         1 delete $self->{points};
1838 1         1 delete $self->{datafile};
1839 1         3 $self->{func} = $func;
1840             }
1841              
1842              
1843             # Copy method of the data set object
1844             sub copy
1845             {
1846 2     2   8 my ($self, $num) = @_;
1847 2         6 my @clone = &_copy(@_);
1848              
1849 2         4 foreach my $clone (@clone)
1850             {
1851 4         9 my $dirTmp = tempdir(CLEANUP => 1);
1852 4 50       923 ($^O =~ /MSWin/)? ($dirTmp .= '\\'): ($dirTmp .= '/');
1853 4         12 $clone->{_data} = $dirTmp . "data";
1854             }
1855 2 100       8 return($clone[0]) if (!defined $num);
1856 1         4 return(@clone);
1857             }
1858              
1859              
1860             # Thaw the data set object
1861             # - call _fillStyle()
1862             # _ call different _thaw*()
1863             #
1864             # TODO:
1865             # - data file delimiter
1866             # - data labels
1867             sub _thaw
1868             {
1869 33     33   149 my ($self, $chart) = @_;
1870 33         36 my $string;
1871 33         45 my $using = '';
1872              
1873             # Data points stored in arrays
1874             # - in any case, ydata need to be defined
1875 33 100       171 if (defined $self->{ydata})
    100          
    100          
    50          
1876             {
1877 15         29 my $fileTmp = $self->{_data};
1878 15         76 $string = "'$fileTmp'";
1879              
1880             # Process 3D data set
1881             # - zdata is defined
1882 15 100 100     363 if (defined $self->{zdata})
    100 100        
    100 100        
    100 100        
    100 100        
    100 100        
    100 100        
      100        
      100        
      100        
1883             {
1884 2 100       13 $using = (ref($self->{xdata}->[0]) eq 'ARRAY')?
1885             &_thawXYZGrid($self) : &_thawXYZ($self);
1886             }
1887             # Treatment for financebars and candlesticks styles
1888             # - Both xdata and ydata are defined
1889             elsif (defined $self->{xdata} && defined $self->{style} &&
1890             $self->{style} =~ /^(financebars|candlesticks)$/)
1891             {
1892 1         5 $using = &_thawXYFinance($self);
1893             }
1894             # Treatment for errorbars and errorlines styles
1895             # - Both xdata and ydata are defined
1896             # - Style is defined and contain "error"
1897             elsif (defined $self->{xdata} && defined $self->{style} &&
1898             $self->{style} =~ /error/)
1899             {
1900             # Error bars along x-axis
1901 3 100       29 if ($self->{style} =~ /^xerror/)
    100          
    50          
1902             {
1903 1         7 $using = &_thawXYXError($self);
1904             }
1905             # Error bars along y-axis
1906             elsif ($self->{style} =~ /^(y|box)error/)
1907             {
1908 1         5 $using = &_thawXYYError($self);
1909             }
1910             # Error bars along both x and y-axis
1911             elsif ($self->{style} =~ /^(box)?xyerror/)
1912             {
1913 1         5 $using = &_thawXYXYError($self);
1914             }
1915             }
1916             # Treatment for hbars
1917             # - use "boxxyerrorbars" style to mimic
1918             elsif (defined $self->{xdata} && defined $self->{style} &&
1919             $self->{style} eq 'hbars')
1920             {
1921 1         5 &_thawXYHbars($self);
1922             }
1923             # Treatment for hlines
1924             # - use "boxxyerrorbars" style to mimic
1925             elsif (defined $self->{xdata} && defined $self->{style} &&
1926             $self->{style} eq 'hlines')
1927             {
1928 1         5 &_thawXYHlines($self);
1929             }
1930             elsif (defined $self->{xdata} && defined $self->{style} &&
1931             $self->{style} eq 'histograms')
1932             {
1933 1         5 $using = &_thawXYHistograms($self);
1934             }
1935             # Normal x-y plot
1936             # - Both xdata and ydata are defined
1937             elsif (defined $self->{xdata})
1938             {
1939 2         10 $using = &_thawXY($self);
1940             }
1941             # Only ydata is defined
1942             # - Plot ydata against index
1943             else
1944             {
1945             # Treatment for financebars and candlesticks styles
1946 4 100 100     42 if (defined $self->{style} &&
    100 100        
1947             $self->{style} =~ /^(financebars|candlesticks)$/)
1948             {
1949 1         5 &_thawYFinance($self);
1950             }
1951             # Treatment for errorbars and errorlines styles
1952             # - Style is defined and contain "error"
1953             elsif (defined $self->{style} && $self->{style} =~ /^yerror/)
1954             {
1955 1         4 &_thawYError($self);
1956             }
1957             # Other plotting styles
1958             else
1959             {
1960 2         7 &_thawY($self);
1961             }
1962 4 50       22 $using = "1:2" if (defined $self->{timefmt});
1963             }
1964             }
1965             # Data in points
1966             elsif (defined $self->{points})
1967             {
1968 5         9 my $pt = $self->{points};
1969 5         9 my $fileTmp = $self->{_data};
1970 5         13 $string = "'$fileTmp'";
1971              
1972             # Horizontal lines plotting style
1973 5 100 100     72 if (defined $self->{style} && $self->{style} eq 'hlines')
    100 100        
    100 66        
    100          
1974             {
1975 1         5 &_thawPointsHLines($self);
1976             }
1977             # Horizontal bars plotting style
1978             elsif (defined $self->{style} && $self->{style} eq 'hbars')
1979             {
1980 1         5 &_thawPointsHBars($self);
1981             }
1982             # Horizontal bars plotting style
1983             elsif (defined $self->{style} && $self->{style} eq 'histograms')
1984             {
1985 1         5 $using = &_thawPointsHistograms($self);
1986             }
1987             # 3D grid data points
1988             elsif (ref($$pt[0][0]) eq 'ARRAY')
1989             {
1990 1         5 $using = &_thawPointsGrid($self);
1991             }
1992             else
1993             {
1994 1         3 $using = &_thawPoints($self);
1995             }
1996             }
1997             # File
1998             elsif (defined $self->{datafile})
1999             {
2000 1         2 $string = "'$self->{datafile}'";
2001 1 50       4 $string .= " every $self->{every}" if (defined $self->{every});
2002 1 50       3 $string .= " index $self->{index}" if (defined $self->{index});
2003             }
2004             # Function
2005             elsif (defined $self->{func})
2006             {
2007             # Parametric function
2008 12 100       32 if (ref($self->{func}) eq 'HASH')
2009             {
2010 2 100       2 if (defined ${$self->{func}}{z})
  2         8  
2011             {
2012 1         1 $string = "${$self->{func}}{x},${$self->{func}}{y},".
  1         3  
  1         3  
2013 1         3 "${$self->{func}}{z}";
2014             }
2015             else
2016             {
2017 1         2 $string = "${$self->{func}}{x},${$self->{func}}{y}";
  1         3  
  1         2  
2018             }
2019             }
2020             else
2021             {
2022 10         106 $string = "$self->{func}";
2023             }
2024             }
2025             else
2026             {
2027 0         0 croak("Unknown or undefined data source");
2028             }
2029              
2030             # Process the Gnuplot "using" feature
2031 33 50       96 $using = $self->{using} if (defined $self->{using});
2032 33 100       69 $string .= " using $using" if ($using ne '');
2033              
2034             # Add title for the data sets
2035 33 100       90 (defined $self->{title})? ($string .= " title \"$self->{title}\""):
2036             ($string .= " title \"\"");
2037              
2038             # Change plotting style, color, width and point size
2039 33 100       71 $string .= " smooth $self->{smooth}" if (defined $self->{smooth});
2040 33 100       70 $string .= " axes $self->{axes}" if (defined $self->{axes});
2041 33 100       92 $string .= " with $self->{style}" if (defined $self->{style});
2042 33 100       69 $string .= " linetype ".&_lineType($self->{linetype}) if
2043             (defined $self->{linetype});
2044 33 100       72 $string .= " linecolor rgb \"$self->{color}\"" if (defined $self->{color});
2045 33 100       76 $string .= " linewidth $self->{width}" if (defined $self->{width});
2046 33 100       72 $string .= " pointtype ".&_pointType($self->{pointtype}) if
2047             (defined $self->{pointtype});
2048 33 100       72 $string .= " pointsize $self->{pointsize}" if (defined $self->{pointsize});
2049            
2050             # Filling style of the curve
2051 33 50       69 if (defined $self->{fill})
2052             {
2053 0         0 $string .= " fill".&_fillStyle($self->{fill});
2054              
2055             # Set details of the border
2056 0 0       0 if (defined $self->{border})
2057             {
2058 0 0       0 if (ref($self->{border}) eq 'HASH')
    0          
2059             {
2060 0         0 $string .= " border";
2061 0 0       0 $string .= " linecolor rgb \"$self->{border}{color}\"" if
2062             (defined $self->{border}{color});
2063             }
2064             elsif ($self->{border} =~ /^(off|no)$/)
2065             {
2066 0         0 $string .= " noborder";
2067             }
2068             }
2069             }
2070 33         90 return($string);
2071             }
2072              
2073              
2074             # Process input data of array of y
2075             sub _thawY
2076             {
2077 2     2   7 my ($ds) = @_;
2078 2         6 my $ydata = $ds->{ydata};
2079              
2080             # Write data into temp file
2081 2         3 my $fileTmp = $ds->{_data};
2082 2 50       136 open(DATA, ">$fileTmp") || confess("Can't write data to temp file");
2083 2         11 for (my $i = 0; $i < @$ydata; $i++)
2084             {
2085 15         50 print DATA "$i $$ydata[$i]\n";
2086             }
2087 2         72 close(DATA);
2088             }
2089              
2090              
2091             # Process input data of array of y for plotting style "yerror..."
2092             sub _thawYError
2093             {
2094 1     1   3 my ($ds) = @_;
2095 1         2 my $ydata = $ds->{ydata};
2096              
2097             # Write data into temp file
2098 1         3 my $fileTmp = $ds->{_data};
2099 1 50       73 open(DATA, ">$fileTmp") || confess("Can't write data to temp file");
2100 1         4 for (my $i = 0; $i < @{$$ydata[0]}; $i++)
  6         15  
2101             {
2102 5         18 print DATA "$i $$ydata[0][$i]";
2103 5         11 for (my $j = 1; $j < @$ydata; $j++)
2104             {
2105 5         34 print DATA " $$ydata[$j][$i]";
2106             }
2107 5         9 print DATA "\n";
2108             }
2109 1         38 close(DATA);
2110             }
2111              
2112              
2113             # Process input data of array of y for plotting financial time series
2114             sub _thawYFinance
2115             {
2116 1     1   3 my ($ds) = @_;
2117 1         3 my $ydata = $ds->{ydata};
2118              
2119             # Write data into temp file
2120 1         2 my $fileTmp = $ds->{_data};
2121 1 50       89 open(DATA, ">$fileTmp") || confess("Can't write data to temp file");
2122 1         5 for (my $i = 0; $i < @{$$ydata[0]}; $i++)
  6         16  
2123             {
2124 5         32 print DATA "$i $$ydata[0][$i] $$ydata[1][$i] ".
2125             "$$ydata[2][$i] $$ydata[3][$i]\n";
2126             }
2127 1         39 close(DATA);
2128             }
2129              
2130              
2131             # Process input data of array of x and y
2132             sub _thawXY
2133             {
2134 2     2   4 my ($ds) = @_;
2135              
2136 2         5 my $xdata = $ds->{xdata};
2137 2         4 my $ydata = $ds->{ydata};
2138 2 50       8 croak("x-data and y-data have unequal length") if
2139             (scalar(@$ydata) != scalar(@$xdata));
2140              
2141             # Write data into temp file
2142 2         3 my $fileTmp = $ds->{_data};
2143 2 50       134 open(DATA, ">$fileTmp") || confess("Can't write data to temp file");
2144 2         12 for (my $i = 0; $i < @$xdata; $i++)
2145             {
2146 26         81 print DATA "$$xdata[$i] $$ydata[$i]\n";
2147             }
2148 2         68 close(DATA);
2149              
2150             # Construst using statement for date-time data
2151 2         5 my $using = '';
2152 2 50       11 if (defined $ds->{timefmt})
2153             {
2154 0         0 my @a = split(/\s+/, $$xdata[0]);
2155 0         0 my $yCol = scalar(@a) + 1;
2156 0         0 $using = "1:$yCol";
2157             }
2158 2         8 return($using);
2159             }
2160              
2161              
2162             # Process input data of array of x and y for plotting style "xerror..."
2163             sub _thawXYXError
2164             {
2165 1     1   3 my ($ds) = @_;
2166              
2167 1         3 my $xdata = $ds->{xdata};
2168 1         3 my $ydata = $ds->{ydata};
2169 1         7 croak("x-data and y-data have unequal length") if
2170 1 50       3 (scalar(@{$$xdata[0]}) != scalar(@$ydata));
2171              
2172             # Write data into temp file
2173 1         3 my $fileTmp = $ds->{_data};
2174 1 50       77 open(DATA, ">$fileTmp") || confess("Can't write data to temp file");
2175 1         9 for (my $i = 0; $i < @$ydata; $i++)
2176             {
2177 5         18 print DATA "$$xdata[0][$i] $$ydata[$i]";
2178 5         13 for (my $j = 1; $j < @$xdata; $j++)
2179             {
2180 5         33 print DATA " $$xdata[$j][$i]";
2181             }
2182 5         12 print DATA "\n";
2183             }
2184 1         37 close(DATA);
2185              
2186             # Construst using statement for date-time data
2187 1         3 my $using = '';
2188 1 50       9 if (defined $ds->{timefmt})
2189             {
2190 0 0       0 my ($xTmp) = (ref($$xdata[0]) eq 'ARRAY')? ($$xdata[0][0]):
2191             ($$xdata[0]);
2192 0         0 my @a = split(/\s+/, $xTmp);
2193 0         0 my $yCol = scalar(@a) + 1;
2194 0         0 $using = "1:$yCol";
2195             }
2196 1         5 return($using);
2197             }
2198              
2199              
2200             # Process input data of array of x and y for plotting style "yerror..."
2201             sub _thawXYYError
2202             {
2203 1     1   3 my ($ds) = @_;
2204              
2205 1         3 my $xdata = $ds->{xdata};
2206 1         3 my $ydata = $ds->{ydata};
2207 1         6 croak("x-data and y-data have unequal length") if
2208 1 50       1 (scalar(@{$$ydata[0]}) != scalar(@$xdata));
2209              
2210             # Write data into temp file
2211 1         3 my $fileTmp = $ds->{_data};
2212 1 50       86 open(DATA, ">$fileTmp") || confess("Can't write data to temp file");
2213 1         8 for (my $i = 0; $i < @$xdata; $i++)
2214             {
2215 5         18 print DATA "$$xdata[$i] $$ydata[0][$i]";
2216 5         12 for (my $j = 1; $j < @$ydata; $j++)
2217             {
2218 5         34 print DATA " $$ydata[$j][$i]";
2219             }
2220 5         13 print DATA "\n";
2221             }
2222 1         41 close(DATA);
2223              
2224             # Construst using statement for date-time data
2225 1         4 my $using = '';
2226 1 50       5 if (defined $ds->{timefmt})
2227             {
2228 0 0       0 my ($xTmp) = (ref($$xdata[0]) eq 'ARRAY')? ($$xdata[0][0]):
2229             ($$xdata[0]);
2230 0         0 my @a = split(/\s+/, $xTmp);
2231 0         0 my $yCol = scalar(@a) + 1;
2232 0         0 $using = "1:$yCol";
2233             }
2234 1         5 return($using);
2235             }
2236              
2237              
2238             # Process input data of array of x and y for plotting style "xyerror..."
2239             sub _thawXYXYError
2240             {
2241 1     1   2 my ($ds) = @_;
2242              
2243 1         3 my $xdata = $ds->{xdata};
2244 1         4 my $ydata = $ds->{ydata};
2245              
2246             # Write data into temp file
2247 1         3 my $fileTmp = $ds->{_data};
2248 1 50       77 open(DATA, ">$fileTmp") || confess("Can't write data to temp file");
2249 1 50       9 if (scalar(@$xdata) == scalar(@$ydata))
2250             {
2251 1         3 for (my $i = 0; $i < @{$$xdata[0]}; $i++)
  6         18  
2252             {
2253 5         17 print DATA "$$xdata[0][$i] $$ydata[0][$i]";
2254 5         15 for (my $j = 1; $j < @$ydata; $j++)
2255             {
2256 5         42 print DATA " $$xdata[$j][$i] $$ydata[$j][$i]";
2257             }
2258 5         11 print DATA "\n";
2259             }
2260             }
2261             else
2262             {
2263 0         0 for (my $i = 0; $i < @{$$xdata[0]}; $i++)
  0         0  
2264             {
2265 0         0 print DATA "$$xdata[0][$i] $$ydata[0][$i]";
2266 0 0       0 if (scalar(@$xdata) == 2)
2267             {
2268 0         0 my $ltmp = $$xdata[0][$i] - $$xdata[1][$i]*0.5;
2269 0         0 my $htmp = $$xdata[0][$i] + $$xdata[1][$i]*0.5;
2270 0         0 print DATA " $ltmp $htmp ".
2271             "$$ydata[1][$i] $$ydata[2][$i]\n";
2272             }
2273             else
2274             {
2275 0         0 my $ltmp = $$ydata[0][$i] - $$ydata[1][$i]*0.5;
2276 0         0 my $htmp = $$ydata[0][$i] - $$ydata[1][$i]*0.5;
2277 0         0 print DATA " $$xdata[1][$i] $$xdata[2][$i] ".
2278             "$ltmp $htmp\n";
2279             }
2280             }
2281             }
2282 1         36 close(DATA);
2283            
2284             # Construst using statement for date-time data
2285 1         3 my $using = '';
2286 1 50       7 if (defined $ds->{timefmt})
2287             {
2288 0 0       0 my ($xTmp) = (ref($$xdata[0]) eq 'ARRAY')? ($$xdata[0][0]):
2289             ($$xdata[0]);
2290 0         0 my @a = split(/\s+/, $xTmp);
2291 0         0 my $yCol = scalar(@a) + 1;
2292 0         0 $using = "1:$yCol";
2293             }
2294 1         5 return($using);
2295             }
2296              
2297              
2298             # Process input data of array of x and y for plotting financial time series
2299             sub _thawXYFinance
2300             {
2301 1     1   2 my ($ds) = @_;
2302              
2303 1         3 my $xdata = $ds->{xdata};
2304 1         3 my $ydata = $ds->{ydata};
2305 1         7 croak("x-data and y-data have unequal length") if
2306 1 50       1 (scalar(@{$$ydata[0]}) != scalar(@$xdata));
2307              
2308             # Write data into temp file
2309 1         3 my $fileTmp = $ds->{_data};
2310 1 50       78 open(DATA, ">$fileTmp") || confess("Can't write data to temp file");
2311 1         8 for (my $i = 0; $i < @$xdata; $i++)
2312             {
2313 5         33 print DATA "$$xdata[$i] $$ydata[0][$i] $$ydata[1][$i] ".
2314             "$$ydata[2][$i] $$ydata[3][$i]\n";
2315             }
2316 1         38 close(DATA);
2317              
2318             # Construst using statement for date-time data
2319 1         4 my $using = '';
2320 1 50       6 if (defined $ds->{timefmt})
2321             {
2322 0         0 my @a = split(/\s+/, $$xdata[0]);
2323 0         0 my $yCol = scalar(@a) + 1;
2324 0         0 $using = "1:".join(':', ($yCol .. $yCol+3));
2325             }
2326 1         5 return($using);
2327             }
2328              
2329              
2330             # Process input data of arrays of x and y for plottiny style "hlines"
2331             sub _thawXYHlines
2332             {
2333 1     1   2 my ($ds) = @_;
2334 1         3 my $xdata = $ds->{xdata};
2335 1         2 my $ydata = $ds->{ydata};
2336              
2337             # Write data into temp file
2338 1         3 my $fileTmp = $ds->{_data};
2339 1 50       84 open(DATA, ">$fileTmp") || confess("Can't write data to temp file");
2340 1         8 for (my $i = 0; $i < @$xdata; $i++)
2341             {
2342 5         28 print DATA "0 $$ydata[$i] 0 $$xdata[$i] $$ydata[$i] ".
2343             "$$ydata[$i]\n";
2344             }
2345 1         35 close(DATA);
2346 1         7 $ds->{style} = "boxxyerrorbars";
2347             }
2348              
2349              
2350             # Process input data of arrays of x and y for plottiny style "hbars"
2351             sub _thawXYHbars
2352             {
2353 1     1   2 my ($ds) = @_;
2354 1         4 my $xdata = $ds->{xdata};
2355 1         2 my $ydata = $ds->{ydata};
2356              
2357             # Put the corrdinates in a hash
2358 1         2 my %points;
2359 1         7 for (my $i = 0; $i < @$xdata; $i++)
2360             {
2361 5         53 $points{$$xdata[$i]} = $$ydata[$i];
2362             }
2363              
2364             # Sort x and y according to y values
2365 1         3 my (@sortX, @sortY) = ();
2366 1         9 foreach my $sx (sort {$points{$a} <=> $points{$b}} keys %points)
  7         13  
2367             {
2368 5         8 push(@sortX, $sx);
2369 5         7 push(@sortY, $points{$sx});
2370             }
2371              
2372 1         4 my $ylow = my $yhigh = $sortY[0];
2373 1 50       5 if (scalar(@sortY) > 1)
2374             {
2375 1         4 $ylow = 0.5*(3*$sortY[0]-$sortY[1]);
2376 1         4 $yhigh = 0.5*(3*$sortY[-1]-$sortY[-2]);
2377             }
2378              
2379             # Write data into temp file
2380 1         2 my $fileTmp = $ds->{_data};
2381 1 50       78 open(DATA, ">$fileTmp") || confess("Can't write data to temp file");
2382 1         7 for (my $i = 0; $i < @$xdata; $i++)
2383             {
2384 5 100       11 $ylow = 0.5*($sortY[$i]+$sortY[$i-1]) if ($i > 0);
2385 5 100       16 $yhigh = ($i < $#sortY)?
2386             0.5*($sortY[$i]+$sortY[$i+1]) :
2387             2.0*$sortY[$i] - $ylow;
2388 5         46 print DATA "0 $sortY[$i] 0 $sortX[$i] $ylow $yhigh\n";
2389             }
2390 1         36 close(DATA);
2391 1         10 $ds->{style} = "boxxyerrorbars";
2392             }
2393              
2394              
2395             # Process input data of arrays of x and y for plottiny style "histograms"
2396             sub _thawXYHistograms
2397             {
2398 1     1   2 my ($ds) = @_;
2399 1         3 my $xdata = $ds->{xdata};
2400 1         3 my $ydata = $ds->{ydata};
2401 1 50       5 croak("x-data and y-data have unequal length") if
2402             (scalar(@$ydata) != scalar(@$xdata));
2403 1         2 my $using;
2404              
2405             # Write data into temp file
2406 1         2 my $fileTmp = $ds->{_data};
2407 1 50       71 open(DATA, ">$fileTmp") || confess("Can't write data to temp file");
2408 1 50       7 if (ref($$ydata[0]) eq 'ARRAY')
2409             {
2410 0         0 for (my $i = 0; $i < @$xdata; $i++)
2411             {
2412 0         0 print DATA "\"$$xdata[$i]\" " . join(' ', @{$$ydata[$i]}) . "\n";
  0         0  
2413             }
2414 0         0 $using = join(':', (2 .. scalar(@{$$ydata[0]})+1)) . ":xticlabels(1)";
  0         0  
2415             }
2416             else
2417             {
2418 1         6 for (my $i = 0; $i < @$xdata; $i++)
2419             {
2420 5         23 print DATA "\"$$xdata[$i]\" $$ydata[$i]\n";
2421             }
2422 1         2 $using = "2:xticlabels(1)";
2423             }
2424 1         34 close(DATA);
2425              
2426 1         6 return($using);
2427             }
2428              
2429              
2430             # Process input data of array of x, y and z
2431             sub _thawXYZ
2432             {
2433 1     1   2 my ($ds) = @_;
2434              
2435 1         3 my $xdata = $ds->{xdata};
2436 1         2 my $ydata = $ds->{ydata};
2437 1         3 my $zdata = $ds->{zdata};
2438 1 50       5 croak("x-data and y-data have unequal length") if
2439             (scalar(@$ydata) != scalar(@$xdata));
2440 1 50       3 croak("y-data and z-data have unequal length") if
2441             (scalar(@$ydata) != scalar(@$zdata));
2442              
2443             # Write data into temp file
2444 1         3 my $fileTmp = $ds->{_data};
2445 1 50       74 open(DATA, ">$fileTmp") || confess("Can't write data to temp file");
2446 1         8 for (my $i = 0; $i < @$xdata; $i++)
2447             {
2448 5         24 print DATA "$$xdata[$i] $$ydata[$i] $$zdata[$i]\n";
2449             }
2450 1         39 close(DATA);
2451              
2452             # Construst using statement for date-time data
2453 1         7 my $using = '';
2454 1 50       6 if (defined $ds->{timefmt})
2455             {
2456 0         0 my @a = split(/\s+/, $$xdata[0]);
2457 0         0 my $yCol = scalar(@a) + 1;
2458 0         0 $using = "1:$yCol";
2459              
2460 0         0 my @b = split(/\s+/, $$ydata[0]);
2461 0         0 my $zCol = scalar(@b) + $yCol;
2462 0         0 $using .= ":$zCol";
2463             }
2464 1         6 return($using);
2465             }
2466              
2467              
2468             # Process input data of matrice of x, y and z
2469             sub _thawXYZGrid
2470             {
2471 1     1   3 my ($ds) = @_;
2472              
2473 1         2 my $xdata = $ds->{xdata};
2474 1         3 my $ydata = $ds->{ydata};
2475 1         2 my $zdata = $ds->{zdata};
2476 1 50       4 croak("x-data and y-data have unequal length") if
2477             (scalar(@$ydata) != scalar(@$xdata));
2478 1 50       4 croak("y-data and z-data have unequal length") if
2479             (scalar(@$ydata) != scalar(@$zdata));
2480              
2481             # Write data into temp file
2482 1         2 my $fileTmp = $ds->{_data};
2483 1 50       80 open(DATA, ">$fileTmp") || confess("Can't write data to temp file");
2484 1         7 for (my $i = 0; $i < @$xdata; $i++)
2485             {
2486 3         5 for (my $j = 0; $j < @{$$xdata[$i]}; $j++)
  12         24  
2487             {
2488 9         34 print DATA "$$xdata[$i][$j] $$ydata[$i][$j] $$zdata[$i][$j]\n";
2489             }
2490 3         8 print DATA "\n";
2491             }
2492 1         33 close(DATA);
2493              
2494             # Construst using statement for date-time data
2495 1         4 my $using = '';
2496 1 50       5 if (defined $ds->{timefmt})
2497             {
2498 0         0 my @a = split(/\s+/, $$xdata[0][0]);
2499 0         0 my $yCol = scalar(@a) + 1;
2500 0         0 $using = "1:$yCol";
2501              
2502 0         0 my @b = split(/\s+/, $$ydata[0][0]);
2503 0         0 my $zCol = scalar(@b) + $yCol;
2504 0         0 $using .= ":$zCol";
2505             }
2506 1         5 return($using);
2507             }
2508              
2509              
2510             # Process input data of array of points
2511             sub _thawPoints
2512             {
2513 1     1   2 my ($ds) = @_;
2514              
2515             # Write data into temp file
2516 1         6 my $pt = $ds->{points};
2517 1         3 my $fileTmp = $ds->{_data};
2518 1 50       50 open(DATA, ">$fileTmp") || confess("Can't write data to temp file");
2519 1         5 for (my $i = 0; $i < @$pt; $i++)
2520             {
2521 6         7 print DATA join(" ", @{$$pt[$i]}), "\n";
  6         22  
2522             }
2523 1         25 close(DATA);
2524              
2525             # Construst using statement for date-time data
2526 1         3 my $using = '';
2527 1 50       4 if (defined $ds->{timefmt})
2528             {
2529 0         0 my $col = 1;
2530 0         0 $using = "1";
2531 0         0 for (my $i = 0; $i < @{$$pt[0]}-1; $i++)
  0         0  
2532             {
2533 0         0 my @a = split(/\s+/, $$pt[0][$i]);
2534 0         0 $col += scalar(@a);
2535 0         0 $using .= ":$col";
2536             }
2537             }
2538 1         3 return($using);
2539             }
2540              
2541              
2542             # Process input data of array of points for plotting style "hlines"
2543             sub _thawPointsHLines
2544             {
2545 1     1   2 my ($ds) = @_;
2546 1 50       5 confess("Data/time input data is not supported in hlines plotting style")
2547             if (defined $ds->{timefmt});
2548              
2549             # Write data into temp file
2550 1         3 my $pt = $ds->{points};
2551 1         2 my $fileTmp = $ds->{_data};
2552 1 50       74 open(DATA, ">$fileTmp") || confess("Can't write data to temp file");
2553              
2554             # hlines plotting style
2555 1         8 for (my $i = 0; $i < @$pt; $i++)
2556             {
2557 5         33 print DATA "0 $$pt[$i][1] 0 $$pt[$i][0] $$pt[$i][1] $$pt[$i][1]\n";
2558             }
2559              
2560 1         4 $ds->{style} = "boxxyerrorbars";
2561 1         37 close(DATA);
2562             }
2563              
2564              
2565             # Process input data of array of points for plotting style "hbars"
2566             sub _thawPointsHBars
2567             {
2568 1     1   3 my ($ds) = @_;
2569 1 50       5 confess("Data/time input data is not supported in hbars plotting style")
2570             if (defined $ds->{timefmt});
2571              
2572 1         2 my $pt = $ds->{points};
2573              
2574             # Put the corrdinates in a hash
2575 1         2 my %points;
2576 1         5 for (my $i = 0; $i < @$pt; $i++)
2577             {
2578 5         19 $points{$$pt[$i][0]} = $$pt[$i][1];
2579             }
2580              
2581             # Sort x and y according to y values
2582 1         3 my (@sortX, @sortY) = ();
2583 1         9 foreach my $sx (sort {$points{$a} <=> $points{$b}} keys %points)
  7         13  
2584             {
2585 5         7 push(@sortX, $sx);
2586 5         9 push(@sortY, $points{$sx});
2587             }
2588              
2589 1         4 my $ylow = my $yhigh = $sortY[0];
2590 1 50       4 if (scalar(@sortY) > 1)
2591             {
2592 1         5 $ylow = 0.5*(3*$sortY[0]-$sortY[1]);
2593 1         3 $yhigh = 0.5*(3*$sortY[-1]-$sortY[-2]);
2594             }
2595              
2596             # Write data into temp file
2597 1         3 my $fileTmp = $ds->{_data};
2598 1 50       72 open(DATA, ">$fileTmp") || confess("Can't write data to temp file");
2599 1         8 for (my $i = 0; $i < @$pt; $i++)
2600             {
2601 5 100       16 $ylow = 0.5*($sortY[$i]+$sortY[$i-1]) if ($i > 0);
2602 5 100       14 $yhigh = ($i < $#sortY)?
2603             0.5*($sortY[$i]+$sortY[$i+1]) :
2604             2.0*$sortY[$i] - $ylow;
2605 5         49 print DATA "0 $sortY[$i] 0 $sortX[$i] $ylow $yhigh\n";
2606             }
2607 1         37 close(DATA);
2608              
2609 1         4 $ds->{style} = "boxxyerrorbars";
2610 1         8 close(DATA);
2611             }
2612              
2613              
2614             # Process input data of array of points for plotting histograms
2615             sub _thawPointsHistograms
2616             {
2617 1     1   3 my ($ds) = @_;
2618              
2619             # Write data into temp file
2620 1         3 my $pt = $ds->{points};
2621 1         2 my $fileTmp = $ds->{_data};
2622 1 50       79 open(DATA, ">$fileTmp") || confess("Can't write data to temp file");
2623 1         3 my $numCol = scalar(@{$$pt[0]});
  1         5  
2624 1         5 for (my $i = 0; $i < @$pt; $i++)
2625             {
2626 5         16 print DATA "\"$$pt[$i][0]\" ", join(' ', @{$$pt[$i]}[1 .. $numCol-1]),
  5         22  
2627             "\n";
2628             }
2629 1         38 close(DATA);
2630              
2631 1         7 my $using = join(':', (2 .. $numCol)) . ":xticlabels(1)";
2632 1         6 return($using);
2633             }
2634              
2635              
2636             # Process input data of a matrix of points
2637             sub _thawPointsGrid
2638             {
2639 1     1   2 my ($ds) = @_;
2640              
2641             # Write data into temp file
2642 1         4 my $pt = $ds->{points};
2643 1         3 my $fileTmp = $ds->{_data};
2644 1 50       77 open(DATA, ">$fileTmp") || confess("Can't write data to temp file");
2645 1         8 for (my $i = 0; $i < @$pt; $i++)
2646             {
2647 3         5 for (my $j = 0; $j < @{$$pt[$i]}; $j++)
  12         29  
2648             {
2649 9         11 print DATA join(" ", @{$$pt[$i][$j]}), "\n";
  9         33  
2650             }
2651 3         11 print DATA "\n";
2652             }
2653 1         35 close(DATA);
2654              
2655             # Construst using statement for date-time data
2656 1         5 my $using = '';
2657 1 50       5 if (defined $ds->{timefmt})
2658             {
2659 0         0 my $col = 1;
2660 0         0 $using = "1";
2661 0         0 for (my $i = 0; $i < @{$$pt[0][0]}-1; $i++)
  0         0  
2662             {
2663 0         0 my @a = split(/\s+/, $$pt[0][0][$i]);
2664 0         0 $col += scalar(@a);
2665 0         0 $using .= ":$col";
2666             }
2667             }
2668 1         5 return($using);
2669             }
2670              
2671              
2672             # Curve fitting method
2673             #
2674             # NOTICE: This feature is experimental and in alpha phase.
2675             #
2676             # Usage example:
2677             # my $dataSet = Chart::Gnuplot::DataSet->new(...);
2678             #
2679             # my $dataFit = $dataSet->fit(
2680             # func => "a*x + b", # linear fit
2681             # vars => 'x',
2682             # params => {a => -1, b => 0.5}, # seed
2683             # );
2684             #
2685             # print "a = $dataFit->{params}->{a}\n";
2686             # print "b = $dataFit->{params}->{b}\n";
2687             #
2688             # # Plot the raw data set and fitted curve
2689             # $chart->plot2d($dataSet, $dataFit);
2690             sub fit
2691             {
2692 0     0     my ($self, %hash) = @_;
2693 0           my $script = my $data = my $result = my $log = $self->{_data};
2694 0 0         my $styleTmp = (defined $self->{style})? $self->{style} : 'lines';
2695              
2696             # Filename of the temp files
2697 0           $script =~ s/\/data$/\/fit\.script/;
2698 0           $result =~ s/\/data$/\/fit\.result/;
2699 0           $log =~ s/\/data$/\/fit\.log/;
2700              
2701             # Prepare parameter and error string for printing
2702 0           my $paraString = my $paraList = my $errList = '';
2703 0           my @params = ();
2704 0           my $paraRef = ref($hash{params});
2705 0 0         if ($paraRef eq 'HASH')
    0          
2706             {
2707 0           @params = keys %{$hash{params}};
  0            
2708 0           my @err = ();
2709 0           my $parFile = $self->{_data};
2710 0           $parFile =~ s/\/data$/\/par\.dat/;
2711 0 0         open(PARA, ">$parFile") || confess "Can't write parameter to $parFile";
2712 0           foreach my $pTmp (@params)
2713             {
2714 0           my $vTmp = (defined ${$hash{params}}{$pTmp})?
  0            
2715 0 0         ${$hash{params}}{$pTmp} : 1.0;
2716 0           print PARA "$pTmp = $vTmp\n";
2717 0           push(@err, $pTmp . "_err");
2718             }
2719 0           close(PARA);
2720 0           $paraString = "\"$parFile\"";
2721 0           $paraList = join(',', @params);
2722 0           $errList = join(',', @err);
2723             }
2724             elsif ($paraRef eq 'ARRAY')
2725             {
2726 0           @params = @{$hash{params}};
  0            
2727 0           my @err = map {$_ . '_err'} @params;
  0            
2728 0           $paraString = $paraList = join(',', @params);
2729 0           $errList = join(',', @err);
2730             }
2731             else
2732             {
2733 0           @params = split(/,\s*/, $hash{params});
2734 0           my @err = map {$_ . '_err'} @params;
  0            
2735 0           $paraString = $paraList = $hash{params};
2736 0           $errList = join(',', @err);
2737             }
2738              
2739 0 0         if (!defined $hash{using})
2740             {
2741 0           my @col = split(/\s*,\s*/, $hash{vars});
2742 0           my $numCol = scalar(@col) + 1;
2743 0 0         if (ref($self->{ydata}->[0]) eq 'ARRAY')
2744             {
2745 0           $numCol++;
2746 0           $self->{style} = 'yerror'; # temp style for data file generation
2747             }
2748 0           $hash{using} = join(':', (1 .. $numCol));
2749             }
2750 0 0         $self->_thaw() if (!-e $data); # generate data file
2751 0           $self->{style} = $styleTmp;
2752              
2753             # Generate gnuplot script for curve fitting
2754 0 0         open(FIT, ">$script") || confess("Can't generate script to $script");
2755 0           print FIT "set fit logfile \"$log\" errorvariables\n";
2756 0           print FIT "set print \"$result\"\n";
2757 0           print FIT "fit $hash{func} \"$data\" using $hash{using}".
2758             " via $paraString\n";
2759 0           print FIT "print $paraList\n";
2760 0           print FIT "print $errList\n";
2761 0           close(FIT);
2762              
2763             # Call gnuplot
2764 0           system("gnuplot $script >& /dev/null");
2765              
2766             # Read and parse the result file
2767 0 0         open(RES, $result) || confess("Can't read fitting result $result");
2768 0           chomp(my ($pLine, $eLine) = );
2769 0           close(RES);
2770              
2771             # Save the result in DataSet object
2772 0           my %param;
2773 0           my @pVal = split(/\s+/, $pLine);
2774 0           my @eVal = split(/\s+/, $eLine);
2775 0           my $fitted = '';
2776 0           for (my $i = 0; $i < @pVal; $i++)
2777             {
2778 0           $param{$params[$i]} = $pVal[$i];
2779 0           $param{$params[$i]."_err"} = $eVal[$i];
2780 0           $fitted .= "$params[$i] = $pVal[$i],";
2781             }
2782              
2783 0           $fitted .= $hash{func};
2784 0           my $outDS = Chart::Gnuplot::DataSet->new(
2785             func => $fitted,
2786             params => \%param,
2787             );
2788 0           return($outDS);
2789             }
2790              
2791              
2792             1;
2793              
2794             __END__