#!/opt/tcl803/bin/wishx
#
package require BLT
#
proc is_leap_year y {

	if {[fmod $y 400] == 0} {
		return 1
	}

	if {([fmod $y 4] == 0) && ([fmod $y 100] != 0)} {
		return 1
	}

	return 0
}
#
proc days_in_month {m y} {

	global Mdays

	if {$m != 2} {
		return $Mdays($m)
	}

	if [is_leap_year $y] {
		return 29
	} else {
		return $Mdays($m)
	}
}
#
proc days_bt_years {y1 y2} {

	set d 0
	if {$y1 > $y2} {
		return 0
	}

	loop y $y1 [expr $y2+1] {
		if [is_leap_year $y] {
			incr d 366
		} else {
			incr d 365
		}
	}
	return $d
}
#
proc days_bt_months {m1 m2 y} {

	set d 0

	if {$m1 > $m2} {
		return 0
	}

	loop m $m1 [expr $m2 + 1] {
		incr d [days_in_month $m $y]
	}

	return $d
}
#
proc days_old {} {

	global BY BM BD
	global TY TM TD

	set d 0
	if {$TY > $BY} {
		incr d [days_bt_years [expr $BY+1] [expr $TY-1]]
		incr d [days_bt_months [expr $BM + 1] 12 $BY]
		incr d [days_bt_months 1 [expr $TM - 1] $TY]
		incr d $TD
		incr d [expr [days_in_month $BM $BY] - $BD]
	} else {
		if {$TM > $BM} {
			incr d [days_bt_months [expr $BM + 1] [expr $TM - 1] $BY]
			incr d $TD
			incr d [expr [days_in_month $BM $BY] - $BD]
		} else {
			incr d [expr $TD - $BD]
		}
	}

	return $d
}
#
proc verify_date d {

#	The user fed us a date.
#	anything not containing / will be understood to be TODAY

	if {[string first / $d] < 0} {
		set d [clock format [clock seconds] -format "%d/%m/%Y"]
	}

	lassign [split $d /] d m y
	set d [string trimleft $d 0]
	set m [string trimleft $m 0]

	if {$y == ""} {
		set y $m
		set m $d
		set d [string trimleft [clock format [clock seconds] -format %d] 0]
	}

	if {$y == ""} {
		set y $m
		set m [string trimleft [clock format [clock seconds] -format %m] 0]
		set d [string trimleft [clock format [clock seconds] -format %d] 0]
	}

	if {($d < 1) || ($d > [days_in_month $m $y])} {
		return "SORRY BAD DAY $d"
	}

	if {($m < 1) || ($m > 12)} {
		return "SORRY BAD MONTH $m"
	}

	if {$y < 1753} {
		return "SORRY TOO LONG-AGO"
	}

	return [list $d $m $y]
}
#
proc make_vectors {days} {

	set pi 3.14159

	catch {blt::vector destroy E}
	catch {blt::vector destroy I}
	catch {blt::vector destroy P}

	blt::vector create E
	blt::vector create I
	blt::vector create P

	blt::vector create EI
	blt::vector create EP
	blt::vector create IP

	set ed [floor [fmod $days 28]]
	set id [floor [fmod $days 33]]
	set pd [floor [fmod $days 23]]
	
#	31 days of plots, -15 -> today -> +15

	loop i $ed [expr $ed + 32] {
		E append [expr sin([double $i]*(2*$pi/28.0))]
	}
	loop i $id [expr $id + 32] {
		I append [expr sin([double $i]*(2*$pi/33.0))]
	}
	loop i $pd [expr $pd + 32] {
		P append [expr sin([double $i]*(2*$pi/23.0))]
	}

	EI expr {(E + I)/2}
	EP expr {(E + P)/2}
	IP expr {(I + P)/2}	
	
}
#
proc doPlot {} {

	global BY BM BD TY TM TD bday target
	global E I P EI EP IP X hues

	lassign [verify_date $bday] BD BM BY

	if {$BD == "SORRY"} {
		set Message "$BD $BM $BY"
		return
	}

	lassign [verify_date $target] TD TM TY
	if {$TD == "SORRY"} {
		set Message "$TD $TM $TY"
		return
	}
	
	set days [expr [days_old] - 15]

	make_vectors $days

	set elems [.g element names]
	foreach e $elems {
		.g element delete $e
	}
	foreach m [.g marker names] {
		.g marker delete $m
	}

	foreach v [list E I P EI EP IP] {
		.g element create e$v -xdata X -ydata $v -symbol none -smooth linear -color $hues($v) -mapy y -mapx x
	}

	set m1 [.g marker create line -coords "0 -2 0 2" -linewidth 1]
	.g marker configure $m1 -color white -dash {1 2} -hide 0
	set m2 [.g marker create line -coords "-15 0 15 0" -linewidth 1]
	.g marker configure $m2 -color white -dash {1 2} -hide 0

	.g configure -title "$TM/$TD/$TY"
}
#
proc toggle v {

	set en e$v

	set hidden [.g element cget $en -hide]

	if {$hidden} {
		.g element configure $en -hide 0
	} else {
		.g element configure $en -hide 1
	}

}
#
set hues(E) red
set hues(I) green
set hues(P) yellow
set hues(EI) gray
set hues(EP) purple
set hues(IP) blue
set Mdays(1) 31
set Mdays(2) 28
set Mdays(3) 31
set Mdays(4) 30
set Mdays(5) 31
set Mdays(6) 30
set Mdays(7) 31
set Mdays(8) 31
set Mdays(9) 30
set Mdays(10) 31
set Mdays(11) 30
set Mdays(12) 31
#
label .blab -text "Birth Date"
label .tlab -text "TargetDate"
entry .born -textvariable bday -width 10
entry .targ -textvariable target -width 10
button .plot -command "doPlot" -text Plot
button .quit -command "destroy ." -text QUIT
blt::graph .g -width 600 -height 400 -plotbackground black
blt::vector create X 
loop i -15 16 {
	X append [double $i]
}
button .togE -command "toggle E" -text E
button .togI -command "toggle I" -text I
button .togP -command "toggle P" -text P
button .togEI -command "toggle EI" -text EI
button .togEP -command "toggle EP" -text EP
button .togIP -command "toggle IP" -text IP
#
grid .blab -in . -row 0 -column 0
grid .born -in . -row 0 -column 1
grid .tlab -in . -row 1 -column 0
grid .targ -in . -row 1 -column 1
grid .quit -in . -row 0 -column 2
grid .plot -in . -row 1 -column 2
grid .togE -in . -row 2 -column 0
grid .togI -in . -row 3 -column 0
grid .togP -in . -row 4 -column 0
grid .togEI -in . -row 5 -column 0
grid .togEP -in . -row 6 -column 0
grid .togIP -in . -row 7 -column 0
grid .g -in . -column 1 -row 2 -columnspan 2 -rowspan 6
#
global env
set home .
catch {set home $env(HOME)}
if {[file isdirectory $home]} {
	if {[file exists $home/.tkBio]} {
		set bday [string trim [read_file $home/.tkBio]]
	}
}