
# tkodometer - the Mac Mouse Odometer, Tk style.
#
# Stephen O. Lidie, Lehigh University Computing Center, 94/07/09.
#
# lusol@Lehigh.EDU
#


proc tk_odo {w} {

    #
    # Track the cursor forever, while updating the odometer file every so often.
    #

    global Options autosave_ticks autosave_count

    compute_distances $w

    incr autosave_count -1
    if { $autosave_count <= 0 } {
	set autosave_count $autosave_ticks
	save_tkodo
    }

    after $Options(mit) [list tk_odo $w]

}; # end tkodo


proc build_main_window {w} {

    #
    # Construct the main tkodometer window.
    #

    global Options cursor env color_state

    catch {destroy $w}
    frame $w

    # Frame to contain the menu buttons across the top of the main window.

    frame $w.menu -bd 1 -relief raised

    # File menu.

    menubutton $w.menu.file -text File -underline 0 -menu $w.menu.file.m -cursor "$cursor" -bd 1 -relief raised
    menu $w.menu.file.m
    $w.menu.file.m add command -label "Import .xodo" -underline 0 -command "import_xodo $env(HOME)/.xodo"
    $w.menu.file.m add separator
    set close_command {wm iconify .}
    $w.menu.file.m add command -label Close -underline 0 -command "$close_command" -accelerator "Ctrl-w"
    bind . <Control-Key-w> "$close_command"
    set save_command {save_tkodo}
    $w.menu.file.m add command -label Save -underline 0 -command "$save_command" -accelerator "Ctrl-s"
    bind . <Control-Key-s> "$save_command"
    $w.menu.file.m add separator
    set quit_command {save_tkodo; exit_tkodo}
    $w.menu.file.m add command -label Quit -underline 0 -command "$quit_command" -accelerator "Ctrl-q"
    bind . <Control-Key-q> "$quit_command"

    # Prefs menu.

    menubutton $w.menu.prefs -text Prefs -underline 0 -menu $w.menu.prefs.m -cursor "$cursor" -bd 1 -relief raised
    menu $w.menu.prefs.m

    $w.menu.prefs.m add cascade -label Odometers -underline 0 -menu $w.menu.prefs.m.odometer
    menu $w.menu.prefs.m.odometer
    $w.menu.prefs.m.odometer add radiobutton -label Cursor  -variable Options(o) -value cursor  -command {which_odo $w}
    $w.menu.prefs.m.odometer add radiobutton -label Pointer -variable Options(o) -value pointer -command {which_odo $w}
    $w.menu.prefs.m.odometer add radiobutton -label Both    -variable Options(o) -value both    -command {which_odo $w}
    $w.menu.prefs.m add separator
    $w.menu.prefs.m add command -label "Color Editor" -underline 0 -state $color_state -command do_color

    # Units menu.

    menubutton $w.menu.units -text Units -underline 0 -menu $w.menu.units.m -cursor "$cursor" -bd 1 -relief raised
    menu $w.menu.units.m

    $w.menu.units.m add cascade -label Metric -underline 0 -menu $w.menu.units.m.metric
    menu $w.menu.units.m.metric
    $w.menu.units.m.metric add radiobutton -label millimeters      -variable tkodo_units -value 1.0 \
	-command {set tkodo_units_human mm}
    $w.menu.units.m.metric add radiobutton -label centimeters      -variable tkodo_units -value 0.1  \
	-command {set tkodo_units_human cm}
    $w.menu.units.m.metric add radiobutton -label decimeters       -variable tkodo_units -value 0.01 \
	-command {set tkodo_units_human dm}
    $w.menu.units.m.metric add radiobutton -label meters           -variable tkodo_units -value 0.001 \
	-command {set tkodo_units_human m} 
    $w.menu.units.m.metric add radiobutton -label dekameters       -variable tkodo_units -value 0.0001 \
	-command {set tkodo_units_human dam}
    $w.menu.units.m.metric add radiobutton -label hectometers      -variable tkodo_units -value 0.00001 \
	-command {set tkodo_units_human hm} 
    $w.menu.units.m.metric add radiobutton -label kilometers       -variable tkodo_units -value 0.000001 \
	-command {set tkodo_units_human km} 
    $w.menu.units.m.metric add radiobutton -label myriameters      -variable tkodo_units -value 0.0000001 \
	-command {set tkodo_units_human mym}

    $w.menu.units.m add cascade -label English -underline 0 -menu $w.menu.units.m.english
    menu $w.menu.units.m.english
    $w.menu.units.m.english add radiobutton -label inches        -variable tkodo_units -value [ expr 0.1 / 2.54 ] \
	-command {set tkodo_units_human in} 
    $w.menu.units.m.english add radiobutton -label feet          -variable tkodo_units -value [ expr 0.1 / 2.54 / 12.0 ] \
	-command {set tkodo_units_human ft} 
    $w.menu.units.m.english add radiobutton -label yards         -variable tkodo_units -value [ expr 0.1 / 2.54 / 12.0 / 3.0 ] \
	-command {set tkodo_units_human yd} 
    $w.menu.units.m.english add radiobutton -label rods          -variable tkodo_units \
	-value [ expr 0.1 / 2.54 / 12.0 / 3.0 / 5.5 ]    -command {set tkodo_units_human rd}
    $w.menu.units.m.english add radiobutton -label miles         -variable tkodo_units \
	-value [ expr 0.1 / 2.54 / 12.0 / 3.0 / 1760.0 ] -command {set tkodo_units_human mi}
    $w.menu.units.m.english add radiobutton -label furlongs      -variable tkodo_units \
	-value [ expr 0.1 / 2.54 / 12.0 / 3.0 / 220.0 ]  -command {set tkodo_units_human fl} 
    $w.menu.units.m.english add radiobutton -label fathoms       -variable tkodo_units -value [ expr 0.1 / 2.54 / 12.0 / 6.0 ] \
	-command {set tkodo_units_human fm}

    $w.menu.units.m add cascade -label Other -underline 0 -menu $w.menu.units.m.other
    menu $w.menu.units.m.other
    $w.menu.units.m.other add radiobutton -label light-nanoseconds -variable tkodo_units \
	-value [ expr 0.001 / 299792458.0 * 1.0E+9 ] -command {set tkodo_units_human lns}
    $w.menu.units.m.other add radiobutton -label "marine leagues"  -variable tkodo_units -value [ expr 0.001 / 1852.0 / 3.0 ] \
	-command {set tkodo_units_human mlg}
    $w.menu.units.m.other add radiobutton -label "nautical miles"  -variable tkodo_units -value [ expr 0.001 / 1852.0 ] \
	-command {set tkodo_units_human nm} 

    # Help Menu.

    menubutton $w.menu.help -text Help -underline 0 -menu $w.menu.help.m -cursor "$cursor" -bd 1 -relief raised
    menu $w.menu.help.m
    $w.menu.help.m add command -label About    -underline 0 -command {display_about}
    $w.menu.help.m add separator
    set usage_command {display_usage}
    $w.menu.help.m add command -label Usage    -underline 0 -command "$usage_command" -accelerator "Ctrl-u"
    bind . <Control-Key-u> "$usage_command"
    $w.menu.help.m add separator
    set numbers_command {display_numbers}
    $w.menu.help.m add command -label "Verify" -underline 0 -command "$numbers_command"

    # Cursor odometer.

    frame $w.codo
    label $w.codo.clabel -text Cursor
    pack $w.codo.clabel -in $w.codo -side top -fill x
    frame $w.codo.ctotal
    label $w.codo.ctotal1 -bd 1 -relief sunken -width 5 -font $Options(fn)
    label $w.codo.ctotal2 -bd 1 -relief sunken -width 5 -font $Options(fn) -fg $Options(background) -bg $Options(foreground)
    pack $w.codo.ctotal1 -in $w.codo.ctotal -side left
    pack $w.codo.ctotal2 -in $w.codo.ctotal -side right
    pack $w.codo.ctotal -in $w.codo -side top
    button $w.codo.creset -height 2 -width 5 -bitmap gray50 -relief flat -command {reset_trip cursor} -cursor "$cursor"
    bind $w.codo.creset <Button2-ButtonRelease> {reset_trip cursor; reset_trip pointer}
    pack $w.codo.creset -in $w.codo -side top -anchor w
    frame $w.codo.ctrip
    label $w.codo.ctrip1 -bd 1 -relief sunken -width 5 -font $Options(fn)
    label $w.codo.ctrip2 -bd 1 -relief sunken -width 5 -font $Options(fn) -fg $Options(background) -bg $Options(foreground)
    pack $w.codo.ctrip1 -in $w.codo.ctrip -side left
    pack $w.codo.ctrip2 -in $w.codo.ctrip -side right
    pack $w.codo.ctrip -in $w.codo -side top

    # Pointer odometer.

    frame $w.podo
    label $w.podo.plabel -text Pointer
    pack $w.podo.plabel -in $w.podo -side top -fill x
    frame $w.podo.ptotal
    label $w.podo.ptotal1 -bd 1 -relief sunken -width 5 -font $Options(fn)
    label $w.podo.ptotal2 -bd 1 -relief sunken -width 5 -font $Options(fn) -fg $Options(background) -bg $Options(foreground)
    pack $w.podo.ptotal1 -in $w.podo.ptotal -side left
    pack $w.podo.ptotal2 -in $w.podo.ptotal -side right
    pack $w.podo.ptotal -in $w.podo -side top
    button $w.podo.preset -height 2 -width 5 -bitmap gray50 -relief flat -command {reset_trip pointer} -cursor "$cursor"
    bind $w.podo.preset <Button2-ButtonRelease> {reset_trip cursor; reset_trip pointer}
    pack $w.podo.preset -in $w.podo -side top -anchor w
    frame $w.podo.ptrip
    label $w.podo.ptrip1 -bd 1 -relief sunken -width 5 -font $Options(fn)
    label $w.podo.ptrip2 -bd 1 -relief sunken -width 5 -font $Options(fn) -fg $Options(background) -bg $Options(foreground)
    pack $w.podo.ptrip1 -in $w.podo.ptrip -side left
    pack $w.podo.ptrip2 -in $w.podo.ptrip -side right
    pack $w.podo.ptrip  -in $w.podo -side top

    # Miscellaneous information.

    label $w.misc -font fixed

    # Pack it all up.  We may see one or the other odometer, or perhaps both.

    pack $w

    pack $w.menu -in $w -side top -fill x
    pack $w.menu.file -in $w.menu -side left
    pack $w.menu.prefs -in $w.menu -side left
    pack $w.menu.units -in $w.menu -side left
    pack $w.menu.help -in $w.menu -side right
    pack $w.codo -in $w -side top 
    pack $w.podo -in $w -side top 
    pack $w.misc -in $w -pady 2m
    tk_menuBar $w.menu $w.menu.file $w.menu.prefs $w.menu.units $w.menu.help

    which_odo $w

}; # end build_main_window


proc build_numbers_window {} {

    #
    # Construct a window that's useful in tkodometer verification.
    #

    global Options LIBDIR cursor color_state
    global pixels_per_inch_x pixels_per_inch_y pixels_per_cm_x pixels_per_cm_y

    toplevel .numbers -class dialog
    wm title .numbers "Verify tkodo"
    wm iconname .numbers

    # Create the File menu.

    frame .numbers.menu -bd 1 -relief raised
    menubutton .numbers.menu.file -text File -underline 0 -menu .numbers.menu.file.m -cursor "$cursor" -bd 1 -relief raised
    menu .numbers.menu.file.m
    set close_command {wm withdraw .numbers; return}
    .numbers.menu.file.m add command -label Close -underline 0 -command "$close_command" -accelerator "Ctrl-w"
    bind . <Control-Key-w> "$close_command"

    # Create a cm/in scale for tkodometer scaling verification.

    frame .numbers.f -relief raised -bd 1;
    canvas .numbers.f.c -width 3.2i -height 2.25i
    message .numbers.f.msg -bd 1 -relief sunken -text "Use this data to verify that tkodometer is properly \
calibrated.  The X-Y axes should both be 1 inch (2.54 centimeters) in length."
    .numbers.f.c create window 200 50 -window .numbers.f.msg
    .numbers.f.c create bitmap 2.55i 1.75i -bitmap "@${LIBDIR}/icon.xbm" -tags {background foreground}
    .numbers.f.c create line 10 10 10 [expr $pixels_per_inch_y+10] [expr $pixels_per_inch_x+10] [expr $pixels_per_inch_y+10] \
	-tags fill
    .numbers.f.c create line 10 [expr $pixels_per_inch_y+10-$pixels_per_cm_y] 20 [expr $pixels_per_inch_y+10-$pixels_per_cm_y] \
	-tags fill
    .numbers.f.c create line 10 [expr $pixels_per_inch_y+10-(2*$pixels_per_cm_y)] \
	20 [expr $pixels_per_inch_y+10-(2*$pixels_per_cm_y)] -tags fill
    .numbers.f.c create line [expr $pixels_per_cm_x+10] [expr $pixels_per_inch_y+10] \
	[expr $pixels_per_cm_x+10] [expr $pixels_per_inch_y+10-10] -tags fill
    .numbers.f.c create line [expr (2*$pixels_per_cm_x)+10] [expr $pixels_per_inch_y+10] \
	[expr (2*$pixels_per_cm_x)+10] [expr $pixels_per_inch_y+10-10] -tags fill

    # Create miscellaneous textual information.

    set pointer_scale_factor [lindex $Options(numbers) 0]
    set threshold [lindex $Options(numbers) 1]
    set acceleration [lindex $Options(numbers) 2]
    set numbers [format "\
          Pointer Scale Factor :  %.2f\n\
          Threshold            :  %d\n\
          Acceleration         :  %.2f\n\
          Pixles/inch X        :  %d\n\
          Pixles/inch Y        :  %d" \
	  $pointer_scale_factor $threshold $acceleration $pixels_per_inch_x $pixels_per_inch_y]
    .numbers.f.c create text 1.0i 1.75i -text "$numbers" -font fixed -tags fill
    .numbers.f.c create text 0.7i 0.55i -text "2.54 cm/in" -font fixed -tags fill

    pack .numbers.menu -in .numbers -side top -fill x
    pack .numbers.menu.file -in .numbers.menu -side left
    pack .numbers.f.c -in .numbers.f -side top
    pack .numbers.f -in .numbers

    # See a foreground option is available and use it to configure the canvas rather than the default "fill" color of black.

    if { $color_state == "normal" } {
	set fg [option get . foreground Foreground]
	if { $fg != "" } {
	    configure_tkodo_colors .numbers.f foreground $fg
	}
    }

}; # end build_numbers_window


proc build_usage_window {} {

    #
    # Configure the usage information window using evaluate_parameters information.
    #

    global Options cursor

    toplevel .usage
    wm title .usage "tkodo Usage"
    wm iconname .usage Usage
    frame .usage.m -bd 1 -relief raised
    pack .usage.m -in .usage -side top -fill x
    menubutton .usage.file -text File -underline 0 -menu .usage.file.m -cursor "$cursor" -bd 1 -relief raised
    menu .usage.file.m
    set close_command {wm withdraw .usage; return}
    .usage.file.m add command -label Close -underline 0 -command "$close_command" -accelerator "Ctrl-w"
    bind . <Control-Key-w> "$close_command"
    pack .usage.file -in .usage.m -side left
    frame .usage.f
    text .usage.f.t -yscrollcommand ".usage.f.s set" -wrap word -bd 1 -relief raised
    .usage.f.t insert end [exec -keepnewline $Options(program_name) -full_help]
    scrollbar .usage.f.s -orient vertical -command ".usage.f.t yview" -cursor "$cursor" -relief raised
    pack .usage.f.t -in .usage.f -side left
    pack .usage.f.s -in .usage.f -side right -fill y
    pack .usage.f -in .usage -side top

}; # end build_usage_window


proc Tk_ConfigureApplicationColorHooks {} {

    #
    # This command is called by Tk_ConfigureApplicationColors to see what non-standard color processing might be required.
    # In the case of tkodometer, we must special case the odometer labels and a few canvas items, so we need our own
    # color configurator.
    #

    return { {apply configure_tkodo_colors} {delete disabledforeground} {delete sliderforeground} }

}; # end Tk_ConfigureApplicationColorHooks


proc configure_tkodo_colors {win type color} {

    #
    # Recursively descend the widget tree $win and configure the attribute $type for color $color.
    #
    # If $color == UseWidgetDefaultColor then reset all colors to the Tk defaults.
    #

    if { $win == ".tk_ConfigureApplicationColors" } {
	return; # ignore status window
    }

    set reset [expr { ($color == "UseWidgetDefaultColor") ? 1 : 0 }]

    set destroy_win ""
    if { ! [winfo exists .tk_ConfigureApplicationColors] } {
	toplevel .tk_ConfigureApplicationColors
	wm geometry .tk_ConfigureApplicationColors +0+0
	label .tk_ConfigureApplicationColors.l -width 50 -anchor w
	pack .tk_ConfigureApplicationColors.l -in .tk_ConfigureApplicationColors -side top
	set destroy_win $win
    }
    wm title .tk_ConfigureApplicationColors "Configure $type"
    .tk_ConfigureApplicationColors.l configure -text "WIDGET:  $win"
    update

    foreach child [winfo children $win] {
	
	switch -regexp [winfo class $child] {

	    {^Button|Checkbutton|Entry|Frame|Listbox|Menu|Menubutton|Message|Radiobutton|Scale|Scrollbar|Text|Toplevel$} {
		if { $reset } {
		    catch {set color [lindex [$child configure -${type}] 3]}
		}
		catch {$child configure -${type} $color}
	    }

	    {^Canvas$} {
		catch {$child configure -${type} $color}
		switch -exact $type {
		    {background} {
			foreach tag [$child find withtag background] {
			    if { $reset } {
				set color [lindex [$child itemconfigure $tag -background] 3]
			    }
			    $child itemconfigure $tag -background $color
			}
		    }

		    {foreground} {
			foreach tag [$child find withtag foreground] {
			    if { $reset } {
				set color [lindex [$child itemconfigure $tag -foreground] 3]
			    }
			    $child itemconfigure $tag -foreground $color
			}
			foreach tag [$child find withtag fill] {
			    if { $reset } {
				set color [lindex [$child itemconfigure $tag -fill] 3]
			    }
			    $child itemconfigure $tag -fill $color
			}
		    }
		}; # switchend
	    }

	    {^Label$} {; # for the odometer numbers, fg/bg are reversed for digits to the right of the decimal point.

		set real_color $color
		set real_type $type
		if { $reset } {
		    catch {set color [lindex [$child configure -${type}] 3]}
		}
		if { [regexp {^.+2+$} $child] } {
		    if { $type == "foreground" } {
			set type background
		    } elseif { $type == "background" } {
			set type foreground
		    }
		}
		catch {$child configure -${type} $color}
		set color $real_color
		set type $real_type
	    }

	}; # switchend

	configure_tkodo_colors $child $type $color; # configure kids

    }; # forend all child widgets

    if { $destroy_win == $win } {
	destroy .tk_ConfigureApplicationColors
    }

}; # end configure_tkodo_colors


proc display_about {} {

    global LIBDIR

    tk_dialog .help "About tkodo" \
	    "tkodometer 1.0\n\nThe Mac Mouse Odometer, Tk Style\n\nStephen O. Lidie, 94/07/07\nlusol@Lehigh.EDU" \
	    "@${LIBDIR}/SOL.xbm" 0 OK

}; # end display_about


proc display_numbers {} {

    if { [winfo exists .numbers] } {
	wm deiconify .numbers
    } else {
	build_numbers_window
    }

}; # end display_numbers


proc display_usage {} {

    if { [winfo exists .usage] } {
	wm deiconify .usage
    } else {
	build_usage_window
    }

}; # end display_usage


proc do_color {} {

    #
    # Start/resume a color editor so the user can change various tkodometer colors.  Then send
    # `color_editor' the window in our application to update, and de-iconify `color_editor'.
    #

    global LIBDIR cursor color_editor_pid Tk_ColorEditorApplicationName

    if { $color_editor_pid == "" } {
	set color_editor_pid [exec ${LIBDIR}/Tk_ColorEditor [winfo name .] $cursor &]
	tkwait variable Tk_ColorEditorApplicationName
    }

    send $Tk_ColorEditorApplicationName "set window .; wm deiconify ."

}; # end do_color


proc exit_tkodo {} {
    
    global color_editor_pid

    if { $color_editor_pid != "" } {
	catch {exec kill $color_editor_pid}
    }
    exit 0

}; # end exit_tkodo


proc which_odo {w} {

    global Options

    pack forget $w.codo $w.podo

    if { $Options(o) == "cursor" } {
	pack $w.codo -in $w -before $w.misc
    } elseif { $Options(o) == "pointer" } {
	pack $w.podo -in $w -before $w.misc
    } else {
	pack $w.codo -in $w -before $w.misc
	pack $w.podo -in $w -before $w.misc
    }

}; #end which_odo


# tkodometer Main.

wm withdraw .
if { $Options(i) == "0" } { ; # if not iconify
    toplevel .t
    wm geometry .t +0+0
    wm title .t "tkodo"
    label .t.l -bitmap "@${LIBDIR}/icon.xbm"
    message .t.m -text "Initializing tkodo ..." -aspect 800
    pack .t.l .t.m -in .t -side top
    update
}
tk_bindForTraversal .
wm iconname . "tkodo"
wm iconbitmap . "@${LIBDIR}/icon.xbm"
wm minsize . 50 50
wm protocol . WM_DELETE_WINDOW {save_tkodo; exit}

set cursor "@${LIBDIR}/cursor.xbm ${LIBDIR}/cursor.mask Black White"

set autosave_ticks [expr $Options(oat) * 60 * 1000000 / $Options(mit)]
set autosave_count $autosave_ticks

if { $Options(mit) >= 1000 } {; # convert microseconds to milliseconds
    set Options(mit) [expr $Options(mit) / 1000 ]
} else {
    set Options(mit) 100; # default rate is 10 samples per second
}

set Tk_ColorEditorApplicationName ""
set color_editor_pid ""
set color_state normal
if { [tk colormodel .] != "color" } {
    set color_state disabled
}

set w ".tkodo"
build_main_window $w

if { $Options(i) == "1" } {; # if iconify
    wm iconify .
} else {
    destroy .t
    update
    wm deiconify .
}

tk_odo $w
