Beefy Boxes and Bandwidth Generously Provided by pair Networks
Perl Monk, Perl Meditation
 
PerlMonks  

Re: BCD Clock TK

by Three (Pilgrim)
on Dec 31, 2002 at 16:43 UTC ( #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; } }


Comment on Re: BCD Clock TK
Download Code
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
Node Status?
node history
Node Type: note [id://223375]
help
Chatterbox?
and the web crawler heard nothing...

How do I use this? | Other CB clients
Other Users?
Others having an uproarious good time at the Monastery: (9)
As of 2014-07-22 23:56 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    My favorite superfluous repetitious redundant duplicative phrase is:









    Results (130 votes), past polls