# Set up global vars.
set width 400
set height 200
set yaw [expr $height/2]
set emotional 0.22439947525641
set physical  0.27318196987737
set intellectual 0.19039955476302
set newtodaydate {}
set bogusdays 10
set boguslength 0
set lastdays 7
set lmargin -100
set state 0
set dateitem {}

# Make first line of widgets
frame .db
button .db.today -text "Today!" -command {
    set todaysdate $origtoday
    adjustdate
    calcbios $lastdays
    .c itemconfig $dateitem -text $todaysdate
}
pack .db.today -side left 
label .db.t2 -text "Starting Date:"
entry .db.t -textvariable todaysdate
label .db.t1 -text "Birthdate:"
entry .db.b -textvariable birthdate
pack .db.t2 -side left
pack .db.t -side left
pack .db.t1 -side left
pack .db.b -side left
pack .db

#Make second line
frame .td
label .td.td -text {}
pack .td.td
pack .td

set origtoday [clock format [clock seconds] -format {%d %b %Y}]
.db.t insert end $origtoday
set newtodaydate [clock scan $origtoday]
set origbirthdate [clock format [expr [clock seconds]-(29*86400*365)] -format {%d %b %Y}]
.db.b insert end $origbirthdate

#Make third line
frame .dd
label .dd.lb -text "\# days to graph:"
pack .dd.lb -side left -anchor sw
scale .dd.days -from 14 -to 1 -command {calcbios} \
    -orient horiz -length $width -variable bogusdays
pack .dd.days -side right -padx 6
pack .dd -fill x
frame .bb
label .bb.lb -text "Graph Date Adj:"
pack .bb.lb -side left -anchor sw
scale .bb.days -from -120 -to 120 -command {adjustdate} -orient horiz -length $width -variable boguslength
pack .bb.days -side right -padx 6
pack .bb -fill x

# When the user releases button 1, do this:
bind .bb.days <ButtonRelease-1> {
    set todaysdate [.c itemcget $dateitem -text]
    calcbios $lastdays
    set boguslength 0
}

# Where to draw the canvas.
canvas .c -relief sunken -bd 2 -height [expr $height+32] -width [expr $width-($lmargin-2)] \
    -scrollregion [list $lmargin 0 $width $height]
pack .c

# Put the decorations:
.c create line 0 0 0 $height -fill black
.c create line 0 $yaw $width $yaw -fill black
.c create text $lmargin 0 -fill blue -text HIGH -anchor nw
.c create text $lmargin $height -fill red -text LOW -anchor sw
.c create text -10 [expr $yaw-20] -fill red -text Emotional -anchor e
.c create text -10 $yaw           -fill green -text Physical -anchor e
.c create text -10 [expr $yaw+20] -fill blue -text Intellectual -anchor e
set dateitem [.c create text 0 [expr $height+4]  -fill black -text $todaysdate -anchor n]

# Set up some eventhandling
bind .db.b <Return> {calcbios $lastdays}
bind .db.t <Return> {set newtodaydate $todaysdate;adjustdate;calcbios $lastdays;.c itemconfig $dateitem -text $todaysdate}
bind .db.b <Tab> {calcbios $lastdays}
bind .db.t <Tab> {set newtodaydate $todaysdate;adjustdate;calcbios $lastdays;.c itemconfig $dateitem -text $todaysdate}

# Called when moving the bottom slider.  Adjusts the date that will be shown.
proc adjustdate {{adjustvalue 0}} {
    global todaysdate newtodaydate lastdays dateitem

    if {[catch {clock scan $todaysdate} t] < 1} {
	set newtodaydate [expr $t + $adjustvalue*86400]
	calcbios $lastdays
	.c itemconfig $dateitem -text [clock format $newtodaydate -format {%d %b %Y}]
    }
}

# When the dates to display have changed, redraw them.
proc calcbios { numdays } {
    global birthdate todaysdate line width height yaw emotional physical
    global origtoday intellectual state origbirthdate origtoday lastdays
    global newtodaydate
    
    if {$state < 1} {
	set state 1
	set thisdate [clock format $newtodaydate -format {%d %b %Y}]
        if {[catch {clock scan $thisdate} t] < 1} {
	    if {[catch {clock scan $birthdate} u] < 1} {
		set totaldays [expr ($t-$u)/86400]
		.td.td config -text "Total Days: $totaldays (~[format "%0.1f" [expr $totaldays/365.25]] years)"
		foreach {edat pdat idat} {{} {} {}} {}
		set space {}
		for {set i 0} {$i <= $numdays} {incr i} {
		    set lx($i) [expr $i*($width/$numdays)]
		    append edat "$space$lx($i) [expr $yaw - (sin($emotional*($totaldays+$i))*$yaw)]"
		    append pdat "$space$lx($i) [expr $yaw - (sin($physical*($totaldays+$i))*$yaw)]"
		    append idat "$space$lx($i) [expr $yaw - (sin($intellectual*($totaldays+$i))*$yaw)]"
		    set space { }
		}
		set limit [expr $numdays+4]
		for {set i 0} {$i <= $limit} {incr i} {
		    catch {.c delete $line($i)}
		}
		set rise [expr $yaw-($height/20)]
		set fall [expr $yaw+($height/20)]
		for {set i 0} {$i <= $numdays} {incr i} {
		    set line($i) [.c create line $lx($i) $rise $lx($i) $fall -fill black]
		}
		set line($i) [eval .c create line $edat -fill red -splinesteps 1]
		incr i
		set line($i) [eval .c create line $pdat -fill green -splinesteps 1]
		incr i
		set line($i) [eval .c create line $idat -fill blue -splinesteps 1]
	    } else {
		Fakedialog "That's not a valid Birthdate... setting it back to $origbirthdate." Ok
		set birthdate $origbirthdate
	    }
	} else {
	    Fakedialog "That's not a valid starting date... setting it back to today's date." Ok
	    set todaysdate $origtoday
	}
	set lastdays $numdays
	set state 0
    }
}

# A routine to put up a 'fake' dialog box in front of the program,
# since toplevels are a little rude from within Netscape.
proc Fakedialog {text button {button2 {}} {button3 {}}} {
    set buttonstatus {}
    frame .top -bd 2 -relief raised
    frame .top.r -bd 2 -relief sunken
    message .top.r.lb -text $text
    frame .top.r.bs
    frame .top.r.bs.f
    set buttonstatus
    button .top.r.bs.f.b1 -text $button -command {set buttonstatus 1}
    pack .top.r.bs.f.b1 -side left -padx 10 -pady 10
    if {$button2 != {}} {
	button .top.r.bs.f.b2 -text $button2 -command {set buttonstatus 2}
	pack .top.r.bs.f.b2 -side left -padx 10 -pady 10
    }
    if {$button3 != {}} {
	button .top.r.bs.f.b3 -text $button3 -command {set buttonstatus 3}
	pack .top.r.bs.f.b3 -side left -padx 10 -pady 10
    }
    pack .top.r.bs.f -side bottom
    pack .top.r.bs -side bottom -fill x
    pack .top.r.lb -expand 1 -pady 20 -padx 10
    pack .top.r -expand 1
    place .top -relx .5 -rely .5 -anchor c
    set oldfocus [focus -lastfor .]
    focus .top.r.bs.f.b1
    bind .top.r.bs.f.b1 <Return> {
	tkButtonInvoke %W
    }
    grab .
    tkwait variable buttonstatus
    grab release .
    destroy .top
    focus $oldfocus
    return $buttonstatus
}

calcbios $lastdays