source/rcdaq/rcdaq_configmenu.pl

0001 #! /usr/bin/perl
0002
0003 use Tk;
0004 require Tk::Balloon;
0005
0006 sub display_script
0007 {
0008     my $arg=$_[0];
0009     $mytext->delete('1.0', 'end');
0010     $mytext->insert('end', $LC{$arg});
0011     $filelabel->configure ( -text=>$arg, -bg=>$neutralcolor);
0012     $executebutton->configure( -command => [\&execute_script,$arg], -bg => $buttonbgcolor, -state => "normal");
0013     $cancelbutton->configure( -command => [\&cancel_script], -bg => $buttonbgcolor, -state => "normal");
0014 }
0015
0016 sub execute_script
0017 {
0018     my $arg=$_[0];
0019     $mytext->delete('1.0', 'end');
0020     open (OUT, "/bin/sh $_[0] |");
0021     while ( <OUT> )
0022     {
0023     $mytext->insert('end', $_);
0024     $mytext->SetCursor('end');
0025     }
0026     $filelabel->configure ( -text=>$arg . ". executed", -bg=>$executedcolor);
0027     $executebutton->configure(  -bg => $graycolor, -state => "disabled");
0028     $cancelbutton->configure(  -bg => $graycolor, -state => "disabled");
0029 }
0030
0031 sub cancel_script
0032 {
0033     my $arg=$_[0];
0034     $mytext->delete('1.0','end');
0035     $filelabel->configure ( -text=>"", -bg=>$graycolor);
0036     $executebutton->configure( -bg => $graycolor, -state => "disabled");
0037     $cancelbutton->configure( -bg => $graycolor, -state => "disabled");
0038
0039 }
0040
0041
0042 $time_used = 2;
0043
0044 #$color1 = "#cccc99";
0045 #$color1 = "#999900";
0046 $color1 = "#CCCC99";
0047 $okcolor = "#00cc99";
0048 $errorcolor= "#ff6666";
0049 $neutralcolor ="#cc9900";
0050 $panelcolor = "#336633";
0051 $warncolor = "IndianRed4";
0052 $graycolor = "#929292";
0053 $executedcolor="orange";
0054
0055
0056 $buttonbgcolor='#33CCCC';
0057
0058 $smalltextfg = '#00CCFF';
0059 $smalltextbg = '#333366';
0060
0061 $slinebg='#cccc00';
0062
0063 $oncolor = "orange2";
0064 $offcolor = "yellow4";
0065
0066
0067 #$bgcolor = "#cccc66";
0068 $bgcolor = "#990000";
0069
0070 $runstatcolor = "aquamarine";
0071 $stopstatcolor = "palegreen";
0072 $neutralcolor = "khaki";
0073
0074 $smallfont = "6x10";
0075
0076 $normalfont = "6x13";
0077 $bigfont = "9x15bold";
0078
0079 $mw = MainWindow->new();
0080
0081 $mw->title("RCDAQ Configuration");
0082
0083
0084 $label{'sline'} = $mw->Label(-text => "RCDAQ Configuration", -background=>$slinebg, -font =>$bigfont);
0085 $label{'sline'}->pack(-side=> 'top', -fill=> 'x', -ipadx=> '15m', -ipady=> '1m');
0086
0087
0088 $frame{'center'} = $mw->Frame()->pack(-side => 'top', -fill => 'x');
0089
0090
0091
0092 # update once to fill all the values in
0093 #update();
0094
0095 getfilelist();
0096
0097 my $file;
0098
0099 my @files  = ( sort keys %SC );
0100
0101 $label{'buttonframe'} = $frame{'center'}->Label(-bg => $color1, -relief=> 'raised')->pack(-side =>'left', -fill=> 'both');
0102
0103 $label{'descriptionframe'} = $frame{'center'}->Label(-bg => $neutralcolor, -relief=> 'raised')->pack(-side =>'right', -fill=> 'x');
0104 $mytext = $label{'descriptionframe'}->Scrolled( 'Text', -scrollbars => 'osoe', -width => 80 )->pack(-side =>'top', -fill=> 'both', -padx=> '1m',  -pady=> '1m');
0105
0106 $executebutton =  $label{'descriptionframe'}->
0107     Button( -bg => $graycolor, -text => "Execute", -relief =>'raised', -font=> $normalfont)->
0108     pack(-side =>'right', -fill=> 'x', -ipadx=> '2m',  -ipady=> '1m');
0109
0110 $cancelbutton =  $label{'descriptionframe'}->
0111     Button( -bg => $graycolor, -text => "Cancel", -relief =>'raised', -font=> $normalfont)->
0112     pack(-side =>'right', -fill=> 'x', -ipadx=> '2m',  -ipady=> '1m');
0113
0114 $filelabel =  $label{'descriptionframe'}->
0115     Label( -bg => $graycolor, -text => "", -relief =>'flat', -font=> $normalfont)->
0116     pack(-side =>'left', -fill=> 'x', -ipadx=> '2m',  -ipady=> '1m');
0117
0118 $label{'outerlabel'} = $label{'buttonframe'}->Label(-bg => $color1)->pack(-side =>'top', -fill=> 'x', -padx=> '1m',  -pady=> '1m');
0119 $label{'toplinelabel'} = $label{'outerlabel'}->Label(-bg => $color1)->pack(-side =>'top', -fill=> 'y', -padx=> '0m',  -pady=> '0m');
0120
0121 $label{'heading'} = $label{'toplinelabel'}->
0122       Label(-text => "Configurations", -font => $bigfont, -fg => 'black', -bg => $panelcolor)->
0123       pack(-side =>'top', -fill=> 'x', -ipadx=> '2m',  -ipady=> '1m');
0124
0125 my $b = $mw->Balloon(-statusbar => $frame{'center'});
0126
0127 foreach $filename ( sort keys %SC )
0128 {
0129     $button{$filename} = $label{'outerlabel'}->
0130     Button( -bg => $buttonbgcolor, -text => $filename, -command => [\&display_script,$filename], -relief =>'raised', -font=> $normalfont)->
0131     pack(-side =>'top', -fill=> 'x', -ipadx=> '2m',  -ipady=> '1m');
0132
0133     $b->attach( $button{$filename}, -balloonmsg => $SC{$filename} );
0134 }
0135
0136
0137 #$mw->repeat($time_used * 1000,\&update);
0138
0139 MainLoop();
0140
0141
0142 sub getfilelist()
0143 {
0144
0145 # get all files ending in .sh or pl
0146     my @list = <*.{sh,pl}>;
0147
0148     foreach my $f ( @list )
0149     {
0150     open(FH, $f);
0151     my @buffer=<FH>;
0152     close FH;
0153
0154     my @lines = grep {/#\s*--RCDAQGUI/} @buffer;
0155     if ($#lines >=0)
0156     {
0157
0158 #     get the "short comment"
0159         my @SCT = grep {/#\s*--SC/} @buffer;
0160         if ($#SCT >=0)
0161         {
0162         my $SCT=$SCT[ $#SCT ];
0163         $SCT =~ s/#.--SC//;
0164         $SC{"$f"} = $SCT;
0165         }
0166         else
0167         {
0168         $SC{"$f"}=0;
0169         }
0170
0171         my @LCT = grep {/#\s*--LC/} @buffer;
0172         if ($#LCT >=0)
0173         {
0174         my $LCT=join ("", @LCT);
0175         $LCT =~ s/#\s*--LC//g;
0176         $LC{"$f"} = $LCT;
0177         }
0178         else
0179         {
0180         $LC{"$f"}=0;
0181         }
0182     }
0183
0184     }
0185
0186     #  foreach $f ( sort keys %SC  )
0187     # {
0188     #   print "$f", $SC{$f}, "\n", $LC{$f}, "\n";
0189     # }
0190
0191 }
0192