Chris@1: #!/usr/bin/perl -w Chris@1: use strict; Chris@1: use Tk; Chris@1: use Tk::Xrm; Chris@1: use Tk qw(exit); Chris@1: Chris@1: my $version="Analyzer 20020429"; Chris@1: Chris@1: my %bases; Chris@1: my $first_file=undef; Chris@1: my $last_file=undef; Chris@1: my $fileno=0; Chris@1: Chris@1: my @panel_labels; Chris@1: my @panel_ones; Chris@1: my @panel_twos; Chris@1: my @panel_onevars; Chris@1: my @panel_twovars; Chris@1: my @panel_keys; Chris@1: my $panel_count; Chris@1: Chris@1: # pop the toplevels Chris@1: Chris@1: my $toplevel=new MainWindow(-class=>'AnalyzerGraph'); Chris@1: my $Xname=$toplevel->Class; Chris@1: $toplevel->optionAdd("$Xname.geometry", "800x600",20); Chris@1: Chris@1: my $geometry=$toplevel->optionGet('geometry',''); Chris@1: $geometry=~/^(\d+)x(\d+)/; Chris@1: Chris@1: $toplevel->configure(-width=>$1); Chris@1: $toplevel->configure(-height=>$2); Chris@1: Chris@1: Chris@1: Chris@1: Chris@1: Chris@1: $toplevel->optionAdd("$Xname.background", "#4fc627",20); Chris@1: $toplevel->optionAdd("$Xname*highlightBackground", "#80c0d3",20); Chris@1: $toplevel->optionAdd("$Xname.Panel.background", "#4fc627",20); Chris@1: $toplevel->optionAdd("$Xname.Panel.foreground", "#d0d0d0",20); Chris@1: $toplevel->optionAdd("$Xname.Panel.font", Chris@1: '-*-helvetica-bold-r-*-*-18-*-*-*-*-*-*-*',20); Chris@1: $toplevel->optionAdd("$Xname*Statuslabel.font", Chris@1: '-*-helvetica-bold-r-*-*-18-*-*-*-*-*-*-*',20); Chris@1: $toplevel->optionAdd("$Xname*Statuslabel.foreground", "#606060"); Chris@1: $toplevel->optionAdd("$Xname*Status.font", Chris@1: '-*-helvetica-bold-r-*-*-18-*-*-*-*-*-*-*',20); Chris@1: Chris@1: $toplevel->optionAdd("$Xname*AlertDetail.font", Chris@1: '-*-helvetica-medium-r-*-*-10-*-*-*-*-*-*-*',20); Chris@1: Chris@1: Chris@1: $toplevel->optionAdd("$Xname*background", "#d0d0d0",20); Chris@1: $toplevel->optionAdd("$Xname*foreground", '#000000',20); Chris@1: Chris@1: $toplevel->optionAdd("$Xname*Button*background", "#f0d0b0",20); Chris@1: $toplevel->optionAdd("$Xname*Button*foreground", '#000000',20); Chris@1: $toplevel->optionAdd("$Xname*Button*borderWidth", '2',20); Chris@1: $toplevel->optionAdd("$Xname*Button*relief", 'groove',20); Chris@1: $toplevel->optionAdd("$Xname*Button*padY", 1,20); Chris@1: Chris@1: #$toplevel->optionAdd("$Xname*Scale*background", "#f0d0b0",20); Chris@1: $toplevel->optionAdd("$Xname*Scale*foreground", '#000000',20); Chris@1: $toplevel->optionAdd("$Xname*Scale*borderWidth", '1',20); Chris@1: #$toplevel->optionAdd("$Xname*Scale*relief", 'groove',20); Chris@1: $toplevel->optionAdd("$Xname*Scale*padY", 1,20); Chris@1: Chris@1: $toplevel->optionAdd("$Xname*Checkbutton*background", "#f0d0b0",20); Chris@1: $toplevel->optionAdd("$Xname*Checkbutton*foreground", '#000000',20); Chris@1: $toplevel->optionAdd("$Xname*Checkbutton*borderWidth", '2',20); Chris@1: $toplevel->optionAdd("$Xname*Checkbutton*relief", 'groove',20); Chris@1: Chris@1: $toplevel->optionAdd("$Xname*activeBackground", "#ffffff",20); Chris@1: $toplevel->optionAdd("$Xname*activeForeground", '#0000a0',20); Chris@1: $toplevel->optionAdd("$Xname*borderWidth", 0,20); Chris@1: $toplevel->optionAdd("$Xname*relief", 'flat',20); Chris@1: $toplevel->optionAdd("$Xname*activeBorderWidth", 1,20); Chris@1: $toplevel->optionAdd("$Xname*highlightThickness", 0,20); Chris@1: $toplevel->optionAdd("$Xname*padX", 2,20); Chris@1: $toplevel->optionAdd("$Xname*padY", 2,20); Chris@1: $toplevel->optionAdd("$Xname*font", Chris@1: '-*-helvetica-bold-r-*-*-12-*-*-*-*-*-*-*',20); Chris@1: $toplevel->optionAdd("$Xname*Entry.font", Chris@1: '-*-helvetica-medium-r-*-*-12-*-*-*-*-*-*-*',20); Chris@1: $toplevel->optionAdd("$Xname*Exit.font", Chris@1: '-*-helvetica-bold-r-*-*-10-*-*-*-*-*-*-*',20); Chris@1: $toplevel->optionAdd("$Xname*Exit.relief", 'groove',20); Chris@1: $toplevel->optionAdd("$Xname*Exit.padX", 1,20); Chris@1: $toplevel->optionAdd("$Xname*Exit.padY", 1,20); Chris@1: $toplevel->optionAdd("$Xname*Exit.borderWidth", 2,20); Chris@1: $toplevel->optionAdd("$Xname*Exit*background", "#a0a0a0",20); Chris@1: $toplevel->optionAdd("$Xname*Exit*disabledForeground", "#ffffff",20); Chris@1: Chris@1: #$toplevel->optionAdd("$Xname*Canvas.background", "#c0c0c0",20); Chris@1: Chris@1: $toplevel->optionAdd("$Xname*Entry.background", "#ffffff",20); Chris@1: $toplevel->optionAdd("$Xname*Entry.disabledForeground", "#c0c0c0",20); Chris@1: $toplevel->optionAdd("$Xname*Entry.relief", "sunken",20); Chris@1: $toplevel->optionAdd("$Xname*Entry.borderWidth", 1,20); Chris@1: Chris@1: $toplevel->optionAdd("$Xname*Field.background", "#ffffff",20); Chris@1: $toplevel->optionAdd("$Xname*Field.disabledForeground", "#c0c0c0",20); Chris@1: $toplevel->optionAdd("$Xname*Field.relief", "flat",20); Chris@1: $toplevel->optionAdd("$Xname*Field.borderWidth", 1,20); Chris@1: Chris@1: $toplevel->optionAdd("$Xname*Label.disabledForeground", "#c0c0c0",20); Chris@1: $toplevel->optionAdd("$Xname*Label.borderWidth", 1,20); Chris@1: Chris@1: $toplevel->configure(-background=>$toplevel->optionGet("background","")); Chris@1: Chris@1: #$toplevel->resizable(FALSE,FALSE); Chris@1: Chris@1: my $panel=new MainWindow(-class=>'AnalyzerPanel'); Chris@1: my $X2name=$panel->Class; Chris@1: Chris@1: $panel->optionAdd("$X2name.background", "#353535",20); Chris@1: $panel->optionAdd("$X2name*highlightBackground", "#80c0d3",20); Chris@1: $panel->optionAdd("$X2name.Panel.background", "#353535",20); Chris@1: $panel->optionAdd("$X2name.Panel.foreground", "#4fc627",20); Chris@1: $panel->optionAdd("$X2name.Panel.font", Chris@1: '-*-helvetica-bold-o-*-*-18-*-*-*-*-*-*-*',20); Chris@1: $panel->optionAdd("$X2name*Statuslabel.font", Chris@1: '-*-helvetica-bold-r-*-*-18-*-*-*-*-*-*-*',20); Chris@1: $panel->optionAdd("$X2name*Statuslabel.foreground", "#4fc627",20); Chris@1: $panel->optionAdd("$X2name*Status.font", Chris@1: '-*-helvetica-bold-r-*-*-18-*-*-*-*-*-*-*',20); Chris@1: Chris@1: $panel->optionAdd("$X2name*AlertDetail.font", Chris@1: '-*-helvetica-medium-r-*-*-10-*-*-*-*-*-*-*',20); Chris@1: Chris@1: Chris@1: $panel->optionAdd("$X2name*background", "#d0d0d0",20); Chris@1: $panel->optionAdd("$X2name*foreground", '#000000',20); Chris@1: Chris@1: $panel->optionAdd("$X2name*Button*background", "#f0d0b0",20); Chris@1: $panel->optionAdd("$X2name*Button*foreground", '#000000',20); Chris@1: $panel->optionAdd("$X2name*Button*borderWidth", '2',20); Chris@1: $panel->optionAdd("$X2name*Button*relief", 'groove',20); Chris@1: $panel->optionAdd("$X2name*Button*padY", 1,20); Chris@1: Chris@1: $panel->optionAdd("$X2name*Checkbutton*background", "#f0d0b0",20); Chris@1: $panel->optionAdd("$X2name*Checkbutton*foreground", '#000000',20); Chris@1: $panel->optionAdd("$X2name*Checkbutton*borderWidth", '2',20); Chris@1: #$panel->optionAdd("$X2name*Checkbutton*padX", '0',20); Chris@1: #$panel->optionAdd("$X2name*Checkbutton*padY", '0',20); Chris@1: #$panel->optionAdd("$X2name*Checkbutton*relief", 'groove',20); Chris@1: Chris@1: $panel->optionAdd("$X2name*activeBackground", "#ffffff",20); Chris@1: $panel->optionAdd("$X2name*activeForeground", '#0000a0',20); Chris@1: $panel->optionAdd("$X2name*borderWidth", 0,20); Chris@1: $panel->optionAdd("$X2name*relief", 'flat',20); Chris@1: $panel->optionAdd("$X2name*activeBorderWidth", 1,20); Chris@1: $panel->optionAdd("$X2name*highlightThickness", 0,20); Chris@1: $panel->optionAdd("$X2name*padX", 2,20); Chris@1: $panel->optionAdd("$X2name*padY", 2,20); Chris@1: $panel->optionAdd("$X2name*font", Chris@1: '-*-helvetica-bold-r-*-*-12-*-*-*-*-*-*-*',20); Chris@1: $panel->optionAdd("$X2name*Entry.font", Chris@1: '-*-helvetica-medium-r-*-*-12-*-*-*-*-*-*-*',20); Chris@1: Chris@1: $panel->optionAdd("$X2name*Exit.font", Chris@1: '-*-helvetica-bold-r-*-*-10-*-*-*-*-*-*-*',20); Chris@1: $panel->optionAdd("$X2name*Exit.relief", 'groove',20); Chris@1: $panel->optionAdd("$X2name*Exit.padX", 1,20); Chris@1: $panel->optionAdd("$X2name*Exit.padY", 1,20); Chris@1: $panel->optionAdd("$X2name*Exit.borderWidth", 2,20); Chris@1: $panel->optionAdd("$X2name*Exit*background", "#a0a0a0",20); Chris@1: $panel->optionAdd("$X2name*Exit*disabledForeground", "#ffffff",20); Chris@1: Chris@1: $panel->optionAdd("$X2name*Entry.background", "#ffffff",20); Chris@1: $panel->optionAdd("$X2name*Entry.disabledForeground", "#c0c0c0",20); Chris@1: $panel->optionAdd("$X2name*Entry.relief", "sunken",20); Chris@1: $panel->optionAdd("$X2name*Entry.borderWidth", 1,20); Chris@1: Chris@1: $panel->optionAdd("$X2name*Field.background", "#ffffff",20); Chris@1: $panel->optionAdd("$X2name*Field.disabledForeground", "#c0c0c0",20); Chris@1: $panel->optionAdd("$X2name*Field.relief", "flat",20); Chris@1: $panel->optionAdd("$X2name*Field.borderWidth", 1,20); Chris@1: Chris@1: $panel->optionAdd("$X2name*Label.disabledForeground", "#c0c0c0",20); Chris@1: $panel->optionAdd("$X2name*Label.borderWidth", 1,20); Chris@1: Chris@1: $panel->configure(-background=>$panel->optionGet("background","")); Chris@1: Chris@1: #$panel->resizable("FALSE","FALSE"); Chris@1: Chris@1: my $panel_shell=$panel->Label(Name=>"shell",-borderwidth=>1,-relief=>'raised')-> Chris@1: place(-x=>10,-y=>36,-relwidth=>1.0,-relheight=>1.0, Chris@1: -width=>-20,-height=>-46,-anchor=>'nw'); Chris@1: Chris@1: my $panel_quit=$panel_shell->Button(-class=>"Exit",-text=>"quit",-command=>[sub{Shutdown()}])-> Chris@1: place(-x=>-1,-y=>-1,-relx=>1.0,-rely=>1.0,-anchor=>'se'); Chris@1: Chris@1: $panel->Label(Name=>"logo text",-class=>"Panel",-text=>$version)-> Chris@1: place(-x=>5,-y=>5,-anchor=>'nw'); Chris@1: Chris@1: Chris@1: my $graph_shell=$toplevel->Label(Name=>"shell",-borderwidth=>1,-relief=>'raised')-> Chris@1: place(-x=>10,-y=>36,-relwidth=>1.0,-relheight=>1.0, Chris@1: -width=>-20,-height=>-46,-anchor=>'nw'); Chris@1: Chris@1: my $graph_status=$toplevel->Label(Name=>"logo text",-class=>"Panel",-text=>"Starting up")-> Chris@1: place(-x=>5,-y=>5,-anchor=>'nw'); Chris@1: Chris@1: Chris@1: my $panely=5; Chris@1: my $panel_rescan=$panel_shell->Button(-text=>"rescan",-command=>[sub{scan_directory()}])-> Chris@1: place(-x=>-5,-relx=>1.,-y=>$panely,-anchor=>'ne'); Chris@1: $panely+=$panel_rescan->reqheight()+6; Chris@1: Chris@1: Chris@1: my$temp=$graph_shell->Button(-text=>"<<", Chris@1: -command=>[sub{$fileno-=10;$fileno=$first_file if($fileno<$first_file); Chris@1: load_graph();}])-> Chris@1: place(-x=>5,-y=>-5,-rely=>1.,-relwidth=>.2,-width=>-5,-anchor=>'sw'); Chris@1: $graph_shell->Button(-text=>">>", Chris@1: -command=>[sub{$fileno+=10;$fileno=$last_file if($fileno>$last_file); Chris@1: load_graph();}])-> Chris@1: place(-x=>-5,-y=>-5,-relwidth=>.2,-rely=>1.,-width=>-5,-relx=>1.,-anchor=>'se'); Chris@1: $graph_shell->Button(-text=>"<", Chris@1: -command=>[sub{$fileno-=1;$fileno=$first_file if($fileno<$first_file); Chris@1: load_graph();}])-> Chris@1: place(-x=>5,-y=>-5,-relwidth=>.3,-width=>-7,-rely=>1.,-relx=>.2,-anchor=>'sw'); Chris@1: $graph_shell->Button(-text=>">", Chris@1: -command=>[sub{$fileno+=1;$fileno=$last_file if($fileno>$last_file); Chris@1: load_graph();}])-> Chris@1: place(-x=>-5,-y=>-5,-relwidth=>.3,-width=>-7,-rely=>1.,-relx=>.8,-anchor=>'se'); Chris@1: my$graphy=-10-$temp->reqheight(); Chris@1: my$graph_slider=$temp=$graph_shell->Scale(-bigincrement=>1, Chris@1: -resolution=>1, Chris@1: -showvalue=>'TRUE',-variable=>\$fileno,-orient=>'horizontal')-> Chris@1: place(-x=>5,-y=>$graphy,-relwidth=>1.,-rely=>1.,-width=>-10,-anchor=>'sw'); Chris@1: $graphy-=$temp->reqheight()+5; Chris@1: Chris@1: my$onecrop; Chris@1: my$twocrop; Chris@1: Chris@1: my$oneresize=$temp=$graph_shell->Checkbutton(-text=>"rescale",-variable=>\$onecrop, Chris@1: -command=>[sub{draw_graph();}])-> Chris@1: place(-x=>5,-y=>5,-anchor=>'nw'); Chris@1: Chris@1: my$one=$graph_shell->Canvas()-> Chris@1: place(-relwidth=>1.,-width=>-10,-relheight=>.5,-height=>($graphy/2)-5-$temp->reqheight(), Chris@1: -x=>5,-y=>5+$temp->reqheight,-anchor=>'nw'); Chris@1: Chris@1: Chris@1: my$tworesize=$temp=$graph_shell->Checkbutton(-text=>"rescale",-variable=>\$twocrop, Chris@1: -command=>[sub{draw_graph();}])-> Chris@1: place(-rely=>1.,-y=>5,-anchor=>'nw',-in=>$one); Chris@1: my$two=$graph_shell->Canvas()-> Chris@1: place(-relwidth=>1.,-relheight=>1.,-rely=>1.,-y=>5+$temp->reqheight(),-anchor=>'nw',-in=>$one); Chris@1: Chris@1: scan_directory(); Chris@1: Chris@1: my%onestate; Chris@1: my%twostate; Chris@1: my @data; Chris@1: Chris@1: $onestate{"canvas"}=$one; Chris@1: $onestate{"vars"}=\@panel_onevars; Chris@1: $twostate{"canvas"}=$two; Chris@1: $twostate{"vars"}=\@panel_twovars; Chris@1: Chris@1: $graph_slider->configure(-command=>[sub{load_graph()}]); Chris@1: load_graph(); Chris@1: $toplevel->bind('MainWindow','',[sub{$toplevel->update(); Chris@1: draw_graph()}]); Chris@1: Chris@1: Tk::MainLoop(); Chris@1: Chris@1: sub load_graph{ Chris@1: Chris@1: scan_directory()if(!defined($panel_count)); Chris@1: Chris@1: @data=undef; Chris@1: Chris@1: for(my$i=0;$i<$panel_count;$i++){ Chris@1: my$filename=$panel_keys[$i]."_$fileno.m"; Chris@1: if(open F, "$filename"){ Chris@1: $data[$i]=[()]; Chris@1: close F; Chris@1: } Chris@1: } Chris@1: draw_graph(); Chris@1: } Chris@1: Chris@1: sub graphhelper{ Chris@1: my($graph)=@_; Chris@1: my$count=0; Chris@1: my@colors=("#ff0000","#00df00","#0000ff","#ffff00","#ff00ff","#00ffff","#ffffff", Chris@1: "#9f0000","#007f00","#00009f","#8f8f00","#8f008f","#008f8f","#000000"); Chris@1: Chris@1: my$w=$graph->{"canvas"}; Chris@1: my$rescale=0; Chris@1: Chris@1: Status("Plotting $fileno"); Chris@1: $w->delete('foo'); Chris@1: $w->delete('legend'); Chris@1: $w->delete('lines'); Chris@1: Chris@1: # count range Chris@1: for(my$i=0;$i<$panel_count;$i++){ Chris@1: if($graph->{"vars"}->[$i]){ Chris@1: if(defined($data[$i])){ Chris@1: if(!defined($graph->{"minx"})){ Chris@1: $data[$i]->[0]=~m/^\s*(-?[0-9\.]*)[ ,]+(-?[0-9\.]*)/; Chris@1: $graph->{"maxx"}=$1; Chris@1: $graph->{"minx"}=$1; Chris@1: $graph->{"maxy"}=$2; Chris@1: $graph->{"miny"}=$2; Chris@1: $rescale=1; Chris@1: } Chris@1: Chris@1: for(my$j=0;$j<=$#{$data[$i]};$j++){ Chris@1: $data[$i]->[$j]=~m/^\s*(-?[0-9\.]*)[ ,]+(-?[0-9\.]*)/; Chris@1: $rescale=1 if($1>$graph->{"maxx"}); Chris@1: $rescale=1 if($1<$graph->{"minx"}); Chris@1: $rescale=1 if($2>$graph->{"maxy"}); Chris@1: $rescale=1 if($2<$graph->{"miny"}); Chris@1: $graph->{"maxx"}=$1 if($1>$graph->{"maxx"}); Chris@1: $graph->{"minx"}=$1 if($1<$graph->{"minx"}); Chris@1: $graph->{"maxy"}=$2 if($2>$graph->{"maxy"}); Chris@1: $graph->{"miny"}=$2 if($2<$graph->{"miny"}); Chris@1: } Chris@1: } Chris@1: $count++; Chris@1: } Chris@1: } Chris@1: Chris@1: my$width=$w->width(); Chris@1: my$height=$w->height(); Chris@1: Chris@1: $rescale=1 if(!defined($graph->{"width"}) || Chris@1: $width!=$graph->{"width"} || Chris@1: $height!=$graph->{"height"}); Chris@1: Chris@1: $graph->{"width"}=$width; Chris@1: $graph->{"height"}=$height; Chris@1: Chris@1: if(defined($graph->{"maxx"})){ Chris@1: # draw axes, labels Chris@1: # look for appropriate axis scales Chris@1: Chris@1: if($rescale){ Chris@1: Chris@1: $w->delete('ylabel'); Chris@1: $w->delete('xlabel'); Chris@1: $w->delete('axes'); Chris@1: Chris@1: my$yscale=1.; Chris@1: my$xscale=1.; Chris@1: my$iyscale=1.; Chris@1: my$ixscale=1.; Chris@1: while(($graph->{"maxx"}-$graph->{"minx"})*$xscale>15){$xscale*=.1;$ixscale*=10.;} Chris@1: while(($graph->{"maxy"}-$graph->{"miny"})*$yscale>15){$yscale*=.1;$iyscale*=10.;} Chris@1: Chris@1: while(($graph->{"maxx"}-$graph->{"minx"})*$xscale<3){$xscale*=10.;$ixscale*=.1;} Chris@1: while(($graph->{"maxy"}-$graph->{"miny"})*$yscale<3){$yscale*=10.;$iyscale*=.1;} Chris@1: Chris@1: # how tall are the x axis labels? Chris@1: $w->createText(-1,-1,-anchor=>'se',-tags=>['foo'],-text=>"0123456789."); Chris@1: my($x1,$y1,$x2,$y2)=$w->bbox('foo'); Chris@1: $w->delete('foo'); Chris@1: my$maxlabelheight=$y2-$y1; Chris@1: my$useabley=$height-$maxlabelheight-3; Chris@1: my$pixelpery=$useabley/($graph->{"maxy"}-$graph->{"miny"}); Chris@1: Chris@1: # place y axis labels at proper spacing/height Chris@1: my$lasty=-$maxlabelheight/2; Chris@1: my$topyval=int($graph->{"maxy"}*$yscale+1.)*$iyscale; Chris@1: Chris@1: for(my$i=0;;$i++){ Chris@1: my$yval= $topyval-$i*$iyscale; Chris@1: my$y= ($graph->{"maxy"}-$yval)*$pixelpery; Chris@1: last if($y>$useabley); Chris@1: if($y-$maxlabelheight>=$lasty){ Chris@1: $w->createText(0,$y,-anchor=>'e',-tags=>['ylabel'],-text=>"$yval"); Chris@1: $lasty=$y; Chris@1: } Chris@1: } Chris@1: Chris@1: # get the max ylabel width and place them at proper x Chris@1: ($x1,$y1,$x2,$y2)=$w->bbox('ylabel'); Chris@1: my$maxylabelwidth=$x2-$x1; Chris@1: $w->move('ylabel',$maxylabelwidth,0); Chris@1: Chris@1: my$beginx=$maxylabelwidth+3; Chris@1: my$useablex=$width-$beginx; Chris@1: Chris@1: # draw basic axes Chris@1: $w->createLine($beginx,0,$beginx,$useabley,$width,$useabley, Chris@1: -tags=>['axes'],-width=>2); Chris@1: # draw y tix Chris@1: $lasty=-$maxlabelheight/2; Chris@1: for(my$i=0;;$i++){ Chris@1: my$yval= $topyval-$i*$iyscale; Chris@1: my$y= ($graph->{"maxy"}-$yval)*$pixelpery; Chris@1: last if($y>$useabley); Chris@1: if($yval==0){ Chris@1: $w->createLine($beginx,$y,$width,$y, Chris@1: -tags=>['axes'],-width=>1); Chris@1: }else{ Chris@1: if($y-$maxlabelheight>=$lasty){ Chris@1: $w->createLine($beginx,$y,$width,$y, Chris@1: -tags=>['axes'],-width=>1, Chris@1: -stipple=>'gray50'); Chris@1: Chris@1: $lasty=$y; Chris@1: } Chris@1: } Chris@1: } Chris@1: Chris@1: # place x axis labels at proper spacing Chris@1: my$topxval=int($graph->{"maxx"}*$xscale+1.)*$ixscale; Chris@1: my$pixelperx=$useablex/($graph->{"maxx"}-$graph->{"minx"}); Chris@1: Chris@1: for(my$i=0;;$i++){ Chris@1: my$xval= $topxval-$i*$ixscale; Chris@1: my$x= $width-($graph->{"maxx"}-$xval)*$pixelperx; Chris@1: Chris@1: last if($x<$beginx); Chris@1: # bounding boxen are hard. place temp labels. Chris@1: $w->createText(-1,-1,-anchor=>'e',-tags=>['foo'],-text=>"$xval"); Chris@1: } Chris@1: Chris@1: ($x1,$y1,$x2,$y2)=$w->bbox('foo'); Chris@1: my$maxxlabelwidth=$x2-$x1; Chris@1: $w->delete('foo'); Chris@1: my$lastx=$width; Chris@1: Chris@1: for(my$i=0;;$i++){ Chris@1: my$xval= $topxval-$i*$ixscale; Chris@1: my$x= $width-($graph->{"maxx"}-$xval)*$pixelperx; Chris@1: Chris@1: last if($x-$maxxlabelwidth/2<0 || $x<$beginx); Chris@1: if($xval==0 && $x<$width){ Chris@1: $w->createLine($x,0,$x,$useabley,-tags=>['axes'],-width=>1); Chris@1: } Chris@1: Chris@1: if($x+$maxxlabelwidth<=$lastx){ Chris@1: $w->createText($x,$height-1,-anchor=>'s',-tags=>['xlabel'],-text=>"$xval"); Chris@1: $w->createLine($x,0,$x,$useabley,-tags=>['axes'],-width=>1,-stipple=>"gray50"); Chris@1: $lastx=$x; Chris@1: } Chris@1: } Chris@1: $graph->{"labelheight"}=$maxlabelheight; Chris@1: $graph->{"xo"}=$beginx; Chris@1: $graph->{"ppx"}=$pixelperx; Chris@1: $graph->{"ppy"}=$pixelpery; Chris@1: } Chris@1: Chris@1: # plot the files Chris@1: $count=0; Chris@1: my$legendy=$graph->{"labelheight"}/2; Chris@1: for(my$i=0;$i<$panel_count;$i++){ Chris@1: if($graph->{"vars"}->[$i]){ Chris@1: $count++; # count here for legend color selection stability Chris@1: if(defined($data[$i])){ Chris@1: # place a legend placard; Chris@1: my$color=$colors[($count-1)%($#colors+1)]; Chris@1: $w->createText($width,$legendy,-anchor=>'e',-tags=>['legend'], Chris@1: -fill=>$color,-text=>$panel_keys[$i]); Chris@1: $legendy+=$graph->{"labelheight"}; Chris@1: Chris@1: # plot the lines Chris@1: my@pairs=map{if(/^\s*(-?[0-9\.]*)[ ,]+(-?[0-9\.]*)/){ Chris@1: (($1-$graph->{"minx"})*$graph->{"ppx"}+$graph->{"xo"}, Chris@1: (-$2+$graph->{"maxy"})*$graph->{"ppy"})}} (@{$data[$i]}); Chris@1: Chris@1: $w->createLine((@pairs),-fill=>$color,-tags=>['lines']); Chris@1: } Chris@1: } Chris@1: } Chris@1: } Chris@1: } Chris@1: Chris@1: sub draw_graph{ Chris@1: Chris@1: if($onecrop){ Chris@1: $onestate{"minx"}=undef; Chris@1: $onestate{"miny"}=undef; Chris@1: $onestate{"maxx"}=undef; Chris@1: $onestate{"maxy"}=undef; Chris@1: } Chris@1: if($twocrop){ Chris@1: $twostate{"minx"}=undef; Chris@1: $twostate{"miny"}=undef; Chris@1: $twostate{"maxx"}=undef; Chris@1: $twostate{"maxy"}=undef; Chris@1: } Chris@1: Chris@1: for(my$i=0;$i<$panel_count;$i++){ Chris@1: if($twostate{"vars"}->[$i]){ Chris@1: Chris@1: #re-place the canvases Chris@1: Chris@1: $oneresize->place(-x=>5,-y=>5,-anchor=>'nw'); Chris@1: Chris@1: $one->place(-relwidth=>1.,-width=>-10,-relheight=>.5, Chris@1: -height=>($graphy/2)-5-$oneresize->reqheight(), Chris@1: -x=>5,-y=>5+$oneresize->reqheight,-anchor=>'nw'); Chris@1: Chris@1: $tworesize->place(-rely=>1.,-y=>5,-anchor=>'nw',-in=>$one); Chris@1: $two->place(-relwidth=>1.,-relheight=>1.,-rely=>1., Chris@1: -y=>5+$tworesize->reqheight(),-anchor=>'nw',-in=>$one); Chris@1: Chris@1: graphhelper(\%onestate); Chris@1: graphhelper(\%twostate); Chris@1: return; Chris@1: } Chris@1: } Chris@1: Chris@1: $oneresize->place(-x=>5,-y=>5,-anchor=>'nw'); Chris@1: Chris@1: $one->place(-relwidth=>1.,-width=>-10,-relheight=>1., Chris@1: -height=>$graphy-5-$oneresize->reqheight(), Chris@1: -x=>5,-y=>5+$oneresize->reqheight,-anchor=>'nw'); Chris@1: Chris@1: $tworesize->placeForget(); Chris@1: $two->placeForget(); Chris@1: Chris@1: graphhelper(\%onestate); Chris@1: } Chris@1: Chris@1: sub depopulate_panel{ Chris@1: my $win; Chris@1: foreach $win (@panel_labels){ Chris@1: $win->destroy(); Chris@1: } Chris@1: @panel_labels=(); Chris@1: foreach $win (@panel_ones){ Chris@1: $win->destroy(); Chris@1: } Chris@1: @panel_ones=(); Chris@1: foreach $win (@panel_twos){ Chris@1: $win->destroy(); Chris@1: } Chris@1: @panel_twos=(); Chris@1: @panel_keys=(); Chris@1: } Chris@1: Chris@1: sub populate_panel{ Chris@1: my $localy=$panely; Chris@1: my $key; Chris@1: my $i=0; Chris@1: foreach $key (sort (keys %bases)){ Chris@1: $panel_keys[$i]=$key; Chris@1: if(!defined($panel_onevars[$i])){ Chris@1: $panel_onevars[$i]=0; Chris@1: $panel_twovars[$i]=0; Chris@1: } Chris@1: Chris@1: my $temp=$panel_twos[$i]=$panel_shell-> Chris@1: Checkbutton(-variable=>\$panel_twovars[$i],-command=>['main::draw_graph'],-text=>'2')-> Chris@1: place(-y=>$localy,-x=>-5,-anchor=>"ne",-relx=>1.); Chris@1: my $oney=$temp->reqheight(); Chris@1: my $onex=$temp->reqwidth()+15; Chris@1: Chris@1: $temp=$panel_ones[$i]=$panel_shell-> Chris@1: Checkbutton(-variable=>\$panel_onevars[$i],-command=>['main::draw_graph'],-text=>'1')-> Chris@1: place(-y=>0,-x=>0,-anchor=>"ne",-in=>$temp,-bordermode=>'outside'); Chris@1: $oney=$temp->reqheight() if ($oney<$temp->reqheight()); Chris@1: $onex+=$temp->reqwidth(); Chris@1: Chris@1: $temp=$panel_labels[$i]=$panel_shell->Label(-text=>$key,-class=>'Field',-justify=>'left')-> Chris@1: place(-y=>$localy,-x=>5,-anchor=>"nw",-relwidth=>1.,-width=>-$onex, Chris@1: -bordermode=>'outside'); Chris@1: $oney=$temp->reqheight() if ($oney<$temp->reqheight()); Chris@1: Chris@1: $localy+=$oney+2; Chris@1: $i++; Chris@1: } Chris@1: $panel_count=$i; Chris@1: Chris@1: $localy+=$panel_quit->reqheight()+50; Chris@1: my $geometry=$panel->geometry(); Chris@1: $geometry=~/^(\d+)/; Chris@1: Chris@1: $panel->configure(-height=>$localy); Chris@1: $panel->configure(-width=>$1); Chris@1: } Chris@1: Chris@1: sub Shutdown{ Chris@1: Tk::exit(); Chris@1: } Chris@1: Chris@1: sub Status{ Chris@1: my$text=shift @_; Chris@1: $graph_status->configure(-text=>"$text"); Chris@1: $toplevel->update(); Chris@1: } Chris@1: Chris@1: sub scan_directory{ Chris@1: Chris@1: %bases=(); Chris@1: my$count=0; Chris@1: Chris@1: $first_file=undef; Chris@1: $last_file=undef; Chris@1: Chris@1: if(opendir(D,".")){ Chris@1: my$file; Chris@1: while(defined($file=readdir(D))){ Chris@1: if($file=~m/^(\S*)_(\d+).m/){ Chris@1: $bases{"$1"}="0"; Chris@1: $first_file=$2 if(!defined($first_file) || $2<$first_file); Chris@1: $last_file=$2 if(!defined($last_file) || $2>$last_file); Chris@1: $count++; Chris@1: Chris@1: Status("Reading... $count")if($count%117==0); Chris@1: } Chris@1: } Chris@1: closedir(D); Chris@1: } Chris@1: Status("Done Reading: $count files"); Chris@1: depopulate_panel(); Chris@1: populate_panel(); Chris@1: Chris@1: $fileno=$first_file if($fileno<$first_file); Chris@1: $fileno=$last_file if($fileno>$last_file); Chris@1: Chris@1: $graph_slider->configure(-from=>$first_file,-to=>$last_file); Chris@1: Chris@1: } Chris@1: Chris@1: Chris@1: Chris@1: Chris@1: