Beefy Boxes and Bandwidth Generously Provided by pair Networks
Do you know where your variables are?
 
PerlMonks  

Re: BCD Clock TK

by Three (Pilgrim)
on Dec 31, 2002 at 16:43 UTC ( [id://223375]=note: print w/replies, xml ) Need Help??


in reply to BCD Clock built using only binary logic.

Heay I made a quick tk version of the bcd clock if anyone wants it here it is.
It's sort of crappy and the idea was completely inspired by the great saint who started this.
PS. I know the logic is ugly as sin but didn't have time to be clever and make better.
#Emulate think geek binary clock in perl tk use strict; use warnings; #Get package in PPM by install Tk use English; require TK; use Tk; #Varables my %rb; #Holds the radio buttons controller varables #Setup the screen my $main=MainWindow->new(); $main->MoveToplevelWindow(1,1); $main->title("Binary Clock"); #Split screen up for hours minutes and seconds my $lefttmp = $main->Frame()->pack(-side=>'left'); my $seconds = $main->Frame()->pack(-side=>'right'); my $hours = $lefttmp->Frame()->pack(-side=>'left'); my $minutes = $lefttmp->Frame()->pack(-side=>'right'); #Hours my $h1 = $hours->Frame()->pack(-side=>'left'); my $h2 = $hours->Frame()->pack(-side=>'right'); my $h18 = $h1->Radiobutton(-value=>1,-variable=>\$rb{'h18'})->pack(); my $h14 = $h1->Radiobutton(-value=>1,-variable=>\$rb{'h14'})->pack(); my $h12 = $h1->Radiobutton(-value=>1,-variable=>\$rb{'h12'})->pack(); my $h11 = $h1->Radiobutton(-value=>1,-variable=>\$rb{'h11'})->pack(); my $h28 = $h2->Radiobutton(-value=>1,-variable=>\$rb{'h28'})->pack(); my $h24 = $h2->Radiobutton(-value=>1,-variable=>\$rb{'h24'})->pack(); my $h22 = $h2->Radiobutton(-value=>1,-variable=>\$rb{'h22'})->pack(); my $h21 = $h2->Radiobutton(-value=>1,-variable=>\$rb{'h21'})->pack(); #Minutes my $m1 = $minutes->Frame()->pack(-side=>'left'); my $m2 = $minutes->Frame()->pack(-side=>'right'); my $m18 = $m1->Radiobutton(-value=>1,-variable=>\$rb{'m18'})->pack(); my $m14 = $m1->Radiobutton(-value=>1,-variable=>\$rb{'m14'})->pack(); my $m12 = $m1->Radiobutton(-value=>1,-variable=>\$rb{'m12'})->pack(); my $m11 = $m1->Radiobutton(-value=>1,-variable=>\$rb{'m11'})->pack(); my $m28 = $m2->Radiobutton(-value=>1,-variable=>\$rb{'m28'})->pack(); my $m24 = $m2->Radiobutton(-value=>1,-variable=>\$rb{'m24'})->pack(); my $m22 = $m2->Radiobutton(-value=>1,-variable=>\$rb{'m22'})->pack(); my $m21 = $m2->Radiobutton(-value=>1,-variable=>\$rb{'m21'})->pack(); #Seconds my $s1 = $seconds->Frame()->pack(-side=>'left'); my $s2 = $seconds->Frame()->pack(-side=>'right'); my $s18 = $s1->Radiobutton(-value=>1,-variable=>\$rb{'s18'})->pack(); my $s14 = $s1->Radiobutton(-value=>1,-variable=>\$rb{'s14'})->pack(); my $s12 = $s1->Radiobutton(-value=>1,-variable=>\$rb{'s12'})->pack(); my $s11 = $s1->Radiobutton(-value=>1,-variable=>\$rb{'s11'})->pack(); my $s28 = $s2->Radiobutton(-value=>1,-variable=>\$rb{'s28'})->pack(); my $s24 = $s2->Radiobutton(-value=>1,-variable=>\$rb{'s24'})->pack(); my $s22 = $s2->Radiobutton(-value=>1,-variable=>\$rb{'s22'})->pack(); my $s21 = $s2->Radiobutton(-value=>1,-variable=>\$rb{'s21'})->pack(); #Setup screen update launcher my $status_timer = Tk::After->new($main,'1000','repeat',\&process_loop +); #Loop for visuals MainLoop(); sub process_loop { #Main loop of program #Varables my @lt = localtime; #Get local time #Handle single 0 problem if(length($lt[2]) == 1) { $lt[2] = '0' . $lt[2]; } if(length($lt[1]) == 1) { $lt[1] = '0' . $lt[1]; } if(length($lt[0]) == 1) { $lt[0] = '0' . $lt[0]; } #Set the radio buttons set_bin(substr($lt[2],0,1),'h1'); set_bin(substr($lt[2],1,1),'h2'); set_bin(substr($lt[1],0,1),'m1'); set_bin(substr($lt[1],1,1),'m2'); set_bin(substr($lt[0],0,1),'s1'); set_bin(substr($lt[0],1,1),'s2'); } sub set_bin { #Ugly cludge to set the radio buttons my ($value, $varset) = @_; #Check 8 if($value >= 8) { $rb{$varset . '8'} = 1; $value -= 8; } else { $rb{$varset . '8'} = 0; } #Check 4 if($value >= 4) { $rb{$varset . '4'} = 1; $value -= 4; } else { $rb{$varset . '4'} = 0; } #Check 2 if($value >= 2) { $rb{$varset . '2'} = 1; $value -= 2; } else { $rb{$varset . '2'} = 0; } #Check 1 if($value >= 1) { $rb{$varset . '1'} = 1; $value -= 1; } else { $rb{$varset . '1'} = 0; } }

Replies are listed 'Best First'.
Re: Re: BCD Clock TK
by zentara (Archbishop) on Jan 01, 2003 at 15:27 UTC
    Works nice. I had to drop the require TK; line though. ;-)

Log In?
Username:
Password:

What's my password?
Create A New User
Domain Nodelet?
Node Status?
node history
Node Type: note [id://223375]
help
Chatterbox?
and the web crawler heard nothing...

How do I use this?Last hourOther CB clients
Other Users?
Others having a coffee break in the Monastery: (5)
As of 2024-03-29 14:55 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    No recent polls found