#!/usr/bin/wish -f
#
# To install, you simply need to find where "wish" is located.  Do this by:
# 
# % which wish
# 
# Change the first line from:
# 
# #!/usr/bin/wish
# 
# to:
# 
# #!WHEREEVER-YOUR-WISH-IS
# 
# Then "chmod a+x" it and run it!

proc restart {} {
    global typebreak

    set typebreak(waited) 0
    set typebreak(waitedTotal) 0
    set typebreak(idleTotal) 0
    set typebreak(idle) 0
}

proc logFile {x} {
	global	typebreak

	set date [open {| date} r]
	set line [gets $date]
	close $date
	puts $typebreak(logfile) "$line: $x"
	flush $typebreak(logfile)
}

# Reading the initialization file

proc readFile {} {
    global typebreak

    if [catch "open [glob ~]/$typebreak(file)" fp] {
	puts stderr "Cannot open $typebreak(file): using default values"
	return
    }

    if {[gets $fp version_line] == -1} {
	puts stderr "File $typebreak(file) empty: using default values"
	return
    }

    if {[gets $fp line] == -1} {
	puts stderr "File $typebreak(file) only 1 line"
	return
    }

    if {$version_line >= 0.6} {
	    if {! [regexp {^([1-9][0-9]*) ([1-9][0-9]*) "([^"]*)" "([^"]*)" "([^"]*)" "([^"]*)"} \
		    $line junk typebreak(upFile) typebreak(downFile) \
		    typebreak(prehookFile) typebreak(posthookFile) \
		    typebreak(duringhookFile) typebreak(logfilename)]} {
		puts stderr "Error reading from $typebreak(file): using default values"
		return
	    }
    } else {
	    set typebreak(logfilename) ""
	    if {! [regexp {^([1-9][0-9]*) ([1-9][0-9]*) "([^"]*)" "([^"]*)" "([^"]*)"} \
		    $line junk typebreak(upFile) typebreak(downFile) \
		    typebreak(prehookFile) typebreak(posthookFile) \
		    typebreak(duringhookFile)]} {
		puts stderr "Error reading from $typebreak(file): using default values"
		return
	    }
    }
    close $fp

    set typebreak(downWait) $typebreak(downFile)
    guiUpdate work $typebreak(downWait)
    set typebreak(upWait) $typebreak(upFile)
    guiUpdate break $typebreak(upWait)
    set typebreak(prehook) $typebreak(prehookFile)
    set typebreak(duringhook) $typebreak(duringhookFile)
#    guiUpdate prehook $typebreak(prehook)
    set typebreak(posthook) $typebreak(posthookFile)
#    guiUpdate posthook $typebreak(posthook)
    logFileInit
    if {$typebreak(logfile) != ""} {
	logFile "work: $typebreak(downWait)"
	logFile "break: $typebreak(upWait)"
    }
}

# Save out the current delays to the initialization file.

proc saveFile {} {
    global typebreak

    if [catch "open [glob ~]/$typebreak(file) w" fp] {
	puts stderr "Cannot open $typebreak(file): save failed"
	return
    }

    puts $fp "0.7"
    puts $fp "$typebreak(upWait) $typebreak(downWait) \"$typebreak(prehook)\" \"$typebreak(posthook)\" \"$typebreak(duringhook)\" \"$typebreak(logfilename)\""
    close $fp
}

# Something has changed a delay value.  Reflect
# that change in the slider and the label.

proc guiUpdate {timer val} {
    global typebreak

    switch $timer {
	break {
	    set typebreak(upWait) $val
	    if [winfo exists $typebreak(brkF)] {
		$typebreak(brkF).v config -text $val
		$typebreak(brkF).s set $val
	    }

	}
	work {
	    set typebreak(downWait) $val
	    if [winfo exists $typebreak(wkF)] {
		$typebreak(wkF).v config -text $val
		$typebreak(wkF).s set $val
	    }
	}
	default {
	    puts stderr "Unknown timer type <$timer>"
	}
    }
}

# The GUI

proc xbw {} {
    global typebreak

    set sliderWidth 20
    set sliderLength 300
    set nameWidth 15
    set valueWidth 5

    if [winfo exists $typebreak(cpW)] {
	destroy $typebreak(cpW)
    }

    wm title [toplevel $typebreak(cpW)] $typebreak(title)

    # Each slider gets one frame; the pair is in another, just in case.

    set sliders [frame $typebreak(cpW).slidf]
    pack $sliders -side top -ipady 10

    # The 'work' slider

    set swork [frame $sliders.wrkf]
    set swl [label $swork.n -width $nameWidth -text "Work (minutes)"]
    pack $swl -side left
    set sws [scale $swork.s -from 1 -to 60 -tickinterval 0 \
	-width $sliderWidth -length $sliderLength\
	-orient horizontal -showvalue false \
	-command {guiUpdate work}]
    pack $sws -side left
    set swl [label $swork.v -width $valueWidth -text 0]
    guiUpdate work $typebreak(downWait)
    pack $swl -side left
    pack $swork -side top -expand 1 -fill x

    # The 'break' slider

    set sbrk [frame $sliders.brkf]
    set sbn [label $sbrk.n -width $nameWidth -text "Break (minutes)"]
    pack $sbn -side left
    set sbs [scale $sbrk.s -from 1 -to 60 -tickinterval 0 \
	-width $sliderWidth -length $sliderLength\
	-orient horizontal -showvalue false \
	-command {guiUpdate break}]
    pack $sbs -side left
    set sbl [label $sbrk.v -width $valueWidth -text 0]
    guiUpdate break $typebreak(upWait)
    pack $sbl -side left
    pack $sbrk -side top -expand 1 -fill x

    # Other parameters.

    set hooks [frame $typebreak(cpW).hooks]
    pack $hooks -side top -ipady 10 -expand 1 -fill x
    set prehook [frame $hooks.prehook]
    pack $prehook -side top -expand 1 -fill x
    label $prehook.label -width $nameWidth -text "Prehook:"
    entry $prehook.entry -relief sunken -textvariable typebreak(prehook)
    pack $prehook.label $prehook.entry -side left
    set duringhook [frame $hooks.duringhook]
    pack $duringhook -side top -expand 1 -fill x
    label $duringhook.label -width $nameWidth -text "Duringhook:"
    entry $duringhook.entry -relief sunken -textvariable typebreak(duringhook)
    pack $duringhook.label $duringhook.entry -side left
    set posthook [frame $hooks.posthook]
    pack $posthook -side top -expand 1 -fill x
    label $posthook.label -width $nameWidth -text "Posthook:"
    entry $posthook.entry -relief sunken -textvariable typebreak(posthook)
    pack $posthook.label $posthook.entry -side left

    # log file

    set logfiles [frame $typebreak(cpW).logfiles]
    pack $logfiles -side top -ipady 10 -expand 1 -fill x
    set logfile [frame $logfiles.logfile]
    pack $logfile -side top -expand 1 -fill x
    label $logfile.label -width $nameWidth -text "Log file:"
    entry $logfile.entry -relief sunken -textvariable typebreak(logfilename)
    pack $logfile.label $logfile.entry -side left

    # Stealing Mark's nice redlight greenlight idea...

    pack [set sigf [frame $typebreak(cpW).sigf]] -fill x
    pack [label $typebreak(sigW)] -fill x

    # Buttons are all in one frame.

    set bf [frame $typebreak(cpW).bf]

    set rstrtb [button $bf.rstrt -text {Restart} -command "restart"]
    pack $rstrtb -side left -expand 1 -fill x

    set sb [button $bf.s -text {Save} \
	-command saveFile]
    pack $sb -side left -expand 1 -fill x

#    set rlb [button $bf.rl -text {Reload} \
#	-command {readFile; restart}]
#    pack $rlb -side left -expand 1 -fill x

    set eb [button $bf.e -text {Exit} -command "destroy ."]
    pack $eb -side left -expand 1 -fill x

    # Pack the button frame into the most exterior user-created frame.
    pack $bf -side top -expand 1 -fill x
}

proc logFileInit {} {
    global  typebreak

    if {$typebreak(logfilename) != ""} {
	if [catch "open $typebreak(logfilename) w" typebreak(logfile)] {
	    set typebreak(logfile) ""
	}
    }
}

proc xidle {} {
	global	env

	set fing [open {| finger} r]
	set line [gets $fing]
	set line [string tolower $line]
	set idleInd [string first idle $line]
	set loginInd [string first login $line]
	set ttyInd [string first tty $line]
	set min 10512000
	while {! [eof $fing]} {
		set line [gets $fing]
#		set thisTty [string range $line $ttyInd [expr $ttyInd + 2]]
#		regsub " +" $thisTty "" thisTty
#		if {$thisTty == "co"} {
#			continue
#		}
		set thisLogin [string range $line $loginInd [expr $loginInd + 8]]
		regsub " +" $thisLogin "" thisLogin
		if {$thisLogin != $env(USER)} {
			continue
		}
		set thisIdle [string range $line $idleInd [expr $idleInd + 3]]
		if [regexp {([0-9]*):([0-9]*)} $thisIdle foo hours minutes] {
			if {$minutes == ""} {
				set minutes 0
			}
			set totIdle [expr $hours * 60 + $minutes]
		} else {
			if [regexp {([0-9]*)d} $thisIdle foo days] {
				set totIdle [expr $days * 24 * 60]
			} else {
				regsub -all " +" $thisIdle "" thisIdle
				set totIdle $thisIdle
				if {$totIdle == ""} {
					set totIdle 0
				}
			}
		}
		if {$totIdle < $min} {
			set min $totIdle
		}
	}
	close $fing
	return $min
}

proc secondsNow {} {
	set date [open {| date +%S} r]
	set line [gets $date]
	set tot [expr $line]
	close $date
	return $tot
}

proc updateBreakWin {w idlePeriod idleTime} {
	global	typebreak

	set idle [expr $idlePeriod - $idleTime]
	wm deiconify $typebreak(msgW)
	wm geometry $typebreak(msgW) =500x500+200+200
	raise $typebreak(msgW)
	$typebreak(msgW).msg configure -text "STOP TYPING $idle MINUTES"
	update idletasks
	update
}

proc makeBreakWin {w} {
	global	typebreak

	toplevel $typebreak(msgW)
	wm geometry $typebreak(msgW) =500x500+200+200
	wm withdraw $typebreak(msgW)
	if [catch {set msg [message $typebreak(msgW).msg \
-font -b&h-*-medium-r-normal-*-60-300-75-*-p-*-*-* \
-text "STOP TYPING"]}] {
		set msg [message $typebreak(msgW).msg \
-text "STOP TYPING"]
	}
	pack $msg -fill both -expand 1
}

proc idleTest {time} {
	global	typebreak
	global	env

	set xidle1 [xidle]
	switch $xidle1 {
		0 {
			incr typebreak(waitedTotal)
			incr typebreak(waited)
			if {$typebreak(logfile) != ""} {
			    logFile "typing total: $typebreak(waitedTotal), subtotal: $typebreak(waited)"
			}
			if {$typebreak(idleMode)} {
				incr typebreak(waitedWhileIdle)
				set env(TYPEBREAK_INCREASED) 1
			}
		}
		default {
			incr typebreak(idleTotal)
			set typebreak(idle) [expr $typebreak(idle) + $xidle1 - $typebreak(lastXidle)]
			if {$typebreak(idleMode)} {
				set env(TYPEBREAK_INCREASED) 0
			}
			if {!$typebreak(idleMode) &&
			    $typebreak(idle) > $typebreak(upWait)} {
				if {$typebreak(logfile) != "" &&
				    $typebreak(waited) != 0} {
				    logFile "resetting typing time due to rest > $typebreak(upWait)"
				}
				set typebreak(waited) 0
				set typebreak(idle) 0
			}
		}
	}
	set typebreak(lastXidle) $xidle1
#	puts "typing time=$typebreak(waitedTotal)"
#	puts "idle time=$typebreak(idleTotal)"
	set secs [secondsNow]
	if {!$typebreak(idleMode) && $typebreak(waited) >= $typebreak(downWait)} {
		set typebreak(idleMode) 1
		set typebreak(idle) 0
		set typebreak(waitedWhileIdle) 0
		set upWait $typebreak(upWait)
		updateBreakWin $typebreak(msgW) $upWait $typebreak(idle)
		if {$typebreak(logfile) != ""} {
		    logFile "break for $upWait"
		}
		if {$typebreak(prehook) != ""} {
			if [catch {exec $typebreak(prehook)} msg] {
				puts $msg
			}
		}
	} elseif $typebreak(idleMode) {
#		puts "typebreak(waited)=$typebreak(waited)"
#		puts "typebreak(downWait)=$typebreak(downWait)"
#		puts "typebreak(upWait)=$typebreak(upWait)"
#		puts "tot=[expr double($typebreak(waited) - $typebreak(downWait)) * $typebreak(upWait) / $typebreak(downWait)]"
		set upWait [expr $typebreak(upWait) + int(ceil(double($typebreak(waited) - $typebreak(downWait)) * $typebreak(upWait) / $typebreak(downWait)))]
		if {$typebreak(idle) >= $upWait} {
			set typebreak(idleMode) 0
			set typebreak(waited) 0
			set typebreak(idle) 0
			if {$typebreak(logfile) != ""} {
			    logFile "break finished"
			}
			if {$typebreak(posthook) != ""} {
				if [catch {exec $typebreak(posthook)} msg] {
					puts $msg
				}
			}
			wm withdraw $typebreak(msgW)
		} else {
			if {$env(TYPEBREAK_INCREASED) != 0} {
				if {$typebreak(logfile) != ""} {
				    logFile "typing $typebreak(waitedWhileIdle) while break; increased to $upWait"
				}
			}
			set env(TYPEBREAK_BREAKMINLEFT) $upWait
			updateBreakWin $typebreak(msgW) $upWait $typebreak(idle)
			if {$typebreak(duringhook) != ""} {
				if [catch {exec $typebreak(duringhook)} msg] {
					puts $msg
				}
			}
			set typebreak(lastUpWait) $upWait
		}
	} else {
		wm withdraw $typebreak(msgW)
	}
	set idlePause [expr int(round(1000 * (61 - $secs)))]
	set typebreak(aftId) [after $idlePause idleTest $idlePause]
}

wm withdraw .
tk colormodel . monochrome
set typebreak(title) "TypeBreak 0.7"
set typebreak(file) ".typebreak"
set typebreak(upDef) 5
set typebreak(downDef) 30
set typebreak(upFile) $typebreak(upDef)
set typebreak(downFile) $typebreak(downDef)
set typebreak(upWait) $typebreak(upDef)
set typebreak(downWait) $typebreak(downDef)
set typebreak(lastUpWait) 0
set typebreak(cpW) .typebreak
set typebreak(wkF) .typebreak.slidf.wrkf
set typebreak(brkF) .typebreak.slidf.brkf
set typebreak(aftId) 0
set typebreak(msgW) .bkw
makeBreakWin $typebreak(msgW)
set typebreak(makeNoise) 1
set typebreak(idlePause) 60000
set typebreak(idle) 0
set typebreak(waited) 0
set typebreak(sigW) .typebreak.sigf.sig
set typebreak(idleC) #00ff00
set typebreak(busyC) #ffff00
set typebreak(stopC) #ff0000
set typebreak(waitedTotal) 0
set typebreak(waitedWhileIdle) 0
set typebreak(idleTotal) 0
set typebreak(idleMode) 0
set typebreak(lastXidle) 0
set typebreak(logfilename) ""
set typebreak(logfile) ""
xbw
readFile
idleTest 0
