Version 1 of Vertigo - a little Tk game
Updated 2005-02-07 18:31:12Fred Limouzin - 7 Feb 2005:
Here's a little game I coded about a year ago from my version in C. It's called Vertigo - a little Tk game and has been inspired by an old game from After-Dark (can't remember the platform). This is my first wiki page so bear with me if I'm making a mess out if it!
First of all, here's a screenshot: 
More information on rules and how to play can be found below in the help file.
You'll find the code and help file ready for download at this location: http://dire.straits.free.fr/vertigo ([L1 ]). Else copy and paste the help text below and save in a file called VertigoTkRegles.txt (b-t-w: regles = rules in French!). Then copy & paste the code into a file called (for instance) TkVertigo.tk.
It's by no mean state-of-the-art, but as usual with Tcl, had the advantage of being coded in just a few hours, whilst I had spent ages on the C version!
Any feedback, comments, etc. much appreciated. Have fun!
--Fred ([L2 ])
This is the help file. Copy everything in a text file named VertigoTkRegles.txt (must use this name as it is expected by the code thereafter).
help file begins Tk-Vertigo, by Frederic Limouzin Copyrights (c)2004-2005 Fred Limouzin (inspired by an old game from AFTER-DARK). Download it at http://dire.straits.free.fr/vertigo Goal: Set the people free! Secondary goal: Destroy all bricks. People: ======= There are as many people as columns. Each person (grey square at the top at the beginning), has a 'quality' randomly assigned at the beginning of a new game. Dark Grey = Quality of 0; light grey (nearly white) = 6. This corresponds to the maximum number of bricks directly below him from which he'll start his descend from his column; For instance, Renaud, second-to-none-alpinist, has a quality of 6. He'll be able to free himself if he stands on a column up to 6 bricks tall. Taller, he'll remain prisoner. On the other hand, Fred, desperately lacking exercise after all those hours spent on the front of a computer, has a quality of 0. He'll be set free only if all bricks below him are destroyed. Bricks and Blocs: ================ When a game starts, the game table is filled in randomly by picking a color for each brick. A bloc is a contiguous ensemble of at least 2 bricks of same color.. For instance, in the following game table: R B P V P V R R R P V R P P P B R P B P P R R R V V B B B B You find 4 blocs: . . . . P . . . . . . . . . P . R R R . . . P P P . R . . . . . P . P . R . . . . . . . . . R R R . . . . . . . . . . . . . . . . . . . . . V . . . . . . . . . V . . . . . . . . . . . . . . and . . . . . . . . . . . . . . . . . . . . . B B B B The goal is therefore to destroy all blocs by clicking on one of the bricks constituting the bloc we want to blast, and by doing so the columns will collapse and decrease their size, having the prisoners ever so slightly closer from freedom. Thanks to Gravity, not only apples, but bricks fall if the supporting bricks below them vanish. From the preceding example, if we click on a Red brick from the red 'C'-shaped-block, that bloc disapears. R B P V P V - - - P V - P P P B - P B P P - - - V V B B B B But due to Gravity, this is in fact what happens: R - - - P V - - - P V - P V P B - P P P P B P B V V B B B B Note that by blasting the Red C-shaped blocs, we have increased the size of the Blue and Purple blocs. When a full column is destroyed, the game is squeezed to the left. For instance if we now select a brick in the Blue bloc, the second column from the left will be empty. But after the squeezing force the result is in fact as follows: R - - - - V - - P - V - - P - B P - P - P P V P - V P P V - Scores: ======= Each freed prisoner gives a lame lonely point. If - and only if - all dudes have escaped from Shawshank, then each empty column adds another point If all bricks have been destroyed, a Bonus of 50 points is Oh So generously given to you time wasters. Finally, and also only in the case of an empty game table, the 'timed' Bonus left at the end of the game is added. When you start a game the timed-Bonus is 100. But hurry!, every second robes you of a precious point. 'Tries' is the number of games played in one session. 'Best' is the best score you got in one session of x games. Interface: ========== Although the C version gives very little configurability, the Tk Version gives plenty! Just browse the menu, and select the level of difficulty, which depends on many parameters. The game knows if its over and your are stuck with no more 'moves' or if you won. A message in red is displayed under the game table in both cases. Very often you'll be unable to destroy all bricks. Do not despair, hit the 'New Game' button and try again. Warning: I find this game very addictive. I will not be held responsible of O.D'ing, time wasted, sleep or job loss.... :-) Enjoy, Have Fun! --Fred [email protected] (personal email; not read regularly) (Note: I'd love to find a new job in Canada (esp. Vancouver, or elsewhere). Let me know if you want to see my CV as an IC Design Verification Engineer (7 year exp), or CAD tool developer. I've been using Tcl/Tk in the Verification flow. I'm French, currently working in Ireland, and filling in the application for a Canadian permanent resident Visa). end of help file
And now the tcl/tk code:
#!/bin/sh # [email protected] \ exec wish "$0" {1+"$@"} #/*************************************************/ #/* */ #/* Vertigo Game, 8 Septembre 2000 (C) */ #/* Vertigo Game, 2 January 2004 (TclTk 8.4) */ #/* (c)2000-2004 Frederic LIMOUZIN */ #/* [email protected] */ #/* download it from dire.straits.free.fr/vertigo */ #/* */ #/*************************************************/ set DEBUG false if {($tcl_platform(platform) eq {windows}) && ($DEBUG eq {true})} { console show } #-------------------------------------------------------------------- set fname(scores) VertigoScores.log ;# not used yet; tbd set fname(rules) VertigoTkRegles.txt # ----=================================================---- # Sorry half of my comments are in French! # (i.e. those that came straight from my version in C from which # I based the Tk Version) #// Table de Jeu Max(X)*Max(Y). x E [0;Max(X)-1]; y E [0;Max(Y)-1] #//rem: au debut, les personnage se trouvent en fait a y=Max(Y). set Options(XMax) 16 set Options(YMax) 10 set Options(BoxSize) 20 ;#pixels set Options(BoxBorder) 2 ;#pixels set Options(Offset) 10 #//Chaque brique a une qualite (example: couleur), choisi parmi les #//qualite disponibles dans l'espace defini par la constante ci-dessous: #// Qualite Brique E [0;Max(QBriq)-1] #//max: 6; conseille: 5 (3:facile; 6:difficile) set Options(ColorList) {red blue green yellow orange darkblue purple cyan} set Options(NbColors) 4 #//Les personnages ont une 'Qualite'; il s'agit du nombre de briques #//a partir et au dessous duquel ils entament leur dessente, et se #//liberent. #//Un personnage de qualite 3 pourra se liberer si la pile en dessous #//de lui est au maximum de 3 briques (il se libere donc s'il a 0,1,2 ou 3 #//briques sous lui, mais reset prisonier s'il y a 4 ou plus briques). #// Qualite Personne E [0;Max(QPers)-1] #//max: 6; conseille: 6 (0:difficile, 6:facile) set Options(QualMax) 6 set Options(QualMin) 0 #//Bonus set Options(AllFreedBonus) 50 set Options(TimeBonus) 101 # ----=================================================---- set Scores(points) 0 set Scores(essais) 0 set Scores(best) 0 set Scores(bonus) $Options(TimeBonus) set Scores(decbonus) off set Scores(game) off # ----=================================================---- wm title . "TkVertigo" wm iconname . "TkVertigo" wm resizable . 0 0 ;# not resizable in either x or y # ----=================================================---- set Menu(Root) .menubar set Menu(File) $Menu(Root).filemenu set Menu(Pref) $Menu(Root).prefmenu set Menu(Help) $Menu(Root).help menu $Menu(Root) . configure -menu $Menu(Root) $Menu(Root) add cascade -label "File" -menu $Menu(File) -underline 0 $Menu(Root) add cascade -label "Pref" -menu $Menu(Pref) -underline 0 $Menu(Root) add cascade -label "Help" -menu $Menu(Help) -underline 0 menu $Menu(File) -tearoff 0 $Menu(File) add command -label "Load" -command {Load} $Menu(File) add command -label "Save" -command {Save} $Menu(File) add separator $Menu(File) add command -label "Exit" -command {Quit} -underline 1 -accelerator "Ctrl-X" proc Load {} {tk_messageBox -message "Not Done yet..." -type ok} proc Save {} {tk_messageBox -message "Not Done yet..." -type ok} proc About {} {tk_messageBox -message "TkVertigo (for Tcl/Tk8.4+)\nCopyrights(c)2004-2005 Frederic Limouzin" -title TkVertigo -type ok} proc Quit {} { catch {after cancel $::afterId} res exit } #------------------ menu $Menu(Pref) -tearoff 1 -title "Preferences" menu $Menu(Pref).cols -tearoff 0 menu $Menu(Pref).rows -tearoff 0 menu $Menu(Pref).nbcolors -tearoff 0 menu $Menu(Pref).qmax -tearoff 0 menu $Menu(Pref).qmin -tearoff 0 menu $Menu(Pref).blocsz -tearoff 0 for {set i 5} {$i <= 20} {incr i} { $Menu(Pref).cols add radiobutton -label $i -value $i -variable Options(XMax) -command {InitBoard} $Menu(Pref).rows add radiobutton -label $i -value $i -variable Options(YMax) -command {InitBoard} } for {set i 3} {$i <= 8} {incr i} { $Menu(Pref).nbcolors add radiobutton -label $i -value $i -variable Options(NbColors) -command {InitBoard} } for {set i 0} {$i <= 6} {incr i} { $Menu(Pref).qmax add radiobutton -label $i -value $i -variable Options(QualMax) -command {InitBoard} $Menu(Pref).qmin add radiobutton -label $i -value $i -variable Options(QualMin) -command {InitBoard} } foreach i {15 20 30 40 60} { $Menu(Pref).blocsz add radiobutton -label $i -value $i -variable Options(BoxSize) -command {InitBoard} } $Menu(Pref) add cascade -label "Nb Cols" -menu $Menu(Pref).cols $Menu(Pref) add cascade -label "Nb Rows" -menu $Menu(Pref).rows $Menu(Pref) add separator $Menu(Pref) add cascade -label "Nb Colors" -menu $Menu(Pref).nbcolors $Menu(Pref) add separator $Menu(Pref) add cascade -label "Qual Max" -menu $Menu(Pref).qmax $Menu(Pref) add cascade -label "Qual Min" -menu $Menu(Pref).qmin $Menu(Pref) add separator $Menu(Pref) add cascade -label "Bloc Size" -menu $Menu(Pref).blocsz $Menu(Pref) add checkbutton -label "Bloc Border" -onvalue 2 -offvalue 0 -variable Options(BoxBorder) -command {InitBoard} #------------------ menu $Menu(Help) -tearoff 1 -title "Help Menu" $Menu(Help) add command -label "Help" -command {Help} $Menu(Help) add command -label "About" -command {About} # ----=================================================---- label .titre -text {~~---===[ Vertigo by Fred ]===---~~} -font {Courier} pack .titre -side top label .cprght -text {Copyrights (c)2000-2005 Fred-Phenix, Fred Limouzin} -justify right pack .cprght -side bottom -fill x -anchor e button .xit -text Exit -command {exit} pack .xit -side bottom -fill x set remtxt {} label .rembox -textvariable remtxt -foreground red pack .rembox -side bottom canvas .board -background black -relief sunken -borderwidth $Options(BoxBorder) pack .board -side left frame .score label .score.lbbon -text {Bonus:} label .score.bon -textvariable Scores(bonus) label .score.lbpts -text {Points:} label .score.pts -textvariable Scores(points) label .score.lbtry -text {Tries:} label .score.try -textvariable Scores(essais) label .score.lbbest -text {Best:} label .score.best -textvariable Scores(best) button .score.new -text {New Game} -command {NewGame} grid .score.lbbon -row 1 -column 1 grid .score.bon -row 1 -column 2 grid .score.lbpts -row 2 -column 1 grid .score.pts -row 2 -column 2 grid .score.lbtry -row 3 -column 1 grid .score.try -row 3 -column 2 grid .score.lbbest -row 4 -column 1 grid .score.best -row 4 -column 2 grid .score.new -row 5 -column 1 -columnspan 2 pack .score -side right # ----=================================================---- proc RectangleCoords {px py} { global Options set t [expr {(($Options(YMax) + 1) * $Options(BoxSize)) + (2 * $Options(Offset))}] set x1 [expr {($px * $Options(BoxSize)) + $Options(Offset)}] set y1 [expr {($py * $Options(BoxSize)) + $Options(Offset)}] set x2 [expr {$x1 + $Options(BoxSize)}] set y2 [expr {$y1 + $Options(BoxSize)}] return [list $x1 [expr {$t - $y1}] $x2 [expr {$t - $y2}]] } # ----=================================================---- proc ClickOnBox {px py} { global Board if {$::DEBUG eq {true}} { puts "$px,$py,$Board($px,$py,type),$Board($px,$py,color),$Board($px,$py,qual)" } DestroyBloc $px $py Freedom SkeezeEmptyCol TestEndGame } # ----=================================================---- proc TestEndGame {} { global Scores global Options global remtxt #games was over and still is! if {!$Scores(game)} { return off #game not over } elseif {[RemainingBloc]} { set remtxt {} #game over } else { set Scores(decbonus) off set Scores(game) off set rc [RemainingColumn] #All columns destroyed (hence all people freed) => Bonus if {$rc == 0} { set Scores(points) $Options(AllFreedBonus) incr Scores(points) $Scores(bonus) set remtxt "You Win!" #not all columns destroyed } else { #add nb of col destroyed ONLY when all people freed if {$Scores(points) == $Options(XMax)} { set remtxt "No more Remaining bloc left! Not all columns destroyed!" incr Scores(points) [expr {$Options(XMax) - $rc}] } else { set remtxt "No more Remaining bloc left! Not everyone free!" } } set Scores(bonus) 0 } } # ----=================================================---- proc NewGame {} { global Scores global remtxt global Options set remtxt {} incr Scores(essais) if {$Scores(points) > $Scores(best)} { set Scores(best) $Scores(points) } set Scores(points) 0 set Scores(bonus) $Options(TimeBonus) set Scores(decbonus) off InitBoard set Scores(decbonus) on set Scores(game) on DecBonus } # ----=================================================---- proc InitBoard {} { global Options global Board if {$Options(QualMax) < $Options(QualMin)} { foreach {Options(QualMin) Options(QualMax)} [list $Options(QualMax) $Options(QualMin)] {break;} ;#Quick Swap } eval .board delete [.board find all] .board configure -width [expr {($Options(XMax) + 1) * $Options(BoxSize)}] .board configure -height [expr {($Options(YMax) + 2) * $Options(BoxSize)}] array unset -nocomplain Board for {set i 0} {$i < $Options(XMax)} {incr i} { for {set j 0} {$j <= $Options(YMax)} {incr j} { if {$j == $Options(YMax)} { set q [expr {int(rand()*(1 + $Options(QualMax) - $Options(QualMin))) + $Options(QualMin)}] set Board($i,$Options(YMax),color) [format {#%06X} [expr {0x222222 * (1 + $q)}]] set Board($i,$Options(YMax),type) Person set Board($i,$Options(YMax),qual) $q } else { set Board($i,$j,color) [lindex $Options(ColorList) [expr {int(rand()*$Options(NbColors))}]] set Board($i,$j,type) Bric set Board($i,$j,qual) {} } .board create rectangle [RectangleCoords $i $j] \ -fill $Board($i,$j,color) -outline black -width $Options(BoxBorder) \ -tags tagcoord($i,$j) .board bind tagcoord($i,$j) <Button-1> [list ClickOnBox $i $j] } } } # ----=================================================---- proc Gravity {} { global Options global Board for {set i 0} {$i < $Options(XMax)} {incr i} { for {set j 0} {$j < $Options(YMax)} {incr j} { if {$Board($i,$j,type) eq "Empty"} { for {set jj [expr {$j+1}]} {$jj <= $Options(YMax)} {incr jj} { if {$Board($i,$jj,type) ne "Empty"} { foreach f {type color qual} e {Empty black {}} { set Board($i,$j,$f) $Board($i,$jj,$f) set Board($i,$jj,$f) $e } .board itemconfigure tagcoord($i,$j) -fill $Board($i,$j,color) .board itemconfigure tagcoord($i,$jj) -fill $Board($i,$jj,color) break; } } } } } } # ----=================================================---- proc Freedom {} { global Options global Board global Scores for {set i 0} {$i < $Options(XMax)} {incr i} { for {set j 0} {$j < $Options(QualMax)} {incr j} { if {($Board($i,$j,type) eq "Person") && ($Board($i,$j,qual) >= $j)} { set Board($i,$j,type) Empty foreach f {type color qual} e {Empty black {}} { set Board($i,$j,$f) $e } .board itemconfigure tagcoord($i,$j) -fill $Board($i,$j,color) incr Scores(points) } } } } # ----=================================================---- proc SkeezeEmptyCol {} { global Options global Board global Scores for {set i 0} {$i < [expr {$Options(XMax) - 1}]} {incr i} { if {$Board($i,0,type) eq "Empty"} { for {set ii [expr {$i+1}]} {$ii < $Options(XMax)} {incr ii} { if {$Board($ii,0,type) ne "Empty"} { for {set jj 0} {$jj < [expr {$Options(YMax)+1}]} {incr jj} { foreach f {type color qual} e {Empty black {}} { set Board($i,$jj,$f) $Board($ii,$jj,$f) set Board($ii,$jj,$f) $e } .board itemconfigure tagcoord($i,$jj) -fill $Board($i,$jj,color) .board itemconfigure tagcoord($ii,$jj) -fill $Board($ii,$jj,color) } break; } } } } } # ----=================================================---- proc Recurs_BlocOutline {x y c} { global Options global Board global MatrixDestruction global nbBricsInBloc if {($Board($x,$y,type) eq "Bric")&&($Board($x,$y,color) eq $c)&&($MatrixDestruction($x,$y) == 0)} { set MatrixDestruction($x,$y) 1 incr nbBricsInBloc if {$x > 0} { Recurs_BlocOutline [expr {$x-1}] $y $c } if {$x < $Options(XMax)-1} { Recurs_BlocOutline [expr {$x+1}] $y $c } if {$y > 0} { Recurs_BlocOutline $x [expr {$y-1}] $c } if {$y < $Options(YMax)-1} { Recurs_BlocOutline $x [expr {$y+1}] $c } } } # ----=================================================---- proc BlocOutline {x y} { global Options global Board global MatrixDestruction global nbBricsInBloc set nbBricsInBloc 0 for {set i 0} {$i < $Options(XMax)} {incr i} { for {set j 0} {$j < $Options(YMax)} {incr j} { set MatrixDestruction($i,$j) 0 } } set currcolor $Board($x,$y,color) Recurs_BlocOutline $x $y $currcolor #if bloc (2 brics of same color side-by-side or more) then return 1 if {$nbBricsInBloc > 1} { return 1 #else (isolated bric) return 0 } else { return 0 } } # ----=================================================---- proc DestroyBloc {x y} { global Options global Board global MatrixDestruction if {[BlocOutline $x $y] == 1} { for {set i 0} {$i < $Options(XMax)} {incr i} { for {set j 0} {$j < $Options(YMax)} {incr j} { if {$MatrixDestruction($i,$j) == 1} { foreach f {type color qual} e {Empty black {}} { set Board($i,$j,$f) $e } .board itemconfigure tagcoord($i,$j) -fill $Board($i,$j,color) } } } } Gravity } # ----=================================================---- proc RemainingBloc {} { global Options set br 0 for {set i 0} {$i < $Options(XMax)} {incr i} { for {set j 0} {$j < $Options(YMax)} {incr j} { if {[BlocOutline $i $j] > 0} { set br 1 break; } } if {$br} { break; } } return $br } # ----=================================================---- proc RemainingColumn {} { global Options global Board set colleft 0 while {($colleft < $Options(XMax)) && ($Board($colleft,0,type) ne "Empty")} { incr colleft } return $colleft } # ----=================================================---- proc DecBonus {} { global Scores if {$Scores(bonus) > 0} { #decr bonus every second set ::afterId [after 1000 {uplevel #0 {DecBonus}}] if {$Scores(decbonus)} { incr Scores(bonus) -1 } } else { set Scores(decbonus) off } } # ----=================================================---- proc Help {} { global fname toplevel .help wm title .help "Vertigo Help" text .help.txt -relief sunken -bd 2 -font {Courier} \ -yscrollcommand {.help.scroll set} \ -setgrid 1 -height 30 scrollbar .help.scroll -command {.help.txt yview} button .help.exit -text "Exit" -command {destroy .help} -anchor center pack .help.exit -side bottom -fill x pack .help.txt -side left -fill y pack .help.scroll -side right -fill y set Rf [open $fname(rules) r] .help.txt insert end [read $Rf [file size $fname(rules)]] close $Rf } # ----=================================================---- .score.new invoke