# Land, Air and Sea # This code was last modified on 12/07/1998 # Chris Palmer (palmech@earlham.edu) # If you're new to Tcl/Tk and you want to run this, # just copy the entire page (select all --> copy) and paste # it into the Console of Wish. You may have to hit # but then it should work fine. # Wish (Tcl/Tk compiler) is available at http://www.scriptics.com/ # Sorry about the lack of commenting on this guy, but I created it purely # so I could learn Tcl/Tk, so it's sloppy and not well marked. # # InitializeVariables clears the variables for the beginning of the program # proc InitializeVariables {} { global dieRoll endofgame currentPlayer set dieRoll "-" set endofgame 0 set currentPlayer 1 } # # InitializeBoard sets up the board # proc InitializeBoard {} { for {set counter 0} {$counter < 3} {incr counter} { global Player1 Player2 frame .main.board.player1.$counter frame .main.board.player2.$counter for {set counter2 0} {$counter2 < 2} {incr counter2} { set Player1($counter,$counter2) "-" set Player2($counter,$counter2) "-" button .main.board.player1.$counter.$counter2 -text "___" -width 5 switch $counter$counter2 \ 00 {bind .main.board.player1.0.0 {AssignDieValue 1 0 0}} \ 01 {bind .main.board.player1.0.1 {AssignDieValue 1 0 1}} \ 10 {bind .main.board.player1.1.0 {AssignDieValue 1 1 0}} \ 11 {bind .main.board.player1.1.1 {AssignDieValue 1 1 1}} \ 20 {bind .main.board.player1.2.0 {AssignDieValue 1 2 0}} \ 21 {bind .main.board.player1.2.1 {AssignDieValue 1 2 1}} pack .main.board.player1.$counter.$counter2 -side left -padx 5 button .main.board.player2.$counter.$counter2 -text "___" -width 5 switch $counter$counter2 \ 00 {bind .main.board.player2.0.0 {AssignDieValue 2 0 0}} \ 01 {bind .main.board.player2.0.1 {AssignDieValue 2 0 1}} \ 10 {bind .main.board.player2.1.0 {AssignDieValue 2 1 0}} \ 11 {bind .main.board.player2.1.1 {AssignDieValue 2 1 1}} \ 20 {bind .main.board.player2.2.0 {AssignDieValue 2 2 0}} \ 21 {bind .main.board.player2.2.1 {AssignDieValue 2 2 1}} pack .main.board.player2.$counter.$counter2 -side left -padx 5 } pack .main.board.player1.$counter .main.board.player2.$counter } set instruction "Roll the Die to begin" message .main.instruction -text $instruction -width 200 } # # WipeBoard clears the board to play again # proc WipeBoard {} { global Player1 Player2 dieRoll for {set counter 0} {$counter < 3} {incr counter} { for {set counter2 0} {$counter2 < 2} {incr counter2} { set Player1($counter,$counter2) "-" set Player2($counter,$counter2) "-" .main.board.player1.$counter.$counter2 configure -text "___" .main.board.player2.$counter.$counter2 configure -text "___" } } InitializeVariables .main.resultOfRoll configure -text $dieRoll .main.players.one configure -background beige -foreground black .main.players.two configure -background grey -foreground black } # # ShowIntro puts the instructions to the screen. # proc ShowIntro {} { pack forget .main.menu.showIntro frame .endIntro set IntroMsg1 "Welcome to Land, Air and Sea! This is a very simple game in which the object is to control as much 'territory' as possible There are three territories (Land, Air and Sea) each represented by a horizontal row of buttons (two for each player)." set IntroMsg2 "Turns consist of \"Rolling the Die\" and then placing the number generated (from 1 to 10) in any available space." set IntroMsg3 "Whomever has the greatest total (calculated from multiplying the two bases in the territory together) wins the territory at the end of the game. Ties are possible. The general strategy is togive yourself the high numbers, and your opponent the low ones!" set IntroMsg4 "Player 1 always goes first, and the active player will be highlighted up top. Good luck and enjoy!" message .endIntro.message1 -text $IntroMsg1 -width 200 message .endIntro.message2 -text $IntroMsg2 -width 200 message .endIntro.message3 -text $IntroMsg3 -width 200 message .endIntro.message4 -text $IntroMsg4 -width 200 button .endIntro.terminate -text "Done" -width 20 bind .endIntro.terminate {KillIntro} pack .endIntro.message1 .endIntro.message2 .endIntro.message3 .endIntro.message4 .endIntro.terminate pack .endIntro } # # KillIntro gets rid of the introduction/rules # proc KillIntro {} { global loopme after 500 { bind forget .endIntro destroy .endIntro pack .main.menu.showIntro } } # # RollDie rolls the die and assigns the value to $dieRoll # proc RollDie {} { global dieRoll endofgame set dieRoll 11 set Player1(0,0) "-" set Player2(0,0) "-" while {$dieRoll > 10} { set dieRoll [expr {round([expr {rand() * 10 + 1}])}] if {$endofgame == 0} {.main.instruction configure -text "Place the roll in a box"} } .main.resultOfRoll configure -text $dieRoll } # # AssignDieValue places the value of the die into the correct box # proc AssignDieValue {player first second} { global dieRoll Player1 Player2 endofgame if {$endofgame == 1} {return} if {$dieRoll != "-"} { if {$player == 1} { if {$Player1($first,$second) == "-"} { set Player1($first,$second) $dieRoll .main.board.player1.$first.$second configure -text $dieRoll SwitchPlayers .main.instruction configure -text "Now the other player Rolls the Die" .main.resultOfRoll configure -text "-" set dieRoll "-" } else { .main.instruction configure -text "That place is already set. Choose again." } } else { if {$Player2($first,$second) == "-"} { set Player2($first,$second) $dieRoll .main.board.player2.$first.$second configure -text $dieRoll SwitchPlayers .main.instruction configure -text "Now the other player Rolls the Die" .main.resultOfRoll configure -text "-" set dieRoll "-" } else { .main.instruction configure -text "That place is already set. Choose again." } } } else { .main.instruction configure -text "You need to Roll the Die first" } TestGameStatus } # # SwitchPlayers switches the active player # proc SwitchPlayers {} { global currentPlayer if {$currentPlayer == 1} { set currentPlayer 2 .main.players.one configure -background grey .main.players.two configure -background beige } else { set currentPlayer 1 .main.players.one configure -background beige .main.players.two configure -background grey } } # # TestGameStatus checks if the game is over or not. # proc TestGameStatus {} { global Player1 Player2 endofgame set endofgame 1 for {set counter3 0} {$counter3 < 3} {incr counter3} { for {set counter4 0} {$counter4 < 2} {incr counter4} { if {$Player1($counter3,$counter4) == "-"} { set endofgame 0 return } if {$Player2($counter3,$counter4) == "-"} { set endofgame 0 return } } } TotalTheScore } # # TotalTheScore adds up the two players' scores and announces the winner # proc TotalTheScore {} { set LeftScore 0 set RightScore 0 global Player1 Player2 for {set counter3 0} {$counter3 < 3} {incr counter3} { set LeftSubTotal [expr $Player1($counter3,0) * $Player1($counter3,1)] set RightSubTotal [expr $Player2($counter3,0) * $Player2($counter3,1)] if {$LeftSubTotal > $RightSubTotal} {incr LeftScore} elseif {$LeftSubTotal < $RightSubTotal} {incr RightScore} } if {$LeftScore > $RightScore} { .main.players.one configure -background blue -foreground white .main.players.two configure -background grey } elseif {$LeftScore < $RightScore} { .main.players.two configure -background blue -foreground white .main.players.one configure -background grey } else { .main.players.one configure -background blue -foreground white .main.players.two configure -background blue -foreground white } .main.instruction configure -text "The final score is $LeftScore : $RightScore" pack .main.theEnd pack .main.restart } # # NewGame restarts the game # proc NewGame {} { WipeBoard pack forget .main.theEnd pack forget .main.restart .main.instruction config -text "New Game! Player 1, Roll the Die" } # # # MAIN CODE # # InitializeVariables frame .main button .main.rollTheDie -text "Roll the Die!" message .main.resultOfRoll -text $dieRoll bind .main.rollTheDie {RollDie} pack .main.rollTheDie pack .main.resultOfRoll frame .main.board frame .main.board.player1 frame .main.board.player2 InitializeBoard frame .main.players message .main.players.one -text "Player 1" -background beige message .main.players.two -text "Player 2" pack .main.players.one .main.players.two -side left -padx 30 frame .main.menu button .main.menu.showIntro -text "Instructions" -width 10 bind .main.menu.showIntro {ShowIntro} button .main.menu.quit -text "Quit" -width 10 bind .main.menu.quit {exit} pack .main.menu.quit .main.menu.showIntro -padx 10 -fill x button .main.restart -text "Play Again?" bind .main.restart {NewGame} message .main.theEnd -text "Game Over" # pack .main.players pack .main.board.player1 -side left pack .main.board.player2 -side right pack .main.board pack .main.instruction pack .main.menu pack .main