Rubik's Cube Timer
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.
##+##########################################################################
#
# 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 <Button-1> {DoButton down}
bind .ticks <Button-1> {DoButton down}
bind .ticks <ButtonRelease-1> {DoButton up}
bind all <Key-Escape><Key-Escape><Key-Escape> { ::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 <ButtonRelease-1> [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 <Double-1> [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