Updated 2016-05-23 04:59:30 by kpv ▲

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

Enter Category Here