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
returngold25nov2017, added pix
