[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 ====== ---- [gold]25nov2017, added pix [High Score Package screen png] ---- !!!!!! %| [Category Package] | [Category Games] |% !!!!!!