Previous

Playing against the computer

Next

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:

  1. makeGameBoard : Modified to show computer score and the cards the computer has won.
  2. startGame : Add initialization for computer play information.
  3. playerTurn Add code to give the computer a chance to play if we don't find a match.
  4. 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

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.

  1. Find out what cards are still in play.
  2. Decide which two cards to turn over.

Here are several different ways for the computer to keep track the cards that are in 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


Teaser

Previous

Next


Copyright 2007 Clif Flynt