line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
package Lab::XPRESS::Data::XPRESS_plotter; |
2
|
|
|
|
|
|
|
#ABSTRACT: XPRESS plotting module |
3
|
|
|
|
|
|
|
$Lab::XPRESS::Data::XPRESS_plotter::VERSION = '3.880'; |
4
|
8
|
|
|
8
|
|
110
|
use v5.20; |
|
8
|
|
|
|
|
35
|
|
5
|
|
|
|
|
|
|
|
6
|
8
|
|
|
8
|
|
81
|
use strict; |
|
8
|
|
|
|
|
23
|
|
|
8
|
|
|
|
|
214
|
|
7
|
8
|
|
|
8
|
|
45
|
use Time::HiRes qw/gettimeofday tv_interval/; |
|
8
|
|
|
|
|
33
|
|
|
8
|
|
|
|
|
53
|
|
8
|
8
|
|
|
8
|
|
882
|
use Time::HiRes qw/usleep/, qw/time/; |
|
8
|
|
|
|
|
20
|
|
|
8
|
|
|
|
|
48
|
|
9
|
|
|
|
|
|
|
|
10
|
|
|
|
|
|
|
sub new { |
11
|
0
|
|
|
0
|
0
|
|
my $proto = shift; |
12
|
0
|
|
0
|
|
|
|
my $class = ref($proto) || $proto; |
13
|
0
|
|
|
|
|
|
my $filename = shift; |
14
|
0
|
|
|
|
|
|
my $plot; |
15
|
|
|
|
|
|
|
|
16
|
0
|
0
|
|
|
|
|
if ( ref( @_[0] ) eq 'HASH' ) { |
17
|
0
|
|
|
|
|
|
$plot = @_[0]; |
18
|
|
|
|
|
|
|
} |
19
|
|
|
|
|
|
|
else { |
20
|
0
|
|
|
|
|
|
$plot = shift; |
21
|
|
|
|
|
|
|
} |
22
|
|
|
|
|
|
|
|
23
|
0
|
|
|
|
|
|
my $self = bless { |
24
|
|
|
|
|
|
|
filename => $filename, |
25
|
|
|
|
|
|
|
plot => $plot |
26
|
|
|
|
|
|
|
}, $class; |
27
|
|
|
|
|
|
|
|
28
|
0
|
|
|
|
|
|
my %plot = %$plot; |
29
|
|
|
|
|
|
|
|
30
|
0
|
|
|
|
|
|
$self->{PAUSE} = -1 |
31
|
|
|
|
|
|
|
; # negative value ==> pause disabled, positive value ==> pause enabled |
32
|
|
|
|
|
|
|
|
33
|
0
|
0
|
|
|
|
|
if ( $self->{plot}->{refresh} eq 'block' ) { |
34
|
0
|
|
|
|
|
|
$self->{PAUSE} = 1; |
35
|
|
|
|
|
|
|
} |
36
|
|
|
|
|
|
|
|
37
|
0
|
|
|
|
|
|
$self->{gpipe} = $self->get_gnuplot_pipe(); |
38
|
|
|
|
|
|
|
|
39
|
0
|
|
|
|
|
|
return $self; |
40
|
|
|
|
|
|
|
} |
41
|
|
|
|
|
|
|
|
42
|
|
|
|
|
|
|
sub prepair_plot_config_data { |
43
|
0
|
|
|
0
|
0
|
|
my $self = shift; |
44
|
|
|
|
|
|
|
|
45
|
|
|
|
|
|
|
# prepair y-axis: |
46
|
0
|
0
|
|
|
|
|
if ( ref( $self->{plot}->{'y-axis'} ) ne 'ARRAY' ) { |
47
|
0
|
|
|
|
|
|
$self->{plot}->{'y-axis'} = [ $self->{plot}->{'y-axis'} ]; |
48
|
|
|
|
|
|
|
} |
49
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
# prepair y2-axis: |
51
|
0
|
0
|
|
|
|
|
if ( ref( $self->{plot}->{'y2-axis'} ) ne 'ARRAY' ) { |
52
|
0
|
|
|
|
|
|
$self->{plot}->{'y2-axis'} = [ $self->{plot}->{'y2-axis'} ]; |
53
|
|
|
|
|
|
|
} |
54
|
|
|
|
|
|
|
|
55
|
|
|
|
|
|
|
# replace columnames by columnumbers: |
56
|
0
|
0
|
|
|
|
|
if ( exists $self->{COLUMN_NAMES}{ $self->{plot}->{'x-axis'} } ) { |
57
|
|
|
|
|
|
|
$self->{plot}->{'x-axis'} |
58
|
0
|
|
|
|
|
|
= $self->{COLUMN_NAMES}{ $self->{plot}->{'x-axis'} }; |
59
|
|
|
|
|
|
|
} |
60
|
|
|
|
|
|
|
|
61
|
0
|
|
|
|
|
|
my $temp = (); |
62
|
0
|
|
|
|
|
|
foreach my $axis ( @{ $self->{plot}->{'y-axis'} } ) { |
|
0
|
|
|
|
|
|
|
63
|
0
|
0
|
|
|
|
|
if ( exists $self->{COLUMN_NAMES}{$axis} ) { |
|
|
0
|
|
|
|
|
|
64
|
0
|
|
|
|
|
|
push( @{$temp}, $self->{COLUMN_NAMES}{$axis} ); |
|
0
|
|
|
|
|
|
|
65
|
|
|
|
|
|
|
} |
66
|
|
|
|
|
|
|
elsif ( $axis <= $self->{NUMBER_OF_COLUMNS} ) { |
67
|
0
|
|
|
|
|
|
push( @{$temp}, $axis ); |
|
0
|
|
|
|
|
|
|
68
|
|
|
|
|
|
|
} |
69
|
|
|
|
|
|
|
else { |
70
|
0
|
|
|
|
|
|
print "$axis does not exist\n"; |
71
|
|
|
|
|
|
|
} |
72
|
0
|
|
|
|
|
|
$self->{plot}->{'y-axis'} = $temp; |
73
|
|
|
|
|
|
|
} |
74
|
|
|
|
|
|
|
|
75
|
0
|
|
|
|
|
|
my $temp = (); |
76
|
0
|
|
|
|
|
|
foreach my $axis ( @{ $self->{plot}->{'y2-axis'} } ) { |
|
0
|
|
|
|
|
|
|
77
|
0
|
0
|
|
|
|
|
if ( exists $self->{COLUMN_NAMES}{$axis} ) { |
|
|
0
|
|
|
|
|
|
78
|
0
|
|
|
|
|
|
push( @{$temp}, $self->{COLUMN_NAMES}{$axis} ); |
|
0
|
|
|
|
|
|
|
79
|
|
|
|
|
|
|
} |
80
|
|
|
|
|
|
|
elsif ( $axis <= $self->{NUMBER_OF_COLUMNS} ) { |
81
|
0
|
|
|
|
|
|
push( @{$temp}, $axis ); |
|
0
|
|
|
|
|
|
|
82
|
|
|
|
|
|
|
} |
83
|
0
|
|
|
|
|
|
$self->{plot}->{'y2-axis'} = $temp; |
84
|
|
|
|
|
|
|
} |
85
|
|
|
|
|
|
|
|
86
|
0
|
0
|
|
|
|
|
if ( exists $self->{COLUMN_NAMES}{ $self->{plot}->{'z-axis'} } ) { |
87
|
|
|
|
|
|
|
$self->{plot}->{'z-axis'} |
88
|
0
|
|
|
|
|
|
= $self->{COLUMN_NAMES}{ $self->{plot}->{'z-axis'} }; |
89
|
|
|
|
|
|
|
} |
90
|
|
|
|
|
|
|
|
91
|
0
|
0
|
|
|
|
|
if ( exists $self->{COLUMN_NAMES}{ $self->{plot}->{'cb-axis'} } ) { |
92
|
|
|
|
|
|
|
$self->{plot}->{'cb-axis'} |
93
|
0
|
|
|
|
|
|
= $self->{COLUMN_NAMES}{ $self->{plot}->{'cb-axis'} }; |
94
|
|
|
|
|
|
|
} |
95
|
|
|
|
|
|
|
|
96
|
|
|
|
|
|
|
} |
97
|
|
|
|
|
|
|
|
98
|
|
|
|
|
|
|
sub get_gnuplot_pipe { |
99
|
0
|
|
|
0
|
0
|
|
my $self = shift; |
100
|
0
|
|
|
|
|
|
my $gpname; |
101
|
0
|
0
|
|
|
|
|
if ( $^O =~ /MSWin32/ ) { |
102
|
0
|
|
|
|
|
|
$gpname = "gnuplot"; |
103
|
|
|
|
|
|
|
} |
104
|
|
|
|
|
|
|
else { |
105
|
0
|
|
|
|
|
|
$gpname = "gnuplot -noraise"; |
106
|
|
|
|
|
|
|
} |
107
|
0
|
0
|
|
|
|
|
if ( open my $GP, "| $gpname" ) { |
108
|
0
|
|
|
|
|
|
my $oldfh = select($GP); |
109
|
0
|
|
|
|
|
|
$| = 1; |
110
|
0
|
|
|
|
|
|
select($oldfh); |
111
|
0
|
|
|
|
|
|
return $GP; |
112
|
|
|
|
|
|
|
} |
113
|
0
|
|
|
|
|
|
return undef; |
114
|
|
|
|
|
|
|
} |
115
|
|
|
|
|
|
|
|
116
|
|
|
|
|
|
|
sub init_gnuplot { |
117
|
0
|
|
|
0
|
0
|
|
my $self = shift; |
118
|
|
|
|
|
|
|
|
119
|
0
|
|
|
|
|
|
$self->prepair_plot_config_data(); |
120
|
|
|
|
|
|
|
|
121
|
0
|
|
|
|
|
|
my %plot = %{ $self->{plot} }; |
|
0
|
|
|
|
|
|
|
122
|
0
|
|
|
|
|
|
my $gp; |
123
|
0
|
|
|
|
|
|
my $gpipe = $self->{gpipe}; |
124
|
|
|
|
|
|
|
|
125
|
0
|
|
|
|
|
|
$gp .= "set title font 'arial,18'\n"; |
126
|
0
|
|
|
|
|
|
$gp .= "set xlabel font 'arial,12'\n"; |
127
|
0
|
|
|
|
|
|
$gp .= "set ylabel font 'arial,12'\n"; |
128
|
0
|
|
|
|
|
|
$gp .= "set zlabel font 'arial,12'\n"; |
129
|
0
|
|
|
|
|
|
$gp .= "set cblabel font 'arial,12'\n"; |
130
|
0
|
|
|
|
|
|
$gp .= "set xtics font 'arial,10'\n"; |
131
|
0
|
|
|
|
|
|
$gp .= "set ytics font 'arial,10'\n"; |
132
|
0
|
|
|
|
|
|
$gp .= "set ztics font 'arial,10'\n"; |
133
|
0
|
|
|
|
|
|
$gp .= "set cbtics font 'arial,7'\n"; |
134
|
0
|
|
|
|
|
|
$gp .= "set format cb '%.4e'\n"; |
135
|
0
|
|
|
|
|
|
$gp .= "set key font 'arial,8' at graph 1,1.15\n"; |
136
|
0
|
|
|
|
|
|
$gp .= "set title offset -32,0.6\n"; |
137
|
|
|
|
|
|
|
|
138
|
|
|
|
|
|
|
# store column_names and axis index to gnuplot terminal: |
139
|
0
|
|
|
|
|
|
my $i = 1; |
140
|
0
|
|
|
|
|
|
while ( my ( $column, $index ) = each %{ $self->{COLUMN_NAMES} } ) { |
|
0
|
|
|
|
|
|
|
141
|
0
|
|
|
|
|
|
$column =~ s/\s+/_/g; #replace all whitespaces by '_' |
142
|
0
|
|
|
|
|
|
$column =~ s/\+/_/; #replace '+' by '_' |
143
|
0
|
|
|
|
|
|
$column =~ s/-/_/; #replace '-' by '_' |
144
|
0
|
|
|
|
|
|
$column =~ s/\//_/; #replace '/' by '_' |
145
|
0
|
|
|
|
|
|
$column =~ s/\*/_/; #replace '*' by '_' |
146
|
|
|
|
|
|
|
|
147
|
0
|
|
|
|
|
|
$gp .= "COLUMN_$index = '" . $column . "'; "; |
148
|
0
|
|
|
|
|
|
$i++; |
149
|
|
|
|
|
|
|
} |
150
|
0
|
|
|
|
|
|
print $gpipe $gp; |
151
|
0
|
|
|
|
|
|
$gp = ""; |
152
|
|
|
|
|
|
|
|
153
|
0
|
|
|
|
|
|
my $i = 1; |
154
|
0
|
|
|
|
|
|
foreach my $y ( @{ $self->{plot}->{'y-axis'} } ) { |
|
0
|
|
|
|
|
|
|
155
|
0
|
0
|
|
|
|
|
if ( not defined $y ) { next; } |
|
0
|
|
|
|
|
|
|
156
|
0
|
|
|
|
|
|
$gp .= "Y1$i = $y; "; |
157
|
0
|
|
|
|
|
|
$i++; |
158
|
|
|
|
|
|
|
} |
159
|
0
|
|
|
|
|
|
print $gpipe $gp; |
160
|
0
|
|
|
|
|
|
$gp = ""; |
161
|
|
|
|
|
|
|
|
162
|
0
|
|
|
|
|
|
my $i = 1; |
163
|
0
|
|
|
|
|
|
foreach my $y ( @{ $self->{plot}->{'y2-axis'} } ) { |
|
0
|
|
|
|
|
|
|
164
|
0
|
0
|
|
|
|
|
if ( not defined $y ) { next; } |
|
0
|
|
|
|
|
|
|
165
|
0
|
|
|
|
|
|
$gp .= "Y2$i = $y; "; |
166
|
0
|
|
|
|
|
|
$i++; |
167
|
|
|
|
|
|
|
} |
168
|
0
|
|
|
|
|
|
print $gpipe $gp; |
169
|
0
|
|
|
|
|
|
$gp = ""; |
170
|
|
|
|
|
|
|
|
171
|
0
|
|
|
|
|
|
$gp .= "X1 = " . $self->{plot}->{'x-axis'} . "; "; |
172
|
|
|
|
|
|
|
|
173
|
|
|
|
|
|
|
# prepair data selection: |
174
|
|
|
|
|
|
|
|
175
|
0
|
0
|
|
|
|
|
if ( not defined $self->{plot}->{LineIncrement} ) { |
176
|
0
|
|
|
|
|
|
$self->{plot}->{LineIncrement} = 1; |
177
|
|
|
|
|
|
|
} |
178
|
0
|
|
|
|
|
|
$gp .= "LineIncrement = " . $self->{plot}->{LineIncrement} . "; "; |
179
|
|
|
|
|
|
|
|
180
|
0
|
0
|
|
|
|
|
if ( not defined $self->{plot}->{BlockIncrement} ) { |
181
|
0
|
|
|
|
|
|
$self->{plot}->{BlockIncrement} = 1; |
182
|
|
|
|
|
|
|
} |
183
|
0
|
|
|
|
|
|
$gp .= "BlockIncrement = " . $self->{plot}->{BlockIncrement} . "; "; |
184
|
|
|
|
|
|
|
|
185
|
0
|
0
|
|
|
|
|
if ( not defined $self->{plot}->{LineFrom} ) { |
186
|
0
|
|
|
|
|
|
$self->{plot}->{LineFrom} = 0; |
187
|
|
|
|
|
|
|
} |
188
|
0
|
|
|
|
|
|
$gp .= "LineFrom = " . $self->{plot}->{LineFrom} . "; "; |
189
|
|
|
|
|
|
|
|
190
|
0
|
0
|
|
|
|
|
if ( not defined $self->{plot}->{BlockFrom} ) { |
191
|
0
|
|
|
|
|
|
$self->{plot}->{BlockFrom} = 0; |
192
|
|
|
|
|
|
|
} |
193
|
0
|
|
|
|
|
|
$gp .= "BlockFrom = " . $self->{plot}->{BlockFrom} . "; "; |
194
|
|
|
|
|
|
|
|
195
|
0
|
0
|
|
|
|
|
if ( not defined $self->{plot}->{LineTo} ) { |
196
|
0
|
|
|
|
|
|
$self->{plot}->{LineTo} = $self->{LINE_NUM}; |
197
|
|
|
|
|
|
|
} |
198
|
0
|
|
|
|
|
|
$gp .= "LineTo = " . $self->{plot}->{LineTo} . "; "; |
199
|
|
|
|
|
|
|
|
200
|
0
|
0
|
|
|
|
|
if ( not defined $self->{plot}->{BlockTo} ) { |
201
|
0
|
|
|
|
|
|
$self->{plot}->{BlockTo} = $self->{BLOCK_NUM}; |
202
|
|
|
|
|
|
|
} |
203
|
0
|
|
|
|
|
|
$gp .= "BlockTo = " . $self->{plot}->{BlockTo} . "; "; |
204
|
|
|
|
|
|
|
|
205
|
0
|
|
|
|
|
|
$gp .= "BLOCK_NUM = " . $self->{BLOCK_NUM} . "; "; |
206
|
0
|
|
|
|
|
|
$gp .= "LINE_NUM = " . $self->{LINE_NUM} . "; "; |
207
|
|
|
|
|
|
|
|
208
|
|
|
|
|
|
|
#$gp .= "show variables;\n"; |
209
|
0
|
|
|
|
|
|
print $gpipe $gp; |
210
|
0
|
|
|
|
|
|
$gp = ""; |
211
|
|
|
|
|
|
|
|
212
|
0
|
0
|
|
|
|
|
if ( defined $plot{'title'} ) { |
213
|
0
|
|
|
|
|
|
$gp .= "set title '$plot{'title'}'\n"; |
214
|
|
|
|
|
|
|
|
215
|
|
|
|
|
|
|
#print $gp."\n"; |
216
|
|
|
|
|
|
|
} |
217
|
|
|
|
|
|
|
|
218
|
0
|
0
|
|
|
|
|
if ( defined $plot{'y2-axis'}[0] ) { |
219
|
0
|
|
|
|
|
|
$gp .= "set y2tics\n"; |
220
|
0
|
|
|
|
|
|
$gp .= "set ytics nomirror\n"; |
221
|
|
|
|
|
|
|
} |
222
|
|
|
|
|
|
|
|
223
|
0
|
0
|
0
|
|
|
|
if ( defined $plot{'x-min'} or defined $plot{'x-max'} ) { |
224
|
0
|
|
|
|
|
|
$gp .= "set xrange [$plot{'x-min'}:$plot{'x-max'}]\n"; |
225
|
|
|
|
|
|
|
|
226
|
|
|
|
|
|
|
#print $gp."\n"; |
227
|
|
|
|
|
|
|
} |
228
|
|
|
|
|
|
|
|
229
|
0
|
0
|
0
|
|
|
|
if ( defined $plot{'y-min'} or defined $plot{'y-max'} ) { |
230
|
0
|
|
|
|
|
|
$gp .= "set yrange [$plot{'y-min'}:$plot{'y-max'}]\n"; |
231
|
|
|
|
|
|
|
|
232
|
|
|
|
|
|
|
#print $gp."\n"; |
233
|
|
|
|
|
|
|
} |
234
|
|
|
|
|
|
|
|
235
|
0
|
0
|
0
|
|
|
|
if ( defined $plot{'z-min'} or defined $plot{'z-max'} ) { |
236
|
0
|
|
|
|
|
|
$gp .= "set zrange [$plot{'z-min'}:$plot{'z-max'}]\n"; |
237
|
|
|
|
|
|
|
|
238
|
|
|
|
|
|
|
#print $gp."\n"; |
239
|
|
|
|
|
|
|
} |
240
|
|
|
|
|
|
|
|
241
|
0
|
0
|
0
|
|
|
|
if ( defined $plot{'cb-min'} or defined $plot{'cb-max'} ) { |
242
|
0
|
|
|
|
|
|
$gp .= "set cbrange [$plot{'cb-min'}:$plot{'cb-max'}]\n"; |
243
|
|
|
|
|
|
|
|
244
|
|
|
|
|
|
|
#print $gp."\n"; |
245
|
|
|
|
|
|
|
} |
246
|
|
|
|
|
|
|
|
247
|
0
|
0
|
|
|
|
|
if ( defined $plot{'x-format'} ) { |
248
|
0
|
|
|
|
|
|
$gp .= "set format x '" . $plot{'x-format'} . "'\n"; |
249
|
|
|
|
|
|
|
} |
250
|
|
|
|
|
|
|
|
251
|
0
|
0
|
|
|
|
|
if ( defined $plot{'y-format'} ) { |
252
|
0
|
|
|
|
|
|
$gp .= "set format y '" . $plot{'y-format'} . "'\n"; |
253
|
|
|
|
|
|
|
} |
254
|
|
|
|
|
|
|
|
255
|
0
|
0
|
|
|
|
|
if ( defined $plot{'y2-format'} ) { |
256
|
0
|
|
|
|
|
|
$gp .= "set format y2 '" . $plot{'y2-format'} . "'\n"; |
257
|
|
|
|
|
|
|
} |
258
|
|
|
|
|
|
|
|
259
|
0
|
0
|
|
|
|
|
if ( defined $plot{'z-format'} ) { |
260
|
0
|
|
|
|
|
|
$gp .= "set format z '" . $plot{'z-format'} . "'\n"; |
261
|
|
|
|
|
|
|
} |
262
|
|
|
|
|
|
|
|
263
|
0
|
0
|
|
|
|
|
if ( defined $plot{'cb-format'} ) { |
264
|
0
|
|
|
|
|
|
$gp .= "set format cb '" . $plot{'cb-format'} . "'\n"; |
265
|
|
|
|
|
|
|
} |
266
|
|
|
|
|
|
|
|
267
|
0
|
0
|
|
|
|
|
if ( defined $plot{'x-label'} ) { |
|
|
0
|
|
|
|
|
|
268
|
0
|
|
|
|
|
|
$gp .= "set xlabel '$plot{'x-label'}'\n"; |
269
|
|
|
|
|
|
|
} |
270
|
|
|
|
|
|
|
elsif ( defined $plot{'x-axis'} ) { |
271
|
0
|
|
|
|
|
|
my $i = $plot{'x-axis'}; |
272
|
0
|
|
|
|
|
|
$gp .= "set xlabel COLUMN_$i\n"; |
273
|
|
|
|
|
|
|
} |
274
|
|
|
|
|
|
|
|
275
|
0
|
0
|
|
|
|
|
if ( defined $plot{'y-label'} ) { |
|
|
0
|
|
|
|
|
|
276
|
0
|
|
|
|
|
|
$gp .= "set ylabel '$plot{'y-label'}'\n"; |
277
|
|
|
|
|
|
|
} |
278
|
|
|
|
|
|
|
elsif ( defined $plot{'y-axis'} ) { |
279
|
0
|
|
|
|
|
|
my $i = $plot{'y-axis'}[0]; |
280
|
0
|
0
|
|
|
|
|
if ( $i ne "" ) { $gp .= "set ylabel COLUMN_$i\n"; }; |
|
0
|
|
|
|
|
|
|
281
|
|
|
|
|
|
|
} |
282
|
|
|
|
|
|
|
|
283
|
0
|
0
|
|
|
|
|
if ( defined $plot{'y2-label'} ) { |
|
|
0
|
|
|
|
|
|
284
|
0
|
|
|
|
|
|
$gp .= "set y2label '$plot{'y2-label'}'\n"; |
285
|
|
|
|
|
|
|
} |
286
|
|
|
|
|
|
|
elsif ( defined $plot{'y2-axis'} ) { |
287
|
0
|
|
|
|
|
|
my $i = $plot{'y2-axis'}[0]; |
288
|
0
|
0
|
|
|
|
|
if ( $i ne "" ) { $gp .= "set y2label COLUMN_$i\n"; }; |
|
0
|
|
|
|
|
|
|
289
|
|
|
|
|
|
|
} |
290
|
|
|
|
|
|
|
|
291
|
0
|
0
|
|
|
|
|
if ( defined $plot{'z-label'} ) { |
|
|
0
|
|
|
|
|
|
292
|
0
|
|
|
|
|
|
$gp .= "set zlabel '$plot{'z-label'}'\n"; |
293
|
|
|
|
|
|
|
} |
294
|
|
|
|
|
|
|
elsif ( defined $plot{'z-axis'} ) { |
295
|
0
|
|
|
|
|
|
my $i = $plot{'z-axis'}; |
296
|
0
|
|
|
|
|
|
$gp .= "set zlabel COLUMN_$i\n"; |
297
|
|
|
|
|
|
|
} |
298
|
|
|
|
|
|
|
|
299
|
0
|
0
|
|
|
|
|
if ( defined $plot{'cb-label'} ) { |
|
|
0
|
|
|
|
|
|
300
|
0
|
|
|
|
|
|
$gp .= "set cblabel '$plot{'cb-label'}'\n"; |
301
|
|
|
|
|
|
|
} |
302
|
|
|
|
|
|
|
elsif ( defined $plot{'cb-axis'} ) { |
303
|
0
|
|
|
|
|
|
my $i = $plot{'cb-axis'}; |
304
|
0
|
|
|
|
|
|
$gp .= "set cblabel COLUMN_$i\n"; |
305
|
|
|
|
|
|
|
} |
306
|
|
|
|
|
|
|
|
307
|
0
|
0
|
|
|
|
|
if ( defined $plot{'grid'} ) { |
308
|
0
|
|
|
|
|
|
$gp .= "set grid $plot{'grid'}\n"; |
309
|
|
|
|
|
|
|
} |
310
|
|
|
|
|
|
|
|
311
|
0
|
0
|
|
|
|
|
if ( not defined $plot{'x-axis'} ) { |
312
|
0
|
|
|
|
|
|
die "Error while plotting data. x-axis is not defined."; |
313
|
|
|
|
|
|
|
} |
314
|
|
|
|
|
|
|
|
315
|
0
|
0
|
|
|
|
|
if ( not defined $plot{'y-axis'} ) { |
316
|
0
|
|
|
|
|
|
die "Error while plotting data. y-axis is not defined."; |
317
|
|
|
|
|
|
|
} |
318
|
|
|
|
|
|
|
|
319
|
0
|
0
|
0
|
|
|
|
if ( not defined $plot{'z-axis'} |
|
|
|
0
|
|
|
|
|
320
|
|
|
|
|
|
|
and not defined $plot{'cb-axis'} |
321
|
|
|
|
|
|
|
and $plot{'type'} eq 'pm3d' ) { |
322
|
0
|
|
|
|
|
|
die |
323
|
|
|
|
|
|
|
"Error while plotting data. Plot type = pm3d: z-axis and/or cb-axis are not defined."; |
324
|
|
|
|
|
|
|
} |
325
|
|
|
|
|
|
|
|
326
|
0
|
|
|
|
|
|
%{ $self->{plot} } = %plot; |
|
0
|
|
|
|
|
|
|
327
|
|
|
|
|
|
|
|
328
|
0
|
|
|
|
|
|
print $gpipe $gp; |
329
|
0
|
|
|
|
|
|
usleep(1e4); |
330
|
|
|
|
|
|
|
|
331
|
0
|
|
|
|
|
|
return $gpipe; |
332
|
|
|
|
|
|
|
|
333
|
|
|
|
|
|
|
} |
334
|
|
|
|
|
|
|
|
335
|
|
|
|
|
|
|
sub init_gnuplot_bindings { |
336
|
0
|
|
|
0
|
0
|
|
my $self = shift; |
337
|
|
|
|
|
|
|
|
338
|
0
|
|
|
|
|
|
$self->bind_s(); |
339
|
0
|
|
|
|
|
|
$self->bind_x(); |
340
|
0
|
|
|
|
|
|
$self->bind_y(); |
341
|
|
|
|
|
|
|
|
342
|
0
|
0
|
|
|
|
|
if ( defined $self->{plot}->{'z-axis'} ) { |
343
|
0
|
|
|
|
|
|
$self->bind_z(); |
344
|
|
|
|
|
|
|
} |
345
|
|
|
|
|
|
|
|
346
|
0
|
0
|
|
|
|
|
if ( defined $self->{plot}->{'cb-axis'} ) { |
347
|
0
|
|
|
|
|
|
$self->bind_c(); |
348
|
|
|
|
|
|
|
} |
349
|
|
|
|
|
|
|
|
350
|
|
|
|
|
|
|
} |
351
|
|
|
|
|
|
|
|
352
|
|
|
|
|
|
|
sub toggle_pause { |
353
|
0
|
|
|
0
|
0
|
|
my $self = shift; |
354
|
|
|
|
|
|
|
|
355
|
0
|
|
|
|
|
|
$self->{PAUSE} *= -1; |
356
|
|
|
|
|
|
|
|
357
|
0
|
|
|
|
|
|
return; |
358
|
|
|
|
|
|
|
} |
359
|
|
|
|
|
|
|
|
360
|
|
|
|
|
|
|
sub start_plot { |
361
|
0
|
|
|
0
|
0
|
|
my $self = shift; |
362
|
0
|
|
|
|
|
|
my $block_num = shift; |
363
|
0
|
|
|
|
|
|
my $filename = $self->{filename}; |
364
|
0
|
|
|
|
|
|
my $gp; |
365
|
0
|
|
|
|
|
|
my $gpipe = $self->{gpipe}; |
366
|
|
|
|
|
|
|
|
367
|
0
|
|
|
|
|
|
print "Starting plot\n"; |
368
|
|
|
|
|
|
|
|
369
|
|
|
|
|
|
|
# if plot mode == pm3d, then change to other start routine: |
370
|
0
|
0
|
0
|
|
|
|
if ( $self->{plot}->{'type'} eq 'pm3d' and $block_num <= 1 ) { |
|
|
0
|
0
|
|
|
|
|
371
|
0
|
|
|
|
|
|
return 1; |
372
|
|
|
|
|
|
|
} |
373
|
|
|
|
|
|
|
elsif ( $self->{plot}->{'type'} eq 'pm3d' and $block_num > 1 ) { |
374
|
0
|
|
|
|
|
|
$self->start_plot_pm3d($block_num); |
375
|
0
|
|
|
|
|
|
return 1; |
376
|
|
|
|
|
|
|
} |
377
|
|
|
|
|
|
|
|
378
|
0
|
|
|
|
|
|
my $gpipe = $self->{gpipe}; |
379
|
0
|
|
|
|
|
|
print $gpipe $gp; |
380
|
|
|
|
|
|
|
|
381
|
|
|
|
|
|
|
# create PLOT-command: |
382
|
|
|
|
|
|
|
|
383
|
|
|
|
|
|
|
#-------------------------------------------------------------------------------------------------# |
384
|
|
|
|
|
|
|
#---- y1-axis ------------------------------------------------------------------------------------# |
385
|
|
|
|
|
|
|
#-------------------------------------------------------------------------------------------------# |
386
|
0
|
|
|
|
|
|
my $i = 1; |
387
|
0
|
|
|
|
|
|
$gp = "plot "; |
388
|
0
|
|
|
|
|
|
foreach my $y ( @{ $self->{plot}->{'y-axis'} } ) { |
|
0
|
|
|
|
|
|
|
389
|
0
|
0
|
|
|
|
|
if ( not defined $y ) { |
390
|
0
|
|
|
|
|
|
next; |
391
|
|
|
|
|
|
|
} |
392
|
|
|
|
|
|
|
|
393
|
0
|
0
|
|
|
|
|
if ( not defined $self->{plot}->{'type'} ) { |
394
|
0
|
|
|
|
|
|
$self->{plot}->{'type'} = 'point'; |
395
|
|
|
|
|
|
|
} |
396
|
|
|
|
|
|
|
|
397
|
0
|
0
|
|
|
|
|
if ( $self->{plot}->{'type'} |
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
398
|
|
|
|
|
|
|
=~ /\b(line|lines|LINE|LINES|L|l|ln|LN)\b/ ) { |
399
|
0
|
0
|
|
|
|
|
if ( $block_num > 1 ) { |
400
|
|
|
|
|
|
|
|
401
|
|
|
|
|
|
|
#my $parameter = $self->{plot}->{'x-axis'}; |
402
|
0
|
|
|
|
|
|
my $old_blocks = $block_num - 2; |
403
|
0
|
|
|
|
|
|
my $current_block = $block_num - 1; |
404
|
0
|
|
|
|
|
|
$gp |
405
|
|
|
|
|
|
|
.= "'$filename' using X1:Y1$i every :::0::$old_blocks with lines,"; |
406
|
0
|
|
|
|
|
|
$gp .= "'$filename' using X1:Y1$i every :::$current_block" |
407
|
|
|
|
|
|
|
. "::$current_block with lines,"; |
408
|
|
|
|
|
|
|
} |
409
|
|
|
|
|
|
|
else { |
410
|
|
|
|
|
|
|
#my $parameter = $self->{plot}->{'x-axis'}; |
411
|
0
|
|
|
|
|
|
$gp .= "'$filename' using X1:Y1$i with lines,"; |
412
|
|
|
|
|
|
|
} |
413
|
|
|
|
|
|
|
} |
414
|
|
|
|
|
|
|
elsif ( $self->{plot}->{'type'} |
415
|
|
|
|
|
|
|
=~ /\b(linetrace|LINETRACE|trace|TRACE)\b/ ) { |
416
|
|
|
|
|
|
|
|
417
|
|
|
|
|
|
|
#my $parameter = $self->{plot}->{'x-axis'}; |
418
|
0
|
0
|
|
|
|
|
my $block_old |
419
|
|
|
|
|
|
|
= ( $block_num - 2 < 0 ) ? $block_num - 1 : $block_num - 2; |
420
|
0
|
0
|
|
|
|
|
my $block_new |
421
|
|
|
|
|
|
|
= ( $block_num - 1 < 0 ) ? $block_num : $block_num - 1; |
422
|
0
|
|
|
|
|
|
$gp .= "'$filename' using X1:Y1$i every :::$block_old" |
423
|
|
|
|
|
|
|
. "::$block_old with lines,"; |
424
|
0
|
|
|
|
|
|
$gp .= "'$filename' using X1:Y1$i every :::$block_new" |
425
|
|
|
|
|
|
|
. "::$block_new with points"; |
426
|
|
|
|
|
|
|
} |
427
|
|
|
|
|
|
|
elsif ( $self->{plot}->{'type'} =~ /\b(single|SINGLE)\b/ ) { |
428
|
0
|
0
|
|
|
|
|
if ( $block_num > 1 ) { |
429
|
|
|
|
|
|
|
|
430
|
|
|
|
|
|
|
#my $parameter = $self->{plot}->{'x-axis'}; |
431
|
0
|
|
|
|
|
|
my $current_block = $block_num - 1; |
432
|
0
|
|
|
|
|
|
$gp .= "'$filename' using X1:Y1$i every :::$current_block" |
433
|
|
|
|
|
|
|
. "::$current_block with lines,"; |
434
|
|
|
|
|
|
|
} |
435
|
|
|
|
|
|
|
else { |
436
|
|
|
|
|
|
|
#my $parameter = $self->{plot}->{'x-axis'}; |
437
|
0
|
|
|
|
|
|
$gp .= "'$filename' using X1:Y1$i with lines,"; |
438
|
|
|
|
|
|
|
} |
439
|
|
|
|
|
|
|
} |
440
|
|
|
|
|
|
|
elsif ( $self->{plot}->{'type'} =~ /\b(rainbow|RAINBOW)\b/ ) { |
441
|
0
|
0
|
|
|
|
|
if ( $block_num > 1 ) { |
442
|
|
|
|
|
|
|
|
443
|
|
|
|
|
|
|
#my $parameter = $self->{plot}->{'x-axis'}; |
444
|
0
|
|
|
|
|
|
foreach my $block ( 0 .. $block_num - 1 ) { |
445
|
0
|
|
|
|
|
|
$gp .= "'$filename' using X1:Y1$i every :::$block" |
446
|
|
|
|
|
|
|
. "::$block with lines lt $block ti 'M_$block',"; |
447
|
|
|
|
|
|
|
} |
448
|
|
|
|
|
|
|
} |
449
|
|
|
|
|
|
|
else { |
450
|
|
|
|
|
|
|
#my $parameter = $self->{plot}->{'x-axis'}; |
451
|
0
|
|
|
|
|
|
$gp .= "'$filename' using X1:Y1$i with lines,"; |
452
|
|
|
|
|
|
|
} |
453
|
|
|
|
|
|
|
} |
454
|
|
|
|
|
|
|
elsif ( $self->{plot}->{'type'} |
455
|
|
|
|
|
|
|
=~ /\b(points|point|POINTS|POINT|P|p|pt|PT)\b/ ) { |
456
|
0
|
0
|
|
|
|
|
if ( $block_num > 1 ) { |
457
|
|
|
|
|
|
|
|
458
|
|
|
|
|
|
|
#my $parameter = $self->{plot}->{'x-axis'}; |
459
|
0
|
|
|
|
|
|
my $old_blocks = $block_num - 2; |
460
|
0
|
|
|
|
|
|
my $current_block = $block_num - 1; |
461
|
0
|
|
|
|
|
|
$gp |
462
|
|
|
|
|
|
|
.= "'$filename' using X1:Y1$i every :::0::$old_blocks with lines,"; |
463
|
0
|
|
|
|
|
|
$gp .= "'$filename' using X1:Y1$i every :::$current_block" |
464
|
|
|
|
|
|
|
. "::$current_block with points,"; |
465
|
|
|
|
|
|
|
} |
466
|
|
|
|
|
|
|
else { |
467
|
|
|
|
|
|
|
#my $parameter = $self->{plot}->{'x-axis'}; |
468
|
0
|
|
|
|
|
|
$gp .= "'$filename' using X1:Y1$i with points,"; |
469
|
|
|
|
|
|
|
} |
470
|
|
|
|
|
|
|
} |
471
|
|
|
|
|
|
|
elsif ( $self->{plot}->{'type'} =~ /\b(man|MAN|empty|EMPTY)\b/ ) { |
472
|
0
|
|
|
|
|
|
$gp .= "'$filename',"; |
473
|
|
|
|
|
|
|
} |
474
|
|
|
|
|
|
|
elsif ( $self->{plot}->{'type'} eq 'PlotterGUI' ) { |
475
|
0
|
|
|
|
|
|
$gp .= "'$self->{plot}->{filename}' "; |
476
|
0
|
|
|
|
|
|
$gp .= "using X1:Y1$i axis x1y1 "; |
477
|
0
|
|
|
|
|
|
$gp |
478
|
|
|
|
|
|
|
.= "every LineIncrement:BlockIncrement:LineFrom:BlockFrom:LineTo:BlockTo "; |
479
|
0
|
|
|
|
|
|
$gp .= "with @{$self->{plot}->{y_LineStyle}}[$i] "; |
|
0
|
|
|
|
|
|
|
480
|
0
|
0
|
|
|
|
|
if ( @{ $self->{plot}->{y_LineStyle} }[$i] =~ /lines/ ) { |
|
0
|
|
|
|
|
|
|
481
|
0
|
|
|
|
|
|
$gp .= "linecolor '@{$self->{plot}->{y_LineColor}}[$i]' "; |
|
0
|
|
|
|
|
|
|
482
|
0
|
|
|
|
|
|
$gp .= "linewidth '@{$self->{plot}->{y_LineSize}}[$i]' "; |
|
0
|
|
|
|
|
|
|
483
|
|
|
|
|
|
|
} |
484
|
0
|
0
|
|
|
|
|
if ( @{ $self->{plot}->{y1_style} }[$i] =~ /points/ ) { |
|
0
|
|
|
|
|
|
|
485
|
0
|
|
|
|
|
|
$gp .= "pointtype 13 "; |
486
|
0
|
|
|
|
|
|
$gp .= "pointsize '@{$self->{plot}->{y_LineSize}}[$i]' "; |
|
0
|
|
|
|
|
|
|
487
|
|
|
|
|
|
|
} |
488
|
0
|
|
|
|
|
|
$gp .= "ti '@{$self->{plot}->{y_ColumnLabel}}[$i]' "; |
|
0
|
|
|
|
|
|
|
489
|
|
|
|
|
|
|
|
490
|
|
|
|
|
|
|
} |
491
|
0
|
|
|
|
|
|
$i++; |
492
|
|
|
|
|
|
|
} |
493
|
|
|
|
|
|
|
|
494
|
|
|
|
|
|
|
#-------------------------------------------------------------------------------------------------# |
495
|
|
|
|
|
|
|
#---- y2-axis ------------------------------------------------------------------------------------# |
496
|
|
|
|
|
|
|
#-------------------------------------------------------------------------------------------------# |
497
|
0
|
|
|
|
|
|
my $i = 1; |
498
|
0
|
|
|
|
|
|
foreach my $y ( @{ $self->{plot}->{'y2-axis'} } ) { |
|
0
|
|
|
|
|
|
|
499
|
0
|
0
|
|
|
|
|
if ( not defined $y ) { |
500
|
0
|
|
|
|
|
|
next; |
501
|
|
|
|
|
|
|
} |
502
|
0
|
0
|
|
|
|
|
if ( $self->{plot}->{'type'} |
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
503
|
|
|
|
|
|
|
=~ /\b(line|lines|LINE|LINES|L|l|ln|LN)\b/ ) { |
504
|
0
|
0
|
|
|
|
|
if ( $block_num > 1 ) { |
505
|
|
|
|
|
|
|
|
506
|
|
|
|
|
|
|
#my $parameter = $self->{plot}->{'x-axis'}; |
507
|
0
|
|
|
|
|
|
my $old_blocks = $block_num - 2; |
508
|
0
|
|
|
|
|
|
my $current_block = $block_num - 1; |
509
|
0
|
|
|
|
|
|
$gp |
510
|
|
|
|
|
|
|
.= "'$filename' using X1:Y2$i axis x1y2 every :::0::$old_blocks with lines,"; |
511
|
0
|
|
|
|
|
|
$gp |
512
|
|
|
|
|
|
|
.= "'$filename' using X1:Y2$i axis x1y2 every :::$current_block" |
513
|
|
|
|
|
|
|
. "::$current_block with lines,"; |
514
|
|
|
|
|
|
|
} |
515
|
|
|
|
|
|
|
else { |
516
|
|
|
|
|
|
|
#my $parameter = $self->{plot}->{'x-axis'}; |
517
|
0
|
|
|
|
|
|
$gp .= "'$filename' using X1:Y2$i axis x1y2 with lines,"; |
518
|
|
|
|
|
|
|
} |
519
|
|
|
|
|
|
|
} |
520
|
|
|
|
|
|
|
elsif ( $self->{plot}->{'type'} |
521
|
|
|
|
|
|
|
=~ /\b(linetrace|LINETRACE|trace|TRACE)\b/ ) { |
522
|
|
|
|
|
|
|
|
523
|
|
|
|
|
|
|
#my $parameter = $self->{plot}->{'x-axis'}; |
524
|
0
|
0
|
|
|
|
|
my $block_old |
525
|
|
|
|
|
|
|
= ( $block_num - 2 < 0 ) ? $block_num - 1 : $block_num - 2; |
526
|
0
|
0
|
|
|
|
|
my $block_new |
527
|
|
|
|
|
|
|
= ( $block_num - 1 < 0 ) ? $block_num : $block_num - 1; |
528
|
0
|
|
|
|
|
|
$gp .= "'$filename' using X1:Y1$i axis x1y2 every :::$block_old" |
529
|
|
|
|
|
|
|
. "::$block_old with lines,"; |
530
|
0
|
|
|
|
|
|
$gp .= "'$filename' using X1:Y1$i axis x1y2 every :::$block_new" |
531
|
|
|
|
|
|
|
. "::$block_new with points"; |
532
|
|
|
|
|
|
|
} |
533
|
|
|
|
|
|
|
elsif ( $self->{plot}->{'type'} =~ /\b(single|SINGLE)\b/ ) { |
534
|
0
|
0
|
|
|
|
|
if ( $block_num > 1 ) { |
535
|
|
|
|
|
|
|
|
536
|
|
|
|
|
|
|
#my $parameter = $self->{plot}->{'x-axis'}; |
537
|
0
|
|
|
|
|
|
my $current_block = $block_num - 1; |
538
|
0
|
|
|
|
|
|
$gp |
539
|
|
|
|
|
|
|
.= "'$filename' using X1:Y2$i axis x1y2 every :::$current_block" |
540
|
|
|
|
|
|
|
. "::$current_block with lines,"; |
541
|
|
|
|
|
|
|
} |
542
|
|
|
|
|
|
|
else { |
543
|
|
|
|
|
|
|
#my $parameter = $self->{plot}->{'x-axis'}; |
544
|
0
|
|
|
|
|
|
$gp .= "'$filename' using X1:Y2$i axis x1y2 with lines,"; |
545
|
|
|
|
|
|
|
} |
546
|
|
|
|
|
|
|
} |
547
|
|
|
|
|
|
|
elsif ( $self->{plot}->{'type'} =~ /\b(rainbow|RAINBOW)\b/ ) { |
548
|
0
|
0
|
|
|
|
|
if ( $block_num > 1 ) { |
549
|
|
|
|
|
|
|
|
550
|
|
|
|
|
|
|
#my $parameter = $self->{plot}->{'x-axis'}; |
551
|
0
|
|
|
|
|
|
foreach my $block ( 0 .. $block_num - 1 ) { |
552
|
0
|
|
|
|
|
|
$gp |
553
|
|
|
|
|
|
|
.= "'$filename' using X1:Y2$i axis x1y2 every :::$block" |
554
|
|
|
|
|
|
|
. "::$block with lines lt $block ti 'M_$block',"; |
555
|
|
|
|
|
|
|
} |
556
|
|
|
|
|
|
|
} |
557
|
|
|
|
|
|
|
else { |
558
|
|
|
|
|
|
|
#my $parameter = $self->{plot}->{'x-axis'}; |
559
|
0
|
|
|
|
|
|
$gp .= "'$filename' using X1:Y2$i axis x1y2 with lines,"; |
560
|
|
|
|
|
|
|
} |
561
|
|
|
|
|
|
|
} |
562
|
|
|
|
|
|
|
elsif ( $self->{plot}->{'type'} |
563
|
|
|
|
|
|
|
=~ /\b(points|point|POINTS|POINT|P|p|pt|PT)\b/ ) { |
564
|
0
|
0
|
|
|
|
|
if ( $block_num > 1 ) { |
565
|
|
|
|
|
|
|
|
566
|
|
|
|
|
|
|
#my $parameter = $self->{plot}->{'x-axis'}; |
567
|
0
|
|
|
|
|
|
my $old_blocks = $block_num - 2; |
568
|
0
|
|
|
|
|
|
my $current_block = $block_num - 1; |
569
|
0
|
|
|
|
|
|
$gp |
570
|
|
|
|
|
|
|
.= "'$filename' using X1:Y2$i axis x1y2 every :::0::$old_blocks with lines,"; |
571
|
0
|
|
|
|
|
|
$gp |
572
|
|
|
|
|
|
|
.= "'$filename' using X1:Y2$i axis x1y2 every :::$current_block" |
573
|
|
|
|
|
|
|
. "::$current_block with points,"; |
574
|
|
|
|
|
|
|
} |
575
|
|
|
|
|
|
|
else { |
576
|
|
|
|
|
|
|
#my $parameter = $self->{plot}->{'x-axis'}; |
577
|
0
|
|
|
|
|
|
$gp .= "'$filename' using X1:Y2$i axis x1y2 with points,"; |
578
|
|
|
|
|
|
|
} |
579
|
|
|
|
|
|
|
} |
580
|
|
|
|
|
|
|
elsif ( $self->{plot}->{'type'} =~ /\b(man|MAN|empty|EMPTY)\b/ ) { |
581
|
0
|
|
|
|
|
|
$gp .= "'$filename',"; |
582
|
|
|
|
|
|
|
} |
583
|
0
|
|
|
|
|
|
$i++; |
584
|
|
|
|
|
|
|
} |
585
|
0
|
|
|
|
|
|
chop $gp; |
586
|
0
|
|
|
|
|
|
$gp .= "\n"; |
587
|
0
|
|
|
|
|
|
my $gpipe = $self->{gpipe}; |
588
|
0
|
|
|
|
|
|
print $gpipe $gp; |
589
|
|
|
|
|
|
|
|
590
|
0
|
|
|
|
|
|
$self->{plot}->{started} = 'started'; |
591
|
|
|
|
|
|
|
|
592
|
0
|
|
|
|
|
|
$self->bind_s(); |
593
|
|
|
|
|
|
|
|
594
|
0
|
|
|
|
|
|
return $self; |
595
|
|
|
|
|
|
|
|
596
|
|
|
|
|
|
|
} |
597
|
|
|
|
|
|
|
|
598
|
|
|
|
|
|
|
sub start_plot_pm3d { |
599
|
0
|
|
|
0
|
0
|
|
my $self = shift; |
600
|
0
|
|
|
|
|
|
my $block_num = shift; |
601
|
|
|
|
|
|
|
|
602
|
0
|
|
|
|
|
|
my $filename = $self->{filename}; |
603
|
0
|
|
|
|
|
|
my $gp; |
604
|
|
|
|
|
|
|
|
605
|
0
|
|
|
|
|
|
my $gpipe = $self->get_gnuplot_pipe(); |
606
|
|
|
|
|
|
|
|
607
|
0
|
|
|
|
|
|
$gp .= "#\n# Set color plot\n"; |
608
|
0
|
|
|
|
|
|
$gp .= "set pm3d map corners2color c1\n"; |
609
|
0
|
|
|
|
|
|
$gp .= "set view map\n"; |
610
|
0
|
|
|
|
|
|
$gp .= "set key font 'arial,8' at graph 1,1.15 \n"; |
611
|
|
|
|
|
|
|
|
612
|
|
|
|
|
|
|
#$gp.="set palette ".$self->{meta}->plot_palette($plot)."\n"; |
613
|
|
|
|
|
|
|
|
614
|
0
|
|
|
|
|
|
$gp .= "set border 4095 front linetype -1 linewidth 1.000\n"; |
615
|
0
|
|
|
|
|
|
$gp .= "set style data pm3d\n"; |
616
|
0
|
|
|
|
|
|
$gp .= "set style function pm3d\n"; |
617
|
0
|
|
|
|
|
|
$gp .= "set ticslevel 0\n"; |
618
|
0
|
|
|
|
|
|
$gp .= "set size 0.95,1\n"; |
619
|
|
|
|
|
|
|
|
620
|
0
|
|
|
|
|
|
$gp .= "set title offset -23,0.2\n"; |
621
|
|
|
|
|
|
|
|
622
|
0
|
0
|
|
|
|
|
if ( ref( $self->{plot}->{'x-axis'} ) eq 'ARRAY' ) { |
623
|
0
|
|
|
|
|
|
$self->{plot}->{'x-axis'} = $self->{plot}->{'x-axis'}[0]; |
624
|
|
|
|
|
|
|
} |
625
|
0
|
0
|
|
|
|
|
if ( ref( $self->{plot}->{'y-axis'} ) eq 'ARRAY' ) { |
626
|
0
|
|
|
|
|
|
$self->{plot}->{'y-axis'} = $self->{plot}->{'y-axis'}[0]; |
627
|
|
|
|
|
|
|
} |
628
|
0
|
0
|
|
|
|
|
if ( ref( $self->{plot}->{'z-axis'} ) eq 'ARRAY' ) { |
629
|
0
|
|
|
|
|
|
$self->{plot}->{'z-axis'} = $self->{plot}->{'z-axis'}[0]; |
630
|
|
|
|
|
|
|
} |
631
|
0
|
0
|
|
|
|
|
if ( ref( $self->{plot}->{'cb-axis'} ) eq 'ARRAY' ) { |
632
|
0
|
|
|
|
|
|
$self->{plot}->{'cb-axis'} = $self->{plot}->{'cb-axis'}[0]; |
633
|
|
|
|
|
|
|
} |
634
|
|
|
|
|
|
|
|
635
|
0
|
|
|
|
|
|
$gp .= "X1 = " . $self->{plot}->{'x-axis'} . ";"; |
636
|
0
|
|
|
|
|
|
$gp .= "Y11 = " . $self->{plot}->{'y-axis'} . ";"; |
637
|
0
|
0
|
|
|
|
|
if ( defined $self->{plot}->{'z-axis'} ) { |
638
|
0
|
|
|
|
|
|
$gp .= "Z = " . $self->{plot}->{'z-axis'} . ";"; |
639
|
|
|
|
|
|
|
} |
640
|
0
|
0
|
|
|
|
|
if ( defined $self->{plot}->{'cb-axis'} ) { |
641
|
0
|
|
|
|
|
|
$gp .= "CB = " . $self->{plot}->{'cb-axis'} . ";"; |
642
|
|
|
|
|
|
|
} |
643
|
|
|
|
|
|
|
|
644
|
0
|
|
|
|
|
|
$gp .= "\n"; |
645
|
0
|
|
|
|
|
|
my $gpipe = $self->{gpipe}; |
646
|
0
|
|
|
|
|
|
print $gpipe $gp; |
647
|
0
|
|
|
|
|
|
$gp = ""; |
648
|
|
|
|
|
|
|
|
649
|
0
|
0
|
|
|
|
|
if ( defined $self->{plot}->{'z-axis'} ) { |
|
|
0
|
|
|
|
|
|
650
|
0
|
|
|
|
|
|
$gp = ""; |
651
|
0
|
|
|
|
|
|
$gp .= "splot '$filename' using X1:Y11:Z ; \n"; |
652
|
|
|
|
|
|
|
} |
653
|
|
|
|
|
|
|
elsif ( defined $self->{plot}->{'cb-axis'} ) { |
654
|
0
|
|
|
|
|
|
$gp = ""; |
655
|
0
|
|
|
|
|
|
$gp .= "splot '$filename' using X1:Y11:CB ; \n"; |
656
|
|
|
|
|
|
|
} |
657
|
|
|
|
|
|
|
|
658
|
|
|
|
|
|
|
#print $gp."\n"; |
659
|
0
|
|
|
|
|
|
print $gpipe $gp; |
660
|
0
|
|
|
|
|
|
$self->{plot}->{started} = 1; |
661
|
|
|
|
|
|
|
|
662
|
0
|
|
|
|
|
|
return 1; |
663
|
|
|
|
|
|
|
|
664
|
|
|
|
|
|
|
} |
665
|
|
|
|
|
|
|
|
666
|
|
|
|
|
|
|
sub _stop_live_plot { |
667
|
0
|
|
|
0
|
|
|
my $self = shift; |
668
|
|
|
|
|
|
|
|
669
|
0
|
0
|
|
|
|
|
return unless ( defined $self->{gpipe} ); |
670
|
|
|
|
|
|
|
|
671
|
0
|
|
|
|
|
|
close $self->{gpipe}; |
672
|
0
|
|
|
|
|
|
undef $self->{plot}; |
673
|
|
|
|
|
|
|
} |
674
|
|
|
|
|
|
|
|
675
|
|
|
|
|
|
|
sub replot { |
676
|
0
|
|
|
0
|
0
|
|
my $self = shift; |
677
|
|
|
|
|
|
|
|
678
|
0
|
0
|
|
|
|
|
if ( $self->{PAUSE} > 0 ) { |
679
|
0
|
|
|
|
|
|
return 1; |
680
|
|
|
|
|
|
|
} |
681
|
|
|
|
|
|
|
else { |
682
|
0
|
|
|
|
|
|
my $gpipe = $self->{gpipe}; |
683
|
0
|
|
|
|
|
|
print $gpipe "replot\n"; |
684
|
0
|
|
|
|
|
|
return 1; |
685
|
|
|
|
|
|
|
} |
686
|
|
|
|
|
|
|
} |
687
|
|
|
|
|
|
|
|
688
|
|
|
|
|
|
|
sub gnuplot_cmd { |
689
|
0
|
|
|
0
|
0
|
|
my $self = shift; |
690
|
0
|
|
|
|
|
|
my $cmd = shift; |
691
|
0
|
|
|
|
|
|
my $gp; |
692
|
0
|
|
|
|
|
|
my $gpipe = $self->{gpipe}; |
693
|
|
|
|
|
|
|
|
694
|
0
|
|
|
|
|
|
$gp = "$cmd\n"; |
695
|
|
|
|
|
|
|
|
696
|
0
|
|
|
|
|
|
print $gpipe $gp; |
697
|
0
|
|
|
|
|
|
return $self; |
698
|
|
|
|
|
|
|
|
699
|
|
|
|
|
|
|
} |
700
|
|
|
|
|
|
|
|
701
|
|
|
|
|
|
|
sub bind_x { |
702
|
0
|
|
|
0
|
0
|
|
my $self = shift; |
703
|
0
|
|
|
|
|
|
my $gp; |
704
|
|
|
|
|
|
|
|
705
|
|
|
|
|
|
|
# covert hash of columns to an array: |
706
|
0
|
|
|
|
|
|
my @columns = (); |
707
|
|
|
|
|
|
|
|
708
|
0
|
|
|
|
|
|
while ( my ( $column, $index ) = each %{ $self->{COLUMN_NAMES} } ) { |
|
0
|
|
|
|
|
|
|
709
|
0
|
|
|
|
|
|
$column =~ s/\s+/_/g; #replace all whitespaces by '_' |
710
|
0
|
|
|
|
|
|
$column =~ s/\+/_/; #replace '+' by '_' |
711
|
0
|
|
|
|
|
|
$column =~ s/-/_/; #replace '-' by '_' |
712
|
0
|
|
|
|
|
|
$column =~ s/\//_/; #replace '/' by '_' |
713
|
0
|
|
|
|
|
|
$column =~ s/\*/_/; #replace '*' by '_' |
714
|
|
|
|
|
|
|
|
715
|
0
|
|
|
|
|
|
$columns[$index] = $column; |
716
|
|
|
|
|
|
|
} |
717
|
0
|
|
|
|
|
|
shift @columns; |
718
|
|
|
|
|
|
|
|
719
|
|
|
|
|
|
|
# foreach my $k ( keys %{$self->{COLUMN}}) |
720
|
|
|
|
|
|
|
# { |
721
|
|
|
|
|
|
|
# push (@columns, $k); |
722
|
|
|
|
|
|
|
# } |
723
|
|
|
|
|
|
|
|
724
|
0
|
|
|
|
|
|
my $gpipe = $self->{gpipe}; |
725
|
0
|
|
|
|
|
|
usleep(1e4); |
726
|
0
|
|
|
|
|
|
print $gpipe $gp; |
727
|
|
|
|
|
|
|
|
728
|
0
|
|
|
|
|
|
$gp = ""; |
729
|
|
|
|
|
|
|
|
730
|
|
|
|
|
|
|
# bind x key: |
731
|
0
|
|
|
|
|
|
$gp .= 'bind x "'; |
732
|
|
|
|
|
|
|
|
733
|
|
|
|
|
|
|
# draw background: |
734
|
0
|
|
|
|
|
|
$gp |
735
|
|
|
|
|
|
|
.= "set obj 1001 rect from graph 0, graph 0 to graph 1, graph 1 front fc rgb 'grey' fs transparent solid 0.8; "; |
736
|
0
|
|
|
|
|
|
$gp .= "set label 1001 '';\\\n"; |
737
|
0
|
|
|
|
|
|
print $gpipe $gp; |
738
|
0
|
|
|
|
|
|
usleep(1e4); |
739
|
0
|
|
|
|
|
|
$gp = ""; |
740
|
|
|
|
|
|
|
|
741
|
|
|
|
|
|
|
# draw 'buttons' for each column: |
742
|
0
|
|
|
|
|
|
my $m = 0; |
743
|
0
|
|
|
|
|
|
my $n = 0; |
744
|
0
|
|
|
|
|
|
foreach my $column (@columns) { |
745
|
0
|
|
|
|
|
|
$gp |
746
|
|
|
|
|
|
|
.= "set obj 100" |
747
|
|
|
|
|
|
|
. ( $m * 4 + $n + 2 ) |
748
|
|
|
|
|
|
|
. " rect from graph (0.05+$n*(0.23)), graph ((1-0.05)-$m*(0.12)) to graph (0.05+$n*(0.23)+0.21), graph ((1-0.05)-$m*(0.12) - 0.1) front fc rgb '#2F3239'; "; |
749
|
0
|
|
|
|
|
|
$gp |
750
|
|
|
|
|
|
|
.= "set label 100" |
751
|
|
|
|
|
|
|
. ( $m * 4 + $n + 2 ) . " '" |
752
|
|
|
|
|
|
|
. $column |
753
|
|
|
|
|
|
|
. "' at graph (0.05+$n*(0.23) + 0.1), graph ((1-0.05)-$m*(0.12)-0.05) front center tc rgb 'white'; \\\n"; |
754
|
0
|
|
|
|
|
|
print $gpipe $gp; |
755
|
0
|
|
|
|
|
|
usleep(2e4); |
756
|
0
|
|
|
|
|
|
$gp = ""; |
757
|
0
|
|
|
|
|
|
$n++; |
758
|
0
|
0
|
|
|
|
|
if ( $n >= 4 ) { |
759
|
0
|
|
|
|
|
|
$n = 0; |
760
|
0
|
|
|
|
|
|
$m++; |
761
|
|
|
|
|
|
|
} |
762
|
|
|
|
|
|
|
} |
763
|
0
|
|
|
|
|
|
$gp .= "replot; \\\n"; |
764
|
0
|
|
|
|
|
|
print $gpipe $gp; |
765
|
0
|
|
|
|
|
|
usleep(1e4); |
766
|
0
|
|
|
|
|
|
$gp = ""; |
767
|
|
|
|
|
|
|
|
768
|
|
|
|
|
|
|
# check for mouseclicks: |
769
|
0
|
|
|
|
|
|
$m = 0; |
770
|
0
|
|
|
|
|
|
$n = 0; |
771
|
0
|
|
|
|
|
|
$gp .= "RANGE_X = GPVAL_X_MAX - GPVAL_X_MIN; "; |
772
|
0
|
|
|
|
|
|
$gp .= "RANGE_Y = GPVAL_Y_MAX - GPVAL_Y_MIN; "; |
773
|
0
|
|
|
|
|
|
$gp .= "LOOP = 1; "; |
774
|
0
|
|
|
|
|
|
$gp .= "while(LOOP){"; |
775
|
0
|
|
|
|
|
|
$gp .= "pause mouse 'Click Mouse';"; |
776
|
0
|
|
|
|
|
|
$gp .= "if (exists('MOUSE_X') && exists('MOUSE_Y')) {\\\n"; |
777
|
0
|
|
|
|
|
|
print $gpipe $gp; |
778
|
0
|
|
|
|
|
|
usleep(2e4); |
779
|
0
|
|
|
|
|
|
$gp = ""; |
780
|
|
|
|
|
|
|
|
781
|
0
|
|
|
|
|
|
foreach my $column (@columns) { |
782
|
0
|
|
|
|
|
|
$gp |
783
|
|
|
|
|
|
|
.= "if (( MOUSE_X < ( GPVAL_X_MIN + RANGE_X * " |
784
|
|
|
|
|
|
|
. ( 0.05 + $n * 0.23 + 0.21 ) |
785
|
|
|
|
|
|
|
. " )) && ( MOUSE_X > ( GPVAL_X_MIN + RANGE_X * " |
786
|
|
|
|
|
|
|
. ( 0.05 + $n * 0.23 ) |
787
|
|
|
|
|
|
|
. " )) && ( MOUSE_Y < ( GPVAL_Y_MIN + RANGE_Y * " |
788
|
|
|
|
|
|
|
. ( ( 1 - 0.05 ) - $m * 0.12 ) |
789
|
|
|
|
|
|
|
. " )) && ( MOUSE_Y > ( GPVAL_Y_MIN + RANGE_Y * " |
790
|
|
|
|
|
|
|
. ( ( 1 - 0.05 ) - $m * 0.12 - 0.1 ) |
791
|
|
|
|
|
|
|
. " ))) {"; |
792
|
0
|
|
|
|
|
|
$gp .= "LOOP = 0;"; |
793
|
0
|
|
|
|
|
|
$gp .= "X1 = " . ( $m * 4 + $n + 1 ) . "; "; |
794
|
0
|
|
|
|
|
|
$gp .= "set xlabel COLUMN_" . ( $m * 4 + $n + 1 ) . "; "; |
795
|
0
|
|
|
|
|
|
$gp .= "show variables; "; |
796
|
0
|
|
|
|
|
|
$gp .= "}; \\\n"; |
797
|
0
|
|
|
|
|
|
print $gpipe $gp; |
798
|
0
|
|
|
|
|
|
usleep(2e4); |
799
|
0
|
|
|
|
|
|
$gp = ""; |
800
|
0
|
|
|
|
|
|
$n++; |
801
|
|
|
|
|
|
|
|
802
|
0
|
0
|
|
|
|
|
if ( $n >= 4 ) { |
803
|
0
|
|
|
|
|
|
$n = 0; |
804
|
0
|
|
|
|
|
|
$m++; |
805
|
|
|
|
|
|
|
} |
806
|
|
|
|
|
|
|
} |
807
|
0
|
|
|
|
|
|
$gp .= "}"; |
808
|
0
|
|
|
|
|
|
$gp .= "}; \\\n"; |
809
|
0
|
|
|
|
|
|
print $gpipe $gp; |
810
|
0
|
|
|
|
|
|
usleep(1e4); |
811
|
0
|
|
|
|
|
|
$gp = ""; |
812
|
|
|
|
|
|
|
|
813
|
0
|
|
|
|
|
|
foreach ( 1 .. ( my $length = @columns + 1 ) ) { |
814
|
0
|
|
|
|
|
|
$gp .= "unset obj 100" . $_ . "; "; |
815
|
0
|
|
|
|
|
|
$gp .= "unset label 100" . $_ . "; "; |
816
|
|
|
|
|
|
|
} |
817
|
0
|
|
|
|
|
|
$gp .= "replot; "; |
818
|
|
|
|
|
|
|
|
819
|
0
|
|
|
|
|
|
$gp .= "\n"; |
820
|
|
|
|
|
|
|
|
821
|
0
|
|
|
|
|
|
print $gpipe $gp; |
822
|
0
|
|
|
|
|
|
usleep(5e5); |
823
|
0
|
|
|
|
|
|
print $gpipe "\n"; |
824
|
|
|
|
|
|
|
|
825
|
|
|
|
|
|
|
} |
826
|
|
|
|
|
|
|
|
827
|
|
|
|
|
|
|
sub bind_y { |
828
|
0
|
|
|
0
|
0
|
|
my $self = shift; |
829
|
0
|
|
|
|
|
|
my $gp; |
830
|
|
|
|
|
|
|
|
831
|
|
|
|
|
|
|
# covert hash of columns to an array: |
832
|
0
|
|
|
|
|
|
my @columns = (); |
833
|
0
|
|
|
|
|
|
while ( my ( $column, $index ) = each %{ $self->{COLUMN_NAMES} } ) { |
|
0
|
|
|
|
|
|
|
834
|
0
|
|
|
|
|
|
$column =~ s/\s+/_/g; #replace all whitespaces by '_' |
835
|
0
|
|
|
|
|
|
$column =~ s/\+/_/; #replace '+' by '_' |
836
|
0
|
|
|
|
|
|
$column =~ s/-/_/; #replace '-' by '_' |
837
|
0
|
|
|
|
|
|
$column =~ s/\//_/; #replace '/' by '_' |
838
|
0
|
|
|
|
|
|
$column =~ s/\*/_/; #replace '*' by '_' |
839
|
|
|
|
|
|
|
|
840
|
0
|
|
|
|
|
|
$columns[$index] = $column; |
841
|
|
|
|
|
|
|
} |
842
|
0
|
|
|
|
|
|
shift @columns; |
843
|
|
|
|
|
|
|
|
844
|
0
|
|
|
|
|
|
my $gpipe = $self->{gpipe}; |
845
|
0
|
|
|
|
|
|
usleep(1e4); |
846
|
0
|
|
|
|
|
|
print $gpipe $gp; |
847
|
|
|
|
|
|
|
|
848
|
0
|
|
|
|
|
|
$gp = ""; |
849
|
|
|
|
|
|
|
|
850
|
|
|
|
|
|
|
# bind x key: |
851
|
0
|
|
|
|
|
|
$gp .= 'bind y "'; |
852
|
|
|
|
|
|
|
|
853
|
|
|
|
|
|
|
# draw background: |
854
|
0
|
|
|
|
|
|
$gp |
855
|
|
|
|
|
|
|
.= "set obj 2001 rect from graph 0, graph 0 to graph 1, graph 1 front fc rgb 'grey' fs transparent solid 0.8; "; |
856
|
0
|
|
|
|
|
|
$gp .= "set label 2001 '';\\\n"; |
857
|
0
|
|
|
|
|
|
print $gpipe $gp; |
858
|
0
|
|
|
|
|
|
usleep(1e4); |
859
|
0
|
|
|
|
|
|
$gp = ""; |
860
|
|
|
|
|
|
|
|
861
|
|
|
|
|
|
|
# draw 'buttons' for each column: |
862
|
0
|
|
|
|
|
|
my $m = 0; |
863
|
0
|
|
|
|
|
|
my $n = 0; |
864
|
0
|
|
|
|
|
|
foreach my $column (@columns) { |
865
|
0
|
|
|
|
|
|
$gp |
866
|
|
|
|
|
|
|
.= "set obj 200" |
867
|
|
|
|
|
|
|
. ( $m * 4 + $n + 2 ) |
868
|
|
|
|
|
|
|
. " rect from graph (0.05+$n*(0.23)), graph ((1-0.05)-$m*(0.12)) to graph (0.05+$n*(0.23)+0.21), graph ((1-0.05)-$m*(0.12) - 0.1) front fc rgb '#2F3239'; "; |
869
|
0
|
|
|
|
|
|
$gp |
870
|
|
|
|
|
|
|
.= "set label 200" |
871
|
|
|
|
|
|
|
. ( $m * 4 + $n + 2 ) . " '" |
872
|
|
|
|
|
|
|
. $column |
873
|
|
|
|
|
|
|
. "' at graph (0.05+$n*(0.23) + 0.1), graph ((1-0.05)-$m*(0.12)-0.05) front center tc rgb 'white'; \\\n"; |
874
|
0
|
|
|
|
|
|
print $gpipe $gp; |
875
|
0
|
|
|
|
|
|
usleep(2e4); |
876
|
0
|
|
|
|
|
|
$gp = ""; |
877
|
0
|
|
|
|
|
|
$n++; |
878
|
0
|
0
|
|
|
|
|
if ( $n >= 4 ) { |
879
|
0
|
|
|
|
|
|
$n = 0; |
880
|
0
|
|
|
|
|
|
$m++; |
881
|
|
|
|
|
|
|
} |
882
|
|
|
|
|
|
|
} |
883
|
0
|
|
|
|
|
|
$gp .= "replot; \\\n"; |
884
|
0
|
|
|
|
|
|
print $gpipe $gp; |
885
|
0
|
|
|
|
|
|
usleep(1e4); |
886
|
0
|
|
|
|
|
|
$gp = ""; |
887
|
|
|
|
|
|
|
|
888
|
|
|
|
|
|
|
# check for mouseclicks: |
889
|
0
|
|
|
|
|
|
$m = 0; |
890
|
0
|
|
|
|
|
|
$n = 0; |
891
|
0
|
|
|
|
|
|
$gp .= "RANGE_X = GPVAL_X_MAX - GPVAL_X_MIN; "; |
892
|
0
|
|
|
|
|
|
$gp .= "RANGE_Y = GPVAL_Y_MAX - GPVAL_Y_MIN; "; |
893
|
0
|
|
|
|
|
|
$gp .= "LOOP = 1; "; |
894
|
0
|
|
|
|
|
|
$gp .= "while(LOOP){"; |
895
|
0
|
|
|
|
|
|
$gp .= "pause mouse 'Click Mouse';"; |
896
|
0
|
|
|
|
|
|
$gp .= "if (exists('MOUSE_X') && exists('MOUSE_Y')) {\\\n"; |
897
|
0
|
|
|
|
|
|
print $gpipe $gp; |
898
|
0
|
|
|
|
|
|
usleep(2e4); |
899
|
0
|
|
|
|
|
|
$gp = ""; |
900
|
|
|
|
|
|
|
|
901
|
0
|
|
|
|
|
|
foreach my $column (@columns) { |
902
|
0
|
|
|
|
|
|
$gp |
903
|
|
|
|
|
|
|
.= "if (( MOUSE_X < ( GPVAL_X_MIN + RANGE_X * " |
904
|
|
|
|
|
|
|
. ( 0.05 + $n * 0.23 + 0.21 ) |
905
|
|
|
|
|
|
|
. " )) && ( MOUSE_X > ( GPVAL_X_MIN + RANGE_X * " |
906
|
|
|
|
|
|
|
. ( 0.05 + $n * 0.23 ) |
907
|
|
|
|
|
|
|
. " )) && ( MOUSE_Y < ( GPVAL_Y_MIN + RANGE_Y * " |
908
|
|
|
|
|
|
|
. ( ( 1 - 0.05 ) - $m * 0.12 ) |
909
|
|
|
|
|
|
|
. " )) && ( MOUSE_Y > ( GPVAL_Y_MIN + RANGE_Y * " |
910
|
|
|
|
|
|
|
. ( ( 1 - 0.05 ) - $m * 0.12 - 0.1 ) |
911
|
|
|
|
|
|
|
. " ))) {"; |
912
|
0
|
|
|
|
|
|
$gp .= "LOOP = 0;"; |
913
|
0
|
|
|
|
|
|
$gp .= "Y11 = " . ( $m * 4 + $n + 1 ) . "; "; |
914
|
0
|
|
|
|
|
|
$gp .= "set ylabel COLUMN_" . ( $m * 4 + $n + 1 ) . "; "; |
915
|
0
|
|
|
|
|
|
$gp .= "show variables; "; |
916
|
0
|
|
|
|
|
|
$gp .= "}; \\\n"; |
917
|
0
|
|
|
|
|
|
print $gpipe $gp; |
918
|
0
|
|
|
|
|
|
usleep(2e4); |
919
|
0
|
|
|
|
|
|
$gp = ""; |
920
|
0
|
|
|
|
|
|
$n++; |
921
|
|
|
|
|
|
|
|
922
|
0
|
0
|
|
|
|
|
if ( $n >= 4 ) { |
923
|
0
|
|
|
|
|
|
$n = 0; |
924
|
0
|
|
|
|
|
|
$m++; |
925
|
|
|
|
|
|
|
} |
926
|
|
|
|
|
|
|
} |
927
|
0
|
|
|
|
|
|
$gp .= "}"; |
928
|
0
|
|
|
|
|
|
$gp .= "}; \\\n"; |
929
|
0
|
|
|
|
|
|
print $gpipe $gp; |
930
|
0
|
|
|
|
|
|
usleep(1e4); |
931
|
0
|
|
|
|
|
|
$gp = ""; |
932
|
|
|
|
|
|
|
|
933
|
0
|
|
|
|
|
|
foreach ( 1 .. ( my $length = @columns + 1 ) ) { |
934
|
0
|
|
|
|
|
|
$gp .= "unset obj 200" . $_ . "; "; |
935
|
0
|
|
|
|
|
|
$gp .= "unset label 200" . $_ . "; "; |
936
|
|
|
|
|
|
|
} |
937
|
0
|
|
|
|
|
|
$gp .= "replot; "; |
938
|
|
|
|
|
|
|
|
939
|
0
|
|
|
|
|
|
$gp .= "\n"; |
940
|
|
|
|
|
|
|
|
941
|
0
|
|
|
|
|
|
print $gpipe $gp; |
942
|
0
|
|
|
|
|
|
usleep(5e5); |
943
|
0
|
|
|
|
|
|
print $gpipe "\n"; |
944
|
|
|
|
|
|
|
|
945
|
|
|
|
|
|
|
} |
946
|
|
|
|
|
|
|
|
947
|
|
|
|
|
|
|
sub bind_z { |
948
|
0
|
|
|
0
|
0
|
|
my $self = shift; |
949
|
0
|
|
|
|
|
|
my $gp; |
950
|
|
|
|
|
|
|
|
951
|
|
|
|
|
|
|
# covert hash of columns to an array: |
952
|
0
|
|
|
|
|
|
my @columns = (); |
953
|
0
|
|
|
|
|
|
while ( my ( $column, $index ) = each %{ $self->{COLUMN_NAMES} } ) { |
|
0
|
|
|
|
|
|
|
954
|
0
|
|
|
|
|
|
$column =~ s/\s+/_/g; #replace all whitespaces by '_' |
955
|
0
|
|
|
|
|
|
$column =~ s/\+/_/; #replace '+' by '_' |
956
|
0
|
|
|
|
|
|
$column =~ s/-/_/; #replace '-' by '_' |
957
|
0
|
|
|
|
|
|
$column =~ s/\//_/; #replace '/' by '_' |
958
|
0
|
|
|
|
|
|
$column =~ s/\*/_/; #replace '*' by '_' |
959
|
|
|
|
|
|
|
|
960
|
0
|
|
|
|
|
|
$columns[$index] = $column; |
961
|
|
|
|
|
|
|
} |
962
|
0
|
|
|
|
|
|
shift @columns; |
963
|
|
|
|
|
|
|
|
964
|
0
|
|
|
|
|
|
my $gpipe = $self->{gpipe}; |
965
|
0
|
|
|
|
|
|
usleep(1e4); |
966
|
0
|
|
|
|
|
|
print $gpipe $gp; |
967
|
|
|
|
|
|
|
|
968
|
0
|
|
|
|
|
|
$gp = ""; |
969
|
|
|
|
|
|
|
|
970
|
|
|
|
|
|
|
# bind x key: |
971
|
0
|
|
|
|
|
|
$gp .= 'bind z "'; |
972
|
|
|
|
|
|
|
|
973
|
|
|
|
|
|
|
# draw background: |
974
|
0
|
|
|
|
|
|
$gp |
975
|
|
|
|
|
|
|
.= "set obj 3001 rect from graph 0, graph 0 to graph 1, graph 1 front fc rgb 'grey' fs transparent solid 0.8; "; |
976
|
0
|
|
|
|
|
|
$gp .= "set label 3001 '';\\\n"; |
977
|
0
|
|
|
|
|
|
print $gpipe $gp; |
978
|
0
|
|
|
|
|
|
usleep(1e4); |
979
|
0
|
|
|
|
|
|
$gp = ""; |
980
|
|
|
|
|
|
|
|
981
|
|
|
|
|
|
|
# draw 'buttons' for each column: |
982
|
0
|
|
|
|
|
|
my $m = 0; |
983
|
0
|
|
|
|
|
|
my $n = 0; |
984
|
0
|
|
|
|
|
|
foreach my $column (@columns) { |
985
|
0
|
|
|
|
|
|
$gp |
986
|
|
|
|
|
|
|
.= "set obj 300" |
987
|
|
|
|
|
|
|
. ( $m * 4 + $n + 2 ) |
988
|
|
|
|
|
|
|
. " rect from graph (0.05+$n*(0.23)), graph ((1-0.05)-$m*(0.12)) to graph (0.05+$n*(0.23)+0.21), graph ((1-0.05)-$m*(0.12) - 0.1) front fc rgb '#2F3239'; "; |
989
|
0
|
|
|
|
|
|
$gp |
990
|
|
|
|
|
|
|
.= "set label 300" |
991
|
|
|
|
|
|
|
. ( $m * 4 + $n + 2 ) . " '" |
992
|
|
|
|
|
|
|
. $column |
993
|
|
|
|
|
|
|
. "' at graph (0.05+$n*(0.23) + 0.1), graph ((1-0.05)-$m*(0.12)-0.05) front center tc rgb 'white'; \\\n"; |
994
|
0
|
|
|
|
|
|
print $gpipe $gp; |
995
|
0
|
|
|
|
|
|
usleep(2e4); |
996
|
0
|
|
|
|
|
|
$gp = ""; |
997
|
0
|
|
|
|
|
|
$n++; |
998
|
0
|
0
|
|
|
|
|
if ( $n >= 4 ) { |
999
|
0
|
|
|
|
|
|
$n = 0; |
1000
|
0
|
|
|
|
|
|
$m++; |
1001
|
|
|
|
|
|
|
} |
1002
|
|
|
|
|
|
|
} |
1003
|
0
|
|
|
|
|
|
$gp .= "replot; \\\n"; |
1004
|
0
|
|
|
|
|
|
print $gpipe $gp; |
1005
|
0
|
|
|
|
|
|
usleep(1e4); |
1006
|
0
|
|
|
|
|
|
$gp = ""; |
1007
|
|
|
|
|
|
|
|
1008
|
|
|
|
|
|
|
# check for mouseclicks: |
1009
|
0
|
|
|
|
|
|
$m = 0; |
1010
|
0
|
|
|
|
|
|
$n = 0; |
1011
|
0
|
|
|
|
|
|
$gp .= "RANGE_X = GPVAL_X_MAX - GPVAL_X_MIN; "; |
1012
|
0
|
|
|
|
|
|
$gp .= "RANGE_Y = GPVAL_Y_MAX - GPVAL_Y_MIN; "; |
1013
|
0
|
|
|
|
|
|
$gp .= "LOOP = 1; "; |
1014
|
0
|
|
|
|
|
|
$gp .= "while(LOOP){"; |
1015
|
0
|
|
|
|
|
|
$gp .= "pause mouse 'Click Mouse';"; |
1016
|
0
|
|
|
|
|
|
$gp .= "if (exists('MOUSE_X') && exists('MOUSE_Y')) {\\\n"; |
1017
|
0
|
|
|
|
|
|
print $gpipe $gp; |
1018
|
0
|
|
|
|
|
|
usleep(2e4); |
1019
|
0
|
|
|
|
|
|
$gp = ""; |
1020
|
|
|
|
|
|
|
|
1021
|
0
|
|
|
|
|
|
foreach my $column (@columns) { |
1022
|
0
|
|
|
|
|
|
$gp |
1023
|
|
|
|
|
|
|
.= "if (( MOUSE_X < ( GPVAL_X_MIN + RANGE_X * " |
1024
|
|
|
|
|
|
|
. ( 0.05 + $n * 0.23 + 0.21 ) |
1025
|
|
|
|
|
|
|
. " )) && ( MOUSE_X > ( GPVAL_X_MIN + RANGE_X * " |
1026
|
|
|
|
|
|
|
. ( 0.05 + $n * 0.23 ) |
1027
|
|
|
|
|
|
|
. " )) && ( MOUSE_Y < ( GPVAL_Y_MIN + RANGE_Y * " |
1028
|
|
|
|
|
|
|
. ( ( 1 - 0.05 ) - $m * 0.12 ) |
1029
|
|
|
|
|
|
|
. " )) && ( MOUSE_Y > ( GPVAL_Y_MIN + RANGE_Y * " |
1030
|
|
|
|
|
|
|
. ( ( 1 - 0.05 ) - $m * 0.12 - 0.1 ) |
1031
|
|
|
|
|
|
|
. " ))) {"; |
1032
|
0
|
|
|
|
|
|
$gp .= "LOOP = 0;"; |
1033
|
0
|
|
|
|
|
|
$gp .= "Z = " . ( $m * 4 + $n + 1 ) . "; "; |
1034
|
0
|
|
|
|
|
|
$gp .= "set zlabel COLUMN_" . ( $m * 4 + $n + 1 ) . "; "; |
1035
|
0
|
|
|
|
|
|
$gp .= "show variables; "; |
1036
|
0
|
|
|
|
|
|
$gp .= "}; \\\n"; |
1037
|
0
|
|
|
|
|
|
print $gpipe $gp; |
1038
|
0
|
|
|
|
|
|
usleep(2e4); |
1039
|
0
|
|
|
|
|
|
$gp = ""; |
1040
|
0
|
|
|
|
|
|
$n++; |
1041
|
|
|
|
|
|
|
|
1042
|
0
|
0
|
|
|
|
|
if ( $n >= 4 ) { |
1043
|
0
|
|
|
|
|
|
$n = 0; |
1044
|
0
|
|
|
|
|
|
$m++; |
1045
|
|
|
|
|
|
|
} |
1046
|
|
|
|
|
|
|
} |
1047
|
0
|
|
|
|
|
|
$gp .= "}"; |
1048
|
0
|
|
|
|
|
|
$gp .= "}; \\\n"; |
1049
|
0
|
|
|
|
|
|
print $gpipe $gp; |
1050
|
0
|
|
|
|
|
|
usleep(1e4); |
1051
|
0
|
|
|
|
|
|
$gp = ""; |
1052
|
|
|
|
|
|
|
|
1053
|
0
|
|
|
|
|
|
foreach ( 1 .. ( my $length = @columns + 1 ) ) { |
1054
|
0
|
|
|
|
|
|
$gp .= "unset obj 300" . $_ . "; "; |
1055
|
0
|
|
|
|
|
|
$gp .= "unset label 300" . $_ . "; "; |
1056
|
|
|
|
|
|
|
} |
1057
|
0
|
|
|
|
|
|
$gp .= "replot; "; |
1058
|
|
|
|
|
|
|
|
1059
|
0
|
|
|
|
|
|
$gp .= "\n"; |
1060
|
|
|
|
|
|
|
|
1061
|
0
|
|
|
|
|
|
print $gpipe $gp; |
1062
|
0
|
|
|
|
|
|
usleep(5e5); |
1063
|
0
|
|
|
|
|
|
print $gpipe "\n"; |
1064
|
|
|
|
|
|
|
|
1065
|
|
|
|
|
|
|
} |
1066
|
|
|
|
|
|
|
|
1067
|
|
|
|
|
|
|
sub bind_c { |
1068
|
0
|
|
|
0
|
0
|
|
my $self = shift; |
1069
|
0
|
|
|
|
|
|
my $gp; |
1070
|
|
|
|
|
|
|
|
1071
|
|
|
|
|
|
|
# covert hash of columns to an array: |
1072
|
0
|
|
|
|
|
|
my @columns = (); |
1073
|
0
|
|
|
|
|
|
while ( my ( $column, $index ) = each %{ $self->{COLUMN_NAMES} } ) { |
|
0
|
|
|
|
|
|
|
1074
|
0
|
|
|
|
|
|
$column =~ s/\s+/_/g; #replace all whitespaces by '_' |
1075
|
0
|
|
|
|
|
|
$column =~ s/\+/_/; #replace '+' by '_' |
1076
|
0
|
|
|
|
|
|
$column =~ s/-/_/; #replace '-' by '_' |
1077
|
0
|
|
|
|
|
|
$column =~ s/\//_/; #replace '/' by '_' |
1078
|
0
|
|
|
|
|
|
$column =~ s/\*/_/; #replace '*' by '_' |
1079
|
|
|
|
|
|
|
|
1080
|
0
|
|
|
|
|
|
$columns[$index] = $column; |
1081
|
|
|
|
|
|
|
} |
1082
|
0
|
|
|
|
|
|
shift @columns; |
1083
|
|
|
|
|
|
|
|
1084
|
0
|
|
|
|
|
|
my $gpipe = $self->{gpipe}; |
1085
|
0
|
|
|
|
|
|
usleep(1e4); |
1086
|
0
|
|
|
|
|
|
print $gpipe $gp; |
1087
|
|
|
|
|
|
|
|
1088
|
0
|
|
|
|
|
|
$gp = ""; |
1089
|
|
|
|
|
|
|
|
1090
|
|
|
|
|
|
|
# bind x key: |
1091
|
0
|
|
|
|
|
|
$gp .= 'bind c "'; |
1092
|
|
|
|
|
|
|
|
1093
|
|
|
|
|
|
|
# draw background: |
1094
|
0
|
|
|
|
|
|
$gp |
1095
|
|
|
|
|
|
|
.= "set obj 4001 rect from graph 0, graph 0 to graph 1, graph 1 front fc rgb 'grey' fs transparent solid 0.8; "; |
1096
|
0
|
|
|
|
|
|
$gp .= "set label 4001 '';\\\n"; |
1097
|
0
|
|
|
|
|
|
print $gpipe $gp; |
1098
|
0
|
|
|
|
|
|
usleep(1e4); |
1099
|
0
|
|
|
|
|
|
$gp = ""; |
1100
|
|
|
|
|
|
|
|
1101
|
|
|
|
|
|
|
# draw 'buttons' for each column: |
1102
|
0
|
|
|
|
|
|
my $m = 0; |
1103
|
0
|
|
|
|
|
|
my $n = 0; |
1104
|
0
|
|
|
|
|
|
foreach my $column (@columns) { |
1105
|
0
|
|
|
|
|
|
$gp |
1106
|
|
|
|
|
|
|
.= "set obj 400" |
1107
|
|
|
|
|
|
|
. ( $m * 4 + $n + 2 ) |
1108
|
|
|
|
|
|
|
. " rect from graph (0.05+$n*(0.23)), graph ((1-0.05)-$m*(0.12)) to graph (0.05+$n*(0.23)+0.21), graph ((1-0.05)-$m*(0.12) - 0.1) front fc rgb '#2F3239'; "; |
1109
|
0
|
|
|
|
|
|
$gp |
1110
|
|
|
|
|
|
|
.= "set label 400" |
1111
|
|
|
|
|
|
|
. ( $m * 4 + $n + 2 ) . " '" |
1112
|
|
|
|
|
|
|
. $column |
1113
|
|
|
|
|
|
|
. "' at graph (0.05+$n*(0.23) + 0.1), graph ((1-0.05)-$m*(0.12)-0.05) front center tc rgb 'white'; \\\n"; |
1114
|
0
|
|
|
|
|
|
print $gpipe $gp; |
1115
|
0
|
|
|
|
|
|
usleep(2e4); |
1116
|
0
|
|
|
|
|
|
$gp = ""; |
1117
|
0
|
|
|
|
|
|
$n++; |
1118
|
0
|
0
|
|
|
|
|
if ( $n >= 4 ) { |
1119
|
0
|
|
|
|
|
|
$n = 0; |
1120
|
0
|
|
|
|
|
|
$m++; |
1121
|
|
|
|
|
|
|
} |
1122
|
|
|
|
|
|
|
} |
1123
|
0
|
|
|
|
|
|
$gp .= "replot; \\\n"; |
1124
|
0
|
|
|
|
|
|
print $gpipe $gp; |
1125
|
0
|
|
|
|
|
|
usleep(1e4); |
1126
|
0
|
|
|
|
|
|
$gp = ""; |
1127
|
|
|
|
|
|
|
|
1128
|
|
|
|
|
|
|
# check for mouseclicks: |
1129
|
0
|
|
|
|
|
|
$m = 0; |
1130
|
0
|
|
|
|
|
|
$n = 0; |
1131
|
0
|
|
|
|
|
|
$gp .= "RANGE_X = GPVAL_X_MAX - GPVAL_X_MIN; "; |
1132
|
0
|
|
|
|
|
|
$gp .= "RANGE_Y = GPVAL_Y_MAX - GPVAL_Y_MIN; "; |
1133
|
0
|
|
|
|
|
|
$gp .= "LOOP = 1; "; |
1134
|
0
|
|
|
|
|
|
$gp .= "while(LOOP){"; |
1135
|
0
|
|
|
|
|
|
$gp .= "pause mouse 'Click Mouse';"; |
1136
|
0
|
|
|
|
|
|
$gp .= "if (exists('MOUSE_X') && exists('MOUSE_Y')) {\\\n"; |
1137
|
0
|
|
|
|
|
|
print $gpipe $gp; |
1138
|
0
|
|
|
|
|
|
usleep(2e4); |
1139
|
0
|
|
|
|
|
|
$gp = ""; |
1140
|
|
|
|
|
|
|
|
1141
|
0
|
|
|
|
|
|
foreach my $column (@columns) { |
1142
|
0
|
|
|
|
|
|
$gp |
1143
|
|
|
|
|
|
|
.= "if (( MOUSE_X < ( GPVAL_X_MIN + RANGE_X * " |
1144
|
|
|
|
|
|
|
. ( 0.05 + $n * 0.23 + 0.21 ) |
1145
|
|
|
|
|
|
|
. " )) && ( MOUSE_X > ( GPVAL_X_MIN + RANGE_X * " |
1146
|
|
|
|
|
|
|
. ( 0.05 + $n * 0.23 ) |
1147
|
|
|
|
|
|
|
. " )) && ( MOUSE_Y < ( GPVAL_Y_MIN + RANGE_Y * " |
1148
|
|
|
|
|
|
|
. ( ( 1 - 0.05 ) - $m * 0.12 ) |
1149
|
|
|
|
|
|
|
. " )) && ( MOUSE_Y > ( GPVAL_Y_MIN + RANGE_Y * " |
1150
|
|
|
|
|
|
|
. ( ( 1 - 0.05 ) - $m * 0.12 - 0.1 ) |
1151
|
|
|
|
|
|
|
. " ))) {"; |
1152
|
0
|
|
|
|
|
|
$gp .= "LOOP = 0;"; |
1153
|
0
|
|
|
|
|
|
$gp .= "CB = " . ( $m * 4 + $n + 1 ) . "; "; |
1154
|
0
|
|
|
|
|
|
$gp .= "set cblabel COLUMN_" . ( $m * 4 + $n + 1 ) . "; "; |
1155
|
0
|
|
|
|
|
|
$gp .= "show variables; "; |
1156
|
0
|
|
|
|
|
|
$gp .= "}; \\\n"; |
1157
|
0
|
|
|
|
|
|
print $gpipe $gp; |
1158
|
0
|
|
|
|
|
|
usleep(2e4); |
1159
|
0
|
|
|
|
|
|
$gp = ""; |
1160
|
0
|
|
|
|
|
|
$n++; |
1161
|
|
|
|
|
|
|
|
1162
|
0
|
0
|
|
|
|
|
if ( $n >= 4 ) { |
1163
|
0
|
|
|
|
|
|
$n = 0; |
1164
|
0
|
|
|
|
|
|
$m++; |
1165
|
|
|
|
|
|
|
} |
1166
|
|
|
|
|
|
|
} |
1167
|
0
|
|
|
|
|
|
$gp .= "}"; |
1168
|
0
|
|
|
|
|
|
$gp .= "}; \\\n"; |
1169
|
0
|
|
|
|
|
|
print $gpipe $gp; |
1170
|
0
|
|
|
|
|
|
usleep(1e4); |
1171
|
0
|
|
|
|
|
|
$gp = ""; |
1172
|
|
|
|
|
|
|
|
1173
|
0
|
|
|
|
|
|
foreach ( 1 .. ( my $length = @columns + 1 ) ) { |
1174
|
0
|
|
|
|
|
|
$gp .= "unset obj 400" . $_ . "; "; |
1175
|
0
|
|
|
|
|
|
$gp .= "unset label 400" . $_ . "; "; |
1176
|
|
|
|
|
|
|
} |
1177
|
0
|
|
|
|
|
|
$gp .= "replot; "; |
1178
|
|
|
|
|
|
|
|
1179
|
0
|
|
|
|
|
|
$gp .= "\n"; |
1180
|
|
|
|
|
|
|
|
1181
|
0
|
|
|
|
|
|
print $gpipe $gp; |
1182
|
0
|
|
|
|
|
|
usleep(5e5); |
1183
|
0
|
|
|
|
|
|
print $gpipe "\n"; |
1184
|
|
|
|
|
|
|
|
1185
|
|
|
|
|
|
|
} |
1186
|
|
|
|
|
|
|
|
1187
|
|
|
|
|
|
|
sub bind_s { |
1188
|
0
|
|
|
0
|
0
|
|
my $self = shift; |
1189
|
0
|
|
|
|
|
|
my $gp; |
1190
|
|
|
|
|
|
|
|
1191
|
|
|
|
|
|
|
# split directory/filname .. |
1192
|
0
|
0
|
|
|
|
|
if ( $self->{FILENAME} =~ /(.+)(\/|\/\/|\\|\\\\)(.+)\b/ ) { |
1193
|
0
|
|
|
|
|
|
my $directory = $1; |
1194
|
0
|
|
|
|
|
|
my $filename = $3; |
1195
|
0
|
|
|
|
|
|
my $filenameextension = ".dat"; |
1196
|
0
|
0
|
|
|
|
|
if ( $filename =~ /(.+)(\..+)\b/ ) { |
1197
|
0
|
|
|
|
|
|
$filename = $1; |
1198
|
0
|
|
|
|
|
|
$filenameextension = $2; |
1199
|
|
|
|
|
|
|
} |
1200
|
|
|
|
|
|
|
|
1201
|
|
|
|
|
|
|
#print "$directory $filename $filenameextension\n"; |
1202
|
|
|
|
|
|
|
|
1203
|
|
|
|
|
|
|
# create directory if it doesn't exist: |
1204
|
0
|
0
|
|
|
|
|
if ( not -d $directory ) { |
1205
|
0
|
|
|
|
|
|
warn |
1206
|
|
|
|
|
|
|
"directory given by $self->{FILENAME} doesn't exist. Create directory $directory"; |
1207
|
0
|
|
|
|
|
|
mkdir $directory; |
1208
|
|
|
|
|
|
|
} |
1209
|
|
|
|
|
|
|
|
1210
|
|
|
|
|
|
|
# look for existing files: |
1211
|
0
|
|
|
|
|
|
opendir( DIR, $directory ); |
1212
|
0
|
|
|
|
|
|
my @files = readdir(DIR); |
1213
|
0
|
|
|
|
|
|
my $max_index = 0; |
1214
|
0
|
|
|
|
|
|
foreach my $file (@files) { |
1215
|
0
|
|
|
|
|
|
my $temp_filename = $filename; |
1216
|
0
|
|
|
|
|
|
$temp_filename =~ s/\(/\\\(/g; |
1217
|
0
|
|
|
|
|
|
$temp_filename =~ s/\)/\\\)/g; |
1218
|
0
|
0
|
|
|
|
|
if ( $file =~ /($temp_filename)_(\d+)(\.*)\b/ ) { |
1219
|
0
|
0
|
|
|
|
|
if ( $2 > $max_index ) { |
1220
|
0
|
|
|
|
|
|
$max_index = $2; |
1221
|
|
|
|
|
|
|
} |
1222
|
|
|
|
|
|
|
} |
1223
|
|
|
|
|
|
|
} |
1224
|
0
|
|
|
|
|
|
closedir(DIR); |
1225
|
0
|
|
|
|
|
|
$max_index++; |
1226
|
|
|
|
|
|
|
|
1227
|
|
|
|
|
|
|
# create filename for saving plot as eps-file: |
1228
|
0
|
|
|
|
|
|
my $filename = $self->{FILENAME}; |
1229
|
0
|
|
|
|
|
|
$filename =~ /(.+)\.(.+)\b/; |
1230
|
0
|
|
|
|
|
|
$filename = sprintf( "%s_%02d", $1, $self->{ID} + 1 ); |
1231
|
|
|
|
|
|
|
|
1232
|
0
|
|
|
|
|
|
$gp .= "FILENAME = '" . $filename . "'; "; |
1233
|
0
|
|
|
|
|
|
$gp .= "FILE_INDEX = " . $max_index . "; \n"; |
1234
|
0
|
|
|
|
|
|
my $gpipe = $self->{gpipe}; |
1235
|
0
|
|
|
|
|
|
print $gpipe $gp; |
1236
|
0
|
|
|
|
|
|
$gp = ""; |
1237
|
|
|
|
|
|
|
|
1238
|
0
|
|
|
|
|
|
$gp .= "bind s \""; |
1239
|
0
|
|
|
|
|
|
$gp .= "print 'save...'; "; |
1240
|
0
|
|
|
|
|
|
$gp .= "set term png size 1024,600; "; |
1241
|
0
|
|
|
|
|
|
$gp .= "set output sprintf('%s_%02d.png', FILENAME, FILE_INDEX); "; |
1242
|
0
|
|
|
|
|
|
$gp .= "replot; "; |
1243
|
0
|
|
|
|
|
|
$gp .= "set term wxt; "; |
1244
|
0
|
|
|
|
|
|
$gp .= "FILE_INDEX = FILE_INDEX + 1; "; |
1245
|
0
|
|
|
|
|
|
$gp .= "\"; \n"; |
1246
|
0
|
|
|
|
|
|
my $gpipe = $self->{gpipe}; |
1247
|
0
|
|
|
|
|
|
print $gpipe $gp; |
1248
|
0
|
|
|
|
|
|
usleep(1e5); |
1249
|
0
|
|
|
|
|
|
print $gpipe "\n"; |
1250
|
|
|
|
|
|
|
} |
1251
|
|
|
|
|
|
|
} |
1252
|
|
|
|
|
|
|
|
1253
|
|
|
|
|
|
|
sub save_plot { |
1254
|
0
|
|
|
0
|
0
|
|
my $self = shift; |
1255
|
0
|
|
|
|
|
|
my $type = shift; |
1256
|
0
|
|
|
|
|
|
my $filename = shift; |
1257
|
|
|
|
|
|
|
|
1258
|
0
|
0
|
|
|
|
|
if ( not defined $type ) { |
1259
|
0
|
|
|
|
|
|
$type = 'png'; |
1260
|
|
|
|
|
|
|
} |
1261
|
|
|
|
|
|
|
|
1262
|
0
|
0
|
|
|
|
|
if ( not defined $filename ) { |
1263
|
0
|
|
|
|
|
|
$filename = "undefined.$type"; |
1264
|
|
|
|
|
|
|
} |
1265
|
|
|
|
|
|
|
|
1266
|
0
|
0
|
|
|
|
|
if ( $type eq 'eps' ) { |
|
|
0
|
|
|
|
|
|
1267
|
0
|
|
|
|
|
|
$self->_save_eps($filename); |
1268
|
|
|
|
|
|
|
} |
1269
|
|
|
|
|
|
|
elsif ( $type eq 'png' ) { |
1270
|
0
|
|
|
|
|
|
$self->_save_png($filename); |
1271
|
|
|
|
|
|
|
} |
1272
|
|
|
|
|
|
|
else { |
1273
|
0
|
|
|
|
|
|
warn |
1274
|
|
|
|
|
|
|
"in function 'save_plot': file type $type not defined. Possible types are 'png' and 'eps'."; |
1275
|
|
|
|
|
|
|
} |
1276
|
|
|
|
|
|
|
|
1277
|
0
|
|
|
|
|
|
return $self; |
1278
|
|
|
|
|
|
|
|
1279
|
|
|
|
|
|
|
} |
1280
|
|
|
|
|
|
|
|
1281
|
|
|
|
|
|
|
sub _save_eps { |
1282
|
0
|
|
|
0
|
|
|
my $self = shift; |
1283
|
0
|
|
|
|
|
|
my $filename = shift; |
1284
|
0
|
|
|
|
|
|
$filename .= '.eps'; |
1285
|
0
|
|
|
|
|
|
my %plot = $self->{plot}; |
1286
|
|
|
|
|
|
|
|
1287
|
|
|
|
|
|
|
#my %plot = %$plot; |
1288
|
0
|
|
|
|
|
|
my $gp; |
1289
|
|
|
|
|
|
|
|
1290
|
|
|
|
|
|
|
# set output to eps: |
1291
|
0
|
|
|
|
|
|
$gp .= "#\n# Output to file\n"; |
1292
|
0
|
|
|
|
|
|
$gp .= "set terminal postscript eps color size 13,9.75\n"; |
1293
|
0
|
|
|
|
|
|
$gp .= "set terminal postscript eps color enhanced\n"; |
1294
|
0
|
|
|
|
|
|
$gp .= "set output '$filename'\n"; |
1295
|
0
|
|
|
|
|
|
$gp .= "replot\n"; |
1296
|
|
|
|
|
|
|
|
1297
|
0
|
|
|
|
|
|
my $gpipe = $self->{gpipe}; |
1298
|
0
|
|
|
|
|
|
print $gpipe $gp; |
1299
|
|
|
|
|
|
|
|
1300
|
0
|
|
|
|
|
|
return 1; |
1301
|
|
|
|
|
|
|
|
1302
|
|
|
|
|
|
|
} |
1303
|
|
|
|
|
|
|
|
1304
|
|
|
|
|
|
|
sub _save_png { |
1305
|
0
|
|
|
0
|
|
|
my $self = shift; |
1306
|
0
|
|
|
|
|
|
my $filename = shift; |
1307
|
0
|
|
|
|
|
|
$filename .= '.png'; |
1308
|
0
|
|
|
|
|
|
my %plot = $self->{plot}; |
1309
|
|
|
|
|
|
|
|
1310
|
|
|
|
|
|
|
#my %plot = %$plot; |
1311
|
0
|
|
|
|
|
|
my $gp; |
1312
|
|
|
|
|
|
|
|
1313
|
|
|
|
|
|
|
# set output to eps: |
1314
|
0
|
|
|
|
|
|
$gp .= "#\n# Output to file\n"; |
1315
|
0
|
|
|
|
|
|
$gp .= "set terminal png\n"; |
1316
|
0
|
|
|
|
|
|
$gp .= "set output '$filename'\n"; |
1317
|
0
|
|
|
|
|
|
$gp .= "replot\n"; |
1318
|
|
|
|
|
|
|
|
1319
|
0
|
|
|
|
|
|
my $gpipe = $self->{gpipe}; |
1320
|
0
|
|
|
|
|
|
print $gpipe $gp; |
1321
|
|
|
|
|
|
|
|
1322
|
0
|
|
|
|
|
|
return 1; |
1323
|
|
|
|
|
|
|
|
1324
|
|
|
|
|
|
|
} |
1325
|
|
|
|
|
|
|
|
1326
|
|
|
|
|
|
|
sub datazone { |
1327
|
0
|
|
|
0
|
0
|
|
my $self = shift; |
1328
|
0
|
|
|
|
|
|
my $x_min = shift; |
1329
|
0
|
|
|
|
|
|
my $x_max = shift; |
1330
|
0
|
|
|
|
|
|
my $y_min = shift; |
1331
|
0
|
|
|
|
|
|
my $y_max = shift; |
1332
|
0
|
|
|
|
|
|
my $left = shift; |
1333
|
0
|
|
|
|
|
|
my $center = shift; |
1334
|
0
|
|
|
|
|
|
my $right = shift; |
1335
|
|
|
|
|
|
|
|
1336
|
0
|
|
|
|
|
|
my $gpipe = $self->{gpipe}; |
1337
|
|
|
|
|
|
|
|
1338
|
|
|
|
|
|
|
# info bar: |
1339
|
0
|
|
|
|
|
|
my $gp = "set style rect fc lt -1 fs solid 0.15 noborder\n"; |
1340
|
0
|
|
|
|
|
|
$gp |
1341
|
|
|
|
|
|
|
.= "set object 1 rect from " |
1342
|
|
|
|
|
|
|
. $x_min . "," |
1343
|
|
|
|
|
|
|
. ( $y_min + 0.03 * ( $y_max - $y_min ) ) . " to " |
1344
|
|
|
|
|
|
|
. $x_max . "," |
1345
|
|
|
|
|
|
|
. ( $y_min + 0.1 * ( $y_max - $y_min ) ) |
1346
|
|
|
|
|
|
|
. " behind\n"; |
1347
|
|
|
|
|
|
|
|
1348
|
0
|
|
|
|
|
|
$gp |
1349
|
|
|
|
|
|
|
.= "set label 1 at " |
1350
|
|
|
|
|
|
|
. ( $x_min + 0.025 * ( $x_max - $x_min ) ) . "," |
1351
|
|
|
|
|
|
|
. ( $y_min + 0.06 * ( $y_max - $y_min ) ) |
1352
|
|
|
|
|
|
|
. " left\n"; |
1353
|
0
|
|
|
|
|
|
$gp .= "set label 1 '$left'\n"; |
1354
|
|
|
|
|
|
|
|
1355
|
0
|
|
|
|
|
|
$gp |
1356
|
|
|
|
|
|
|
.= "set label 3 at " |
1357
|
|
|
|
|
|
|
. ( $x_min + 0.5 * ( $x_max - $x_min ) ) . "," |
1358
|
|
|
|
|
|
|
. ( $y_min + 0.06 * ( $y_max - $y_min ) ) |
1359
|
|
|
|
|
|
|
. " center\n"; |
1360
|
0
|
|
|
|
|
|
$gp .= "set label 3 '$center'\n"; |
1361
|
|
|
|
|
|
|
|
1362
|
0
|
|
|
|
|
|
$gp |
1363
|
|
|
|
|
|
|
.= "set label 2 at " |
1364
|
|
|
|
|
|
|
. ( $x_min + 0.975 * ( $x_max - $x_min ) ) . "," |
1365
|
|
|
|
|
|
|
. ( $y_min + 0.06 * ( $y_max - $y_min ) ) |
1366
|
|
|
|
|
|
|
. " right\n"; |
1367
|
0
|
|
|
|
|
|
$gp .= "set label 2 '$right'\n"; |
1368
|
|
|
|
|
|
|
|
1369
|
0
|
|
|
|
|
|
print $gpipe $gp; |
1370
|
|
|
|
|
|
|
|
1371
|
0
|
|
|
|
|
|
return $self; |
1372
|
|
|
|
|
|
|
|
1373
|
|
|
|
|
|
|
} |
1374
|
|
|
|
|
|
|
|
1375
|
|
|
|
|
|
|
1; |
1376
|
|
|
|
|
|
|
|
1377
|
|
|
|
|
|
|
__END__ |
1378
|
|
|
|
|
|
|
|
1379
|
|
|
|
|
|
|
=pod |
1380
|
|
|
|
|
|
|
|
1381
|
|
|
|
|
|
|
=encoding UTF-8 |
1382
|
|
|
|
|
|
|
|
1383
|
|
|
|
|
|
|
=head1 NAME |
1384
|
|
|
|
|
|
|
|
1385
|
|
|
|
|
|
|
Lab::XPRESS::Data::XPRESS_plotter - XPRESS plotting module |
1386
|
|
|
|
|
|
|
|
1387
|
|
|
|
|
|
|
=head1 VERSION |
1388
|
|
|
|
|
|
|
|
1389
|
|
|
|
|
|
|
version 3.880 |
1390
|
|
|
|
|
|
|
|
1391
|
|
|
|
|
|
|
=head1 COPYRIGHT AND LICENSE |
1392
|
|
|
|
|
|
|
|
1393
|
|
|
|
|
|
|
This software is copyright (c) 2023 by the Lab::Measurement team; in detail: |
1394
|
|
|
|
|
|
|
|
1395
|
|
|
|
|
|
|
Copyright 2012 Stefan Geissler |
1396
|
|
|
|
|
|
|
2013 Andreas K. Huettel, Christian Butschkow, Stefan Geissler |
1397
|
|
|
|
|
|
|
2016 Simon Reinhardt |
1398
|
|
|
|
|
|
|
2017 Andreas K. Huettel |
1399
|
|
|
|
|
|
|
2020 Andreas K. Huettel |
1400
|
|
|
|
|
|
|
|
1401
|
|
|
|
|
|
|
|
1402
|
|
|
|
|
|
|
This is free software; you can redistribute it and/or modify it under |
1403
|
|
|
|
|
|
|
the same terms as the Perl 5 programming language system itself. |
1404
|
|
|
|
|
|
|
|
1405
|
|
|
|
|
|
|
=cut |