#!/usr/local/bin/wish4.0 -f

;#
;#    Tue Dec  5 16:16:21 PST 1995
;#
;#    This is a typing/mousing monitor program "tm" for running 
;#    with the Tcl/Tk wish interpreter (for Tk version 4.0). Check out 
;#    "http://web.cs.ualberta.ca/~wade/Auto/Tcl.html" for the
;#    latest Tcl/Tk release.
;#
;#    Contact Rick Walker (walker@opus.hpl.hp.com) for updates and bug 
;#    reports. 
;#
;#    The distribution should also have included the man page "tm.1", and 
;#    the "typehisto" script for creating a weekly typing summary for 
;#    your doctor.
;#
;#    After unpacking, do:
;#
;#    mv tm.1 /usr/local/man/man1
;#    mv tm /usr/local/bin
;#    mv typehisto /usr/local/bin
;#
;#    If "tm" doesn't run, check out the first line of this script.
;#    "/usr/local/bin/wish4.0" must be edited to point to the proper
;#    location and name of your "wish" binary.
;#
;#    Do "man tm" for details on the running the program. 
;#
;#    In particular, this program assumes that it is running on
;#    an HP-UX platform.  For other platforms, you will need to 
;#    explicitly tell "tm" which /dev files are used by your 
;#    keyboard and mouse.  Alternatively, I encourage you to 
;#    hack up the routine "get_dev_files" below, and mail me
;#    your changes.
;#
;#

;# tm version number
set tm_version "1.0 for tcl7.4/tk4.0"

;# command line global variables
set t_pause 10.0
set t_rest 60.0
set t_type 600.0
set t_mouse 1200.0

;# set default obnoxiousness level:
;#   VALUE   beep?    cancel_button?   recenter_warn_window?  grab_focus?
;#     0     no	     yes	      no		     no
;#     1     yes      no		      no		     no
;#     2     yes	     no		      yes		     no
;#    >=3    yes	     no		      yes		     yes

set obnox   1	

set verbose 0	    
set keypath "/dev/hil1"
set mousepath "/dev/hil2"

;# global variables
set nextstate Active
set tidle 0.0
set midle 0.0
set toldidle 0.0
set moldidle 0.0
set t_total 0.0
set m_total 0.0
set a_total 0.0
set latency 5.0
set delta_time 0.0
set ACTIVITY_LIMIT 100.0
set activity 0.0
set fplog ""
set state Active
set mode 1.0

set logfile ~/.typelog
proc openlog {mode permission} {
    global fplog
    global logfile
    
    catch {close $fplog}

    set c [catch {open $logfile $mode $permission} fplog]
    if {$c != 0} {
	tk_error "couldn't open logfile!"
    }
    return $c
}

openlog {CREAT RDWR APPEND} 0600
exec touch [glob $logfile]
set now [file atime $logfile]
set then $now

set date [exec date "+%m/%d/%y %H:%M:%S"]
set old_date $date

scan $date "%s" day
set old_day $day
scan $date "%s %d:%d:%d" tmp1 H M tmp2
set time [format "%02d:%02d" $H $M]

proc usage {} {
    puts {usage: [options] [keyboard_dev_path] [mouse_dev_path]}
    puts {   [-b] run in background, ie., don't create main status window}
    puts {   [-geometry <X11_geometry_spec>] set main status window location}
    puts {   [-l <seconds>] latency time in main loop - shorter times use more CPU}
    puts {   [-m <seconds>] set maximum mousing time}
    puts {   [-o <1-3>] set warning obnoxiousness level}
    puts {   [-p <seconds>] set pause time}
    puts {   [-r <seconds>] set resting time}
    puts {   [-t <seconds>] set maximim typing time}
    puts {   [-v] enable verbose log file}
}

;# options "dfngsh" are already grabbed by wish!
set c [catch {eval exec getopt bl:m:o:p:r:t:v $argv} s]
if { $c != 0} {
    puts "$argv0: $s"
    puts ""
    usage
    exit 2
}

set nargs [llength $s]

set argind 0
while {$argind < $nargs} {
    set opt [lindex $s $argind]
    switch -- $opt {
	-b { wm withdraw . ; incr argind 1 }
	-l {set latency [lindex $s [incr argind 1]]; incr argind 1}
    	-m {set t_mouse [lindex $s [incr argind 1]]; incr argind 1} 
    	-o {set obnox   [lindex $s [incr argind 1]]; incr argind 1} 
    	-p {set t_pause [lindex $s [incr argind 1]]; incr argind 1} 
    	-r {set t_rest  [lindex $s [incr argind 1]]; incr argind 1} 
    	-t {set t_type  [lindex $s [incr argind 1]]; incr argind 1} 
    	-v {set verbose 1; incr argind 1}                     
    	-- {incr argind 1; break}
	default { puts "argv0: unknown option $opt"; exit 3 }
    }
}

proc get_dev_files {} {

;# scan the hil files to determine keyboard and mouse
;#
;#   Warning: this code is platform-dependant!
;#   The assumption here is an HP-UX system using /dev/hil devices.
;#      Algorithm: We check each /dev/hil[0-7] file, in turn, starting
;#      at /dev/hil7, and the first one that is "busy" is assumed to
;#      be the mouse.  The next busy one is assumed to be the keyboard.
;#
;#   TODO: Future changes to this module should run "uname" and do a
;#      case statement on the result.  This would allow different
;#      algorithms to be transparently supported within one script.
;#

    global keypath  mousepath

    set fd ""
    set nfound 0
    for {set i 7} {$i>=1} {incr i -1} {
	set path /dev/hil${i}
	set retcode [catch {open $path} error]
	#puts "path=$path, retcode=$retcode, error=$error"
	if { $retcode == 1 && [regexp "busy" $error] } {
	    switch $nfound {
		0 { set mousepath $path }
		1 { set keypath $path }
	    }
	    incr nfound 1
	} elseif { $retcode == 0 } {
	    catch close $error
	}
    }
}

get_dev_files

;# now override the keyboard and mouse with command line arguments

if {( $nargs - $argind) == 2} {
    set keypath [lindex $s $argind]; incr argind 1
    set mousepath [lindex $s $argind]; incr argind 1
} elseif {($nargs - $argind) == 1} {
    set keypath [lindex $s $argind]; incr argind 1
}

proc show_options {} {
    global t_mouse obnox t_pause t_rest t_type verbose latency keypath mousepath
    set text ""
    set text "$text t_type  (-t) = $t_type\n"
    set text "$text t_mouse (-m) = $t_mouse\n"
    set text "$text t_pause (-p) = $t_pause\n"
    set text "$text t_rest  (-r) = $t_rest\n"
    set text "$text latency (-l) = $latency\n"
    set text "$text obnox   (-o) = $obnox\n"
    set text "$text verbose (-v) = $verbose\n"
    set text "$text keypath      = $keypath\n"
    set text "$text mousepath    = $mousepath"

    tk_dialog .options options $text "" 0 ok
}

proc show_version {} {
    global tm_version
    set text ""
    set text "$text tm version $tm_version is copyright 1995 by"
    set text "$text Richard Walker (walker@opus.hpl.hp.com), and"
    set text "$text Tom Knotts (knotts@opus.hpl.hp.com).  It may"
    set text "$text may be freely used and copied for personal use, as"
    set text "$text long as this notice is preserved intact."

    tk_dialog .options version $text "" 0 ok
}

frame .mbar -relief raised -bd 2
menubutton .mbar.options -text Options -underline 0 -menu .mbar.options.menu
label .mbar.time  -font *-*-bold-r-normal--*-140-*-*-m-*-*-* -textvariable time -relief flat -anchor w

menu .mbar.options.menu
.mbar.options.menu add command -label "reset timer" -command {
    set activity 0.0
    if {$obnox == 0} {
        changestate Rest Idle $date;
        end_rest 
    }
}

;#.mbar.options.menu add command -label "cancel rest" -command {
;#    set activity 0.0;
;#    changestate Rest Idle $date;
;#    end_rest 
;#}
.mbar.options.menu add command -label "show options" -command "show_options"
.mbar.options.menu add command -label "show version" -command "show_version"


set mode 1.0
button .mbar.going -text stop -command {
    global mode
    if [expr ($mode == 0.0)] {
	set mode 1.0
	.mbar.going config -text "stop "
	.wrap.bar config -bg SteelBlue1
    } elseif [expr ($mode == 1.0)] {
	set mode 0.0
	.mbar.going config -text "start"
	.wrap.bar config -bg Red
    } 
}

;#pack .mbar -side top -fill x
;#pack .mbar.options .mbar.going -side left 
;#pack .mbar.going -side right 
;#pack .mbar.time -expand 1 -fill x 

pack .mbar -side top -fill x
pack .mbar.options .mbar.time .mbar.going -expand 1 -side left -fill x

frame .space -width 234 -height 1
frame .wrap -width 230 -height 20 -borderwidth 2 -relief sunken
frame .wrap.bar -width 220 -height 15 -relief flat -borderwidth 2 -bg SteelBlue1
frame .wrap.barrest -width 220 -height 5 -relief flat -borderwidth 2 -bg Green
pack .space -side top
pack .wrap -fill x -side top -padx 5 -pady 5 -anchor sw
pack .wrap.bar -side top -anchor sw
pack .wrap.barrest -side top -anchor sw

label .mode  -font *-*-bold-r-normal--*-140-*-*-m-*-*-* -textvariable annunciate1 -relief flat -anchor w

pack .mode -side top 
wm maxsize . 1000 1000

proc tick {} {
    global ACTIVITY_LIMIT
    global a_total
    global activity
    global date old_date
    global day old_day
    global delta_time
    global fplog
    global keypath
    global latency
    global logfile
    global m_total
    global midle
    global moldidle
    global mode
    global mousepath
    global nextstate
    global now then
    global obnox
    global state
    global t_mouse
    global t_pause
    global t_rest
    global t_total
    global t_type
    global tidle toldidle
    global verbose
    global time

    set old_date $date
    set date [exec date "+%m/%d/%y %H:%M:%S"]
    scan $date "%s %d:%d:%d" tmp1 H M tmp2
    set time [format "%02d:%02d" $H $M]

    set then $now
    exec touch [glob $logfile]
    set now [file atime $logfile]
    set delta_time [expr $now-$then]

    set toldidle $tidle
    set tidle [expr $now-[file atime $keypath]]
    set moldidle $midle
    set midle [expr $now-[file atime $mousepath]]

    set old_day  $day
    scan $date "%s" day

    ;# reset total times everyday at midnight
	     
    if { $day != $old_day } {
	changestate NULL Summary $old_date
	set t_total 0.0
	set m_total 0.0
	set a_total 0.0
    }    

    set state $nextstate

    set width [expr int($activity * 220 / $ACTIVITY_LIMIT)]
    set rwidth [min [expr int(220.0*[min $tidle $midle]/$t_rest)] 220]
    .wrap.bar config -width ${width} -height 15
    .wrap.barrest config -width ${rwidth} -height 5

    switch $state  {
	Idle { 
	    set activity 0.0
	    if { $tidle <= $t_rest || $midle <= $t_rest } {
		changestate $state Active $date
	    }
	}
	Active { 
	    if { $tidle <= $t_pause } {
		set t_total [expr $t_total + $delta_time]
		set t_activity [expr $ACTIVITY_LIMIT * $delta_time / $t_type]
	    } else {
		set t_activity 0.0
	    }
	    if { $midle <= $t_pause } {
		set m_total [expr $m_total + $delta_time]
		set m_activity [expr $ACTIVITY_LIMIT * $delta_time / $t_mouse]
	    } else {
		set m_activity 0.0
	    }
	    if { $tidle <= $t_pause || $midle <= $t_pause} {
		set a_total [expr $a_total + $delta_time]
	    }

	    set aval [expr $activity+$mode*[max $t_activity $m_activity]]
	    set activity [expr [min $aval $ACTIVITY_LIMIT]]

	    if { $tidle >= $t_rest && $midle >= $t_rest } {
		end_rest
		set activity 0.0
		changestate $state Idle $date
	    } elseif { $tidle >= $t_pause && $midle >= $t_pause } {
		changestate $state Paused $date
	    } elseif { $activity >= $ACTIVITY_LIMIT } {
		end_rest
		catch {doWarn .warn "Take a Break" +500+400}
		changestate $state Warning $date
	    }
	}
	Paused { 
	    if { $tidle <= $t_pause || $midle <= $t_pause} {
		changestate $state Active $date
	    } elseif { $tidle >= $t_rest && $midle >= $t_rest } {
		end_rest
		set activity 0.0
		changestate $state Idle $date
	    }
	}
	Warning { 
	    if { $tidle <= $t_pause } {
		set t_total [expr $t_total + $delta_time]
		set t_activity [expr $ACTIVITY_LIMIT * $delta_time / $t_type]
	    } else {
		set t_activity 0.0
	    }
	    if { $midle <= $t_pause } {
		set m_total [expr $m_total + $delta_time]
		set m_activity [expr $ACTIVITY_LIMIT * $delta_time / $t_mouse]
	    } else {
		set m_activity 0.0
	    }
	    if { $tidle <= $t_pause || $midle <= $t_pause} {
		set a_total [expr $a_total + $delta_time]
	    }

	    set aval [expr $activity+$mode*[max $t_activity $m_activity]]
	    set activity [expr [min $aval $ACTIVITY_LIMIT]]

	    if {$tidle > $toldidle && $midle > $moldidle} {
		catch {doWarn .warn "Continue Resting" +6+6}
		changestate $state Resting $date
	    } elseif {$tidle <= $toldidle || $midle <= $moldidle} {
            	change_rest 0.0
 		switch $obnox {
            	    0 { ; }
            	    1 { doWarn .warn "Continue Resting" +6+6; beep }
		    2 { doWarn .warn "Take a Break!" +500+400; beep }
		    default {
			doWarn .warn "Take a Break!" +500+400;
			grab -global .
			beep
		    }
		}
	    }
	}
	Resting { 
	    change_rest [expr [min $tidle $midle]/($t_rest + 0.0)]
	    if {$tidle >= $t_rest && $midle >= $t_rest} {
		beep
		end_rest
		set activity 0.0
		if {$obnox > 2} {
		    grab release .
		}
		changestate $state Idle $date
	    } elseif {$tidle <= $toldidle || $midle <= $moldidle} {
            	change_rest 0.0
 		switch $obnox {
            	    0 { ; }
            	    1 { doWarn .warn "Continue Resting" +6+6; beep }
		    2 { doWarn .warn "Take a Break!" +500+400; beep }
		    default {
			doWarn .warn "Take a Break!" +500+400;
			grab -global .
			beep
		    }
		}
		changestate $state Warning $date
	    }
	}
	default { 
	    puts "$argv0: error in state table!" > stderr
	    exit 4
	    break
	}
    }
    
    global annunciate1

    set annunciate1 [format "\[%-7s\] Total=%s " $state \
	[ptime $a_total] ]

    if { $state == "Resting" || $state == "Warning" } {
    	after 1000 tick	;# high res for bargraph display
    } else {
	after [expr int($latency * 1000) ] tick
    }
}

proc ptime {t} {
    set sec [expr fmod($t,60.0)]
    set min [expr fmod(($t-$sec)/60.0,60.0)]
    set hrs [expr (((($t-$sec)/60.0)-$min)/60.0)]
    return [format "%02d:%02d:%02d"\
	[expr int($hrs)] [expr int($min)] [expr int($sec)] ]
}

proc min {a b} {
    if { $a <= $b } {
	return $a
    } else {
	return $b
    }
}

proc max {a b} {
    if { $a >= $b } {
	return $a
    } else {
	return $b
    }
}



proc changestate {oldstate ns datestring} {

    global fplog 
    global t_total m_total a_total
    global nextstate verbose

    if { $oldstate != "NULL" } {
    	set nextstate $ns
    } 

    if { $ns == "Summary" || \
         $ns == "KILLED"  || \
	 $ns == "RESTART" || $verbose }  {
    
	openlog {CREAT RDWR APPEND} 0600
	puts -nonewline $fplog [format "%s \[%s\] " $datestring $ns]
	puts -nonewline $fplog " T = "
	puts -nonewline $fplog [ptime $t_total]
	puts -nonewline $fplog ", M = "
	puts -nonewline $fplog [ptime $m_total]
	puts -nonewline $fplog ", A = "
	puts $fplog [ptime $a_total]
	flush $fplog
    }
}

proc inittime {} {

    global m_total t_total a_total 
    global fplog

    if {[openlog {RDWR CREAT} 0600 ] == 1} {
	puts "can\'t open logfile"
	exit
    }
   
    scan [exec date "+%m %d %y"] "%d %d %d" \
	today_month today_day today_year

    while { [gets $fplog line] != -1 } {
	set string $line
	regsub -all {\[|\]} $string " " line 

	set test [scan $line \
	    "%d/%d/%d %s %s T = %d:%d:%d, M = %d:%d:%d, A = %d:%d:%d" \
	    month day year hms state th tm ts mh mm ms ah am as]

	if { $test == 14 && \
	     $today_month == $month && \
	     $today_day == $day &&  \
	     $today_year == $year && \
	     $state != "Summary"} {
	    set t_total [expr 60.0*60.0*$th + 60.0*$tm + 1.0*$ts]
	    set m_total [expr 60.0*60.0*$mh + 60.0*$mm + 1.0*$ms]
	    set a_total [expr 60.0*60.0*$ah + 60.0*$am + 1.0*$as]
	}
    }
}

proc change_rest {value} {
    .warn.wrap.bar config -width [eval expr int(220 * $value)] -height 20
}

proc end_rest {} {
    catch {destroy .warn}
}

proc beep {} {
    bell
    # puts -nonewline "\a"
}

proc doWarn {w msg geometry} {

    global $w.wrap.bar
    global activity

    if { [winfo exists $w] } {
	raise $w;
	wm deiconify $w;
	wm geometry $w $geometry
	$w.msg configure -text $msg
    } else {
	toplevel $w -width 220

	# don't allow warning window to be deleted
	wm protocol $w WM_DELETE_WINDOW { beep }

	wm geometry $w $geometry
	label $w.bmap -bitmap warning -relief flat
	label $w.msg -text $msg  -relief flat -anchor w -font *-*-bold-r-normal--*-140-*-*-m-*-*-*
	frame $w.space -width 220 -height 1
	frame $w.wrap -width 220 -height 30 -borderwidth 2 -relief raised -bg White
	frame $w.wrap.bar -width 1 -height 20 -relief raised -borderwidth 2 -bg Red
	pack $w.space -side bottom
	pack $w.wrap -side bottom -fill x -anchor sw
	pack $w.wrap.bar -side bottom -anchor sw
	pack $w.bmap -side left -fill both
	pack $w.msg -side left -fill both
	if {$obnox == 0} {
	    button $w.cancel -text cancel -command {
		set activity 0.0; 
		changestate Rest Idle $date;
		end_rest
	    }
	    pack $w.cancel -side right -fill x
	}
    }
}

proc abort {} {
    global fplog date
    end_rest
    changestate NULL KILLED $date
    flush $fplog
    destroy .    
}

;# Set as many traps as we can to ensure that the
;# logfile gets updated whenever typemon is killed
;#
wm protocol . WM_DELETE_WINDOW { abort }
wm protocol . WM_SAVE_YOURSELF { abort }
bind . <Control-c> {abort}
bind . <Control-q> {abort}
focus .

inittime
openlog {RDWR CREAT APPEND} 0600
puts $fplog [format "#Options: -t%g -m%g -r%g -p%g -o%d %s %s" \
	$t_type $t_mouse $t_rest $t_pause $obnox $keypath $mousepath]
changestate NULL RESTART $date

tick
