[Keith Vetter] 2016-05-22 : There are probably a gazillion Rubik Cube timer programs out there for all platforms, but here's my version with a few tweaks for exactly what I wanted. For example, you can display it in a minimalistic version or add more panels with more functionality; you can select different categories to time, e.g. 3x3x3 or 4x4x4, or even add your own categories. [RubiksTimerScreenShot] ====== ##+########################################################################## # # RubiksTimer.tcl -- rubik's cube timer # by Keith Vetter 2016-05-04 # package require Tk package require Img set S(title) "Rubik's Cube Timer" set S(font) {Helvetica 124 bold} set S(display,text) "" set S(scramble) "" set S(scrambles,old) {} set S(state) idle proc DoDisplay {} { global S wm title . $S(title) frame .left -bg navyblue -bd 2m frame .left.bottom -bg navyblue pack .left -side left -fill both -expand 1 pack .left.bottom -side bottom -fill both -expand 1 ::ttk::frame .history -borderwidth 5 -relief raised ::History::DoDisplay .history if {"displayFont" in [font names]} { font delete displayFont } font create displayFont {*}[font actual $S(font)] set S(display,text) [PrettyTenths 0 1] label .ticks -font displayFont -textvariable S(display,text) -background cyan pack .ticks -in .left -side top -fill x label .scramble -textvariable S(scramble) -bd 2 -relief ridge lappend S(scrambles,old) $S(scramble) set S(scramble) [Scramble] pack .scramble -in .left -side top -fill x -pady {0 2m} button .start -text "Start" -command ToggleTimer -font {Helvetica 48 bold} pack .start -in .left.bottom -side left -expand 1 -fill x -padx 1i -pady 1m button .showStart -image ::bmp::chevrons_down -padx 1m -pady 1m -command ToggleStartButton button .hideStart -image ::bmp::chevrons_up -padx 1m -pady 1m -command ToggleStartButton button .showHistory -image ::bmp::chevrons -padx 1m -command ToggleHistoryPanel place .showStart -in .ticks -relx 1 -rely 1 -x -2m -y -2m -anchor se place .hideStart -in .left.bottom -relx 1 -rely 0 -x -2m -anchor ne place .showHistory -in .left.bottom -relx 1 -rely 1 -x -2m -y -2m -anchor se ToggleHistoryPanel bind .start {DoButton down} bind .ticks {DoButton down} bind .ticks {DoButton up} bind all { ::History::Erase 0 } focus .start } proc PrettyTenths {tenths {long_format 0}} { if {$tenths eq ""} { return "" } set minutes [expr {$tenths / 600}] set tenths [expr {$tenths % 600}] set seconds [expr {$tenths / 10}] set tenths [expr {$tenths % 10}] if {$long_format} { return [format "%02d:%02d.%d" $minutes $seconds $tenths] } if {$minutes > 0} { return [format "%d:%02d.%d" $minutes $seconds $tenths] } return [format "%d.%d" $seconds $tenths] } proc DoButton {how} { global S if {$how eq "down" && $S(state) eq "idle"} { ResetTimer } if {$how eq "up"} { ToggleTimer } } proc ToggleTimer {} { global S focus .start if {$S(state) eq "idle"} { set S(start) [clock milliseconds] set S(state) "timing" .start config -text "Stop" set S(aid) [after idle Timer] } else { after cancel $S(aid) set S(state) "idle" set S(scramble) [Scramble] .start config -text "Start" ::History::AddTime $S(tenths) } } proc ResetTimer {} { set ::S(start) [clock milliseconds] set ::S(display,text) [PrettyTenths 0 1] } proc Timer {} { global S if {$S(state) ne "timing"} return set S(now) [clock milliseconds] set S(tenths) [expr {($S(now) - $S(start)) / 100}] set S(display,text) [PrettyTenths $S(tenths) 1] set S(aid) [after 100 Timer] } proc Scramble {{length 25}} { set MOVES {R L U D F B} set OPPOSITES {"" "" R L L R U D D U F B B F} set scramble {} set last "" set last2 "" for {set i 0} {$i < $length} {incr i} { while {1} { set move [lindex $MOVES [expr {int(rand() * 6)}]] if {$move eq $last} continue if {$move eq [dict get $OPPOSITES $last] && $move eq $last2} continue set last2 $last set last $move break } set modifier [lindex {"" "\u2019" "\uB2"} [expr {int(rand() * 3)}]] lappend scramble $move$modifier } return $scramble } proc ToggleHistoryPanel {} { lower .showStart if {[winfo ismapped .history]} { pack forget .history raise .hideStart raise .showHistory } else { pack .history -side left -fill y lower .hideStart lower .showHistory } } proc ToggleStartButton {} { if {[winfo ismapped .left.bottom]} { pack forget .left.bottom raise .showStart } else { pack .left.bottom -fill x lower .showStart } } proc ToggleErasePanel {} { set f .eraseFrame if {[winfo exists $f] && [winfo ismapped $f]} { grid forget $f grid .history.hideHistory -row 100 -column 0 -pady 1m -padx 1m -sticky w grid .history.showErase -row 100 -column 1 -pady 1m -padx 1m -sticky e foreach w [winfo child .history.lastTimes] { $w config -borderwidth 1 -relief flat destroy $w.x } } else { foreach w [winfo child .history.lastTimes] { regexp {[0-9]+$} $w who $w config -borderwidth 1 -relief solid label $w.x -image ::img::x -bd 1 -relief solid bind $w.x [list ::History::Erase $who] place $w.x -relx 1 -y 0 -anchor ne } grid forget .history.hideHistory grid forget .history.showErase grid $f -in .history -row 1 -column 2 -rowspan 102 -sticky ns -padx 1m } focus .start } proc UniqueTrace {var func} { foreach old [trace info variable $var] { trace remove variable $var {*}$old } if {$func ne ""} { trace variable $var w $func } } image create bitmap ::bmp::chevrons -data { #define chevron_width 14 #define chevron_height 9 static char chevron_bits = { 0x33, 0x03, 0x66, 0x06, 0xcc, 0x0c, 0x98, 0x19, 0x30, 0x33, 0x98, 0x19, 0xcc, 0x0c, 0x66, 0x06, 0x33, 0x03 } } image create bitmap ::bmp::chevrons_left -data { #define chevron_width 14 #define chevron_height 9 static char chevron_bits = { 0x30, 0x33, 0x98, 0x19, 0xcc, 0x0c, 0x66, 0x06, 0x33, 0x03, 0x66, 0x06, 0xcc, 0x0c, 0x98, 0x19, 0x30, 0x33 } } image create bitmap ::bmp::chevrons_up -data { #define chevrons_up_width 9 #define chevrons_up_height 14 static char chevrons_up_bits = { 0x10, 0x00, 0x38, 0x00, 0x6c, 0x00, 0xc6, 0x00, 0x93, 0x01, 0x39, 0x01, 0x6c, 0x00, 0xc6, 0x00, 0x93, 0x01, 0x39, 0x01, 0x6c, 0x00, 0xc6, 0x00, 0x83, 0x01, 0x01, 0x01 } } image create bitmap ::bmp::chevrons_down -data { #define chevrons_down_width 9 #define chevrons_down_height 14 static char chevrons_down_bits = { 0x01, 0x01, 0x83, 0x01, 0xc6, 0x00, 0x6c, 0x00, 0x39, 0x01, 0x93, 0x01, 0xc6, 0x00, 0x6c, 0x00, 0x39, 0x01, 0x93, 0x01, 0xc6, 0x00, 0x6c, 0x00, 0x38, 0x00, 0x10, 0x00 } } image create photo ::img::x -data { iVBORw0KGgoAAAANSUhEUgAAAAcAAAAHCAYAAAGzVWdFAAAABGdBTUEAAYagMeiWXwAAADFJREFUCJljYG Bg+M+ADP6jMP6jS/3HUIeu9D8jsiwTsgEwDiOMQDYEhc+IzUVE6QQAxBwP/TlB3jEAAAAASUVORK5CYII= } proc About {} { tk_messageBox -message "$::S(title)" -detail "by Keith Vetter\nMay 2016" -parent . \ -title "About $::S(title)" } namespace eval ::History { variable times variable H variable rc_file "~/.rubikstimer_rc" variable categories {3x3x3 2x2x2 4x4x4 Cross F2L} variable category 3x3x3 variable undo {} variable minimums unset -nocomplain times if {$::tcl_interactive} { lappend categories debug } foreach i $categories { set times($i) {} } set minimums(3x3x3) 10 set minimums(debug) 10 unset -nocomplain H set H(best) ? set H(5,ave) ? set H(5,times) ? set H(lifetime,ave) ? set H(last,count) 10 } proc ::History::DoDisplay {f} { variable H set args {-borderwidth 2 -relief sunken -anchor c -width 5} tk_optionMenu $f.category ::History::category {*}$::History::categories ::ttk::label $f.l_best -text Best: -anchor e ::ttk::label $f.best -textvariable ::History::H(best) {*}$args ::ttk::label $f.l_lifetime -text Average: ::ttk::label $f.lifetime -textvariable ::History::H(lifetime,ave) {*}$args ::ttk::label $f.l_5 -text "Last 5: " ::ttk::label $f.5 -textvariable ::History::H(5,ave) {*}$args ::ttk::label $f.l_drop -text "Drop hi/lo: " ::ttk::label $f.drop -textvariable ::History::H(drop,ave) {*}$args ::ttk::frame $f.lastTimes -borderwidth 2 -relief sunken for {set i 0} {$i < $H(last,count)} {incr i} { set w $f.lastTimes.$i ::ttk::label $w -textvariable ::History::H(last,$i) -anchor c -borderwidth 1 -relief flat bind $w [list ::History::Erase $i] grid $w -row [expr {$i / 2}] -column [expr {$i % 2}] -sticky ew } grid columnconfigure $f.lastTimes all -weight 1 -uniform same button $f.showErase -image ::bmp::chevrons -padx 1m -command ToggleErasePanel button $f.hideHistory -image ::bmp::chevrons_left -padx 1m -command ToggleHistoryPanel grid $f.category - - -sticky ew -pady {1m 2m} grid $f.l_best $f.best grid $f.l_lifetime $f.lifetime grid $f.l_5 $f.5 grid $f.l_drop $f.drop grid $f.lastTimes - -pady 2m -sticky ew grid rowconfigure $f 99 -weight 1 grid $f.hideHistory -row 100 -column 0 -pady 1m -padx 1m -sticky w grid $f.showErase -row 100 -column 1 -pady 1m -padx 1m -sticky e UniqueTrace ::History::category ::History::Tracer UniqueTrace ::History::undo ::History::Tracer set ff .eraseFrame ::ttk::frame $ff ::ttk::button $ff.about -text About -command About ::ttk::button $ff.erase_last -text "Erase Last" -command {::History::Erase 0} ::ttk::button $ff.erase_all -text "Erase All" -command {::History::Erase all} ::ttk::button $ff.undo -text "Undo Erase" -command ::History::Undo -state disabled grid $ff.about -sticky ew grid $ff.erase_last -sticky ew grid $ff.erase_all -sticky ew grid $ff.undo -sticky ew button $ff.hideEraseFrame -image ::bmp::chevrons_left -padx 1m -command ToggleErasePanel grid rowconfigure $ff 99 -weight 1 grid $ff.hideEraseFrame - -row 100 -pady 1m -padx 1m -sticky e } proc ::History::Tracer {var1 var2 op} { if {$var1 eq "::History::category"} { wm title . "$::S(title) -- $::History::category" ::History::ComputeStats return } if {$var1 eq "undo" && [winfo exists .eraseFrame.undo]} { .eraseFrame.undo config -state [expr {$::History::undo eq "" ? "disabled" : "normal"}] return } } proc ::History::Erase {which} { variable times variable category variable undo if {$which eq "last"} { set which 0 } lappend undo [list $category $times($category)] if {$which eq "all"} { set times($category) {} } else { set times($category) [lreplace $times($category) end-$which end-$which] } ::History::ComputeStats after idle ::History::SaveStats } proc ::History::Undo {} { variable times variable undo if {$undo eq {}} return lassign [lindex $undo end] category data set undo [lrange $undo 0 end-1] set times($category) $data ::History::ComputeStats after idle ::History::SaveStats } proc ::History::AddTime {tenths} { variable times variable category variable minimums set minimum 0 if {[info exists minimums($category)]} { set minimum $minimums($category) } if {[string is double -strict $minimum] && $tenths < 10*$minimum} return lappend times($category) $tenths ::History::ComputeStats after idle ::History::SaveStats } proc ::History::ComputeStats {} { variable times variable H variable category if {$times($category) eq ""} { set H(best) [set H(lifetime,ave) [set H(5,ave) [PrettyTenths 0]]] } else { set H(best) [PrettyTenths [lindex [lsort -integer $times($category)] 0]] set H(lifetime,ave) [PrettyTenths [expr ([join $times($category) +]) / [llength $times($category)]]] set last_5 [lrange $times($category) end-4 end] set H(5,ave) [PrettyTenths [expr round(([join $last_5 +]) / 5.0)]] if {[llength $last_5] < 5} { set H(drop,ave) - } else { set mid_3 [lrange [lsort -integer $last_5] 1 end-1] set H(drop,ave) [PrettyTenths [expr round(([join $mid_3 +]) / 3.0)]] } } for {set i 0} {$i < $H(last,count)} {incr i} { set tenths [lindex $times($category) end-$i] set H(last,$i) [PrettyTenths $tenths] } } proc ::History::NewMode {newMode} { variable categories variable times if {$newMode in $categories} return lappend categories $newMode set w [winfo child .history.category] $w add radiobutton -label $newMode -variable [$w entrycget 0 -variable] set times($newMode) {} } proc ::History::ReadStatsFromRCFile {} { variable times variable categories if {! [file exists $::History::rc_file]} return if {[catch {set fin [open $::History::rc_file r]}]} return set lines [split [string trim [read $fin]] \n] close $fin foreach line $lines { if {[regexp {^current: (.*)$} $line . category]} { ::History::NewMode $category set ::History::category $category } elseif {[regexp {^([a-zA-Z0-9_-]+): ?([0-9 ]+)$} $line . category data]} { ::History::NewMode $category set times($category) [string trim $data] } } } proc ::History::SaveStats {} { variable times set output {} foreach category [lsort -dictionary [array names times]] { if {$times($category) ne {}} { lappend output "$category: $times($category)" } } if {$output eq ""} { file delete $::History::rc_file } else { set n [catch {set fout [open $::History::rc_file w]}] if {! $n} { puts $fout [join $output \n] puts $fout "current: $::History::category" close $fout } } } ################################################################ DoDisplay ::History::ReadStatsFromRCFile if {$tcl_interactive} { set ::History::category debug } ::History::ComputeStats return ====== <>Enter Category Here