[Keith Vetter] 2008-10-08 : Here's a new time picker mega-widget
based on an experimental one at
[http://haineault.com/media/examples/jquery-utils/demo/ui-timepickr.html].
It works with and without Tile (the demo lets you switch between the
two).

Couple of bugs I haven't worked out.
   * if master widget moves or changes stacking order, the popup windows need to follow
   * Tile's highlighting button needs to be better (just pressed state isn't good enough)
   * only one instance allowed at a time (uses global state array)

----
======
##+##########################################################################
#
# TimePicker.tcl -- another time picking tool
# by Keith Vetter Oct 08, 2008
#
# Based on widget at
# http://haineault.com/media/examples/jquery-utils/demo/ui-timepickr.html
#
# Bugs:
#  o better highlighting under Tile (just pressed state isn't enough)
#  o when time entry widgets moves or gets raised or lowered, the popup windows
#    should follow
#  o only one instance allowed at a time (global TC array)
# 

package require Tk
package require Ttk

catch {namespace delete timePicker} 
namespace eval timePicker {
    variable TC
    
    array set TC {
	popup,1 ?.__timepicker1
	popup,2 ?.__timepicker2
	popup,3 ?.__timepicker3
	master ?
	UseTile 1 theTime "1:00 am"
	hour 0 minute 0 ampm 0
	selected,hour 0 selected,minute 0 selected,ampm 0
	selected,color \#b2b4bf
    }
}

##+##########################################################################
# 
# timePicker::timePicker -- Creates a new instance of our timepicker widget
# 
proc timePicker::timePicker {w {UseTile 0}} {
    variable TC
    
    set TC(master) $w
    set TC(UseTile) $UseTile
    set TC(popup,1) $w.__timepicker1
    set TC(popup,2) $w.__timepicker2
    set TC(popup,3) $w.__timepicker3
    
    entry $w -width 8 -textvariable timePicker::TC(theTime)
    bind $w <Enter> [list timePicker::ButtonEnter theTime -]
    return w
}
##+##########################################################################
# 
# timePicker::ButtonEnter -- Reacts to entering a button
# 
proc timePicker::ButtonEnter {who which} {
    variable TC

    if {$who eq "theTime"} {
	if {! [winfo exists $TC(popup,1)] || ! [winfo ismapped $TC(popup,1)]} {
	    timePicker::Init
	    update idletasks
	    timePicker::ShowHours
	}
	return
    }
	
    set TC($who) $which
    
    timePicker::DoHighlight $who $TC(selected,$who) $which
    set TC(selected,$who) $which

    set hour [expr {$TC(selected,hour) + 1 + $TC(selected,ampm)*12}]
    set minute [expr {$TC(selected,minute) * 15}]
    set seconds [expr {$hour * 3600 + $minute * 60}]
    set TC(theTime) [clock format $seconds -gmt 1 -format "%I:%M %P"]
    
    if {$who eq "hour"} {
	timePicker::ShowMinutes
	if {[winfo ismapped $TC(popup,3)]} {
	    update idletasks
	    timePicker::ShowAMPM
	}
    }
    if {$who eq "minute"} timePicker::ShowAMPM
}
proc timePicker::Init {} {
    variable TC

    timePicker::CreatePopup

    # Figure current time and hightlight those buttons
    foreach {hour minute ampm} {1 0 am} break
    set n [catch {
	set seconds [clock scan $TC(theTime) -format "%I:%M %P"]
	set ttime [clock format $seconds -format "%I %M %P"]
	scan $ttime "%d %d %s" hour minute ampm
    }]
    set minute [expr {int($minute/15)}]
    set TC(selected,hour) [expr {$hour-1}]
    set TC(selected,minute) $minute
    set TC(selected,ampm) [expr {$ampm eq "am" ? 0 : 1}]
    timePicker::DoHighlight hour   0 $TC(selected,hour)
    timePicker::DoHighlight minute 0 $TC(selected,minute)
    timePicker::DoHighlight ampm   0 $TC(selected,ampm)
}
proc timePicker::Done {} {
    variable TC

    wm withdraw $TC(popup,1)
    wm withdraw $TC(popup,2)
    wm withdraw $TC(popup,3)
}
##+##########################################################################
# 
# timePicker::PlacePopup -- Places a slave window just below master
# 
proc timePicker::PlacePopup {master slave} {
    variable TC

    set x [winfo rootx $master]
    set y [winfo rooty $master]
    set y [expr {$y + [winfo height $master]}]
    wm geom $slave +$x+$y
}
proc timePicker::DoHighlight {who old new} {
    variable TC

    set id [expr {$who eq "hour" ? 1 : $who eq "minute" ? 2 : 3}]
    
    set w1 $TC(popup,$id).${who}_$old
    set w2 $TC(popup,$id).${who}_$new
    if {$TC(UseTile)} {
	$w1 state !pressed
	$w2 state pressed
    } else {
	$w1 config -bg [lindex [$w1 config -background] 3]
	$w2 config -bg $TC(selected,color)
    }
}
proc timePicker::ShowHours {} {
    variable TC

    timePicker::PlacePopup $TC(master) $TC(popup,1)
    if {[winfo ismapped $TC(popup,1)]} return
    wm deiconify $TC(popup,1) 
}
proc timePicker::ShowMinutes {} {
    variable TC

    set master $TC(popup,1).hour_$TC(selected,hour)
    
    timePicker::PlacePopup $master $TC(popup,2)
    if {[winfo ismapped $TC(popup,2)]} return
    wm deiconify $TC(popup,2)
}
    
proc timePicker::ShowAMPM {} {
    variable TC

    timePicker::PlacePopup $TC(popup,2) $TC(popup,3)
    if {[winfo ismapped $TC(popup,3)]} return
    wm deiconify $TC(popup,3)
}
proc timePicker::CreatePopup {} {
    variable TC
    
    if {[winfo exists $TC(popup,1)]} {
	timePicker::Done
	return
    }

    foreach id {1 2 3} {
	toplevel $TC(popup,$id)
	wm withdraw $TC(popup,$id)
	wm overrideredirect $TC(popup,$id) 1
	wm transient $TC(popup,$id) [winfo toplevel $TC(master)]
	catch { wm attributes $TC(popup,$id) -topmost 1 }
    }

    set button [expr {$TC(UseTile) ? "::ttk::button" : "button"}]
    set bw 3
    
    for {set hour 0} {$hour < 12} {incr hour} {
	set h [format %02d [expr {$hour+1}]]
	set w $TC(popup,1).hour_$hour
	$button $w -text $h -width $bw -command timePicker::Done
	bind $w <Enter> [list timePicker::ButtonEnter hour $hour]
	grid $w -row 1 -column $hour
    }
    for {set minute 0} {$minute < 4} {incr minute} {
	set m [format %02d [expr {$minute * 15}]]
	set w $TC(popup,2).minute_$minute
	$button $w -text $m -width $bw -command timePicker::Done
	bind $w <Enter> [list timePicker::ButtonEnter minute $minute]
	grid $w -row 2 -column $minute
    }
    set w1 $TC(popup,3).ampm_0
    set w2 $TC(popup,3).ampm_1
    $button $w1 -text "am" -width $bw -command timePicker::Done
    bind $w1 <Enter> [list timePicker::ButtonEnter ampm 0]
    $button $w2 -text "pm" -width $bw -command timePicker::Done
    bind $w2 <Enter> [list timePicker::ButtonEnter ampm 1]
    grid $w1 $w2 -row 0
}
##+##########################################################################
# 
# Demo Code
#

set UseTile 0
proc ReDemo {} {
    destroy .time
    timePicker::timePicker .time $::UseTile
    grid .time -row 2
}
timePicker::timePicker .time $UseTile

label .title -text "Time Picker Demo" -font {Times 48 bold}
label .l1 -text "Here's a new timePicker widget\nmouse into and play" \
    -font {Times 18 bold}
frame .buttons
checkbutton .tile -text "Tile" -variable ::UseTile -command ReDemo
::ttk::button .done -text Close -command exit

grid .title -row 0
grid .l1 -row 1
grid .buttons -row 3 -pady {.75i 30} -sticky ew
pack .tile .done -in .buttons -side left -expand 1
ReDemo
return

======
----
!!!!!!
%| [Category Games] | [Category Application] |%
!!!!!!