Solitaire type games are OK, but it's more fun to have an opponent.
Lets rework the concentration game to let the computer
play against us.
We'll look at a few ways for the computer to decide what to do. Since
the computer knows where all the cards are, it would be easy to
program it to cheat and win all the time. That wouldn't make a fun game
for the human to play. (And who cares if the computer is having fun?)
We'll look at ways to program the computer to play without cheating.
Here's the things we'll have to change:
-
makeGameBoard : Modified to show computer score and the cards the computer has won.
-
startGame : Add initialization for computer play information.
-
playerTurn Add code to give the computer a chance to play if we don't find a match.
-
computerTurn a new procedure where the computer takes a turn.
Let's start with the makeGameBoard procedure. We can change
the makeGameBoard procedure without changing any other code.
That means we can test the new code to be sure it's working before we change
other code.
We'll need to add another pair of labels to show the computer's score,
and it would be cool to show which sets of cards have been won by each
player.
We can show a stack of cards the computer has found on one side of
the cards in play, and the stack of cards we've won on the other side.
All we need to do is to make the canvas wider.
The new game will look something like this:
Here's the new makeGameBoard procedure. The changes are
to make the canvas wider and adding new labels for the computer score.
################################################################
# proc makeGameBoard {}--
# Create the game board widgets - canvas and labels.
# Arguments
# NONE
#
# Results
# New GUI widgets are created.
#
proc makeGameBoard {} {
# Create and grid the canvas that will hold the card images
canvas .game -width 890 -height 724 -bg gray
grid .game -row 1 -column 1 -columnspan 6
# Create and grid the labels for turns and score
label .lmyScoreLabel -text "My Score"
label .lmyScore -textvariable concentration(player,score)
label .lcompScoreLabel -text "Computer Score"
label .lcompScore -textvariable concentration(computer,score)
label .lturnLabel -text "Turn"
label .lturn -textvariable concentration(turn)
grid .lmyScoreLabel -row 0 -column 1 -sticky e
grid .lmyScore -row 0 -column 2 -sticky w
grid .lcompScoreLabel -row 0 -column 3 -sticky e
grid .lcompScore -row 0 -column 4 -sticky w
grid .lturnLabel -row 0 -column 5 -sticky e
grid .lturn -row 0 -column 6 -sticky w
}
|
The changes to startGame are also simple. We need to
add a new variable to initialize the computer score to 0, and to
set the location for the cards the computer has matched.
A program is easier to understand if you use some kind of naming
convention for the variables you use in that program.
In this program, we've got
- data related to the player.
- data related to the computer.
- data related to the player's selection.
- data related to the game.
We can keep all of this data in a single array (concentration).
We can keep track of the different types of data
by using different names for the array index.
We can use one word for each type of data, and a second word
for what this particular data is. We can separate the words with a comma.
Here's the naming convention we'll use in this program.
| first word | definition
|
|---|
player,
| data related to the player.
|
computer
| data related to the computer.
|
selection
| data related to the player's selection.
|
a single word with no comma
| data related to the game.
|
When the data is the same (like the current score) we use the same
second word, but a different first word. So, the player's score
is saved in concentration(player,score) and the
computer's score is saved in concentration(computer,score).
We also need to track where to put the cards when we find a duplicate.
We have two sets of locations to keep track of, one for the computer and
one for the player. We can call these
values concentration(computer,x) and
concentration(computer,y) for the location where the
computer's cards go, and
concentration(player,x) and
concentration(player,y) for the location where the
players's cards go.
Remember that since the area for the stack of matched cards is 90
pixels wide, we need to change the start X location for laying out the
cards.
Here's the new procedure:
################################################################
# proc startGame {}--
# Actually start a game running
# Arguments
# NONE
#
# Results
# initializes per-game indices in the global array "concentration"
# The card list is randomized
# The GUI is modified.
#
proc startGame {} {
global concentration
set concentration(player,score) 0
set concentration(computer,score) 0
set concentration(turn) 0
set concentration(selected,rank) {}
set concentration(computer,x) 2
set concentration(computer,y) 2
set concentration(player,x) 800
set concentration(player,y) 2
set concentration(cards) [randomizeList $concentration(cards)]
# Save the height and width of the cards to make the code easier
# to read.
set height [image height [lindex $concentration(cards) 0]]
set width [image width [lindex $concentration(cards) 0]]
# Leave spaces between cards.
incr width
incr height
# Remove any existing items on the canvas
.game delete all
# Start in the upper left hand corner
set x 90
set y 2
# Step through the list of cards
for {set pos 0} {$pos < [llength $concentration(cards)]} {incr pos} {
# Place the back-of-a-card image on the board
# to simulate a card that is face-down.
.game create image $x $y -image back -anchor nw -tag card_$pos
# Add a binding on the card back to react
# to a player left-clicking the back.
.game bind card_$pos <ButtonRelease-1> "playerTurn $pos"
# Step to the next column (the width of a card)
incr x $width
# If we've put up 8 columns of cards, reset X to the
# far left, and step down one row.
if {$x >= [expr 90 + ($width * 8)] } {
set x 90
incr y $height
}
}
}
|
That's two down, and two to go. We can test our code after this change,
since none of the changes we've made so far interact with anything.
The next two changes need to be done at the same time. We'll add a test
to the playerTurn procedure to see if we've found a match,
and if we didn't find a match, it will call the computerTurn
procedure.
The playerTurn has an if statement like this:
if {$rank eq $concentration(selected,rank)} {
# Take care of processing a match
} else {
# Take care of processing a non-match
}
|
Our code will always take one branch or the other of this
if statement. We can put some code in here to track
whether or not the player found a match or not, and call the
computerTurn procedure if not. Leaving out a lot of code,
the new procedure looks like this:
if {$rank eq $concentration(selected,rank)} {
# Take care of processing a match
set foundMatch TRUE
} else {
# Take care of processing a non-match
set foundMatch FALSE
}
if {$foundMatch == FALSE} {
# If the player failed to find a match, the computer gets a turn
computerTurn
}
|
We can use the same moveCard command we wrote for the last game.
We have a prefix argument in the moveCards
procedure that determines whether a card gets moved to the player's
side of the board or the computer's side.
That gets us to the computerTurn procedure. This is
where the computer gets to prove how smart (or not) it is.
This procedure needs to do two things.
- Find out what cards are still in play.
- Decide which two cards to turn over.
Here are several different ways for the computer to keep track the cards
that are in play.
- Make the concentration(cards) list of cards into a list
of lists in which each list element has the card and
a value for whether or not the card is in play. When a
player finds a match and removes a card from play, change
the value.
- Create a list of all the cards in play when the game
starts and remove the cards when players find a match.
- Create an associative array with each index being a
card and the value being whether or not the card is
in play. Change the value whenever a card is taken out
of play.
All of these are good ways to keep track of the cards that are in
play. For complex games, you usually need to maintain a data
collection of some sort to track what's going on.
In this solitaire game, we already have a data collection that tracks
the cards that are in play and the ones that have been matched and
taken out of play. That information is all on the canvas.
We just have to figure out how to make the canvas tell us which
cards are which.
As you might expect, we'll use a couple of new commands to do this.
The Tk canvas can tell us what's been drawn on it. The command to do this is
the canvas find command. The canvas find command
will return a list of all the items drawn on the canvas that match
a test that we provide.
The syntax for the canvas find command is similar to the
other canvas commands:
canvasName
| The name of the canvas to search
|
find
| Find items on this canvas
|
option or option/value pair
| The test to use to identify items we want to find.
|
The find command can do lots of things depending on the
options we use to fine tune it. We can use the find
command to find the closest item to a particular location, or find
items that overlap other items, or (what we'll do for this test) find
all the items drawn on a canvas.
To find everything on the canvas, we use the option all with
no values.
The command to make a list of everything drawn on a canvas is this:
set itemList [.game find all]
|
OK, so now we have a list of the stuff on a canvas. That's very nice, but
is it useful? Well, almost.
What makes this useful (right now) is the canvas itemcget
command. We looked at the canvas itemconfigure command in
lesson 18. As you undoubtably recall, the
canvas itemconfigure command lets us set an option for
something we've already created on the canvas.
The canvas itemcget command will tell us what value is
associated with one of these
options is. The format is just like the canvas itemconfigure
command, except that we leave out the value.
The syntax for the itemcget command is:
canvasName
| The name of the canvas that has this item on it.
|
itemcget
| Retrieve the value for a a configuration option of an item on this canvas.
|
tagOrId
| A Tag or other identifier to specify which item or items to configure.
|
-option
| The value for this option will be returned.
|
To get the image associated with the first card on the canvas, we'd
use a line like this:
set firstCardImage [.game itemcget card_0 -image]
|
Now for the tricky part - all the cards that are still in play will
be sitting face-down in the middle of the board. If the image associated
with a card is back then that card is in play, and if it's
not back, we don't need to worry about it.
Here's how we make a list of all the cards that are currently
available to be picked. Look at the itemcget command for
the -tags option. We'll look at that after the code.
# Look at everything on the canvas. If it's a 'back' image
# it's a card that's still in play.
# The tag associated with the canvas item will be something like
# card_NUMBER where number is the position in the list of cards
# that this canvas item is related to.
foreach item [.game find all] {
if {[.game itemcget $item -image] eq "back"} {
lappend cardTags [lindex [.game itemcget $item -tag] 0]
}
}
|
So, what's with that lindex command? We mentioned how Tcl
sometimes gives you free stuff. One of the things the canvas gives you
for free is an extra tag named current. Whatever canvas
item (card image) is under the cursor will get the tag
current added to its list of tags. We can use the
lindex command to get the first (0'th) element in the list, which will
always be our card_# tag. The current
tag always gets added to the end of the list, never the beginning.
Sometimes we need to work around the language being helpful in order
to get something done.
Once we've got a list of available tags, we've got to decide what
the computer's turn will be. It's got to select two cards.
This gets into a field of computer science called Artificial
Intelligence. Artificial Intelligence is defined as the
science of making a computer do something that we'd consider a sign of
intelligence if a human did it.
We leave out things like adding numbers. A bunch of beans on a wire
can add numbers. We don't consider an abacus to be intelligent.
Activities like writing poetry, solving algebra equations, analyzing
the stock market, or playing a game require Intelligence. The
Intelligence can be real or artificial, depending on whether you're a
human or a machine. (Just how often humans demonstrate real
intelligence is left as an exercise for the reader.)
There are lots of techniques for creating artificial intelligence. Some
actually try to mimic how the human brain works, some start with a clever
human analyzing all the possibilities for how something will behave
and making a list of what to do whenever something else happens, and some
just use a clever trick or two.
For this game, we won't even use a clever trick. We'll just use a trick.
You may remember back when you were a little kid and first played
concentration that you didn't remember where any cards were. You just
turned cards over at random and if you were lucky, they matched.
That's how we'll teach the computer to play. In the next lesson or
two, we'll teach the computer to play a bit smarter.
The code above showed how the computer can get a list of cards to
select from. We've looked at using random numbers a lot so far. As
you recall, to get a number between 0 and 10, we'd get a random fraction,
multiply it by 10 and then round it down to the nearest whole number with
a command like this
set betweenZeroAndTen [expr int(rand() * 10)]
|
If we want to select a random card from the list, we can make up a
random number between 0 and the number of cards in the list, and then
use the lindex command to grab the card we want.
We can find the number of cards in the list with the llength
command.
# The length of the list is the number of cards still in play
set availableCount [llength $cardTags]
# Choose any card to start with - this is an index into
# the list of cards in play
set guess1 [expr int(rand() * $availableCount)]
set card1 [lindex $cardTags $guess1]
|
That selects one card to turn over, but we need two cards.
We could just do the same thing again to select the second card,
but what would stop us from selecting the same card twice? If you
think that wouldn't happen, and you can ignore such things, let me
assure you that anything that can go wrong in a computer program
eventually will. (Probably while you're showing the program to a
friend or teacher.)
What we need to do is find a random number between 0 and
the number of cards available, then find another different
random number. We want to loop until the second number is
not equal to the first.
Notice the word loop in that sentence. We
can do this with a for loop. We've used tests
like $x < 10, but we can also use a test like
$guess1 == $guess2 to stay in the loop for as
long as the first guess is the same as the second.
Here's how we'd make this loop. Look at the code and then
read the description after it.
# Make sure the second guess is not the same as the first.
# keep changing guess2 until it's not equal to guess1
# Start by setting the second card equal to the first -
# this forces it make at least one pass through the loop.
for {set guess2 $guess1} {$guess2 == $guess1} \
{ set guess2 [expr int(rand() * $availableCount)]} {
}
|
The 4 arguments to a for command are:
initialization
| A set of code that is executed once before the loop starts.
|
test
| A test that will continue looping while it tests true.
|
modifier
| Modifies the loop variable.
|
body
| A body of code to evaluate on each pass through the loop.
|
In this forguess2 the same value as guess1.
The test checks to see if guess1 is equal to guess2.
On the first pass, they are the same. We just assigned them the same value.
Since the test is true, the body of the for loop is evaluated. The
body is empty. This doesn't take very long.
After the body is evaluated, the modifier code is run.
This sets the variable guess2 to a new random value.
The next step is to do the test again. If $guess2 is still
the same as $guess1, the code will loop and try again.
If they aren't the same, we've got two cards, and we can continue.
The guesses we've got are location in the list of cards in play.
What we put in that list was the tag associated with the cards. The
tag is the word card followed by an underscore and the
position of this card in the list of all the cards in our deck.
We can get the canvas tags for the cards we chose with the
lindex command. That gives us two values like
card_2 and card_33.
What we need to do is check the rank of the cards those tags
reference.
The first step is to split the tag into the word card and
the number. That number is the position of the card in the list of
all cards.
We use the split command to split the word into a
list, and then use lindex to get the second element
from the list.
The code to get the card tags from the list and then the card
positon in the all-cards list looks like this.
# Get the tags from the available card list
set card1 [lindex $cardTags $guess1]
set card2 [lindex $cardTags $guess2]
# Split card_NUMBER into a list and grab the NUMBER part
# This is the position of these cards in the card image list
set pos1 [lindex [split $card1 _] 1]
set pos2 [lindex [split $card2 _] 1]
|
Now, we can get the card images from the list of all cards. The
card images are named with the suit first, then an underscore,
and then the rank. The Queen of Spades is named s_q
This code looks very similar to the code above, doesn't it?
# Get the images from the list of card images
set image1 [lindex $concentration(cards) $pos1]
set image2 [lindex $concentration(cards) $pos2]
# Split the card image name into the suit and rank.
# save the rank.
set rank1 [lindex [split $image1 _] 1]
set rank2 [lindex [split $image2 _] 1]
|
The final trick to the computerTurn procedure is that
when the ranks match, the computer gets another turn. To do this
we check to see if the cards are the same rank, and if they
are, we move them to the computer's side, increase the computer's
score and then call the computerTurn procedure again.
If the ranks match, we call the computerTurn procedure
from within itself. This sounds like like grabbing yourself by
the shoulders and picking yourself up, but with computers it works.
When a procedure calls itself, it's called a recursive procedure.
Computer programmers use recursive procedures when they need to
do something over and over (sort of like a loop), but the
stopping point will be based on a condition we can't know until we
get there, rather than a count that we sort of know in advance. Most
things that we can do with a loop can be done with recursion and
most things that are done with recursion can be done with loops,
but some types of tasks are easier with one than the other.
Here's the whole code for the computer's turn. This is a bit
longer than the procedures we've written so far.
################################################################
# proc computerTurn {}--
# The computer takes a turn
# Arguments
# NONE
#
# Results
# GUI can be modified.
# concentration(computer,score) may be modified. Game may end.
#
proc computerTurn {} {
global concentration
# Look at everything on the canvas. If it's a 'back' image
# it's a card that's still in play.
# The tag associated with the canvas item will be something like
# card_NUMBER where number is the position in the list of cards
# that this canvas item is related to.
foreach item [.game find all] {
if {[.game itemcget $item -image] eq "back"} {
lappend cardTags [lindex [.game itemcget $item -tag] 0]
}
}
# The length of the list is the number of cards still in play
set availableCount [llength $cardTags]
# Choose any card to start with - this is an index into
# the list of cards in play
set guess1 [expr int(rand() * $availableCount)]
# Set the second card equal to the first - this forces it
# to be changed in the while statement.
set guess2 $guess1
# Make sure the second guess is not the same as the first.
# keep changing guess2 until it's not equal to guess1
for {set guess2 $guess1} {$guess2 == $guess1} \
{ set guess2 [expr int(rand() * $availableCount)]} {
}
# Get the tags from the available card list
set card1 [lindex $cardTags $guess1]
set card2 [lindex $cardTags $guess2]
# Split card_NUMBER into a list and grab the NUMBER part
# This is the position of these cards in the card image list
set pos1 [lindex [split $card1 _] 1]
set pos2 [lindex [split $card2 _] 1]
# Get the images from the list of card images
set image1 [lindex $concentration(cards) $pos1]
set image2 [lindex $concentration(cards) $pos2]
# Flip the cards to show the front side.
flipImageX .game $card1 back $image1 gray
flipImageX .game $card2 back $image2 gray
# Split the card image name into the suit and rank.
# save the rank.
set rank1 [lindex [split $image1 _] 1]
set rank2 [lindex [split $image2 _] 1]
# update the screen and wait a couple seconds for the
# human player to see what's showing.
update idle;
after 2000
if {$rank1 eq $rank2} {
# If we're here, then the ranks are the same:
# The computer found a match!
# Increment the score,
# Move the cards to the computer stack.
# check to see we just got the last pair
# if not time to exit, we get to play again.
incr concentration(computer,score) 1
moveCards $card1 $card2 computer
if {[checkForFinished]} {
endGame
return
}
computerTurn
} else {
# If we're here, the computer didn't find a match
# flip the cards to be face down again
flipImageX .game $card1 $image1 back gray
flipImageX .game $card2 $image2 back gray
}
}
|
The checkForFinished procedure for the solitaire version
of concentration looked at the score, and if the score was equal to 24,
the game was over.
The new program will still need to check to see when the last pair of cards
have been matched. The new test for this is "is the sum of the scores
equal to 24". The new procedure looks like this:
################################################################
# proc checkForFinished {}--
# checks to see if the game is won. Returns true/false
# Arguments
#
#
# Results
#
#
proc checkForFinished {} {
global concentration
if { [expr $concentration(player,score) + $concentration(computer,score)] \
== 24} {
return TRUE
} else {
return FALSE
}
}
|
And that's all the changes. Here's the complete game.
################################################################
# proc loadImages {}--
# Load the card images
# Arguments
# NONE
#
# Results
# The global array "concentration" is modified to include a
# list of card image names
#
proc loadImages {} {
global concentration
# The card image fileNames are named as S_V.gif where
# S is a single letter for suit (Hearts, Diamonds, Spades, Clubs)
# V is a 1 or 2 character descriptor of the suit - one of:
# a k q j 10 9 8 7 6 5 4 3 2
#
# glob returns a list of fileNames that match the pattern - *_*.gif
# means all fileNames that have a underbar in the name, and a .gif extension.
foreach fileName [glob *_*.gif] {
# We discard the aces to leave 48 cards because that makes a
# 6x8 card display.
if {($fileName ne "c_a.gif") &&
($fileName ne "h_a.gif") &&
($fileName ne "d_a.gif") &&
($fileName ne "s_a.gif")} {
# split the card name (c_8) from the suffix (.gif)
set card [lindex [split $fileName .] 0]
# Create an image with the card name, using the file
# and save it in a list of card images: concentration(cards)
image create photo $card -file $fileName
lappend concentration(cards) $card
}
}
# Load the images to use for the card back and
# for blank cards
foreach fileName {blank.gif back.gif} {
# split the card name from the suffix (.gif)
set card [lindex [split $fileName .] 0]
# Create the image
image create photo $card -file $fileName
}
}
################################################################
# proc randomizeList {}--
# Change the order of the cards in the list
# Arguments
# originalList The list to be shuffled
#
# Results
# The concentration(cards) list is changed - no cards will be lost
# of added, but the order will be random.
#
proc randomizeList {originalList} {
# How many cards are we playing with.
set listLength [llength $originalList]
# Initialize a new (random) list to be empty
set newList {}
# Loop for as many cards as are in the card list at the
# start. We remove one card on each pass through the loop.
for {set i $listLength} {$i > 0} {incr i -1} {
# Select a random card from the remaining cards.
set p1 [expr int(rand() * $i)]
# Put that card onto the new list of cards
lappend newList [lindex $originalList $p1]
# Remove that card from the card list.
set originalList [lreplace $originalList $p1 $p1]
}
# Replace the empty list of cards with the new list that's got all
# the cards in it.
return $newList
}
################################################################
# proc makeGameBoard {}--
# Create the game board widgets - canvas and labels.
# Arguments
# NONE
#
# Results
# New GUI widgets are created.
#
proc makeGameBoard {} {
# Create and grid the canvas that will hold the card images
canvas .game -width 890 -height 724 -bg gray
grid .game -row 1 -column 1 -columnspan 6
# Create and grid the labels for turns and score
label .lmyScoreLabel -text "My Score"
label .lmyScore -textvariable concentration(player,score)
label .lcompScoreLabel -text "Computer Score"
label .lcompScore -textvariable concentration(computer,score)
label .lturnLabel -text "Turn"
label .lturn -textvariable concentration(turn)
grid .lmyScoreLabel -row 0 -column 1 -sticky e
grid .lmyScore -row 0 -column 2 -sticky w
grid .lcompScoreLabel -row 0 -column 3 -sticky e
grid .lcompScore -row 0 -column 4 -sticky w
grid .lturnLabel -row 0 -column 5 -sticky e
grid .lturn -row 0 -column 6 -sticky w
}
################################################################
# proc startGame {}--
# Actually start a game running
# Arguments
# NONE
#
# Results
# initializes per-game indices in the global array "concentration"
# The card list is randomized
# The GUI is modified.
#
proc startGame {} {
global concentration
set concentration(player,score) 0
set concentration(computer,score) 0
set concentration(turn) 0
set concentration(selected,rank) {}
set concentration(computer,x) 2
set concentration(computer,y) 2
set concentration(player,x) 800
set concentration(player,y) 2
set concentration(cards) [randomizeList $concentration(cards)]
# Save the height and width of the cards to make the code easier
# to read.
set height [image height [lindex $concentration(cards) 0]]
set width [image width [lindex $concentration(cards) 0]]
# Leave spaces between cards.
incr width
incr height
# Remove any existing items on the canvas
.game delete all
# Start in the upper left hand corner
set x 90
set y 2
# Step through the list of cards
for {set pos 0} {$pos < [llength $concentration(cards)]} {incr pos} {
# Place the back-of-a-card image on the board
# to simulate a card that is face-down.
.game create image $x $y -image back -anchor nw -tag card_$pos
# Add a binding on the card back to react
# to a player left-clicking the back.
.game bind card_$pos <ButtonRelease-1> "playerTurn $pos"
# Step to the next column (the width of a card)
incr x $width
# If we've put up 8 columns of cards, reset X to the
# far left, and step down one row.
if {$x >= [expr 90 + ($width * 8)] } {
set x 90
incr y $height
}
}
}
################################################################
# proc flipImageX {canvas canvasID start end background}--
# Makes it appear that an image object on a canvas is being flipped
# Arguments
# canvas The canvas holding the image
# canvasID The identifier for this canvas item
# start The initial image being displayed
# end The final image to display
# background The color to show behind the image being flipped.
# This is probably the canvas background color
#
# Results
# configuration for the canvas item is modified.
#
proc flipImageX {canvas canvasID start end background} {
global concentration
# Get the height/width of the image we'll be using
set height [image height $start]
set width [image width $start]
# The image will rotate around the X axis
# Calculate and save the center, since we'll be using it a lot
set centerX [expr $width / 2]
# Create a new temp image that we'll be modifying.
image create photo temp -height $height -width $width
# Copy the initial image into our temp image, and configure the
# canvas to show our temp image, instead of the original image
# in this location.
temp copy $start
$canvas itemconfigure $canvasID -image temp
update idle
after 25
# copy the start image into the temp with greater
# subsampling (making it appear like more and more of an
# edge view of the image).
# Move the start of the image to the center on each pass
# through the loop
for {set i 2} {$i < 8} {incr i} {
set left [expr $centerX - $width / (2 * $i)]
set right [expr $centerX + $width / (2 * $i)]
temp put $background -to 0 0 $width $height
temp copy -to $left 0 $right $height -subsample $i 1 $start
update idle
after 10
}
# copy the end image into the temp with less and less
# subsampling (making it appear like less and less of an
# edge view of the image).
# Move the start of the image away from thecenter on each pass
# through the loop
for {set i 8} {$i > 1} {incr i -1} {
set left [expr $centerX - $width / (2 * $i)]
set right [expr $centerX + $width / (2 * $i)]
temp put $background -to 0 0 $width $height
temp copy -to $left 0 $right $height -subsample $i 1 $end
update idle
after 10
}
# configure the canvas to show the final image, and
# delete our temporary image
$canvas itemconfigure $canvasID -image $end
image delete temp
}
################################################################
# proc playerTurn {position}--
# Selects a card for comparison, or checks the current
# card against a previous selection.
# Arguments
# position The position of this card in the deck.
#
# Results
# The selection fields of the global array "concentration"
# are modified.
# The GUI is modified.
#
proc playerTurn {position} {
global concentration
set card [lindex $concentration(cards) $position]
flipImageX .game card_$position back $card gray
set rank [lindex [split $card _] 1]
# If concentration(selected,rank) is empty, this is the first
# part of a turn. Mark this card as selected and we're done.
if {{} eq $concentration(selected,rank)} {
# Increment the turn counter
incr concentration(turn)
set concentration(selected,rank) $rank
set concentration(selected,position) $position
set concentration(selected,card) $card
} else {
# If we're here, then this is the second part of a turn.
# Compare the rank of this card to the previously saved rank.
if {$position == $concentration(selected,position)} {
return
}
# Update the screen *NOW* (to show the card), and pause for one second.
update idle
after 1000
# If the ranks are identical, handle the match condition
if {$rank eq $concentration(selected,rank)} {
# set foundMatch to TRUE to mark that we keep playing
set foundMatch TRUE
# Increase the score by one
incr concentration(player,score)
# Remove the two cards and their backs from the board
# .game itemconfigure card_$position -image blank
# .game itemconfigure card_$concentration(selected,position) -image blank
.game bind card_$position <ButtonRelease-1> ""
.game bind card_$concentration(selected,position) <ButtonRelease-1> ""
moveCards card_$position \
card_$concentration(selected,position) player
# Check to see if we've won yet.
if {[checkForFinished]} {
endGame
}
} else {
# If we're here, the cards were not a match.
# flip the cards to back up (turn the cards face down)
# set foundMatch to FALSE to mark that the computer goes next
set foundMatch FALSE
flipImageX .game card_$position $card back gray
flipImageX .game card_$concentration(selected,position) \
$concentration(selected,card) back gray
}
# Whether or not we had a match, reset the concentration(selected,rank)
# to an empty string so that the next click will be a select.
set concentration(selected,rank) {}
# The computer might play after our second card (or it might not)
if {$foundMatch eq "FALSE"} {
computerTurn
}
}
}
################################################################
# proc computerTurn {}--
# The computer takes a turn
# Arguments
# NONE
#
# Results
# GUI can be modified.
# concentration(computer,score) may be modified. Game may end.
#
proc computerTurn {} {
global concentration
after 10
# Look at everything on the canvas. If it's a 'back' image
# it's a card that's still in play.
# The tag associated with the canvas item will be something like
# card_NUMBER where number is the position in the list of cards
# that this canvas item is related to.
foreach item [.game find all] {
if {[.game itemcget $item -image] eq "back"} {
lappend cardTags [lindex [.game itemcget $item -tag] 0]
}
}
# The length of the list is the number of cards still in play
set availableCount [llength $cardTags]
# Choose any card to start with - this is an index into
# the list of cards in play
set guess1 [expr int(rand() * $availableCount)]
# Set the second card equal to the first - this forces it
# to be changed in the while statement.
set guess2 $guess1
# Make sure the second guess is not the same as the first.
# keep changing guess2 until it's not equal to guess1
for {set guess2 $guess1} {$guess2 == $guess1} \
{ set guess2 [expr int(rand() * $availableCount)]} {
}
# Get the tags from the available card list
set card1 [lindex $cardTags $guess1]
set card2 [lindex $cardTags $guess2]
# Split card_NUMBER into a list and grab the NUMBER part
# This is the position of these cards in the card image list
set pos1 [lindex [split $card1 _] 1]
set pos2 [lindex [split $card2 _] 1]
# Get the images from the list of card images
set image1 [lindex $concentration(cards) $pos1]
set image2 [lindex $concentration(cards) $pos2]
# Flip the cards to show the front side.
flipImageX .game $card1 back $image1 gray
flipImageX .game $card2 back $image2 gray
# Split the card image name into the suit and rank.
# save the rank.
set rank1 [lindex [split $image1 _] 1]
set rank2 [lindex [split $image2 _] 1]
# update the screen and wait a couple seconds for the
# human player to see what's showing.
update idle;
after 2000
if {$rank1 eq $rank2} {
# If we're here, then the ranks are the same:
# The computer found a match!
# Increment the score,
# Move the cards to the computer stack.
# check to see we just got the last pair
# if not time to exit, we get to play again.
incr concentration(computer,score) 1
moveCards $card1 $card2 computer
if {[checkForFinished]} {
endGame
return
}
computerTurn
} else {
# If we're here, the computer didn't find a match
# flip the cards to be face down again
flipImageX .game $card1 $image1 back gray
flipImageX .game $card2 $image2 back gray
}
}
################################################################
# proc moveCards {cvs id1 id2 prefix}--
# moves Cards from their current location to the
# score pile for
# Arguments
# id1 An identifier for a canvas item
# id2 An identifier for a canvas item
# prefix Identifier for which location should get the card
#
# Results
#
#
proc moveCards {id1 id2 prefix} {
global concentration
.game raise $id1
.game raise $id2
.game coords $id1 $concentration($prefix,x) $concentration($prefix,y)
.game coords $id2 $concentration($prefix,x) $concentration($prefix,y)
incr concentration($prefix,y) 30
}
################################################################
# proc checkForFinished {}--
# checks to see if the game is won. Returns true/false
# Arguments
#
#
# Results
#
#
proc checkForFinished {} {
global concentration
if { [expr $concentration(player,score) + $concentration(computer,score)] \
== 24} {
return TRUE
} else {
return FALSE
}
}
################################################################
# proc endGame {}--
# Provide end of game display and ask about a new game
# Arguments
# NONE
#
# Results
# GUI is modified
#
proc endGame {} {
global concentration
set position 0
foreach card $concentration(cards) {
.game itemconfigure card_$position -image $card
incr position
}
# Update the screen *NOW*, and pause for 2 seconds
update idle;
after 2000
.game create rectangle 250 250 450 400 -fill blue \
-stipple gray50 -width 3 -outline gray
button .again -text "Play Again" -command {
destroy .again
destroy .quit
startGame
}
button .quit -text "Quit" -command "exit"
.game create window 350 300 -window .again
.game create window 350 350 -window .quit
}
loadImages
makeGameBoard
startGame
|
Type or copy/paste that code into Komodo Edit and run it.
Modify the endGame procedure to tell you who
won. You can use an if command to compare the
scores, and then create a label on the screen with something
like "You Won" or "You Lost" in it.
The computerTurn procedure has some very similar
lines of code that get an element from a list, split it on an
underscore and extract the second element.
Write a procedure that accepts a list and a position and returns
the second part of the list element at that position. Replace the
lines of code in computerTurn with calls to this
procedure.
Rewriting a part of a computer program to be better (smaller, faster,
more maintainable, etc) is called refactoring.
This lesson covered a lot of material.
The big things are
- A program is easier to understand if you use a consistent naming convention.
- You can use the
for command to loop until any condition
is not true, not just to count.
- You can find items on a canvas with the canvas
find command.
- You can learn what the value of a configuration option for an item on the canvas is with the canvas
itemcget command.
- The canvas item under the mouse cursor always has a tag
current.
- A recursive procedure is one that calls itself.
- You can use the canvas as a data collection for some games.
-
Teaser
Copyright 2007 Clif Flynt
