Go Fish/PureBasic

Go Fish/PureBasic is part of Go Fish. You may find other members of Go Fish at Category:Go Fish.

If 'computer' is entered for the player's name, it will play itself. <lang PureBasic>#MaxCards = 52 ;Max #of cards possible in a card collection

1. ShortCardRanks$ = "2;3;4;5;6;7;8;9;10;J;Q;K;A"
2. LongCardRanks$ = "deuce;three;four;five;six;seven;eight;nine;ten;jack;queen;king;ace"
3. CardRankArticles$ = "a;a;a;a;a;a;an;a;a;a;a;a;an"
4. CardRankPlurals$ = "s;s;s;s;es;s;s;s;s;s;s;s;s"
5. NumCardRanks = 13
6. MaxHistorySize = 4 ;must be 0 < #MaxHistorySize <= #NumCardRanks
7. Indent$ = " "

Structure _membersCardCollectionClass

 *vtable.i 
 size.i ;# of cards present
 card.i[#MaxCards] ;collection content, stores rank# for each card, suits aren't used

EndStructure

Interface CardCollectionObj

 init(isDeck = #False)
 count()
 countMatchingCards(rank)
 drawFrom(src.CardCollectionObj)
 pushCard(rank)
 popCard()
 removeCards(rank)
 transferCards(src.CardCollectionObj, rank)
 shuffle()
 show.s()
 sort()

EndInterface

Structure _membersPlayerClass

 *vtable.i 
 isHuman.i 
 name.s
 score.i
 hand.CardCollectionObj
 ranksOpponentHas.i[#NumCardRanks]  ;priority 1 for requests, index = (rank# - 1)
 newRanksDrawn.i[#NumCardRanks]     ;priority 2 for requests, index = (rank# - 1)
 history.i[#MaxHistorySize]         ;priority 3 requests are selected with the help of this history

EndStructure

Interface PlayerObj

 init(deck.CardCollectionObj)
 getScore()
 getName.s()
 isHuman() ;boolean
 countCardsInHand()
 takeTurn(otherPlayer.PlayerObj,deck.CardCollectionObj)
 draw(deck.CardCollectionObj)
 shiftHistory()
 setHistory(rank)
 createDiffHistory(*hand.CardCollectionObj)
 request(dest.CardCollectionObj, rank) ;boolean
 updateScore()

EndInterface

Enumeration

 #HumanGamePlayer
 #ComputerGamePlayer

EndEnumeration

Structure _membersGameClass

 *vtable.i 
 turn.i  ;player# whose turn it is
 deck.CardCollectionObj
 player.PlayerObj[2]

EndStructure

Interface GameObj

 play()
 displayWinner() 

EndInterface

Procedure handleError(condition,Msg$)

 If Not condition
   MessageRequester("Error",Msg$)
   End
 EndIf 

EndProcedure

Procedure.s verboseCardInfo(rank)

 If rank > 0 And rank <= #NumCardRanks
   ProcedureReturn StringField(#LongCardRanks$, rank, ";")
 EndIf 

EndProcedure

Procedure CC_init(*this._membersCardCollectionClass, isDeck)

 Protected i
 If isDeck
   *this\size = #MaxCards - 1
   For i = 0 To #MaxCards - 1
     *this\card[i] = (i % #NumCardRanks) + 1
   Next
 Else
   *this\size = -1
 EndIf 

EndProcedure

Procedure CC_countCards(*this._membersCardCollectionClass)

 ProcedureReturn *this\size + 1

EndProcedure

Procedure CC_countMatchingCards (*this._membersCardCollectionClass, rank)

 Protected i, count
 For i = 0 To *this\size
   If *this\card[i] = rank
     count + 1
   EndIf
 Next
 ProcedureReturn count 

EndProcedure

Procedure CC_drawFrom(*this._membersCardCollectionClass, *source.CardCollectionObj)

 Protected cardDrawn, *dest.CardCollectionObj = *this
 cardDrawn = *source\popCard()
 *dest\pushCard(cardDrawn)
 ProcedureReturn cardDrawn 

EndProcedure

Procedure CC_pushCard(*this._membersCardCollectionClass, rank)

 If *this\size < #MaxCards And (rank > 0 And rank <= #NumCardRanks)
   *this\size + 1
   *this\card[*this\size] = rank
 EndIf 

EndProcedure

Procedure CC_popCard(*this._membersCardCollectionClass)

 Protected rank
 If *this\size >= 0
   rank = *this\card[*this\size]
   *this\size - 1
 EndIf 
 ProcedureReturn rank ;returns #Null if no cards are in collection

EndProcedure

Procedure CC_removeCards(*this._membersCardCollectionClass, rank)

 ;remove all cards matching rank
 Protected i
 
 For i = *this\size To 0 Step -1
   If *this\card[i] = rank
     If *this\size < (#MaxCards - 1) And i <> *this\size
       MoveMemory(@*this\card[i + 1], @*this\card[i], SizeOf(Integer) * *this\size - i)
     EndIf 
     *this\size - 1
   EndIf 
 Next 

EndProcedure

Procedure CC_transferCards(*this._membersCardCollectionClass, *source.CardCollectionObj, rank)

 ;move all cards matching rank from source and return count
 Protected i, cardsTransfered, *src._membersCardCollectionClass = *source, blankcard
 If *source <> #Null
   For i = *src\size To 0 Step -1
     If *src\card[i] = rank
       *this\size + 1
       *this\card[*this\size] = *src\card[i]
       If *src\size < (#MaxCards - 1) And i <> *src\size
         MoveMemory(@*src\card[i + 1], @*src\card[i], SizeOf(Integer) * (*src\size - i))
       EndIf 
       *src\size - 1
       cardsTransfered + 1
     EndIf
   Next 
 EndIf 
 
 ProcedureReturn cardsTransfered

EndProcedure

Procedure CC_shuffle(*this._membersCardCollectionClass)

 Protected w, i
 If *this\size >= 0
   Dim shuffled(*this\size)
   
   For i = *this\size To 0 Step -1
     w = Random(i)
     shuffled(i) = *this\card[w]
     If w <> i
       *this\card[w] = *this\card[i]
     EndIf
   Next
   
   For i = 0 To *this\size
     *this\card[i] = shuffled(i)
   Next
 EndIf 

EndProcedure

Procedure.s CC_showCards(*this._membersCardCollectionClass)

 Protected i, output$
 
 For i = 0 To *this\size
   output$ + StringField(#ShortCardRanks$, *this\card[i],";")
   If i <> *this\size: output$ + ", ": EndIf 
 Next
 ProcedureReturn output$

EndProcedure

Procedure CC_sortCards(*this._membersCardCollectionClass)

 Protected low, high
 Protected firstIndex, lastIndex = *this\size
   
 If lastIndex > firstIndex + 1
   low = firstIndex + 1
   While low <= lastIndex
     high = low
     While high > firstIndex
       If *this\card[high] < *this\card[high - 1]
         Swap *this\card[high - 1], *this\card[high]
       Else
         Break
       EndIf
       high - 1
     Wend
     low + 1
   Wend
 EndIf

EndProcedure

Procedure newCardCollection(isDeck = #False)

 Protected *newCardCollection._membersCardCollectionClass = AllocateMemory(SizeOf(_membersCardCollectionClass))
 If *newCardCollection
   *newCardCollection\vtable = ?vTable_CardCollectionClass
   CC_init(*newCardCollection, isDeck)
 EndIf
 ProcedureReturn *newCardCollection 

EndProcedure

Procedure _player_validateRank(inputRank.s)

 ;check if inputRank is valid, allows verbose and abbrieviated entries
 Protected rankSize, result, validatedRank, i
 
 inputRank = Trim(inputRank)
 rankSize = Len(inputRank)
 Select rankSize
   Case 0
   Case 1
     inputRank = UCase(inputRank)
     If inputRank = "T": inputRank = "10": EndIf ;handle an alias
     For i = 1 To #NumCardRanks
       If inputRank = StringField(#ShortCardRanks$, i, ";")
         validatedRank = i
         Break
       EndIf 
     Next
   Default
     inputRank = LCase(inputRank)
     
     result = FindString(inputRank, " ", 1)
     If result
       inputRank = Left(inputRank, result - 1)
     EndIf
     
     result = FindString(inputRank, "s", 2)
     If result
       inputRank = Left(inputRank, result - 1)
     EndIf
     
     ;handle some aliases
     Select inputRank
       Case "10"
         inputRank = "ten"
       Case "two"
         inputRank = "deuce"
     EndSelect
     
     For i = 1 To #NumCardRanks
       If inputRank = StringField(#LongCardRanks$, i, ";")
         validatedRank = i
         Break
       EndIf 
     Next 
 EndSelect
 
 ProcedureReturn validatedRank ;returns #Null if rank not valid

EndProcedure

Procedure player_init(*this._membersPlayerClass, *deck.CardCollectionObj)

 Protected i, rankDrawn
 ;draw 9 cards from *deck and add them to player's hand
 If *deck <> #Null
   For i = 1 To 9
     rankDrawn = *this\hand\drawFrom(*deck)
     *this\newRanksDrawn[rankDrawn - 1] = #True
   Next 
 EndIf 

EndProcedure

Procedure player_getScore(*this._membersPlayerClass)

 ProcedureReturn *this\score

EndProcedure

Procedure.s player_getName(*this._membersPlayerClass)

 ProcedureReturn *this\name

EndProcedure

Procedure player_isHuman(*this._membersPlayerClass)

 ProcedureReturn *this\isHuman

EndProcedure

Procedure player_countCardsInHand(*this._membersPlayerClass)

 ProcedureReturn *this\hand\count()

EndProcedure

Procedure player_takeTurn(*this._membersPlayerClass, otherPlayer.PlayerObj, *deck.CardCollectionObj)

 Static tempHand.CardCollectionObj
 Protected player.PlayerObj = *this, *otherPlayer._membersPlayerClass = otherPlayer
 Protected request.s, rank, cardsReceived, turnOver = #False, AI_stage, i
 
 If Not tempHand
   tempHand = newCardCollection()
   handleError(tempHand,"Unable to allocate enough memory.")
 EndIf 
 
 While Not turnOver
   ;prepare request
   If player\isHuman()
     *this\hand\sort()
     Repeat
       PrintN(#CRLF$ + "Your hand: " + *this\hand\show())
       rank = *this\hand\popCard() ;peek at last card
       *this\hand\pushCard(rank)
       If *this\hand\countMatchingCards(rank) = *this\hand\count()
         Print(#CRLF$ + "You are obligated to ask for " + verboseCardInfo(rank) + StringField(#CardRankPlurals$, rank, ";") + ".")
         Break
       Else
         Print(#CRLF$ + player\getName() + ", which rank do you want?")
         rank = _player_validateRank(Input())
         Select rank
           Case #Null 
             PrintN("** That's not a valid rank, try one from your hand.")
           Case 1 To #NumCardRanks
             If *this\hand\countMatchingCards(rank)
               Break
             Else
               PrintN("** You don't have any of those cards in your hand, choose another.")  
             EndIf
         EndSelect
       EndIf 
     ForEver
   Else
     Repeat
       Select AI_stage
         Case 0
           ;request all known cards that are in both opponent's and player's hand
           rank = #Null
           For i = 1 To #NumCardRanks
             If *this\ranksOpponentHas[i - 1] And *this\hand\countMatchingCards(i)
               *this\ranksOpponentHas[i - 1] = 0
               rank = i
             EndIf
           Next 
           
           If rank
             player\shiftHistory()
             player\setHistory(rank)
           Else
             AI_stage = 1
             tempHand\init()
             For i = 1 To #NumCardRanks
               If *this\newRanksDrawn[i - 1]
                 If *this\hand\countMatchingCards(i)
                   tempHand\pushCard(i)
                 Else
                   *this\newRanksDrawn[i - 1] = #False ;card is no longer in hand
                 EndIf 
               EndIf 
             Next 
           EndIf
         Case 1
           ;request a random card from the drawn list
           tempHand\shuffle()
           rank = tempHand\popCard()
           
           If rank
             *this\newRanksDrawn[rank - 1] = #False
             player\shiftHistory()
             player\setHistory(rank)
           Else
             AI_stage = 2
           EndIf 
         Case 2 
           ;request a random card from remaining cards
           player\shiftHistory()
           player\createDiffHistory(tempHand)
           tempHand\shuffle()
           rank = tempHand\popCard()
           player\setHistory(rank)
       EndSelect
     Until rank <> #Null
     
     Print(#CRLF$ + player\getName() + " asks for all of ")
     If otherPlayer\isHuman()
       Print("your ")
     Else
       Print(otherPlayer\getName() + "'s ")
     EndIf
     PrintN(verboseCardInfo(rank) + StringField(#CardRankPlurals$, rank, ";") + ".")
   EndIf   
   
   cardsReceived = otherPlayer\request(*this\hand, rank)
   If cardsReceived
     If player\isHuman()
       Print(#CRLF$ + #Indent$ + "You are given ")
     ElseIf Not otherPlayer\isHuman()
       Print(#CRLF$ + #Indent$ + player\getName() + " is given ")
     Else
       Print(#CRLF$ + #Indent$ + "You give " + player\getName() + " ")
     EndIf 
     Print(Str(cardsReceived) + " " + verboseCardInfo(rank))
     If cardsReceived > 1
       PrintN(StringField(#CardRankPlurals$, rank, ";") + ".")
     Else 
       PrintN(".")
     EndIf 
     
     player\updateScore()
     If otherPlayer\countCardsInHand() = 0
       If Not otherPlayer\draw(*deck)
         turnOver = #True ;game over
       EndIf
     EndIf 
     If player\countCardsInHand() = 0
       If Not player\draw(*deck)
         turnOver = #True ;game over
         Continue
       Else
         AI_stage = 0
       EndIf 
     EndIf 
   Else 
     turnOver = #True
   EndIf 
 Wend
   
 ;go fish
 If *deck\count()
   If otherPlayer\isHuman()
     Print(#CRLF$ + "You tell ")
   Else 
     Print(#CRLF$ + otherPlayer\getName() + " tells ")
   EndIf
   
   If player\isHuman()
     Print("you to 'Go Fish!'")
   Else
     Print(player\getName() + " to 'Go Fish!'")
   EndIf
 EndIf 
 Repeat
   If Not player\draw(*deck)
     Break ;game over, exit loop
   EndIf
 Until player\countCardsInHand() > 0

EndProcedure

Procedure player_draw(*this._membersPlayerClass, *deck.CardCollectionObj)

 ;draw a card from *deck and display card if player is human
 ;return #True if a card was drawn, return #False if no cards drawn
 Protected isGoFish = #False, player.PlayerObj = *this
 If *deck And *deck\count()
   If *this\hand\count() = 0
     If player\isHuman()
       Print(#Indent$ + "You are")
     Else
       Print(#Indent$ + *this\name + " is")
     EndIf 
     Print(" out of cards, so ")
   Else
     isGoFish = #True
     Print(#Indent$)
   EndIf 
   
   Protected cardDrawn = *this\hand\drawFrom(*deck)
   If Not *this\hand\countMatchingCards(cardDrawn)
     *this\newRanksDrawn[cardDrawn - 1] = #True
   EndIf 
   If player\isHuman()
     If isGoFish
       Print("Y")
     Else
       Print("y")
     EndIf 
     PrintN("ou draw a card and get " + StringField(#CardRankArticles$, cardDrawn, ";") + " " + StringField(#LongCardRanks$, cardDrawn, ";") + ".")
   Else
     PrintN(*this\name + " draws a card.")
   EndIf 
   
   If *this\hand\count() > 3
     player\updateScore()
   EndIf 
   ProcedureReturn #True
 Else
   ;No more cards in deck.
   ProcedureReturn #False
 EndIf 

EndProcedure

Procedure player_shiftHistory(*this._membersPlayerClass)

 Protected i

 For i =#MaxHistorySize - 1 To 1 Step - 1
   *this\history[i] = *this\history[i - 1]
 Next 

EndProcedure

Procedure player_setHistory(*this._membersPlayerClass, rank)

 *this\history[0] = rank

EndProcedure

Procedure player_createDiffHistory(*this._membersPlayerClass, *hand.CardCollectionObj)

 ;update *hand to contain only ranks in hand but not in history
 Protected i, activeHistorySize
 ;determine history size (= min(#MaxHistorySize, uniqueRankCount)
 If *hand
   For i = 1 To #NumCardRanks
     If activeHistorySize = #MaxHistorySize: Break: EndIf 
     If *this\hand\countMatchingCards(i)
       activeHistorySize + 1
     EndIf 
   Next 
   ;add all card-ranks from player's hand
   *hand\init()
   For i = 1 To #NumCardRanks
     If *this\hand\countMatchingCards(i)
       *hand\pushCard(i)
     EndIf 
   Next 
   ;remove cards that are also in history
   For i = 0 To activeHistorySize - 1
     *hand\removeCards(*this\history[i])
   Next
 EndIf 

EndProcedure

Procedure player_request(*this._membersPlayerClass, *dest.CardCollectionObj, rank)

 ;report how many cards of rank are present in hand
 ;also mark the requested card as being in the opponent's hand
 Protected cardsPresent
 If *dest <> #Null
   cardsPresent = *dest\transferCards(*this\hand, rank)
   *this\ranksOpponentHas[rank - 1] = 1
   *this\newRanksDrawn[rank - 1] = #False ;no need to keep in two places
   ProcedureReturn cardsPresent
 Else
   ProcedureReturn #Null
 EndIf 

EndProcedure

Procedure player_updateScore(*this._membersPlayerClass)

 ;check for complete books and remove them from hand while increasing score
 Protected bookCount, bookFound, rank, player.PlayerObj = *this
 
 Repeat
   bookFound = #False
   For rank = #NumCardRanks To 1 Step -1
     If *this\hand\countMatchingCards(rank) = 4
       *this\hand\removeCards(rank)
       If player\isHuman()
         Print(#CRLF$ + #Indent$ + "You complete")
       Else
         Print(#CRLF$ + #Indent$ + *this\name + " completes")
       EndIf 
       PrintN(" a book of " + verboseCardInfo(rank) + StringField(#CardRankPlurals$, rank, ";") + ".")
       *this\ranksOpponentHas[rank - 1] = #False
       bookFound = #True
       *this\score + 1
       
       If player\ishuman()
         Print("** You now have ")
       Else
         Print("** " + player\getName() + " now has ")
       EndIf 
       Print(Str(player\getScore()) + " book"): If player\getScore() > 1: Print("s"): EndIf
       PrintN(".")
       Break
     EndIf 
   Next
 Until bookFound = #False

EndProcedure

Procedure newPlayer(isHuman = #False)

 Protected *newPlayer._membersPlayerClass = AllocateMemory(SizeOf(_membersPlayerClass))
 
 If *newPlayer
   *newPlayer\vtable = ?vTable_PlayerClass
   *newPlayer\score = 0
   If Not isHuman
     *newPlayer\name = "Computer"
   Else
     *newPlayer\isHuman = #True
     Protected name.s
     Print("What is your name?")
     name = Trim(Input())

     Select name
       Case ""
         name = "Human"
       Case "computer", "Computer"
         name = "*Computer*"
         *newPlayer\isHuman = #False
       Default
         If Left(name,1) <> UCase(Left(name,1))
           name = UCase(Left(name,1)) + LCase(Mid(name,2))
         EndIf
     EndSelect
     *newPlayer\name = name
   EndIf 
   *newPlayer\hand = newCardCollection()
   handleError(*newPlayer\hand,"Unable to initialize hand.")
 EndIf
 ProcedureReturn *newPlayer 

EndProcedure

Procedure game_Play(*this._membersGameClass)

 *this\deck\shuffle()
 Print(#CRLF$ + "Both players are dealt 9 cards.")
 *this\player[#HumanGamePlayer]\init(*this\deck)
 *this\player[#ComputerGamePlayer]\init(*this\deck)
 *this\player[#HumanGamePlayer]\updateScore()
 *this\player[#ComputerGamePlayer]\updateScore()
 
 PrintN(#Indent$ + *this\player[*this\turn ! 1]\getName() + " will go first.")
 PrintN(#CRLF$ + "-----------------------------------------------------------------------------")
 ;take turns until all books scored (i.e. no cards are in deck or hands)
 Repeat
   *this\turn ! 1
   *this\player[*this\turn]\takeTurn(*this\player[*this\turn ! 1], *this\deck)
   PrintN(#CRLF$ + "-----------------------------------------------------------------------------")
 Until *this\deck\count() = 0 And *this\player[*this\turn]\countCardsInHand() = 0

EndProcedure

Procedure game_DisplayWinner(*this._membersGameClass)

 Protected winningPlayer = #HumanGamePlayer
 
 If *this\player[#ComputerGamePlayer]\getScore() > *this\player[#HumanGamePlayer]\getScore()
   winningPlayer = #ComputerGamePlayer
 EndIf 
 PrintN(*this\player[winningPlayer]\getName() + " won with a score of " + Str(*this\player[winningPlayer]\getScore()) + " books.")

EndProcedure

Procedure newGame()

 Protected *newGame._membersGameClass = AllocateMemory(SizeOf(_membersGameClass))
 If *newGame
   *newGame\vtable = ?vTable_GameClass
   *newGame\player[#HumanGamePlayer] = newPlayer(#True) ;'human'
   *newGame\player[#ComputerGamePlayer] = newPlayer()   ;computer
   *newGame\deck = newCardCollection(#True)
   If *newGame\player[#HumanGamePlayer] = #Null Or *newGame\player[#ComputerGamePlayer] = #Null Or *newGame\deck = #Null
     PrintN("Unable to initialize.") 
     End ;all allocated memory is automatically freed at program's end
   EndIf 
   
   *newGame\turn = Random(1)
 EndIf 
 ProcedureReturn *newGame

EndProcedure

DataSection

 vTable_GameClass:
 Data.i @game_Play()
 Data.i @game_DisplayWinner()
 
 vTable_PlayerClass:
 Data.i @player_init()
 Data.i @player_getScore()
 Data.i @player_getName()
 Data.i @player_isHuman()
 Data.i @player_countCardsInHand()
 Data.i @player_takeTurn()
 Data.i @player_draw()
 Data.i @player_shiftHistory()
 Data.i @player_setHistory()
 Data.i @player_createDiffHistory()
 Data.i @player_request()
 Data.i @player_updateScore()
 
 vTable_CardCollectionClass:
 Data.i @CC_init()
 Data.i @CC_countCards()
 Data.i @CC_countMatchingCards()
 Data.i @CC_drawFrom()
 Data.i @CC_pushCard()
 Data.i @CC_popCard()
 Data.i @CC_removeCards()
 Data.i @CC_transferCards()
 Data.i @CC_shuffle()
 Data.i @CC_showCards()
 Data.i @CC_sortCards()

EndDataSection

handleError(OpenConsole(), "Couldn't open console.") PrintN("===================") PrintN("Let's play GO FISH.") PrintN("===================") Define game.GameObj = newGame() handleError(game,"Couldn't initialize game.")

game\play()

PrintN(#CRLF$ + "Game over.") game\displayWinner()

PrintN(#CRLF$ + "Press Enter to exit.") Input()</lang>