annotate src/libvorbis-1.3.3/examples/frameview.pl @ 36:55ece8862b6d

Merge
author Chris Cannam
date Wed, 11 Mar 2015 13:32:44 +0000
parents 05aa0afa9217
children
rev   line source
Chris@1 1 #!/usr/bin/perl -w
Chris@1 2 use strict;
Chris@1 3 use Tk;
Chris@1 4 use Tk::Xrm;
Chris@1 5 use Tk qw(exit);
Chris@1 6
Chris@1 7 my $version="Analyzer 20020429";
Chris@1 8
Chris@1 9 my %bases;
Chris@1 10 my $first_file=undef;
Chris@1 11 my $last_file=undef;
Chris@1 12 my $fileno=0;
Chris@1 13
Chris@1 14 my @panel_labels;
Chris@1 15 my @panel_ones;
Chris@1 16 my @panel_twos;
Chris@1 17 my @panel_onevars;
Chris@1 18 my @panel_twovars;
Chris@1 19 my @panel_keys;
Chris@1 20 my $panel_count;
Chris@1 21
Chris@1 22 # pop the toplevels
Chris@1 23
Chris@1 24 my $toplevel=new MainWindow(-class=>'AnalyzerGraph');
Chris@1 25 my $Xname=$toplevel->Class;
Chris@1 26 $toplevel->optionAdd("$Xname.geometry", "800x600",20);
Chris@1 27
Chris@1 28 my $geometry=$toplevel->optionGet('geometry','');
Chris@1 29 $geometry=~/^(\d+)x(\d+)/;
Chris@1 30
Chris@1 31 $toplevel->configure(-width=>$1);
Chris@1 32 $toplevel->configure(-height=>$2);
Chris@1 33
Chris@1 34
Chris@1 35
Chris@1 36
Chris@1 37
Chris@1 38 $toplevel->optionAdd("$Xname.background", "#4fc627",20);
Chris@1 39 $toplevel->optionAdd("$Xname*highlightBackground", "#80c0d3",20);
Chris@1 40 $toplevel->optionAdd("$Xname.Panel.background", "#4fc627",20);
Chris@1 41 $toplevel->optionAdd("$Xname.Panel.foreground", "#d0d0d0",20);
Chris@1 42 $toplevel->optionAdd("$Xname.Panel.font",
Chris@1 43 '-*-helvetica-bold-r-*-*-18-*-*-*-*-*-*-*',20);
Chris@1 44 $toplevel->optionAdd("$Xname*Statuslabel.font",
Chris@1 45 '-*-helvetica-bold-r-*-*-18-*-*-*-*-*-*-*',20);
Chris@1 46 $toplevel->optionAdd("$Xname*Statuslabel.foreground", "#606060");
Chris@1 47 $toplevel->optionAdd("$Xname*Status.font",
Chris@1 48 '-*-helvetica-bold-r-*-*-18-*-*-*-*-*-*-*',20);
Chris@1 49
Chris@1 50 $toplevel->optionAdd("$Xname*AlertDetail.font",
Chris@1 51 '-*-helvetica-medium-r-*-*-10-*-*-*-*-*-*-*',20);
Chris@1 52
Chris@1 53
Chris@1 54 $toplevel->optionAdd("$Xname*background", "#d0d0d0",20);
Chris@1 55 $toplevel->optionAdd("$Xname*foreground", '#000000',20);
Chris@1 56
Chris@1 57 $toplevel->optionAdd("$Xname*Button*background", "#f0d0b0",20);
Chris@1 58 $toplevel->optionAdd("$Xname*Button*foreground", '#000000',20);
Chris@1 59 $toplevel->optionAdd("$Xname*Button*borderWidth", '2',20);
Chris@1 60 $toplevel->optionAdd("$Xname*Button*relief", 'groove',20);
Chris@1 61 $toplevel->optionAdd("$Xname*Button*padY", 1,20);
Chris@1 62
Chris@1 63 #$toplevel->optionAdd("$Xname*Scale*background", "#f0d0b0",20);
Chris@1 64 $toplevel->optionAdd("$Xname*Scale*foreground", '#000000',20);
Chris@1 65 $toplevel->optionAdd("$Xname*Scale*borderWidth", '1',20);
Chris@1 66 #$toplevel->optionAdd("$Xname*Scale*relief", 'groove',20);
Chris@1 67 $toplevel->optionAdd("$Xname*Scale*padY", 1,20);
Chris@1 68
Chris@1 69 $toplevel->optionAdd("$Xname*Checkbutton*background", "#f0d0b0",20);
Chris@1 70 $toplevel->optionAdd("$Xname*Checkbutton*foreground", '#000000',20);
Chris@1 71 $toplevel->optionAdd("$Xname*Checkbutton*borderWidth", '2',20);
Chris@1 72 $toplevel->optionAdd("$Xname*Checkbutton*relief", 'groove',20);
Chris@1 73
Chris@1 74 $toplevel->optionAdd("$Xname*activeBackground", "#ffffff",20);
Chris@1 75 $toplevel->optionAdd("$Xname*activeForeground", '#0000a0',20);
Chris@1 76 $toplevel->optionAdd("$Xname*borderWidth", 0,20);
Chris@1 77 $toplevel->optionAdd("$Xname*relief", 'flat',20);
Chris@1 78 $toplevel->optionAdd("$Xname*activeBorderWidth", 1,20);
Chris@1 79 $toplevel->optionAdd("$Xname*highlightThickness", 0,20);
Chris@1 80 $toplevel->optionAdd("$Xname*padX", 2,20);
Chris@1 81 $toplevel->optionAdd("$Xname*padY", 2,20);
Chris@1 82 $toplevel->optionAdd("$Xname*font",
Chris@1 83 '-*-helvetica-bold-r-*-*-12-*-*-*-*-*-*-*',20);
Chris@1 84 $toplevel->optionAdd("$Xname*Entry.font",
Chris@1 85 '-*-helvetica-medium-r-*-*-12-*-*-*-*-*-*-*',20);
Chris@1 86 $toplevel->optionAdd("$Xname*Exit.font",
Chris@1 87 '-*-helvetica-bold-r-*-*-10-*-*-*-*-*-*-*',20);
Chris@1 88 $toplevel->optionAdd("$Xname*Exit.relief", 'groove',20);
Chris@1 89 $toplevel->optionAdd("$Xname*Exit.padX", 1,20);
Chris@1 90 $toplevel->optionAdd("$Xname*Exit.padY", 1,20);
Chris@1 91 $toplevel->optionAdd("$Xname*Exit.borderWidth", 2,20);
Chris@1 92 $toplevel->optionAdd("$Xname*Exit*background", "#a0a0a0",20);
Chris@1 93 $toplevel->optionAdd("$Xname*Exit*disabledForeground", "#ffffff",20);
Chris@1 94
Chris@1 95 #$toplevel->optionAdd("$Xname*Canvas.background", "#c0c0c0",20);
Chris@1 96
Chris@1 97 $toplevel->optionAdd("$Xname*Entry.background", "#ffffff",20);
Chris@1 98 $toplevel->optionAdd("$Xname*Entry.disabledForeground", "#c0c0c0",20);
Chris@1 99 $toplevel->optionAdd("$Xname*Entry.relief", "sunken",20);
Chris@1 100 $toplevel->optionAdd("$Xname*Entry.borderWidth", 1,20);
Chris@1 101
Chris@1 102 $toplevel->optionAdd("$Xname*Field.background", "#ffffff",20);
Chris@1 103 $toplevel->optionAdd("$Xname*Field.disabledForeground", "#c0c0c0",20);
Chris@1 104 $toplevel->optionAdd("$Xname*Field.relief", "flat",20);
Chris@1 105 $toplevel->optionAdd("$Xname*Field.borderWidth", 1,20);
Chris@1 106
Chris@1 107 $toplevel->optionAdd("$Xname*Label.disabledForeground", "#c0c0c0",20);
Chris@1 108 $toplevel->optionAdd("$Xname*Label.borderWidth", 1,20);
Chris@1 109
Chris@1 110 $toplevel->configure(-background=>$toplevel->optionGet("background",""));
Chris@1 111
Chris@1 112 #$toplevel->resizable(FALSE,FALSE);
Chris@1 113
Chris@1 114 my $panel=new MainWindow(-class=>'AnalyzerPanel');
Chris@1 115 my $X2name=$panel->Class;
Chris@1 116
Chris@1 117 $panel->optionAdd("$X2name.background", "#353535",20);
Chris@1 118 $panel->optionAdd("$X2name*highlightBackground", "#80c0d3",20);
Chris@1 119 $panel->optionAdd("$X2name.Panel.background", "#353535",20);
Chris@1 120 $panel->optionAdd("$X2name.Panel.foreground", "#4fc627",20);
Chris@1 121 $panel->optionAdd("$X2name.Panel.font",
Chris@1 122 '-*-helvetica-bold-o-*-*-18-*-*-*-*-*-*-*',20);
Chris@1 123 $panel->optionAdd("$X2name*Statuslabel.font",
Chris@1 124 '-*-helvetica-bold-r-*-*-18-*-*-*-*-*-*-*',20);
Chris@1 125 $panel->optionAdd("$X2name*Statuslabel.foreground", "#4fc627",20);
Chris@1 126 $panel->optionAdd("$X2name*Status.font",
Chris@1 127 '-*-helvetica-bold-r-*-*-18-*-*-*-*-*-*-*',20);
Chris@1 128
Chris@1 129 $panel->optionAdd("$X2name*AlertDetail.font",
Chris@1 130 '-*-helvetica-medium-r-*-*-10-*-*-*-*-*-*-*',20);
Chris@1 131
Chris@1 132
Chris@1 133 $panel->optionAdd("$X2name*background", "#d0d0d0",20);
Chris@1 134 $panel->optionAdd("$X2name*foreground", '#000000',20);
Chris@1 135
Chris@1 136 $panel->optionAdd("$X2name*Button*background", "#f0d0b0",20);
Chris@1 137 $panel->optionAdd("$X2name*Button*foreground", '#000000',20);
Chris@1 138 $panel->optionAdd("$X2name*Button*borderWidth", '2',20);
Chris@1 139 $panel->optionAdd("$X2name*Button*relief", 'groove',20);
Chris@1 140 $panel->optionAdd("$X2name*Button*padY", 1,20);
Chris@1 141
Chris@1 142 $panel->optionAdd("$X2name*Checkbutton*background", "#f0d0b0",20);
Chris@1 143 $panel->optionAdd("$X2name*Checkbutton*foreground", '#000000',20);
Chris@1 144 $panel->optionAdd("$X2name*Checkbutton*borderWidth", '2',20);
Chris@1 145 #$panel->optionAdd("$X2name*Checkbutton*padX", '0',20);
Chris@1 146 #$panel->optionAdd("$X2name*Checkbutton*padY", '0',20);
Chris@1 147 #$panel->optionAdd("$X2name*Checkbutton*relief", 'groove',20);
Chris@1 148
Chris@1 149 $panel->optionAdd("$X2name*activeBackground", "#ffffff",20);
Chris@1 150 $panel->optionAdd("$X2name*activeForeground", '#0000a0',20);
Chris@1 151 $panel->optionAdd("$X2name*borderWidth", 0,20);
Chris@1 152 $panel->optionAdd("$X2name*relief", 'flat',20);
Chris@1 153 $panel->optionAdd("$X2name*activeBorderWidth", 1,20);
Chris@1 154 $panel->optionAdd("$X2name*highlightThickness", 0,20);
Chris@1 155 $panel->optionAdd("$X2name*padX", 2,20);
Chris@1 156 $panel->optionAdd("$X2name*padY", 2,20);
Chris@1 157 $panel->optionAdd("$X2name*font",
Chris@1 158 '-*-helvetica-bold-r-*-*-12-*-*-*-*-*-*-*',20);
Chris@1 159 $panel->optionAdd("$X2name*Entry.font",
Chris@1 160 '-*-helvetica-medium-r-*-*-12-*-*-*-*-*-*-*',20);
Chris@1 161
Chris@1 162 $panel->optionAdd("$X2name*Exit.font",
Chris@1 163 '-*-helvetica-bold-r-*-*-10-*-*-*-*-*-*-*',20);
Chris@1 164 $panel->optionAdd("$X2name*Exit.relief", 'groove',20);
Chris@1 165 $panel->optionAdd("$X2name*Exit.padX", 1,20);
Chris@1 166 $panel->optionAdd("$X2name*Exit.padY", 1,20);
Chris@1 167 $panel->optionAdd("$X2name*Exit.borderWidth", 2,20);
Chris@1 168 $panel->optionAdd("$X2name*Exit*background", "#a0a0a0",20);
Chris@1 169 $panel->optionAdd("$X2name*Exit*disabledForeground", "#ffffff",20);
Chris@1 170
Chris@1 171 $panel->optionAdd("$X2name*Entry.background", "#ffffff",20);
Chris@1 172 $panel->optionAdd("$X2name*Entry.disabledForeground", "#c0c0c0",20);
Chris@1 173 $panel->optionAdd("$X2name*Entry.relief", "sunken",20);
Chris@1 174 $panel->optionAdd("$X2name*Entry.borderWidth", 1,20);
Chris@1 175
Chris@1 176 $panel->optionAdd("$X2name*Field.background", "#ffffff",20);
Chris@1 177 $panel->optionAdd("$X2name*Field.disabledForeground", "#c0c0c0",20);
Chris@1 178 $panel->optionAdd("$X2name*Field.relief", "flat",20);
Chris@1 179 $panel->optionAdd("$X2name*Field.borderWidth", 1,20);
Chris@1 180
Chris@1 181 $panel->optionAdd("$X2name*Label.disabledForeground", "#c0c0c0",20);
Chris@1 182 $panel->optionAdd("$X2name*Label.borderWidth", 1,20);
Chris@1 183
Chris@1 184 $panel->configure(-background=>$panel->optionGet("background",""));
Chris@1 185
Chris@1 186 #$panel->resizable("FALSE","FALSE");
Chris@1 187
Chris@1 188 my $panel_shell=$panel->Label(Name=>"shell",-borderwidth=>1,-relief=>'raised')->
Chris@1 189 place(-x=>10,-y=>36,-relwidth=>1.0,-relheight=>1.0,
Chris@1 190 -width=>-20,-height=>-46,-anchor=>'nw');
Chris@1 191
Chris@1 192 my $panel_quit=$panel_shell->Button(-class=>"Exit",-text=>"quit",-command=>[sub{Shutdown()}])->
Chris@1 193 place(-x=>-1,-y=>-1,-relx=>1.0,-rely=>1.0,-anchor=>'se');
Chris@1 194
Chris@1 195 $panel->Label(Name=>"logo text",-class=>"Panel",-text=>$version)->
Chris@1 196 place(-x=>5,-y=>5,-anchor=>'nw');
Chris@1 197
Chris@1 198
Chris@1 199 my $graph_shell=$toplevel->Label(Name=>"shell",-borderwidth=>1,-relief=>'raised')->
Chris@1 200 place(-x=>10,-y=>36,-relwidth=>1.0,-relheight=>1.0,
Chris@1 201 -width=>-20,-height=>-46,-anchor=>'nw');
Chris@1 202
Chris@1 203 my $graph_status=$toplevel->Label(Name=>"logo text",-class=>"Panel",-text=>"Starting up")->
Chris@1 204 place(-x=>5,-y=>5,-anchor=>'nw');
Chris@1 205
Chris@1 206
Chris@1 207 my $panely=5;
Chris@1 208 my $panel_rescan=$panel_shell->Button(-text=>"rescan",-command=>[sub{scan_directory()}])->
Chris@1 209 place(-x=>-5,-relx=>1.,-y=>$panely,-anchor=>'ne');
Chris@1 210 $panely+=$panel_rescan->reqheight()+6;
Chris@1 211
Chris@1 212
Chris@1 213 my$temp=$graph_shell->Button(-text=>"<<",
Chris@1 214 -command=>[sub{$fileno-=10;$fileno=$first_file if($fileno<$first_file);
Chris@1 215 load_graph();}])->
Chris@1 216 place(-x=>5,-y=>-5,-rely=>1.,-relwidth=>.2,-width=>-5,-anchor=>'sw');
Chris@1 217 $graph_shell->Button(-text=>">>",
Chris@1 218 -command=>[sub{$fileno+=10;$fileno=$last_file if($fileno>$last_file);
Chris@1 219 load_graph();}])->
Chris@1 220 place(-x=>-5,-y=>-5,-relwidth=>.2,-rely=>1.,-width=>-5,-relx=>1.,-anchor=>'se');
Chris@1 221 $graph_shell->Button(-text=>"<",
Chris@1 222 -command=>[sub{$fileno-=1;$fileno=$first_file if($fileno<$first_file);
Chris@1 223 load_graph();}])->
Chris@1 224 place(-x=>5,-y=>-5,-relwidth=>.3,-width=>-7,-rely=>1.,-relx=>.2,-anchor=>'sw');
Chris@1 225 $graph_shell->Button(-text=>">",
Chris@1 226 -command=>[sub{$fileno+=1;$fileno=$last_file if($fileno>$last_file);
Chris@1 227 load_graph();}])->
Chris@1 228 place(-x=>-5,-y=>-5,-relwidth=>.3,-width=>-7,-rely=>1.,-relx=>.8,-anchor=>'se');
Chris@1 229 my$graphy=-10-$temp->reqheight();
Chris@1 230 my$graph_slider=$temp=$graph_shell->Scale(-bigincrement=>1,
Chris@1 231 -resolution=>1,
Chris@1 232 -showvalue=>'TRUE',-variable=>\$fileno,-orient=>'horizontal')->
Chris@1 233 place(-x=>5,-y=>$graphy,-relwidth=>1.,-rely=>1.,-width=>-10,-anchor=>'sw');
Chris@1 234 $graphy-=$temp->reqheight()+5;
Chris@1 235
Chris@1 236 my$onecrop;
Chris@1 237 my$twocrop;
Chris@1 238
Chris@1 239 my$oneresize=$temp=$graph_shell->Checkbutton(-text=>"rescale",-variable=>\$onecrop,
Chris@1 240 -command=>[sub{draw_graph();}])->
Chris@1 241 place(-x=>5,-y=>5,-anchor=>'nw');
Chris@1 242
Chris@1 243 my$one=$graph_shell->Canvas()->
Chris@1 244 place(-relwidth=>1.,-width=>-10,-relheight=>.5,-height=>($graphy/2)-5-$temp->reqheight(),
Chris@1 245 -x=>5,-y=>5+$temp->reqheight,-anchor=>'nw');
Chris@1 246
Chris@1 247
Chris@1 248 my$tworesize=$temp=$graph_shell->Checkbutton(-text=>"rescale",-variable=>\$twocrop,
Chris@1 249 -command=>[sub{draw_graph();}])->
Chris@1 250 place(-rely=>1.,-y=>5,-anchor=>'nw',-in=>$one);
Chris@1 251 my$two=$graph_shell->Canvas()->
Chris@1 252 place(-relwidth=>1.,-relheight=>1.,-rely=>1.,-y=>5+$temp->reqheight(),-anchor=>'nw',-in=>$one);
Chris@1 253
Chris@1 254 scan_directory();
Chris@1 255
Chris@1 256 my%onestate;
Chris@1 257 my%twostate;
Chris@1 258 my @data;
Chris@1 259
Chris@1 260 $onestate{"canvas"}=$one;
Chris@1 261 $onestate{"vars"}=\@panel_onevars;
Chris@1 262 $twostate{"canvas"}=$two;
Chris@1 263 $twostate{"vars"}=\@panel_twovars;
Chris@1 264
Chris@1 265 $graph_slider->configure(-command=>[sub{load_graph()}]);
Chris@1 266 load_graph();
Chris@1 267 $toplevel->bind('MainWindow','<Configure>',[sub{$toplevel->update();
Chris@1 268 draw_graph()}]);
Chris@1 269
Chris@1 270 Tk::MainLoop();
Chris@1 271
Chris@1 272 sub load_graph{
Chris@1 273
Chris@1 274 scan_directory()if(!defined($panel_count));
Chris@1 275
Chris@1 276 @data=undef;
Chris@1 277
Chris@1 278 for(my$i=0;$i<$panel_count;$i++){
Chris@1 279 my$filename=$panel_keys[$i]."_$fileno.m";
Chris@1 280 if(open F, "$filename"){
Chris@1 281 $data[$i]=[(<F>)];
Chris@1 282 close F;
Chris@1 283 }
Chris@1 284 }
Chris@1 285 draw_graph();
Chris@1 286 }
Chris@1 287
Chris@1 288 sub graphhelper{
Chris@1 289 my($graph)=@_;
Chris@1 290 my$count=0;
Chris@1 291 my@colors=("#ff0000","#00df00","#0000ff","#ffff00","#ff00ff","#00ffff","#ffffff",
Chris@1 292 "#9f0000","#007f00","#00009f","#8f8f00","#8f008f","#008f8f","#000000");
Chris@1 293
Chris@1 294 my$w=$graph->{"canvas"};
Chris@1 295 my$rescale=0;
Chris@1 296
Chris@1 297 Status("Plotting $fileno");
Chris@1 298 $w->delete('foo');
Chris@1 299 $w->delete('legend');
Chris@1 300 $w->delete('lines');
Chris@1 301
Chris@1 302 # count range
Chris@1 303 for(my$i=0;$i<$panel_count;$i++){
Chris@1 304 if($graph->{"vars"}->[$i]){
Chris@1 305 if(defined($data[$i])){
Chris@1 306 if(!defined($graph->{"minx"})){
Chris@1 307 $data[$i]->[0]=~m/^\s*(-?[0-9\.]*)[ ,]+(-?[0-9\.]*)/;
Chris@1 308 $graph->{"maxx"}=$1;
Chris@1 309 $graph->{"minx"}=$1;
Chris@1 310 $graph->{"maxy"}=$2;
Chris@1 311 $graph->{"miny"}=$2;
Chris@1 312 $rescale=1;
Chris@1 313 }
Chris@1 314
Chris@1 315 for(my$j=0;$j<=$#{$data[$i]};$j++){
Chris@1 316 $data[$i]->[$j]=~m/^\s*(-?[0-9\.]*)[ ,]+(-?[0-9\.]*)/;
Chris@1 317 $rescale=1 if($1>$graph->{"maxx"});
Chris@1 318 $rescale=1 if($1<$graph->{"minx"});
Chris@1 319 $rescale=1 if($2>$graph->{"maxy"});
Chris@1 320 $rescale=1 if($2<$graph->{"miny"});
Chris@1 321 $graph->{"maxx"}=$1 if($1>$graph->{"maxx"});
Chris@1 322 $graph->{"minx"}=$1 if($1<$graph->{"minx"});
Chris@1 323 $graph->{"maxy"}=$2 if($2>$graph->{"maxy"});
Chris@1 324 $graph->{"miny"}=$2 if($2<$graph->{"miny"});
Chris@1 325 }
Chris@1 326 }
Chris@1 327 $count++;
Chris@1 328 }
Chris@1 329 }
Chris@1 330
Chris@1 331 my$width=$w->width();
Chris@1 332 my$height=$w->height();
Chris@1 333
Chris@1 334 $rescale=1 if(!defined($graph->{"width"}) ||
Chris@1 335 $width!=$graph->{"width"} ||
Chris@1 336 $height!=$graph->{"height"});
Chris@1 337
Chris@1 338 $graph->{"width"}=$width;
Chris@1 339 $graph->{"height"}=$height;
Chris@1 340
Chris@1 341 if(defined($graph->{"maxx"})){
Chris@1 342 # draw axes, labels
Chris@1 343 # look for appropriate axis scales
Chris@1 344
Chris@1 345 if($rescale){
Chris@1 346
Chris@1 347 $w->delete('ylabel');
Chris@1 348 $w->delete('xlabel');
Chris@1 349 $w->delete('axes');
Chris@1 350
Chris@1 351 my$yscale=1.;
Chris@1 352 my$xscale=1.;
Chris@1 353 my$iyscale=1.;
Chris@1 354 my$ixscale=1.;
Chris@1 355 while(($graph->{"maxx"}-$graph->{"minx"})*$xscale>15){$xscale*=.1;$ixscale*=10.;}
Chris@1 356 while(($graph->{"maxy"}-$graph->{"miny"})*$yscale>15){$yscale*=.1;$iyscale*=10.;}
Chris@1 357
Chris@1 358 while(($graph->{"maxx"}-$graph->{"minx"})*$xscale<3){$xscale*=10.;$ixscale*=.1;}
Chris@1 359 while(($graph->{"maxy"}-$graph->{"miny"})*$yscale<3){$yscale*=10.;$iyscale*=.1;}
Chris@1 360
Chris@1 361 # how tall are the x axis labels?
Chris@1 362 $w->createText(-1,-1,-anchor=>'se',-tags=>['foo'],-text=>"0123456789.");
Chris@1 363 my($x1,$y1,$x2,$y2)=$w->bbox('foo');
Chris@1 364 $w->delete('foo');
Chris@1 365 my$maxlabelheight=$y2-$y1;
Chris@1 366 my$useabley=$height-$maxlabelheight-3;
Chris@1 367 my$pixelpery=$useabley/($graph->{"maxy"}-$graph->{"miny"});
Chris@1 368
Chris@1 369 # place y axis labels at proper spacing/height
Chris@1 370 my$lasty=-$maxlabelheight/2;
Chris@1 371 my$topyval=int($graph->{"maxy"}*$yscale+1.)*$iyscale;
Chris@1 372
Chris@1 373 for(my$i=0;;$i++){
Chris@1 374 my$yval= $topyval-$i*$iyscale;
Chris@1 375 my$y= ($graph->{"maxy"}-$yval)*$pixelpery;
Chris@1 376 last if($y>$useabley);
Chris@1 377 if($y-$maxlabelheight>=$lasty){
Chris@1 378 $w->createText(0,$y,-anchor=>'e',-tags=>['ylabel'],-text=>"$yval");
Chris@1 379 $lasty=$y;
Chris@1 380 }
Chris@1 381 }
Chris@1 382
Chris@1 383 # get the max ylabel width and place them at proper x
Chris@1 384 ($x1,$y1,$x2,$y2)=$w->bbox('ylabel');
Chris@1 385 my$maxylabelwidth=$x2-$x1;
Chris@1 386 $w->move('ylabel',$maxylabelwidth,0);
Chris@1 387
Chris@1 388 my$beginx=$maxylabelwidth+3;
Chris@1 389 my$useablex=$width-$beginx;
Chris@1 390
Chris@1 391 # draw basic axes
Chris@1 392 $w->createLine($beginx,0,$beginx,$useabley,$width,$useabley,
Chris@1 393 -tags=>['axes'],-width=>2);
Chris@1 394 # draw y tix
Chris@1 395 $lasty=-$maxlabelheight/2;
Chris@1 396 for(my$i=0;;$i++){
Chris@1 397 my$yval= $topyval-$i*$iyscale;
Chris@1 398 my$y= ($graph->{"maxy"}-$yval)*$pixelpery;
Chris@1 399 last if($y>$useabley);
Chris@1 400 if($yval==0){
Chris@1 401 $w->createLine($beginx,$y,$width,$y,
Chris@1 402 -tags=>['axes'],-width=>1);
Chris@1 403 }else{
Chris@1 404 if($y-$maxlabelheight>=$lasty){
Chris@1 405 $w->createLine($beginx,$y,$width,$y,
Chris@1 406 -tags=>['axes'],-width=>1,
Chris@1 407 -stipple=>'gray50');
Chris@1 408
Chris@1 409 $lasty=$y;
Chris@1 410 }
Chris@1 411 }
Chris@1 412 }
Chris@1 413
Chris@1 414 # place x axis labels at proper spacing
Chris@1 415 my$topxval=int($graph->{"maxx"}*$xscale+1.)*$ixscale;
Chris@1 416 my$pixelperx=$useablex/($graph->{"maxx"}-$graph->{"minx"});
Chris@1 417
Chris@1 418 for(my$i=0;;$i++){
Chris@1 419 my$xval= $topxval-$i*$ixscale;
Chris@1 420 my$x= $width-($graph->{"maxx"}-$xval)*$pixelperx;
Chris@1 421
Chris@1 422 last if($x<$beginx);
Chris@1 423 # bounding boxen are hard. place temp labels.
Chris@1 424 $w->createText(-1,-1,-anchor=>'e',-tags=>['foo'],-text=>"$xval");
Chris@1 425 }
Chris@1 426
Chris@1 427 ($x1,$y1,$x2,$y2)=$w->bbox('foo');
Chris@1 428 my$maxxlabelwidth=$x2-$x1;
Chris@1 429 $w->delete('foo');
Chris@1 430 my$lastx=$width;
Chris@1 431
Chris@1 432 for(my$i=0;;$i++){
Chris@1 433 my$xval= $topxval-$i*$ixscale;
Chris@1 434 my$x= $width-($graph->{"maxx"}-$xval)*$pixelperx;
Chris@1 435
Chris@1 436 last if($x-$maxxlabelwidth/2<0 || $x<$beginx);
Chris@1 437 if($xval==0 && $x<$width){
Chris@1 438 $w->createLine($x,0,$x,$useabley,-tags=>['axes'],-width=>1);
Chris@1 439 }
Chris@1 440
Chris@1 441 if($x+$maxxlabelwidth<=$lastx){
Chris@1 442 $w->createText($x,$height-1,-anchor=>'s',-tags=>['xlabel'],-text=>"$xval");
Chris@1 443 $w->createLine($x,0,$x,$useabley,-tags=>['axes'],-width=>1,-stipple=>"gray50");
Chris@1 444 $lastx=$x;
Chris@1 445 }
Chris@1 446 }
Chris@1 447 $graph->{"labelheight"}=$maxlabelheight;
Chris@1 448 $graph->{"xo"}=$beginx;
Chris@1 449 $graph->{"ppx"}=$pixelperx;
Chris@1 450 $graph->{"ppy"}=$pixelpery;
Chris@1 451 }
Chris@1 452
Chris@1 453 # plot the files
Chris@1 454 $count=0;
Chris@1 455 my$legendy=$graph->{"labelheight"}/2;
Chris@1 456 for(my$i=0;$i<$panel_count;$i++){
Chris@1 457 if($graph->{"vars"}->[$i]){
Chris@1 458 $count++; # count here for legend color selection stability
Chris@1 459 if(defined($data[$i])){
Chris@1 460 # place a legend placard;
Chris@1 461 my$color=$colors[($count-1)%($#colors+1)];
Chris@1 462 $w->createText($width,$legendy,-anchor=>'e',-tags=>['legend'],
Chris@1 463 -fill=>$color,-text=>$panel_keys[$i]);
Chris@1 464 $legendy+=$graph->{"labelheight"};
Chris@1 465
Chris@1 466 # plot the lines
Chris@1 467 my@pairs=map{if(/^\s*(-?[0-9\.]*)[ ,]+(-?[0-9\.]*)/){
Chris@1 468 (($1-$graph->{"minx"})*$graph->{"ppx"}+$graph->{"xo"},
Chris@1 469 (-$2+$graph->{"maxy"})*$graph->{"ppy"})}} (@{$data[$i]});
Chris@1 470
Chris@1 471 $w->createLine((@pairs),-fill=>$color,-tags=>['lines']);
Chris@1 472 }
Chris@1 473 }
Chris@1 474 }
Chris@1 475 }
Chris@1 476 }
Chris@1 477
Chris@1 478 sub draw_graph{
Chris@1 479
Chris@1 480 if($onecrop){
Chris@1 481 $onestate{"minx"}=undef;
Chris@1 482 $onestate{"miny"}=undef;
Chris@1 483 $onestate{"maxx"}=undef;
Chris@1 484 $onestate{"maxy"}=undef;
Chris@1 485 }
Chris@1 486 if($twocrop){
Chris@1 487 $twostate{"minx"}=undef;
Chris@1 488 $twostate{"miny"}=undef;
Chris@1 489 $twostate{"maxx"}=undef;
Chris@1 490 $twostate{"maxy"}=undef;
Chris@1 491 }
Chris@1 492
Chris@1 493 for(my$i=0;$i<$panel_count;$i++){
Chris@1 494 if($twostate{"vars"}->[$i]){
Chris@1 495
Chris@1 496 #re-place the canvases
Chris@1 497
Chris@1 498 $oneresize->place(-x=>5,-y=>5,-anchor=>'nw');
Chris@1 499
Chris@1 500 $one->place(-relwidth=>1.,-width=>-10,-relheight=>.5,
Chris@1 501 -height=>($graphy/2)-5-$oneresize->reqheight(),
Chris@1 502 -x=>5,-y=>5+$oneresize->reqheight,-anchor=>'nw');
Chris@1 503
Chris@1 504 $tworesize->place(-rely=>1.,-y=>5,-anchor=>'nw',-in=>$one);
Chris@1 505 $two->place(-relwidth=>1.,-relheight=>1.,-rely=>1.,
Chris@1 506 -y=>5+$tworesize->reqheight(),-anchor=>'nw',-in=>$one);
Chris@1 507
Chris@1 508 graphhelper(\%onestate);
Chris@1 509 graphhelper(\%twostate);
Chris@1 510 return;
Chris@1 511 }
Chris@1 512 }
Chris@1 513
Chris@1 514 $oneresize->place(-x=>5,-y=>5,-anchor=>'nw');
Chris@1 515
Chris@1 516 $one->place(-relwidth=>1.,-width=>-10,-relheight=>1.,
Chris@1 517 -height=>$graphy-5-$oneresize->reqheight(),
Chris@1 518 -x=>5,-y=>5+$oneresize->reqheight,-anchor=>'nw');
Chris@1 519
Chris@1 520 $tworesize->placeForget();
Chris@1 521 $two->placeForget();
Chris@1 522
Chris@1 523 graphhelper(\%onestate);
Chris@1 524 }
Chris@1 525
Chris@1 526 sub depopulate_panel{
Chris@1 527 my $win;
Chris@1 528 foreach $win (@panel_labels){
Chris@1 529 $win->destroy();
Chris@1 530 }
Chris@1 531 @panel_labels=();
Chris@1 532 foreach $win (@panel_ones){
Chris@1 533 $win->destroy();
Chris@1 534 }
Chris@1 535 @panel_ones=();
Chris@1 536 foreach $win (@panel_twos){
Chris@1 537 $win->destroy();
Chris@1 538 }
Chris@1 539 @panel_twos=();
Chris@1 540 @panel_keys=();
Chris@1 541 }
Chris@1 542
Chris@1 543 sub populate_panel{
Chris@1 544 my $localy=$panely;
Chris@1 545 my $key;
Chris@1 546 my $i=0;
Chris@1 547 foreach $key (sort (keys %bases)){
Chris@1 548 $panel_keys[$i]=$key;
Chris@1 549 if(!defined($panel_onevars[$i])){
Chris@1 550 $panel_onevars[$i]=0;
Chris@1 551 $panel_twovars[$i]=0;
Chris@1 552 }
Chris@1 553
Chris@1 554 my $temp=$panel_twos[$i]=$panel_shell->
Chris@1 555 Checkbutton(-variable=>\$panel_twovars[$i],-command=>['main::draw_graph'],-text=>'2')->
Chris@1 556 place(-y=>$localy,-x=>-5,-anchor=>"ne",-relx=>1.);
Chris@1 557 my $oney=$temp->reqheight();
Chris@1 558 my $onex=$temp->reqwidth()+15;
Chris@1 559
Chris@1 560 $temp=$panel_ones[$i]=$panel_shell->
Chris@1 561 Checkbutton(-variable=>\$panel_onevars[$i],-command=>['main::draw_graph'],-text=>'1')->
Chris@1 562 place(-y=>0,-x=>0,-anchor=>"ne",-in=>$temp,-bordermode=>'outside');
Chris@1 563 $oney=$temp->reqheight() if ($oney<$temp->reqheight());
Chris@1 564 $onex+=$temp->reqwidth();
Chris@1 565
Chris@1 566 $temp=$panel_labels[$i]=$panel_shell->Label(-text=>$key,-class=>'Field',-justify=>'left')->
Chris@1 567 place(-y=>$localy,-x=>5,-anchor=>"nw",-relwidth=>1.,-width=>-$onex,
Chris@1 568 -bordermode=>'outside');
Chris@1 569 $oney=$temp->reqheight() if ($oney<$temp->reqheight());
Chris@1 570
Chris@1 571 $localy+=$oney+2;
Chris@1 572 $i++;
Chris@1 573 }
Chris@1 574 $panel_count=$i;
Chris@1 575
Chris@1 576 $localy+=$panel_quit->reqheight()+50;
Chris@1 577 my $geometry=$panel->geometry();
Chris@1 578 $geometry=~/^(\d+)/;
Chris@1 579
Chris@1 580 $panel->configure(-height=>$localy);
Chris@1 581 $panel->configure(-width=>$1);
Chris@1 582 }
Chris@1 583
Chris@1 584 sub Shutdown{
Chris@1 585 Tk::exit();
Chris@1 586 }
Chris@1 587
Chris@1 588 sub Status{
Chris@1 589 my$text=shift @_;
Chris@1 590 $graph_status->configure(-text=>"$text");
Chris@1 591 $toplevel->update();
Chris@1 592 }
Chris@1 593
Chris@1 594 sub scan_directory{
Chris@1 595
Chris@1 596 %bases=();
Chris@1 597 my$count=0;
Chris@1 598
Chris@1 599 $first_file=undef;
Chris@1 600 $last_file=undef;
Chris@1 601
Chris@1 602 if(opendir(D,".")){
Chris@1 603 my$file;
Chris@1 604 while(defined($file=readdir(D))){
Chris@1 605 if($file=~m/^(\S*)_(\d+).m/){
Chris@1 606 $bases{"$1"}="0";
Chris@1 607 $first_file=$2 if(!defined($first_file) || $2<$first_file);
Chris@1 608 $last_file=$2 if(!defined($last_file) || $2>$last_file);
Chris@1 609 $count++;
Chris@1 610
Chris@1 611 Status("Reading... $count")if($count%117==0);
Chris@1 612 }
Chris@1 613 }
Chris@1 614 closedir(D);
Chris@1 615 }
Chris@1 616 Status("Done Reading: $count files");
Chris@1 617 depopulate_panel();
Chris@1 618 populate_panel();
Chris@1 619
Chris@1 620 $fileno=$first_file if($fileno<$first_file);
Chris@1 621 $fileno=$last_file if($fileno>$last_file);
Chris@1 622
Chris@1 623 $graph_slider->configure(-from=>$first_file,-to=>$last_file);
Chris@1 624
Chris@1 625 }
Chris@1 626
Chris@1 627
Chris@1 628
Chris@1 629
Chris@1 630