#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;
	}
}