#!/usr/bin/perl
# A calendar scheduling program written by Joe Kamphaus in June 2004
# for "Happy Kampers" an assisted living facility
# each square representing a day on the calendar 
# is a text box and may be edited
# In windows in order to print you must have gsprint.exe
# and edit the sub print according to the directions there.

use Tk;
use Time::Local;

$mo = (localtime)[4];
$yr = (localtime)[5];

for $i (0..5) {
	for $n (0..6) {
		$key = "$mo:$yr:$i:$n";
		$info{$key} = "";
	}
}


do "$ENV{HOME}/.lastcal.sch";

# For Windows
# do "c:\\lastcal.sch";


my $moStr = getCalTitle($mo, $yr);

$mw = MainWindow->new(-title => 'Happy Kampers Schedual');

#*****************************************************
#*****************************************************
# IMAGES

$leftuu = '
R0lGODlhKAAUAOcAAAAAAAgAAAgIABAQAAgACAgICBAACBAICBAQCBgYCCkp
CBAAEDExEDk5EFpaEJyUEBgAGCkQGDEhGEJCGFJKGJSUGCEAISkAIUIxIUpK
IVpSIWNjIXNrIXtrIXtzISkAKTEYKUpCKVpCKXNzKXtjKTEIMTEQMTkAMUIh
MUpCMWNSMXNaMXNjMYRzMYyMMTkAOTkQOUopOUIAQkIYQkoASkoYSoRSSoxa
SpRaUloIWmMIWoxSWpRjWmMIY2sIY2sQY3MAc3sAc6UApXMIa2MIc3sIc3sI
e4QIhKUIpa0IvWsQe3sQe4QQe4QQhJQQlKUQpZwQvXMYa4QYhIwYhIwYjJQY
lK0YvaUYxmshY3sha3Mhc4whhIwhjJQhjHspa3spe4Qpe5QpjJwpjJQplJwp
lIwxc4QxhIwxjJwxlIQ5c5Q5hIw5jJlChqVeY5RKc59SgZxClJxKlKUxlKVK
lKVSlK1ClJwxnKUxnKU5nKVSnK05nK1CnKU5paVCpa1Cpa1Cra1KrbUQrbUQ
xrVCpbVKpbVKrbVKtbVStb0Yvb1Kpb1Krb1Srb1SteQ5tcZSrcZStf9SvbVa
jLVanMZapcZatc5atcZjpc5jtc5jvdZjva1re8ZrlM5rlP9rnM5rrdZrvb0Q
xsoEysEYxsUY0NoM1ukQ5O8A5+8K6fcI7/cY3vcU7/8Y7/cQ9/cY9/8Y9/8Q
/8Yhzs4hyto5zu8m0/c5xv8Y//8h7/8h//8p5/8p//8x3v8x//85//9C//9K
//9SzrWMOb2UOb2UQsaUQsacQs6cSsalObW1Ib21Kc6lStPCOd7SKN7eOf/a
Mf/GSu/WQv/eQv/vGP/vKffvOf/vSv/3GP/3If//CP//EP//GP//If//Kf//
Mf//Of//Qv//Srh1dc2fWt6tUt61VveMc/+tWue5Yvmya++9a/+9a+/OWvfa
Vv/nUv//Uv//Y///a9Zrxt5rxvdzjM5znN5zxv97lNZ7nP97986Me9aUhP+E
pe6of/+U//+tpf+1vf/YwCH5BAEAAPwALAAAAAAoABQAAAj+APkJHEiw4EAE
BhMqXGiQQA1ALBgwnMiwQIkoYez0OdRBA8WPBU30WLJljMZDHlKApIggxps9
W5YsYRImDB4/efLEgQPHzBctUX70iKKGjiRJc9iwMAgizSJM9D4tQrOlyBIp
Ycbg6cO1D56aUmTSJAT10iJCbAgikFBnz6JLn+hRwhNT5hYuJvHYsYMmTFi7
eBh9+oSJ0J46CPk96/ZNWFtGl+jRMxym7tUtYbhI2cLECMkuewhFLUzo6wiB
BGbp4+btGbi3mD5RMoymy1+ZS4psFoOHkGBMmBbtwdMljI0MAofcgratm7dw
k6DKNvy1DDBgwrALI1YsWbJx4MXLhUtWjJh5FwMXqFrVSVpzarGjyl705sG3
+97u6//Wrt1+/N4gM5APpahCizPZcGPOJVDJp0kF7kT4jjvvVGjhhRFm2E5B
FiBxSimNXMNNO/lQwqAm3vxzxSi1tOKii7XckouMueTCyy43fqAQDaGUIk80
2HDDziY87HOPEkRYIUgSgjQpCCKIwCKKlLHEgggBDFnwIS3NYKONNzf0w8lK
ZNJAiiqp1GPNNv6IQOabCxyRSivlLCPBm3jmUIot8tyJJ55PqFLCn4QWGhAA
Ow==
====
';

$rightuu = '
R0lGODlhKAAUAOcAAAAAAAgAAAgIABAQAAgACAgICBAACBAICBAQCBgYCCkp
CBAAEDExEDk5EFpaEJyUEBgAGCkQGDEhGEJCGFJKGJSUGCEAISkAIUIxIUpK
IVpSIWNjIXNrIXtrIXtzISkAKTEYKUpCKVpCKXNzKXtjKTEIMTEQMTkAMUIh
MUpCMWNSMXNaMXNjMYRzMYyMMTkAOTkQOUopOUIAQkIYQkoASkoYSoRSSoxa
SpRaUloIWmMIWoxSWpRjWmMIY2sIY2sQY3MAc3sAc6UApXMIa2MIc3sIc3sI
e4QIhKUIpa0IvWsQe3sQe4QQe4QQhJQQlKUQpZwQvXMYa4QYhIwYhIwYjJQY
lK0YvaUYxmshY3sha3Mhc4whhIwhjJQhjHspa3spe4Qpe5QpjJwpjJQplJwp
lIwxc4QxhIwxjJwxlIQ5c5Q5hIw5jJlChqVeY5RKc59SgZxClJxKlKUxlKVK
lKVSlK1ClJwxnKUxnKU5nKVSnK05nK1CnKU5paVCpa1Cpa1Cra1KrbUQrbUQ
xrVCpbVKpbVKrbVKtbVStb0Yvb1Kpb1Krb1Srb1SteQ5tcZSrcZStf9SvbVa
jLVanMZapcZatc5atcZjpc5jtc5jvdZjva1re8ZrlM5rlP9rnM5rrdZrvb0Q
xsoEysEYxsUY0NoM1ukQ5O8A5+8K6fcI7/cY3vcU7/8Y7/cQ9/cY9/8Y9/8Q
/8Yhzs4hyto5zu8m0/c5xv8Y//8h7/8h//8p5/8p//8x3v8x//85//9C//9K
//9SzrWMOb2UOb2UQsaUQsacQs6cSsalObW1Ib21Kc6lStPCOd7SKN7eOf/a
Mf/GSu/WQv/eQv/vGP/vKffvOf/vSv/3GP/3If//CP//EP//GP//If//Kf//
Mf//Of//Qv//Srh1dc2fWt6tUt61VveMc/+tWue5Yvmya++9a/+9a+/OWvfa
Vv/nUv//Uv//Y///a9Zrxt5rxvdzjM5znN5zxv97lNZ7nP97986Me9aUhP+E
pe6of/+U//+tpf+1vf/YwCH5BAEAAPwALAAAAAAoABQAAAj+APkJHEiwoEEE
BhMqXKiQAQtANQgwnEhRoIYOh/rYCROlRIGKIAmm8JDRzpgtS3qYqMiCzRxJ
kuioidLjRxQtX8zAgRMnTx4/eMKEYbJkyZY9b2IgVMiG0KJL9DARGlpUilA8
fbL2wTMmjJQlRbagWfQp6qI0IAoiqLOHEKZPnxjhQVk1DBo7dvCY5ELXKB5K
9D5dWrSnjoSl/EaEwUPIbVlCe7qgNMJkixQuYSwXNRqmLT16lxgVFvat2zN+
GWyE6YJnzyJMbxkRwiPGcpHNVbugaUvpE6bB4J5546ZvlkQXxJIXSxZO3Ljn
yZIVIyZMGDDrwMos5l0W06Rw3rrKbYN2awg/ZN68fVvPvl079uzVr3/wZlHv
sr6piZfWaZWqBQK1486AA75j4IEIuvMOgRVoAtdnv5nDTTbO0KJKKT4M9MEu
vHCYy4e35HJLLa2UWGIto1zxjzea/EZJPu1wc00jpZyChAUGEYBILLGIAouP
iCAiyJCCJCGIFUQocc8+PGzCDjfYRCNPKaHQEFJFnPRzgzfaYNMMLTXieCVF
IvizjTX1pKIKKVaOWZEEy5TTSipHAOgmSBLIY0spOdx5ZQmqPOHnoFcGBAA7
====
';

$leftIMG = $mw->Photo(
	-data => $leftuu,
);
$rightIMG = $mw->Photo(
	-data => $rightuu,
);



#*****************************************************
#*****************************************************
# Build the GUI

# MENUBAR #
	$menubar = $mw->Frame(
		-relief => 'ridge',
		-borderwidth => 4,
			)->pack(
			-side => top,
			-anchor => 'n',
			-expand => 'yes',
			-fill => 'x',
	);
	$menubar->Menubutton(-text => "File", -underline => 0, -menuitems =>
		[	[	'command' => 'Save',
				'-command' => \&save,
				'-underline' => 0],
		'-',
			[	'command' => 'Exit',
				'-command' => \&bye,
				'-underline' => 1],
		]
	 )->pack( -side, 'left' );
	$menubar->Menubutton(-text => 'Edit', -underline => 0, -menuitems =>
		[	[	'command' => 'Cut  (Ctrl-X)',
				'-command' => \&cut,
				'-underline' => 1],
			[	'command' => 'Copy  (Ctrl-C)',
				'-command' => \&copy,
				'-underline' => 0],
			[	'command' => 'Paste  (Ctrl-V)',
				'-command' => \&paste,
				'-underline' => 0],
		])->pack( -side, 'left' );
	$menubar->Button(
		-text => "Draw Printable Calendar",
		-underline => 0,
		-relief => 'flat',
		-command => \&renderCalendar,
		)->pack(
			-side => 'left',
	);

	$menubar->Button(
		-image => $leftIMG,
		-command => \&decrMonth,
		-relief => 'flat',
		)->pack(
			-side => 'left',
			-padx => 40,
	);
	$menubar->Button(
		-image => $rightIMG,
		-command => \&incrMonth,
		-relief => 'flat',
		)->pack(
			-side => 'left',
			-padx => 10,
	);
# TITLE DATE STRING
	$mw->Label(-textvariable => \$moStr)->pack(
			-side => 'top',
			-anchor => 'n',
			-expand => 'yes',
			-fill => 'both',
	);
# CALENDAR FRAME #
	$calFrame = $mw->Frame(
		)->pack(
			-side => 'top',
			-anchor => 'n',
			-expand => 'yes',
			-fill => 'both',
	);
  # DAYS OF THE WEEK #
	foreach ('Sunday', 'Monday', 'Tuesday', 'Wednesday', 'Thursday', 'Friday', 'Saturday'){
		$day{$_} = $calFrame->Label(-text => $_);
	}
	$day{Sunday}->grid(
		$day{Monday},
		$day{Tuesday},
		$day{Wednesday},
		$day{Thursday},
		$day{Friday},
		$day{Saturday},
	);

	my %txtBox;
# CALENDAR TEXTBOXES #
	$a=0;
	foreach $i (0..5) {
		foreach $n (0..6){
			$key = $i . ":" . $n;
			$txtBox{$key} = $calFrame->Text(
				-width => 12,
				-height => 4,
				)->grid(
					-row => $i+1,
					-column => $n,
			);
			$txtBox{$key}->bind('Tk::Text', '<Key-Tab>', sub {});
		}
	}
enterData();


MainLoop;

#*****************************************************
#*****************************************************
# Subroutines

##################################
sub getCalTitle {
	my $mo = shift;
	my $yr = shift;
	my $mostr = ('January', 'February', 'March',
		'April', 'May', 'June', 'July',
		'August', 'September', 'October',
		'November', 'December')[$mo];
	$yr += 1900;
	$mostr .= ", $yr";
	return $mostr;
}

##################################
sub enterData {
	my ($day, $infokey, $boxkey);
	for $i (0..5) {
		for $n (0..6) {
			$infokey = $mo . ":" . $yr . ":" . $i . ":" . $n;
			$boxkey = $i . ":" . $n;
			$txtBox{$boxkey}->configure(-state => "normal");
			if ($info{$infokey} ne ""){
				$day = $info{$infokey};
			} else {
				$day = whatDay($i, $n);
			}
			chomp $day;
			$txtBox{$boxkey}->delete('1.0', 'end');
			$txtBox{$boxkey}->insert('1.0', $day);
			if (($day eq "") or ($day eq "\n\n  ")){
				$txtBox{$boxkey}->configure(-state => disabled);
			}
		}
	}
}

##################################
sub whatDay {
	my $week = shift;
	my $dayofweek = shift;
	my $day = "";
	my $tm = timelocal(1, 1, 1, 1, $mo, $yr);
	my $first = (localtime($tm))[6];
	my $last = (31, 28, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31)[$mo];
	$last++ if (($last == 28) and ($yr % 4 == 0));
	if (($week == 0) and ($dayofweek >= $first)) {
		$day = $week * 7 + $dayofweek - $first + 1;
	} elsif ($week > 0) {
		$day = $week * 7 + $dayofweek - $first + 1;
		if ($day > $last) {
			$day = "";
		}
	}
	return("$day\n\n  ");
}

##################################
sub incrMonth {
	save();
	if (++$mo > 11){
		$mo = 0;
		$yr++;
	}
	$moStr = getCalTitle($mo, $yr);
	enterData();
}

##################################
sub decrMonth {
	save();
	if (--$mo < 0){
		$mo = 11;
		$yr--;
	}
	$moStr = getCalTitle($mo, $yr);
	enterData();

}

##################################
sub bye {
	save();
	exit;
}

##################################
sub openfile {

}

##################################
sub newfile {

}

##################################
sub save {
	for $i (0..5) {
		for $n (0..6) {
			$key = "$mo:$yr:$i:$n";
			$boxkey = $i . ":" . $n;
			$info{$key} = $txtBox{$boxkey}->get('0.1', 'end');
		}
	}
	open FH, ">$ENV{HOME}/.lastcal.sch";

	#For Windows
	# open FH, ">c:\\lastcal.sch";

	print FH '$mo = ', $mo, ";\n";
	print FH '$yr = ', $yr, ";\n";
	foreach $key (keys %info){
		chomp $info{$key};
		print FH '$info{"', $key, '"} = \'', $info{$key}, '\';', "\n";
	}
	close FH;
}

##################################
sub saveas {

}

##################################
sub cut {
	copy();
	deletesel();
}

##################################
sub deletesel {
	$wdgt = $mw->focus(-displayof);
	my ($n, $m) = $wdgt->tagRanges('sel');
	$wdgt->delete($n, $m) if $n;
}

##################################
sub copy {

	$wdgt = $mw->focus(-displayof);
	my $txt = $wdgt->get('sel.first', 'sel.last');
	$wdgt->clipboardClear();
	$wdgt->clipboardAppend($txt);
}

##################################
sub paste {
	$wdgt = $mw->focus(-displayof);
	my $txt = $wdgt->SelectionGet(-selection, 'CLIPBOARD', -type, 'STRING');
	deletesel();
	$wdgt->insert('insert', $txt);
}

##################################
sub renderCalendar {
	$w = 700;
	$h = 500;
	$topcal = $mw->Toplevel(-title => "Printable Calendar");
	$fr = $topcal->Frame()->pack(
			-side => 'top',
			-anchor => 'n',
			-fill => 'x',
			-expand => 'yes'
	);
	$fr->Button(
		-text => "Print",
		-command => \&Print,
		)->pack(
			-side => 'left',
			-fill => 'x',
			-expand => 'yes'
	);

	$fr->Button(
		-text => "Cancel",
		-command => \&cancelPrint,
		)->pack(
			-side => 'right',
			-fill => 'x',
			-expand => 'yes'
	);

	$cal = $topcal->Canvas(
		-width => $w,
		-height => $h,
		-bg => 'white'
		)->pack(
	);

	$h1 = $cal->fontCreate(
		-family => 'Courier New',
		-size => 16,
		-weight => 'bold',
		-slant => 'roman',
	);
	$bold = $cal->fontCreate(
		-family => 'Courier New',
		-size => 12,
		-weight => 'bold',
		-slant => 'roman',
	);
	$normal = $cal->fontCreate(
		-family => 'Courier New',
		-size => 12,
		-weight => 'normal',
		-slant => 'roman',
	);
	$tiny = $cal->fontCreate(
		-family => 'Courier New',
		-size => 10,
		-weight => 'bold',
		-slant => 'roman',
	);

	$cal->createText($w/2,20,
		-text => $moStr,
		-font => $h1,
	);

	$x = 5;
	$y = 40;
	$daywidth = ($w - 10) / 7;
	$dayheight = ($h - 100) / 6;
	foreach $wday qw(Sunday Monday Tuesday Wednesday Thursday Friday Saturday){
		$cal->createText($x + $daywidth / 2, $y,
			-text => $wday,
			-font => $bold,
		);
		$x += $daywidth;
	}
	$x = 5;
	$y = 50;
	foreach $i (0..5){
		foreach $n (0..6){
			$key = $mo . ":" . $yr . ":" . $i . ":" . $n;
			$cal->createRectangle($x, $y, $x + $daywidth, $y + $dayheight);
			$cal->createText($x+3, $y+3,
				-anchor => 'nw',
				-text => $info{$key},
				-font => $bold,
			);
			$x += $daywidth;
		}
		$y += $dayheight;
		$x = 5;
	}

}


##################################
sub Print {
	$cal->postscript(
		-file => "$ENV{HOME}/.cal.ps",
		-pagewidth => "10i",
		-rotate => 1,
	); # For Windows Use Option '-file => "c:\\cal.ps"'

	`lpr $ENV{HOME}/.cal.ps`;
	#  For Windows copy gsprint.exe to C:\gsprint and do
	#  `c:\\gsprint c:\\cal.ps`; instead of the lpr call above.
	$topcal->destroy();
}

##################################
sub cancelPrint {
	$topcal->destroy();
}