High Score Package

Keith Vetter 2008-04-29 : I've written lots of games, many of which I've posted to this wiki. One thing all those games lack is a way to save and show your high scores.

So I wrote the following code to rectify this. Here's a package which will show the high scores, add to the high score table and save the high scores. The header files contains documentation on using the package, and there's a demo at the end.

NB. one game may have multiple high score tables--one for each skill level. This package will display all the tables and let you specify the default one.


##+##########################################################################
#
# highScore.tcl -- package for showing, adding to and saving high scores
# by Keith Vetter, April 28
#
# This package provides routines for showing, adding to and saving high scores.
# It supports multiple high score tables for different skill levels (buts
# works fine with only one table).
#
# A high score entry consists of: username, score, level reached and date,
# and sorts entries first by score, then by level. Changing this is easy
# but requires code changes.
#
# The scores are kept in a file based on the application name and stored in
# either APPDATA or HOME directory.
#
# Three procs are exported:
# ::HighScore::ShowHighScore toplevel appName ?skillLevel? ?highlight?
#      toplevel    -- name for the dialog's toplevel window
#      appName     -- for locating correct highscore data file
#      skillLevel  -- which table to show initially
#      ?highlight? -- if > 0,  which entry to high and to say Congratulations
#
# ::HighScore::Add2HighScore appName skillLevel name score lvl date
#    appName    -- for locating correct highscore data file
#    skillLevel -- which high score table to add to
#    name       -- name value for table
#    score      -- score value for table
#    level      -- level value for table
#    date       -- usually just [clock seconds]
#
# ::HighScore::GetHighScoreFileName appName
#      appName    -- for locating correct highscore data file

package require Tk 8.5
package provide highscore 1.0

namespace eval ::HighScore {
    variable W .highscores
    variable HIGH {}
    variable which                              ;# Which table to display
    variable headers {Name Score Level Date}
    variable headerWidths {100 60 50 85}

    namespace export ShowHighScore Add2HighScore GetHighScoreFileName

    foreach t [trace info variable which] {     ;# For easier debugging
        trace remove variable which {*}$t
    }

    image create photo ::highscore::icon -format gif -data {
    R0lGODlhZABgALMAAAsDBbOYIKimhPzOBQQC/G5SI/j6d5ubYvz9ZWpkYvz+zEsyIdW1Gcy+RJNz
    EcTGlCH5BAEAAAQALAAAAABkAGAAQwT/kMhJq704a7KA/2Aojt52hYWirmzrvvD6HB1pj0+8hicY
    h4OgcEgsDhHIpNKQNDQOiWiCiRTeXrzKrcj4LIzg8FFJLieto+GHlZ2QvmgB2yOug81ktWf3EdYA
    LQIgbiIqfwBoCS19dmJ4VUMBHjkKIAxCDmsvB1mFLQ8hAUOZhyCijmZGpTeaMaAiEiEtCwc6tnOM
    YCJyMYI3C66DFD63Kx0LvLYFQEQjxVgAwLbChK3PLAkjC5eNQQwBDgkODqd6ALXXLtTDssUgcAMf
    ZAf09fYHAlRlIEbtOrAmqrHi160gEUkDRwTMkLChw4ceFkhcIIWeAEq4AGLwt+gXOYMg/+t4gtGG
    HTFOW4RIWcmypcuVBxogoKKvDBpEzT4kq/TBAglze3zhDHOvqD0B+R7ZvKnCCyZrh0z+ZDonZJGa
    j4ZIBGToA7d4e6CViMXxVa4wmYYWzJozmphDPzpxhLEKmVi1BQ+hS8cTAEY+PQVyzYjiojuCIkHs
    5dt3cEYtxAKNUHRtVZGEjP8FlpoZRAE/AwsEmInHgKXL1g5v9slqMbMg8pSSebIqBLybJJAqXMgb
    MsTfN3oLZw28uHGHvBNS3Jm5ufOuJX2nlnG8uo0FaSPfBdBjOmA6VsMXyQNWu7roBOYqqC2EQZQA
    X+18e0m/JZObAxDOjSpdW87b4o0h2/9SsHngQD9hNbUaWWnghlh43xhFD1YEplWKOSzwJ9gHnxWY
    YA0gHRAfEQOeQVVjuLGwzIIpDVBDRyMGOCCGCoLn4V1STWLWUC+q6EE5VpUYSYLZePCVed9xl14I
    ybyWHwou2hhkKkOsOEJ8XpAkl3k7AmhEF1KGoRSCABwYhnrUwTLSLMV5SaKJRegXVpEhUPaMRmg+
    11iMRmQXTTo7eteYkgwmCJg0mVkmRp7QOaPCXx2NVahjkl3Ry4NfMnoLCMx9J52dCi4AqXOYHoKo
    nppJOqkto75AZ4uRFLCVDa0ytk6hmQUqBgO1JdQWAKBec2uhnaY6VJ0U1mSAAPckYSX/XlF+sJix
    hBInwgGtHmIOGRSWaNpZDuog1IIbFffrcQt0GEavNgyXAbteMSCvvGB8I6t1w7qrb3es7OvvvxsE
    9y6+1S3gLsEIJ0xuueimm4BhqKIa6MITlFJAsRFf88AMz76hmqoVlPLPw7W68IAACXSsMJKRgiwY
    XehGk24BBYxjcwA44/wNn7poit6SHwSbZIBEC0GFh4LWSC6jTgbYLXlBkEYeCUKvh16eHRcd9RIz
    1CfF0Ug7Spi1lNpg5gBep612FAcYgBV+3ngBLAs7ks2V3G7pt2sA9LRET85ClIgH3Kg5NiwrhfMc
    nuBQlxdRW4/1945WF2o9AONKAPWg/zXRkXC2DYoPIS/OCUhYVFJj3qjtiYNKLmVk4BZhej3xPU2l
    40qnaMytNjz1Jx/qai2474N5BRqlKIHcOxp/FWl54EoZQCOKHp6qQN05Osl5mOLZDmd53x1PqdLZ
    28Z6X0QPf+LmhkY+6d3GFwhp7AbNOD37AGC8JexnwSvj4JCz2llYNiglralpA7CZHkJXh9vdxAGr
    0912DDgXBJKpILbjQjSgda648GBNSnOLEVTmpjc50EFGIoKfxseCcfUEhCGECAMJNIrffOyFmoKX
    Z6hnFT9ZTwXZqJqCtmMwoCUtEHei36IIaItxbSdHGWtZ8Mh0RLrZIAYaMiKlevQcEf8skYkFtM00
    VqMeJnXGgoVjIWEoYsXftQyKLVAZCUqGKTDISY0fa9U6NLUCOY7xA2fT3CSaA0be6SSK2zkXHqNo
    yIhUyjMlayKm/IRID1ZLizGgE8Ze4MI6NoSRLAJjMV4lAonULJDd+EYVP9af5pSihERggBzf8SOg
    kGppq0xkEWZ5HQcc4FlpjOQTWwkogtigAN5DgtuS4Jk0LrJlLsNkEnMRmybMrh6oYyb9+BhDDKxC
    mM8qRzWRYI9kksFKVHwmKU3AimBpzwOY49YdU6hIN+7uZ/zymAJIua0mNCABOmSFl4AzHOBMEYLa
    mEi6xgEfejVihQkB2PuWpzUGIBQZIhL9l20aElCMZjSjK7tOET9K0pKadCERAAA7}
}
##+##########################################################################
#
# ::HighScore::ShowHighScore -- Puts up the high score dialog
#    toplevel   -- name for the dialog's toplevel window
#    appName    -- for locating correct highscore data file
#    skillLevel -- which table to show initially
#    highlight  -- if > 0,  which entry to high and to say Congratulations
#
proc ::HighScore::ShowHighScore {top appName {skillLevel ""} {highlight -1}} {
    variable W $top
    variable HIGH
    variable which

    ::HighScore::_ReadHighScores $appName

    ::HighScore::_TearDown
    toplevel $W
    wm title $W "$appName Scores"
    wm protocol $W WM_DELETE_WINDOW ::HighScore::_TearDown

    # Allow a game to have several high score tables
    set keys [dict keys $HIGH]
    if {$skillLevel eq ""} { set skillLevel [lindex $keys 0] }
    if {$skillLevel ni $keys} {
        set msg "ERROR: unknown skill level '$skillLevel'"
        tk_messageBox -icon error -title "High Score Error" -message $msg
        return
    }
    set which $skillLevel

    set WV $W.variants
    ::ttk::frame $WV
    ::ttk::label $WV.l -text "Skill Level:"
    ::ttk::menubutton $WV.opt -textvariable ::HighScore::which -menu $WV.menu \
        -direction flush
    menu $WV.menu -tearoff 0
    foreach i $keys {
        $WV.menu add radiobutton -label $i -variable ::HighScore::which
    }
    trace variable ::HighScore::which w ::HighScore::_Tracer
    pack $WV.l -side left
    pack $WV.opt -side left ;#-fill both -expand 1

    ::ttk::label $W.icon -image ::highscore::icon
    label $W.title -text "$appName High Scores" -bd 2 -relief sunken \
        -font {Helvetica 12 bold}
    frame $W.buttons -bd 2 -relief ridge
    ::ttk::button $W.buttons.quit -text "Close" -command ::HighScore::_TearDown
    ::ttk::frame $W.table

    label $W.congrats1 -text "Congratulations!" -font {Helvetica 12 bold}
    label $W.congrats2 -text "You score has made the top ten."

    pack $W.buttons -side bottom -fill x -pady {.1i 0}
    pack $W.icon -side left -anchor n -pady .1i -padx .1i
    pack $W.title -side top -fill x -pady .1i -padx {0 .1i}
    if {$highlight > -1} {
        pack $W.congrats1 -side top -fill x
        pack $W.congrats2 -side top -fill x -padx {0 .1i}
    }
    if {[llength $keys] > 1} {
        pack $W.variants -side top -fill x -pady .1i -padx {0 .1i}
    }
    pack $W.buttons.quit -side bottom -expand 1 -pady .1i
    pack $W.table -side top -fill both -expand 1 -padx {0 .1i}

    set which $which                            ;# Fire the trace
    set tag "tag_${which}_$highlight"
    $W.table.tree tag config $tag -background cyan
    return $W
}
##+##########################################################################
#
# ::HighScore::GetHighScoreFileName -- Returns the highscore filename
#     appname -- used to construct the filename
#       Windows: => $env(APPDATA)/$appName.hs
#       Unix: => ~/.$appName_hs
#
proc ::HighScore::GetHighScoreFileName {appName} {
    global env

    set baseName [string tolower [string map {" " ""} $appName]]
    if {$::tcl_platform(platform) eq "windows"} {
        append baseName ".hs"
    } else {
        append baseName "_hs"
        set baseName ".$baseName"
    }

    set fname [file join ~ $baseName]
    if {[info exists env(APPDATA)]} {
        set fname [file join $env(APPDATA) $baseName]
    }
    return $fname
}
##+##########################################################################
#
# ::HighScore::Add2HighScore -- Adds entry to high score--if good enough
#    appName    -- for locating correct highscore data file
#    skillLevel -- which high score table to add to
#    name       -- name value for table
#    score      -- score value for table
#    level      -- level value for table
#    date       -- usually just [clock seconds]
#
#  returns: position in the top 10 (base 1)
#
proc ::HighScore::Add2HighScore {appName skillLevel name score level date} {
    variable HIGH

    ::HighScore::_ReadHighScores $appName

    set item [list $name $score $level $date]
    set data {}
    if {[dict exists $HIGH $skillLevel]} {
        set data [dict get $HIGH $skillLevel]
    }

    lappend data $item
    set data [lrange [lsort -dec -integer -index 2 $data] 0 9]
    set data [lsort -dec -integer -index 1 $data]
    set n [lsearch $data $item]
    if {$n > -1} {
        dict set HIGH $skillLevel $data
        ::HighScore::_SaveHighScore $appName
    }
    return [incr n]                             ;# Top 10 position (base 1)
}
##+##########################################################################
#
# ::HighScore::_CreateTable -- Creates high score table using tile treeview
#
proc ::HighScore::_CreateTable {W} {
    if {! [winfo exists $W]} return

    set WTREE $W.tree
    set data [::HighScore::_MassageData]

    if {! [winfo exists $WTREE]} {
        ::ttk::treeview $WTREE -columns $::HighScore::headers -show headings \
            -height 10 -yscroll "$W.vsb set" -xscroll "$W.hsb set" \
            -selectmode none
        scrollbar $W.vsb -orient vertical -command "$WTREE yview"
        scrollbar $W.hsb -orient horizontal -command "$WTREE xview"

        grid $WTREE $W.vsb -sticky nsew
        grid $W.hsb          -sticky nsew
        grid column $W 0 -weight 1
        grid row    $W 0 -weight 1
    }
    $WTREE delete [$WTREE children {}]
    foreach col $::HighScore::headers width $::HighScore::headerWidths {
        set name [string totitle $col]
        $WTREE heading $col -text $name
        $WTREE column $col -anchor c -width $width
    }
    $WTREE column Score -anchor e

    set lnum 0
    foreach datum $data {
        set tag "tag_${::HighScore::which}_[incr lnum]"
        $WTREE insert {} end -values $datum -tag $tag
    }
}
##+##########################################################################
#
# ::HighScore::_TearDown -- Cleans up traces from our dialog
#
proc ::HighScore::_TearDown {} {
    foreach t [trace info variable ::HighScore::which] {
        eval trace remove variable ::HighScore::which $t
    }
    destroy $::HighScore::W
}
##+##########################################################################
#
# ::HighScore::_MassageData -- Puts data into pretty format for display
#
proc ::HighScore::_MassageData {} {
    set data {}
    foreach datum [dict get $::HighScore::HIGH $::HighScore::which] {
        if {$datum eq ""} break
        foreach {who score lvl when} $datum break
        lset datum 1 [::HighScore::_Comma $score]
        lset datum 3 [clock format $when -format "%b %d, %Y"]
        lappend data $datum
    }
    return $data
}
##+##########################################################################
#
# ::HighScore::_Tracer -- Handles trace on which skill level to display
#
proc ::HighScore::_Tracer {var1 var2 op} {
    ::HighScore::_CreateTable $::HighScore::W.table
}
proc ::HighScore::_Comma {num} {
    while {[regsub {^([-+]?[0-9]+)([0-9][0-9][0-9])} $num {\1,\2} num]} {}
    return $num
}
##+##########################################################################
#
# ::HighScore::_ReadHighScores -- Reads our high score config file
#    appName    -- for locating correct highscore data file
#
proc ::HighScore::_ReadHighScores {appName} {
    variable HIGH

    unset -nocomplain HIGH
    set HIGH {}

    set fname [::HighScore::GetHighScoreFileName $appName]
    if {! [file readable $fname]} { return "No File" }

    catch {interp delete myInterp}              ;# Easier debugging
    interp create -safe myInterp
    myInterp invokehidden source $fname
    set HIGH [myInterp eval set HIGH]
    interp delete myInterp
    return ""
}
##+##########################################################################
#
# ::HighScore::_SaveHighScore -- Saves our high score config file
#    appName    -- for locating correct highscore data file
#
proc ::HighScore::_SaveHighScore {appName} {
    variable HIGH

    set fname [::HighScore::GetHighScoreFileName $appName]
    set n [catch {set fout [open $fname w]} emsg]
    if {$n} {
        set msg "ERROR: cannot save high scores\n$fname:\n$emsg"
        tk_messageBox -icon error -title "High Score Error" -message $msg
        return
    }
    puts $fout "set HIGH {"
    dict for {key value} $HIGH {
        puts $fout "    [list $key] [list $value]"
    }
    puts $fout "}"
    close $fout
}


################################################################
#
# Demo code
#

package require highscore

set appName "Gem Game"
set users {"Keith Vetter" "John Ousterhout" "Hillary Clinton" "John McCain"
    "Barack Obama"}
set skills {Easy Hard Expert}
file delete [::HighScore::GetHighScoreFileName $appName] ;# Start clean for demo

# Fill in the table with random data
for {set i 0} {$i < 100} {incr i} {
    set who [lindex $users [expr {$i % [llength $users]}]]
    set skill [lindex $skills [expr {$i % [llength $skills]}]]
    set lvl [expr {1 + int(rand()*20)}]
    set score [expr {200 + $lvl*300 + int(rand()*500)}]
    ::HighScore::Add2HighScore $appName $skill $who $score $lvl [clock seconds]
}

# For demo, lets add in a 3rd place result
set skill [lindex $skills [expr {$i % [llength $skills]}]]
lassign [lindex [dict get $::HighScore::HIGH $skill] 1] . score lvl
incr score -10
set n [::HighScore::Add2HighScore $appName $skill $who $score $lvl [clock seconds]]

# This one will say "Congratulations, you made the top ten."
::HighScore::ShowHighScore .high $appName $skill $n

file delete [::HighScore::GetHighScoreFileName $appName] ;# End clean for demo
return

gold25nov2017, added pix High Score Package screen png