23: Let the wookie win

Previous
Let the wookie win
Next

The last version of the concentration game looked pretty cool, but the computer plays very stupidly.

A computer should be smarter than that!

When you play concentration, you start the game without knowing where the cards are. As the cards are turned over you learn which cards are where. Maybe you memorize them in order, or just try to think of where they are.

You might even remember the cards like "king over 2 down 3, Q over 1 down 2", etc.

The computer can learn where the cards are located almost like you do.

The computer already has a list of cards in memory. We use that list instead of the board locations when the computer chooses cards at random.

We can create a similar list as the computer learns where the cards are, so instead of "king 2 over 3 down", the computer will remember the cards as "K position 5, Q Position 7", etc.

Since this is data that we need to keep around for as long as the game is running, we'll put the list of known cards in the concentration global variable. Since these are the known cards, we'll use known as the index.

We could write our program to read and write the concentration(known) list in the playerTurn and computerTurn procedures. We'd have a few new lines of code to add and delete cards from the list as necessary.

The problem with this way of writing the code is that we would end up with special purpose code spread in different places in the program. If we needed change the layout of the data, we'd have to search out every place that the data is used.

It's better to writee a set of procedures to interface with the list and then make the other code use these procedures to access the list of known cards.

As a rule, when you have data in specific format, it's best to write a set of procedures that will access that data, rather than spreading code to access the data around your program.

The advantage of this sort of abstraction is that if we find a better way to handle the computer learning cards, we have all the code that knows about the concentration(known) list in one place. We can modify that without changing the rest of the code.

We'll add three new procedures to the concentration game to deal with the list of known cards:

addKnownCard card position: Add a card and position to the list of known cards.
removeKnownCardscard1 card2: Remove a pair of cards and positions from the list of known cards.
findKnownPair: Search the list to see if there are any pairs of cards.

The first procedure we'll need is actually the simplest procedure.

We can use the lappend command from lesson 17 to append the new card and position to the list like this:


proc addKnownCard  {card pos} {
  global concentration
  lappend concentration(known) $card $pos
}

The problem with this code is that it doesn't check to see if a card is already known. If we end up putting cards into the list multiple times, our program will get confused and will try to do things like match the King of Spades to the King of Spades.

So, we need to check the list to see if the card is already in it.

We could do that with a foreach loop like this one.


set found 0
foreach {oldCard position} $concentration(known) {
  if {$oldCard eq $card} {
    set found 1
  }
}

When this loop is finished, the variable found will be one if we found a match to the new card, or zero if not.

That works, but it can be slow if your list is very long, and it's tedious to type a loop every time you need to search a list. Searching a list is something we need to do a lot in computer programs.

Therefore Tcl includes a fast command to search lists. It's the lsearch command. The lsearch command takes two arguments: the list to search, and a pattern to search for.

Syntax:lsearch list pattern

list The list to search for new elements.
pattern A pattern to search the list for.

This code searches the list {a b c d e} for the element c and stores that location in the variable position.


  set position [lsearch {a b c d e} c]

The value in position will be 2, since the first list element is in position 0.

If the element that we're searching for isn't in the list, then the lsearch command returns a negative 1.

Here's a version of the addKnownCard procedure that only adds a card to the list if it's not already there.


proc addKnownCard  {card pos} {
  global concentration
  set p [lsearch $concentration(known) $card]
  if {$p < 0} {
    lappend concentration(known) $card $pos
  }   
}

Now that we can add cards to the list, the next trick is to remove them.

The known card list has two elements for each card - the card's identifier (like s_2 for the 2 of spades), and the card's location.

We can figure out if a card is in the list by using the lsearch command, and we can build a new list without the identifier and location with the lreplace command that was introduced in lesson 17.

The lreplace command will return a new list that's just like the original except for replacing some elements with new elements.

If we don't give the lreplace command any elements to add, it will replace the elements with nothing. This deletes those elements from the list.

The removeKnownCard procedure looks like this:


proc removeKnownCard {cardID} {
  global concentration
      set p [lsearch $concentration(known) $cardID]
      if {$p >= 0} {
        set concentration(known) \
            [lreplace $concentration(known) $p [expr $p + 1]]
      }
}

The last new procedure is the findKnownPair procedure.

This procedure will look through the list of cards the computer knows to see if there are any cards in the list with the same rank. If there are any matches, the procedure returns a list of the two cards. If it there aren't any matches, it returns an empty list.

Suppose we have a list of known cards like this:


  set concentration(known) {s_a 1 h_k 3 d_a 5 s_q 6}

There are two aces in this list - the first element is the Ace of Spades and the fifth element is the Ace of Diamonds.

We need to step through this list looking for cards with the same rank.

We can step through the list of cards with a loop like this, using the split command (also introduced in lesson 17) to split the card identifier into the suit and rank.


  foreach {card1 pos1} $concentration(known) {
    foreach {suit rank} [split $card1 _] {break;}
    # Look for another card of the same rank
  }

We know how to search for an identical card, but how do we search for a card when we don't know exactly what we're searching for?

The pattern that we give to the lsearch command can be exactly the characters in the list element. This is what we did to make sure that a card wasn't already in the list.

The pattern can also be a glob pattern, similar to the patterns we discussed with the glob command in (guess which lesson).

Just like we used a * as a wildcard in the names of files with the glob command, we can use a * to find a card of any suit with a certain rank using an lsearch command like this:


  lsearch $concentration(known) *_$rank

The problem with this is that the lsearch usually starts at the beginning of the list, so it will always find the first list element that matches the pattern. That won't help us find the second card in the list.

There's an option we can use with the lsearch command to make it start looking at a particular location. That option is -start.

Here's code starts searching for a list element that ends in _a at the beginning of the list. It will assign the value 0 to the variable p1.


  set concentration(known) {s_a 1 h_k 3 d_a 5 s_q 6}
  set p1 [lsearch $concentration(known) *_a]

This code tells Tcl to start at the second element in the list. It will assign the value 4 to the variable p2:


  set concentration(known) {s_a 1 h_k 3 d_a 5 s_q 6}
  set p2 [lsearch -start 1 $concentration(known) *_a]

That's all the new commands we need to step through the list of known cards, find the rank of each card, and then search the rest of the list for any other cards of that rank.

If this procedure finds a two cards of the same rank, it will return the positions of those two cards. If it never finds a match, the foreach loop will finish, and the procedure will return an empty list.


proc findKnownPair {} {
  global concentration
      
  # concentration(known) is a list of
  # suit_rank1 position1 suit_rank2 position2 ...
  # Start searching from just after the current position
   
  set currentPosition 1

  foreach {card1 pos1} $concentration(known) {
    foreach {suit rank} [split $card1 _] {break;}

    # Look for a card with the same rank in the list
    set p [lsearch -start $currentPosition $concentration(known) "*_$rank"]
    if {$p >= 0} {
      # If here, we found a match.
      set card2 [lindex $concentration(known) $p]
      incr p
      set pos2 [lindex $concentration(known) $p]
      return [list $pos1 $pos2]
    }
    incr currentPosition 2
  }
  return {}
}

That takes care of the new procedures. One to add new cards to the list of known cards, one to remove the cards, and one to find any matches in the list of known cards.

Now we need to merge calls to these procedures into the computer and player turns procedures.

This is actually the easy part.

In the playerTurn procedure we need to add every card that the player selects to the list of known cards.

The playerTurn procedure gets called when a player left-clicks on a card back. This procedure is passed the position of the card the player clicked. The first thing that the playerTurn procedure does is to look in the list of all cards to find out what card is at that position so it can flip the card over to show you what card it is.

Once we know what the card is and its position, we can add it to the known card list like this;


proc playerTurn {position} {   
  global concentration

  set card [lindex $concentration(cards) $position]
  flipImageX .game card_$position back $card gray

  addKnownCard $card $position
  # ...

When the player finds a match, we've got to take those cards out of the computer's list of known cards. Otherwise, the computer will try to score points by matching cards we've already taken off the board.

We can remove the cards from the computer's list of known cards as soon as the playerTurn procedure realizes that the player has found a match.

This shows the new lines right after the test to see if the two cards are the same rank:


    # If the ranks are identical, handle the match condition
    if {$rank eq $concentration(selected,rank)} {
    
      removeKnownCard $card
      removeKnownCard $concentration(selected,card)
 # ...

The computerTurn procedure needs a few more changes.

The computerTurn procedure used to call the chooseRandomPair procedure to select two cards to turn over. The name of this procedure reminds us that it's not being clever, just making sure that it doesn't try to turn over the same card twice.

Now we need to make the comptureTurn procedure call the findKnownPair procedure first, to see if knows about any matches. If there aren't any matches, then it will call the chooseRandomPair to get two cards.

Once the program has selected two cards, it can add them to the list of known cards.

The new code looks like this:


proc computerTurn {} {
  global concentration
    
  set pair [findKnownPair]
     
  if {[llength $pair] != 2} {
    set pair [chooseRandomPair]
  } 
   
  set pos1 [lindex $pair 0]
  set pos2 [lindex $pair 1]

  # Get the images from the list of card images
  set image1 [lindex $concentration(cards) $pos1]
  set image2 [lindex $concentration(cards) $pos2]
 
  # Add the cards to the known list.
  addKnownCard  $image1 $pos1  
  addKnownCard  $image2 $pos2

The other change is to remove the cards from the known list when the computer finds a match. This is very similar to the code in the playerTurn procedure:


  if {$rank1 eq $rank2} {
    removeKnownCard $image1
    removeKnownCard $image2

That's all the changes.

Here is the complete game, all in one place.


################################################################
# 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(known) {}

  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 removeKnownCard {}--
#    Remove a pair of known cards from the known card list
# Arguments
#   card1	a card value like d_4
#   card2	a card value like d_4
# 
# Results
#   State index known is modified if the cards were known
# 
proc removeKnownCard {cardID} {
  global concentration
      set p [lsearch $concentration(known) $cardID]
      if {$p >= 0} { 
        set concentration(known) \
	    [lreplace $concentration(known) $p [expr $p + 1]]
      }
}

proc addKnownCard  {card pos} {
  global concentration
puts "add Known $card $pos"
  set p [lsearch $concentration(known) $card]
  if {$p < 0} {
    lappend concentration(known) $card $pos
  }
}
################################################################
# 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
  
  addKnownCard $card $position
  
  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)} {

      removeKnownCard $card 
      removeKnownCard $concentration(selected,card)

      # 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 chooseRandomPair {}--
#    Choose two random face-down cards from the board
# Arguments
#   NONE
# 
# Results
#   No Side Effects
# 
proc chooseRandomPair {} {
  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"} {
      # Tag is something like card_#, where # is the
      #  index of this card in concentration(cards)
      set tag [lindex [.game itemcget $item -tag] 0]
      lappend cards [lindex [split $tag _] 1]
    }
  }

  # The length of the list is the number of cards still in play

  set availableCount [llength $cards]

  # Choose any card to start with - this is an index into
  # the list of cards in play
  set guess1 [expr int(rand() * $availableCount)]

  # 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)]} {
  }
puts "RTN: $guess1 $guess2 -> [list [lindex $cards $guess1] [lindex $cards $guess2]]"
  return [list [lindex $cards $guess1] [lindex $cards $guess2]]
}

################################################################
# proc findKnownPair {}--
#    Return a pair of cards that will match, 
#    Return an empty list if no known match available.
#
# Arguments
#   NONE
# 
# Results
#   No Side Effect
# 

proc findKnownPair {} {
  global concentration
  
  # concentration(known) is a list of 
  # suit_rank1 position1 suit_rank2 position2 ...
  # Start searching from just after the current position

  set currentPosition 1

  foreach {card1 pos1} $concentration(known) {
    foreach {suit rank} [split $card1 _] {break;}

    # Look for a card with the same rank in the list
    set p [lsearch -start $currentPosition $concentration(known) "*_$rank"]
    if {$p >= 0} {
      # If here, we found a match.  
      set card2 [lindex $concentration(known) $p]
      incr p
      set pos2 [lindex $concentration(known) $p]
      return [list $pos1 $pos2]
    }
    incr currentPosition 2
  }
  return {}
}

################################################################
# 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
  
  set pair [findKnownPair]

  if {[llength $pair] != 2} {
    set pair [chooseRandomPair]
  }

  set pos1 [lindex $pair 0]
  set pos2 [lindex $pair 1]

  # Get the images from the list of card images
  set image1 [lindex $concentration(cards) $pos1]
  set image2 [lindex $concentration(cards) $pos2]
  
  # Add the cards to the known list.
  addKnownCard  $image1 $pos1
  addKnownCard  $image2 $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]

  # Flip the cards to show the front side.

  flipImageX .game card_$pos1 back $image1 gray
  flipImageX .game card_$pos2 back $image2 gray

  # 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} {
    removeKnownCard $image1 
    removeKnownCard $image2

    # 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 card_$pos1 card_$pos2 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 card_$pos1 $image1 back gray
    flipImageX .game card_$pos2 $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
  
  # Get the X and Y coordinates  for the two cards

  foreach {c1x c1y} [.game coords $id1] {break}
  foreach {c2x c2y} [.game coords $id2] {break}
  
  # Calculate the distance that this card is from where
  # it needs to go.  Do this for both the X and Y dimensions.
  # Do it for both cards.

  set d1x [expr $concentration($prefix,x) - $c1x ]
  set d1y [expr $concentration($prefix,y) - $c1y ]

  set d2x [expr $concentration($prefix,x) - $c2x ]
  set d2y [expr $concentration($prefix,y) - $c2y ]
  
  # We'll take 10 steps to move the cards to the new location.
  # Figure out 1/10 the distance to the score pile for each card.

  set step1x [expr $d1x / 10]
  set step1y [expr $d1y / 10]

  set step2x [expr $d2x / 10]
  set step2y [expr $d2y / 10]
  
  # Loop 10 times, moving the card 1/10'th the distance to the
  # new location.  Pause 1/10 of a second (100 ms) between movements.
  # It will take 1 second to move a card from the current location to
  # the desired location.

  for {set i 0} {$i < 10} {incr i} {
    .game move $id1 $step1x $step1y
    .game move $id2 $step2x $step2y
    update idle
    after 100
  }
  
  # Set the matched card location to stack the next card 
  # a bit lower than the previous cards.
  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

In this version of the game the computer never forgets. You can make the computer play more like a person by removing some cards from the list of known cards whenever it gets too long.

Add a new procedure to remove the oldest card from the list, and then add a test to the computerTurn procedure to call this procedure whenever there are more then 10 cards in the known list.

You can also do this by making a procedure that will trim the list whenver it has more than 10 cards, and invoke that each time the computerTurn procedure is started.

You can make how well the computer plays change by making a new concentration element for the maximum number of cards in the known list. Call that concentration(maxKnownCards).

Modify the procedure to use this array index instead of hardcoding the number 10.

You can make the concentration game change to match the player by having the game modify the concentration(maxKnownCards) parameter. Every time the computer wins, make that number smaller, and every time the human wins, make it larger.

Add these changes to the concentration game and play a few games to see how the computer adjusts how well it plays to match how well you play.

We covered a lot in this lesson.

The really big thing is the example of how to make the computer play a game the way a person plays. This is a simple form of Artificial Intelligence. We programmed the computer to choose cards the way would learn where the cards are and make their selection.

We also learned a new command, the lsearch command.

You can search a list quickly with the lsearch command.
The lsearch can search for list elements by an exact match or a pattern.
The lsearch command will search from the first element by default, or you can tell it which element to start from with the -start option
You can control how well a computer plays by changing a configuration parameter.

That's enough card games. The next few lessons will show you how to make an arcade game. We'll learn a few more commands, and a few more ways to use Tcl.

It's time for Space Invaders.

Previous
Next

`list`	The list to search for new elements.
`pattern`	A pattern to search the list for.

Copyright 2007 Clif Flynt