| 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 |