#!/usr/bin/wish -f
######################################################################
# Name: Stopwatch
# Author: Don Libes <libes@nist.gov>
# Date first released: 9/26/96
# Description: Stopwatch is a tool for hand timing, such as timing how
#   long a talk or part of a talk takes.  See the home page for more
#   details.
#
set version 3.5
set versionDate 2004/6/23
# For the latest version: http://expect.nist.gov/stopwatch
######################################################################

######################################################################
# User-settable features
######################################################################

catch {                       ;# allow it to run in a browser
    tk_setPalette     #dfd5e7 ;# touch of lavender
}

set time(startColor) #009900  ;# medium green
set time(stopColor)  #ff0000  ;# red
set time(msecShow) 1          ;# To disable millisecond timing, set to 0.
                              ;# Not much reason to do this unless you
			      ;# find the millisecond display distracting
			      ;# or you're timing for more than 24 days.
			      ;# If the version of Tcl that you're using
			      ;# doesn't support millisecond timing, then
			      ;# this option will be disabled automatically.

set time(forward) 1           ;# runs backward when 0
set time(stopAtZero) 1        ;# to use in countdown mode

option add *Entry.font {Times 18}

######################################################################
# End of user-settable features
######################################################################

proc stop {} {
    global time

    .startstop config -text start -command start
    .startstop config -foreground       $time(startColor) \
	              -activeforeground $time(startColor)
    .m.r entryconfigure $::menuStartStopIndex \
	              -foreground       $time(startColor) \
	              -activeforeground $time(startColor) \
    		      -label Start \
    		      -command start
    .m.r entryconfigure $::menuMsecIndex     -state normal
    .m.r entryconfigure $::menuForwardIndex  -state normal
    .m.r entryconfigure $::menuBackwardIndex -state normal

    if {![info exists time(tickId)]} return
    after cancel $time(tickId)
    unset time(tickId)
}

proc start {} {
    global time

    if {[catch {timescan time(total)} time(tstart,relative)]} return
    if {[catch {timescan time(lap)} time(lstart,relative)]} return

    .startstop config -text stop -command stop
    .startstop config -foreground       $time(stopColor) \
	              -activeforeground $time(stopColor)
    .m.r entryconfigure $::menuStartStopIndex \
	              -foreground       $time(stopColor) \
	              -activeforeground $time(stopColor) \
    		      -label Stop \
    		      -command stop
    .m.r entryconfigure $::menuMsecIndex     -state disabled
    .m.r entryconfigure $::menuForwardIndex  -state disabled
    .m.r entryconfigure $::menuBackwardIndex -state disabled
    set now [now]

    if {$time(forward)} {
	set time(tstart) [expr {$now - $time(tstart,relative)}]
	set time(lstart) [expr {$now - $time(lstart,relative)}]
    } else {
	set time(tstart) [expr {$now + $time(tstart,relative)}]
	set time(lstart) [expr {$now + $time(lstart,relative)}]
    }	    

    # start the clock ticking
    tick
}

# configure millisecond support according to the setting of time(msecShow)
proc msecConfig {} {
    global time

    # If millisecond time requested, try it out first and if it doesn't
    # work, fall back to single-second timing.
    if {$time(msecShow) && (0 == [catch {clock clicks -milliseconds}])} {
	proc now {} {clock clicks -milliseconds}
    } else {
	proc now {} {clock seconds}
	set time(msecShow) 0
    }

    # By using either msecs or secs as the underlying quantum, we can get
    # accuracy where we want it.
    if {$time(msecShow)} {
	set time(msecsPerTick)     1
	set time(ticksPerSec)   1000
	set time(ticksPerMin)  60000
	set time(ticksPerHr) 3600000
    } else {
	set time(msecsPerTick)  1000
	set time(ticksPerSec)      1
	set time(ticksPerMin)     60
	set time(ticksPerHr)    3600
    }
}
msecConfig

# tick is called every so often to update the clock.
proc tick {} {
    global time

    set now [now]
    set stop 0

    if {$::time(forward)} {
	set ttime [expr {$now - $time(tstart)}]
	set ltime [expr {$now - $time(lstart)}]

	if {$time(stopAtZero)} {
	    # time has passed zero crossing, so adjust both counters
	    # so at least one of them shows perfect zero and the other
	    # is adjusted by the difference.

	    if {(($time(tstart,relative) < 0) && ($ttime >= 0))} {
		incr ltime [expr {-$ttime}]
		set  ttime 0
		set stop 1
	    } elseif {(($time(lstart,relative) < 0) && ($ltime >= 0))} {
		incr ttime [expr {-$ltime}]
		set  ltime 0
		set stop 1
	    }
	}
    } else {
	set ttime [expr {$time(tstart) - $now}]
	set ltime [expr {$time(lstart) - $now}]

	if {$time(stopAtZero)} {
	    # time has passed zero crossing, so adjust both counters
	    # so at least one of them shows perfect zero and the other
	    # is adjusted by the difference.

	    if {(($time(tstart,relative) > 0) && ($ttime <= 0))} {
		incr ltime [expr {-$ttime}]
		set  ttime 0
		set stop 1
	    } elseif {(($time(lstart,relative) > 0) && ($ltime <= 0))} {
		incr ttime [expr {-$ltime}]
		set  ltime 0
		set stop 1
	    }
	}
    }
    set time(total) [timeformat $ttime]
    set time(lap)   [timeformat $ltime]

    if {$stop} {
	stop
	bell
    } else {
	set time(tickId) [after $time(msecsPerTick) tick]
    }
}

# parse displayed time
proc timescan {timevar} {
    upvar $timevar timetext
    global time

    # possible sign
    regexp ^(-)?(.*) $timetext x sign timetext

    # accept user-supplied time with or without msec
    if {4 != [scan $timetext %d:%d:%d.%d hr min sec msec]} {
	set msec 0
	if {3 != [scan $timetext %d:%d:%d hr min sec]} {
	    set timetext "what?"
	    error "conversion error"
	}
    }

    if {!$time(msecShow)} {
	set msec 0
    }

    set ticks [expr {(($hr*60 + $min)*60 + $sec)*$time(ticksPerSec) + $msec}]
    if {$sign == "-"} {
	set ticks [expr {0 - $ticks}]
    }

    return $ticks
}

# format time for display
proc timeformat {ticks} {
    global time

    if {$ticks < 0} {
	set sign "-"
	set ticks [expr {abs($ticks)}]
    } else {
	set sign ""
    }

    set r $sign[format %03d:%02d:%02d \
	       [expr { $ticks                      /$time(ticksPerHr) }] \
	       [expr {($ticks % $time(ticksPerHr) )/$time(ticksPerMin)}] \
	       [expr {($ticks % $time(ticksPerMin))/$time(ticksPerSec)}]]
    if {$time(msecShow)} {
	append r [format ".%03d" [expr {$ticks % 1000}]]
    }

    return $r
}

proc record {type time} {
    .record.t tag remove sel 1.0 end
    .record.t insert 1.0 "$type $time$::recordeol"
    .record.t tag add sel 1.2 1.end
    .record.t see 1.0
    
    # add newlines after every record but the first
    set ::recordeol "\n"
}
set recordeol ""

########################################################################
# Mostly widget layout stuff after this point.
########################################################################

# Allow enough display space for "hhh:mm:ss.mmm"  These don't literally
# add up because less space is taken by punctuation.
option add *Entry.width 12

label .totallabel -text "total:" -anchor e
entry .totaltime  -textvar time(total)
button .totalzero -text "zero" -command {
    set time(total) [timeformat 0]
    .lapzero invoke
    set time(tstart) [now] ;# if clock running, this needs to be updated
}
button .totalrecord -text "record" -command {
    record T $time(total)
}
proc totalzr {} {
    .totalrecord invoke
    .totalzero invoke
}
bind .totalzero <Control-1> {totalzr; break}
bind .totalrecord <Control-1> {totalzr; break}

label .laplabel -text "lap:" -anchor e
entry .laptime -textvar time(lap)
button .lapzero -text "zero" -command {
    set time(lap) [timeformat 0]
    set time(lstart) [now] ;# if clock running, this needs to be updated
}
button .laprecord -text "record" -command {
    record L $time(lap)
}
proc lapzr {} {
    .laprecord invoke
    .lapzero invoke
}
bind .lapzero <Control-1> {lapzr; break}
bind .laprecord <Control-1> {lapzr; break}

button .startstop -text start -command start \
    -foreground       $time(startColor) \
    -activeforeground $time(startColor)

frame     .record
scrollbar .record.sb -command {.record.t yview}
text      .record.t -height 5 -width 10 -yscroll {.record.sb set}
button    .record.clear -text clear -command {.record.t delete 1.0 end}

grid .totallabel .totaltime .totalrecord .totalzero
grid configure .totallabel    -sticky e
grid configure .totaltime     -sticky ns
grid .laplabel .laptime .laprecord .lapzero
grid configure .laplabel      -sticky e
grid configure .laptime       -sticky ns
grid .startstop -columnspan 4 -sticky ew

grid .record       -columnspan 4    -sticky nsew
grid .record.sb    -column 0 -row 0 -sticky ns
grid .record.t     -column 1 -row 0 -sticky nsew
grid .record.clear -column 2 -row 0 -sticky ns

grid columnconfigure . 0       -weight 1
grid rowconfigure    . 3       -weight 1

grid columnconfigure .record 1 -weight 1
grid rowconfigure    .record 0 -weight 1

########################################
# miscellaneous other things of interest to the UI
########################################
proc about {} {
#    tk_messageBox -message "Stopwatch $::version by Don Libes <don@libes.com>"
    set w .about
    if {[winfo exists $w]} {
	wm deiconify $w
	raise $w
	return
    }
    toplevel     $w
    wm title     $w "about stopwatch"
    wm iconname  $w "about stopwatch"
    wm resizable $w 0 0

    button $w.b -text Dismiss -command [list wm withdraw $w]

    label $w.title -text "Stopwatch" -font "Times 16" -borderwidth 10 -fg red
    label $w.version -text "Version $::version, Released $::versionDate"
    label $w.author -text "Written by Don Libes <don@libes.com>"
    label $w.using -text "Using Tcl $::tcl_patchLevel,\
                                Tk $::tk_patchLevel"
    grid $w.title
    grid $w.version
    grid $w.author
    grid $w.using
    grid $w.b -sticky ew
}

proc help {} {
    if {[winfo exists .help]} {
	destroy .help
	return
    }

    toplevel .help
    wm title .help "Stopwatch help"
    wm iconname .help "Stopwatch help"

    scrollbar .help.sb -command {.help.text yview}
    text .help.text -width 80 -height 30 -yscroll {.help.sb set} -wrap word

    button .help.ok -text "OK" -command {destroy .help} -relief raised
    bind .help <Return> {destroy .help;break}
    grid .help.sb -row 0 -column 0 -sticky ns
    grid .help.text -row 0 -column 1 -sticky nsew
    grid .help.ok -row 1 -columnspan 2 -sticky ew  -padx 2 -pady 2

    # let text box only expand
    grid rowconfigure .help 0 -weight 1
    grid columnconfigure .help 1 -weight 1

    .help.text tag configure h1 -foreground #008000

    .help.text insert end "Stopwatch $::version - by Don Libes <don@libes.com>" h1
    .help.text insert end {

Stopwatch does what its name implies - enables hand timing much like a physical stopwatch.  Stopwatch can also countdown like a timer.

Stopwatch runs on UNIX, Windows, and MacOS.  Stopwatch may run as a traditional program or in a browser.

}

    .help.text insert end "Directions" h1
    .help.text insert end {

Press "start" to start timing and "stop" to stop it.  "record" records the current time and selects it so that it can readily be pasted into other programs.  Recorded times are marked with an L for "lap" or T for "total".  When stopped, you can cut/paste/edit the time by hand and set it to any valid time.  "zero" resets the time to zero.

Time moves forward or backward according to the Run menu.  By default, time stops automatically when either the lap or total time reaches zero.  To disable the automatic stop, unselect Run -> Stop At Zero.

}

    .help.text insert end "Shortcuts" h1
    .help.text insert end "

<z> zeros the lap time.  <Z> zeros the total time.
<r> resets the lap time.  <R> resets the total time.
<s> starts/stops the time.
<c> clears the recorded times.

Holding down the control key while pressing the record or zero buttons/keys, records and then zeros the time.

"

    .help.text insert end "Command line arguments" h1
    .help.text insert end "

-forward: executes stopwatcher with the timer on
-backward TIME: executes stopwatch with the timer on, backward, with initial TIME as time (same format than stopwatch GUI)

"

    .help.text insert end "Caveats" h1
    .help.text insert end {

Stopwatch requires Tcl/Tk.  Millisecond timing is only available when using Tcl 8.3 or later.

By default, the maximum time is just over 596 hours (about 25 days).  The range may be increased (to about 68 years) by disabling the millisecond timer.  To disable the millisecond timer, select Run => Milliseconds (or edit the source to change it permanently.)

By default, the "Stop At Zero" action is a bell.  To change this, edit the source and redefine the "bell" procedure as desired.}
}

######################################################################
# set up menu bar
######################################################################

menu .m -tearoff 0
.m add cascade -menu .m.f    -label "File"  -underline 0
.m add cascade -menu .m.e    -label "Edit"  -underline 0
.m add cascade -menu .m.r    -label "Run"   -underline 0
.m add cascade -menu .m.help -label "Help"  -underline 0

menu .m.f
menu .m.e
menu .m.r
menu .m.help

.m.f    add command -label "Exit"	-command exit

.m.e    add command -label "Cut" 	-command {event generate [selection own] <<Cut>>}
.m.e    add command -label "Copy"       -command {event generate [selection own] <<Copy>>}
.m.e    add command -label "Paste"      -command {event generate [selection own] <<Paste>>}
.m.e    add command -label "Clear"      -command {selection clear}
.m.e    add command -label "Select All" -command {selectAll}

proc selectAll {} {
    set w [focus]
    if {$w == "."} {
	# if no focus, use recording area
	set w .record.t
    }

    switch [winfo class $w] {
	"Text" {
	    $w tag remove sel 0.0 end
	    $w tag add sel 1.0 end
	} "Entry" {
	    $w selection range 0 end
	}
    }
}

# Note that changes to this menu may impact the indexes below which
# are manually calculated.
.m.r    add command -label "Start"      -command start
.m.r    add checkbutton -label "Stop At Zero" -variable time(stopAtZero)
.m.r    add checkbutton -label "Milliseconds" -variable time(msecShow) -command msecConfig
.m.r    add radio   -label "Forward"    -variable time(forward) -value 1
.m.r    add radio   -label "Backward"   -variable time(forward) -value 0
set menuStartStopIndex 1
set menuMsecIndex      3
set menuForwardIndex   4
set menuBackwardIndex  5
.m.r entryconfigure $::menuStartStopIndex \
	              -foreground       $time(startColor) \
	              -activeforeground $time(startColor)

.m.help add command -label "About"      -command about
.m.help add command -label "Help"       -command help
. config -m .m

.totalzero invoke

bind all <s> {.startstop    invoke}
bind all <c> {.record.clear invoke}

bind all <r> {.laprecord    invoke} ; bind all <Control-r> {lapzr}
bind all <R> {.totalrecord  invoke} ; bind all <Control-R> {totalzr}
bind all <z> {.lapzero      invoke} ; bind all <Control-z> {lapzr}
bind all <Z> {.totalzero    invoke} ; bind all <Control-Z> {totalzr}

set option_location [lsearch $argv "-forward"]
if { $option_location >= 0 } {
    start
}

set option_location [lsearch $argv "-backward"]
if { $option_location >= 0 } {
    set time(total) [lindex $argv [expr {$option_location+1}]]
    set time(forward) 0
    start
}