vpower 6.27 KB
Newer Older
1 2 3 4 5 6 7
#!/usr/local/bin/perl -w
use strict;
use Tk;

#Color values

my $main_bg = 'grey80';
8
my $act_bg = 'grey90';
9 10 11 12 13 14 15 16 17 18

#other Variables

my $op="";
my @machines=();

#Build the Widgets now

#set up main
my $main = MainWindow->new();
19
$main->title("vpower - Visual Power");
20 21 22 23 24 25
#$main->minsize( qw(200 100) );
$main->configure(-background => $main_bg );

#add some frames
my $msg_frm = 
    $main->Frame( -relief=>'sunken', -borderwidth=>2, -background=>$main_bg
26
		   )->pack(-side=>'bottom',-expand=>'1', -fill=>'x');
27
my $msg_area = 
28 29
    $msg_frm->Label(-background=>$main_bg, -anchor=>'nw') 
    ->pack(-side=>'left',-expand=>'1',-fill=>'x',-anchor=>'nw');
30

31
my $frm = 
32 33
    $main->Frame( -relief=>'flat', -background=>$main_bg
		  ) ->pack (-side=>'left', -fill=>'x');
34 35
my $frm1 = 
    $frm->Frame( -relief=>'flat', -background=>$main_bg
36
		  ) ->pack (-side=>'left', -fill=>'x');
37 38 39 40 41
my $frm2 = 
    $frm->Frame( -relief=>'flat', -background=>$main_bg
		  ) ->pack (-side=>'left', -fill=>'x');
my $frm3 = 
    $frm->Frame( -relief=>'flat', -background=>$main_bg
42 43 44 45 46
		  ) ->pack (-side=>'left', -fill=>'x');

#set up the machines

my @mach;
47
my @machvals;
48 49

$mach[1] = 
50
    $frm1->Checkbutton(-variable=>\$machvals[1], -text=>"tbpc01",
51 52
		       -background=>$main_bg, -width=>'6',-anchor=>'nw'
		       )->pack(-side=>'top',-fill=>'x', -anchor=>'w');
53
$mach[2] = 
54
    $frm1->Checkbutton(-variable=>\$machvals[2], -text=>"tbpc02",
55
			   -background=>$main_bg, -width=>'6',-anchor=>'nw'
56 57
			   )->pack(-side=>'top',-fill=>'x', -anchor=>'w');
$mach[3] = 
58
    $frm1->Checkbutton(-variable=>\$machvals[3], -text=>"tbpc03",
59
			   -background=>$main_bg, -width=>'6',-anchor=>'nw'
60 61
			   )->pack(-side=>'top',-fill=>'x', -anchor=>'w');
$mach[4] = 
62
    $frm1->Checkbutton(-variable=>\$machvals[4], -text=>"tbpc04",
63
			   -background=>$main_bg, -width=>'6',-anchor=>'nw'
64 65
			   )->pack(-side=>'top',-fill=>'x', -anchor=>'w');
$mach[5] = 
66
    $frm1->Checkbutton(-variable=>\$machvals[5], -text=>"tbpc05",
67
			   -background=>$main_bg, -width=>'6',-anchor=>'nw'
68 69
			   )->pack(-side=>'top',-fill=>'x', -anchor=>'w');
$mach[6] = 
70
    $frm2->Checkbutton(-variable=>\$machvals[6], -text=>"tbpc06",
71
			   -background=>$main_bg, -width=>'6',-anchor=>'nw'
72 73
			   )->pack(-side=>'top',-fill=>'x', -anchor=>'w');
$mach[7] = 
74
    $frm2->Checkbutton(-variable=>\$machvals[7], -text=>"tbpc07",
75
			   -background=>$main_bg, -width=>'6',-anchor=>'nw'
76 77
			   )->pack(-side=>'top',-fill=>'x', -anchor=>'w');
$mach[8] = 
78
    $frm2->Checkbutton(-variable=>\$machvals[8], -text=>"tbpc08",
79
			   -background=>$main_bg, -width=>'6',-anchor=>'nw'
80 81
			   )->pack(-side=>'top',-fill=>'x', -anchor=>'w');
$mach[9] = 
82
    $frm2->Checkbutton(-variable=>\$machvals[9], -text=>"tbpc09",
83
			   -background=>$main_bg, -width=>'6',-anchor=>'nw'
84 85
			   )->pack(-side=>'top',-fill=>'x', -anchor=>'w');
$mach[10] = 
86
    $frm2->Checkbutton(-variable=>\$machvals[10], -text=>"tbpc10",
87
			   -background=>$main_bg, -width=>'6',-anchor=>'nw'
88 89
			   )->pack(-side=>'top',-fill=>'x', -anchor=>'w');
$mach[11] = 
90 91 92
    $frm3->Checkbutton(-variable=>\$machvals[11], -text=>"alpha",
			   -background=>$main_bg, -width=>'6',-anchor=>'nw'
			   )->pack(-side=>'top',-fill=>'x');
93
$mach[12] = 
94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125
    $frm3->Checkbutton(-variable=>\$machvals[12], -text=>"beta",
			   -background=>$main_bg, -width=>'6', -anchor=>'nw'
			   )->pack(-side=>'top',-fill=>'x');
$mach[13] = 
    $frm3->Checkbutton(-variable=>\$machvals[13], -text=>"gamma",
			   -background=>$main_bg, -width=>'6', -anchor=>'nw'
			   )->pack(-side=>'top',-fill=>'x');
$mach[14] = 
    $frm3->Checkbutton(-variable=>\$machvals[14], -text=>"delta",
			   -background=>$main_bg, -width=>'6', -anchor=>'nw'
			   )->pack(-side=>'top',-fill=>'x');
$mach[15] = 
    $frm3->Checkbutton(-variable=>\$machvals[15], -text=>"",
			   -background=>$main_bg, -width=>'6', -anchor=>'nw'
			   )->pack(-side=>'top',-fill=>'x');

#set up the operations

my $op_on = 
    $frm1->
    Radiobutton( -variable=> \$op, -text => 'On', -background=>$main_bg,
		 -value=>'on', -width=>'6', -anchor=>'nw'
		 )->pack(-side=>'top',-fill=>'x', -anchor=>'w');

my $op_off = 
    $frm2->
    Radiobutton( -variable=> \$op, -text => 'Off',-background=>$main_bg,
		 -value=>'off', -width=>'6', -anchor=>'nw'
		 )->pack(-side=>'top',-fill=>'x', -anchor=>'w');

my $op_cyc = 
    $frm3->
126
    Radiobutton( -variable=> \$op, -text => 'Cycle',-background=>$main_bg,
127 128
		 -value=>'cycle', -width=>'6', -anchor=>'nw'
		 )->pack(-side=>'top',-fill=>'x', -anchor=>'w');
129 130 131 132

#set up the buttons

my $go = 
133 134 135 136 137 138 139
    $frm1->Button(-text=>'Go!',-background=>$main_bg,-width=>'6', 
		  -anchor=>'center', -relief=>'raised',-command=>
		  sub {
		      my $n=0;
		      @machines=();
		      while ($n <= $#machvals ) {
			  if (defined($machvals[$n])&&$machvals[$n]==1) {
140 141
			      push(@machines,"tbpc0$n") if ($n < 10);
			      push(@machines,"tbpc$n") if ($n == 10);
142 143 144 145 146 147 148
			      push(@machines,"alpha") if ($n==11);
			      push(@machines,"beta") if ($n==12);
			      push(@machines,"gamma") if ($n==13);
			      push(@machines,"delta") if ($n==14);
			  }
			  $n++;
		      }
149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170
		      if ($#machines<0) {
			  &message
			      ($msg_area,
			       "Please select at least one machine.");
		      } elsif (!$op) {
			  &message ($msg_area, 
				    "Please select an operation.");
		      } else {
			  my @output=();
			  open(PWR,"power $op @machines |");
			  while (<PWR>) {
			      chop;
			      push (@output,$_);
			  }
			  &message ($msg_area,
				    join ("\n",@output));
			  my $n=0;
			  while ($n <= $#machvals ) {
			      $machvals[$n]=0;
			      $n++;
			  }
		      }
171
		  })
172 173 174 175
    ->pack(-side=>'left',-anchor=>'s',-fill=>'x',
    -padx=>'2',-pady=>'2');

my $help_btn=
176 177
    $frm2->Button(-text=>'Help',-background => $main_bg,-width=>'6', 
    -anchor=>'center', -relief=>'raised',-command=>sub {
178
	&message( $msg_area, 
179
		  "Select machine(s) to update\n", 
180
		  "Select on, off, or cycle\n",
181
		  "Press the Go! button"); } )
182 183 184 185
    ->pack(-side=>'left',-anchor=>'s',-fill=>'x',
    -padx=>'2',-pady=>'2');

my $exit_btn= 
186 187
    $frm3->Button(-text=>'Exit', -background => $main_bg,-width=>'6', 
    -anchor=>'center', -relief=>'raised',-command=>sub{$main->destroy})
188 189 190 191 192 193 194
    ->pack(-side=>'left',-anchor=>'s',-fill=>'x',
    -padx=>'2',-pady=>'2');

MainLoop();

sub message {
    (my $area,my @msg) = @_;
195 196
    my $text= join("",@msg);
    $area->configure(-text=> $text, -anchor=>'nw' );
197 198
}