That’s it - we’re finished!
All we need to do is celebrate winning - once we’ve figured out that the player has won, that is.
Rule: When all the cards are in the Ace stacks, then the player has won
From this rule we can say that we can only win after the action to move a card into the ace stack. Therefore, we only need to check if the player has won in this single place.
let updateAceSourceStack game keystroke =
let updatedGame =
match keystroke with
| Number sourceStack when (sourceStack >= 1 && sourceStack <= 6)
-> game |> applyUpdate (StackToAce sourceStack)
| 't' -> game |> applyUpdate TableToAce
| '\x1B' -> game |> nextPhase General
| _ -> game
// check if the player has won the game after this update
{ updatedGame with phase = if hasWon updatedGame then PlayerHasWon else updatedGame.phase }
As you can see, we will need a new state PlayerHasWon, which will need the associated updateGame... function and a matched line in the printCommands function. An advantage of use a DU is that the compiler can immediately tell you where you’re not handling one of the cases.
Write the hasWon function that counts the cards in the Ace stacks and checks if they add up to 52.
let hasWon game =
game.aces
|> List.map List.length
|> List.sum
|> (=) 52 // Shortcut:
// It means that we use `=` as a function
// with 52 as the first input
// and the piped value as the second input
I’m going to move some of the extensions we added to make the rules work into the Cards module, such as IsRed/Black and the type extensions that
got us a number etc. I’m doing this because in my mind they feel like common “Card” things, rather than something particular to do with Solitaire.
The other thing I’m going to tidy up is the special codes for printing in colour. This is specific to printing on a terminal, so I will move this work into printing.fs as a function that transforms a printed card into a coloured, printed card.
How would you change the code to celebrate the player’s success. A message on the playing surface / fireworks / even an animation!
When the celebration is over, we need to decide how to end. I have chosen to ask the player if they want to play another game; if they say yes then shuffle and deal a new game out and continue on, or allow them to quit.
module Cards
open System
//SYMBOL CODES
let SYMBOL_HEART = "\u2665"
let SYMBOL_DIAMOND = "\u2666"
let SYMBOL_CLUB = "\u2663"
let SYMBOL_SPADE = "\u2660"
type CardNumber =
| Ace
| Two
| Three
| Four
| Five
| Six
| Seven
| Eight
| Nine
| Ten
| Jack
| Queen
| King
with
override this.ToString() =
match this with
| Two -> "2 "
| Three -> "3 "
| Four -> "4 "
| Five -> "5 "
| Six -> "6 "
| Seven -> "7 "
| Eight -> "8 "
| Nine -> "9 "
| Ten -> "10"
| Jack -> "J "
| Queen -> "Q "
| King -> "K "
| Ace -> "A "
member this.Ordinal =
match this with
| Ace -> 1
| Two -> 2
| Three -> 3
| Four -> 4
| Five -> 5
| Six -> 6
| Seven -> 7
| Eight -> 8
| Nine -> 9
| Ten -> 10
| Jack -> 11
| Queen -> 12
| King -> 13
type Card =
| Hearts of CardNumber
| Diamonds of CardNumber
| Clubs of CardNumber
| Spades of CardNumber
| Joker
with
override this.ToString() =
match this with
| Hearts x -> $"{SYMBOL_HEART}{x}"
| Diamonds x -> $"{SYMBOL_DIAMOND}{x}"
| Clubs x -> $"{SYMBOL_CLUB}{x}"
| Spades x -> $"{SYMBOL_SPADE}{x}"
| Joker -> "Jok"
member this.Number =
match this with
| Hearts a
| Diamonds a
| Clubs a
| Spades a -> a
| Joker -> failwith "Joker?!?!?"
let (|IsRed|_|) (card:Card) =
match card with
| Hearts _
| Diamonds _ -> Some card
| _ -> None
let (|IsBlack|_|) (card:Card) =
match card with
| IsRed _ -> None
| _ -> Some card
let (|Number|_|) (ch:Char) =
match Char.GetNumericValue(ch) with
| -1.0 -> None
| a -> a |> int |> Some
let printOut (hand: 'a seq) =
"[" + String.Join("] [", hand) + "]"
let newDeck =
let suits = [Hearts; Diamonds; Clubs; Spades]
let numbers = [
Ace; Two; Three; Four; Five; Six; Seven; Eight; Nine; Ten;
Jack; Queen; King
]
List.allPairs suits numbers
|> List.map (fun (suit, number) -> suit number)
let rec shuffle deck =
let random = System.Random()
match deck with
| [] -> []
| [a] -> [a]
| _ ->
let randomPosition = random.Next(deck.Length)
let cardAtPosition = deck[randomPosition]
let rest = deck |> List.removeAt randomPosition
[cardAtPosition] @ (shuffle rest)
//moves the cursor up "n" lines
let moveUpLines n =
printfn "\x1B[%dA" n
let combineUpdate printScreen updater game command =
updater game command
|> printScreen
let loopGame<'G>
(printScreen: 'G -> 'G)
(updater: 'G -> char -> 'G)
(initialGame: 'G) =
printScreen initialGame |> ignore
(fun _ -> Console.ReadKey().KeyChar |> Char.ToLowerInvariant)
|> Seq.initInfinite
|> Seq.takeWhile (fun x -> x <> 'q')
|> Seq.fold (combineUpdate printScreen updater) initialGame
module Solitaire.Model
open System
open Cards
type StackCard = {
card: Card
isFaceUp: bool
} with
override this.ToString() =
if this.isFaceUp then
this.card.ToString()
else
"###"
type Game = {
deck: Card list
table: Card list
stacks: StackCard list list
aces: Card list list
}
type Phase =
| General
| SelectingSourceStack
| SelectingNumCards of int
| SelectingTargetStack of int * int
| SelectingAceSource
| PlayerHasWon
type MultiPhaseGame = {
game: Game
phase: Phase
}
module Solitaire.Printing
open System
open Cards
open Solitaire.Model
let clearLine = "\x1B[K"
let printHeader multiGame =
printfn "%s========================== Solitaire ===========================" clearLine
multiGame
let printStacks multiGame =
printfn "%s| 1 | 2 | 3 | 4 | 5 | 6 |===| %s | %s | %s | %s |"
clearLine SYMBOL_HEART SYMBOL_DIAMOND SYMBOL_CLUB SYMBOL_SPADE
[0..19] |> List.iter (fun cardNum ->
let stackline =
[0..5] |> List.map (fun stackNum ->
if multiGame.game.stacks[stackNum].Length > cardNum then
multiGame.game.stacks[stackNum][cardNum]
|> sprintf "[%O]"
else
// the stack is out of cards
" "
)
|> fun strings -> String.Join (" ", strings)
let aceline =
[0..3] |> List.map (fun stackNum ->
if multiGame.game.aces[stackNum].Length > cardNum then
multiGame.game.aces[stackNum][cardNum]
|> sprintf "[%O]"
else
// the ace stack is out of cards
" "
)
|> fun strings -> String.Join (" ", strings)
printfn "%s%s %s" clearLine stackline aceline
)
multiGame //pass it on to the next function
let printTable multiGame =
let tableLine =
match multiGame.game.table with
| [] -> ""
| a ->
String.init a.Length (fun _ -> "[")
+ a.Head.ToString()
+ "]"
printfn "%s" clearLine //spacer
printfn "%sTable: %s" clearLine tableLine
multiGame
let printDeck multiGame =
let deckLine = String.init multiGame.game.deck.Length (fun _ -> "[")
printfn "%sDeck: %s###]" clearLine deckLine
multiGame
let printCommands multiGame =
match multiGame.phase with
| General ->
printfn
"%s<d>raw cards, <1-6> put on stack, <m>ove cards between stacks <q>uit"
clearLine
| SelectingSourceStack ->
printfn
"%sMove cards from stack ___(1-6), <esc> Go back, <q>uit"
clearLine
| SelectingNumCards stack->
let numCardsInStack =
multiGame.game.stacks[stack - 1]
|> List.filter (fun a -> a.isFaceUp )
|> List.length
printfn
"%sMove ___(1-%d, or <a>ll) cards from stack %d, <esc> Go back, <q>uit"
clearLine numCardsInStack stack
| SelectingTargetStack (stack, card) ->
printfn
"%sMove %d cards from stack %d to stack ___, <esc> Go back, <q>uit"
clearLine card stack
| SelectingAceSource ->
printfn
"%sMove to ACE stack from stack ___(1-6) or <t>able, <esc> Go back, <q>uit"
clearLine
| PlayerHasWon ->
printfn
"%sYou have won! Play again (y), <q>uit"
clearLine
multiGame
let printMoveToTop multiGame =
let maxCardInAnyStack =
multiGame.game.stacks
|> List.map (fun stack -> stack.Length )
|> List.max
let n =
1 //header
+ 1 //stack numbers
+ 21 //stacks
+ 1 //table
+ 1 //deck
+ 1 //commands
+ 1 //current line
moveUpLines n
multiGame
let printScreen multiGame =
multiGame
|> printMoveToTop
|> printHeader
|> printStacks
|> printTable
|> printDeck
|> printCommands
module Solitaire.Actions
open System
open Cards
open Solitaire.Model
let (|Number|_|) (ch:Char) =
match Char.GetNumericValue(ch) with
| -1.0 -> None
| a -> a |> int |> Some
let deal shuffledDeck =
let emptyGame = {
deck = shuffledDeck |> List.except [Joker]
table = []
stacks = []
aces = List.init 4 (fun _ -> [])
}
[6..-1..1]
|> List.fold (fun game i ->
let newStack =
game.deck
|> List.take i // flip the last card
|> List.mapi (fun n card -> { isFaceUp = (n = i - 1); card=card})
{game with
stacks = game.stacks @ [ newStack ]
deck = game.deck |> List.skip i
}
) emptyGame
let private drawCards game =
let withEnoughCardsToDraw =
match game.deck.Length with
| n when n < 3 ->
{game with
deck = game.deck @ game.table
table = []
}
| _ -> game
// in case there is less than 3 remaining
let cardsToTake = Math.Min(3, withEnoughCardsToDraw.deck.Length)
{withEnoughCardsToDraw with
table =
(withEnoughCardsToDraw.deck |> List.take cardsToTake)
@ withEnoughCardsToDraw.table
deck = withEnoughCardsToDraw.deck |> List.skip cardsToTake
}
type Card with
member this.Number =
match this with
| Hearts a
| Diamonds a
| Clubs a
| Spades a -> a
| Joker -> failwith "Joker?!?!?"
type CardNumber with
member this.Ordinal =
match this with
| Ace -> 1
| Two -> 2
| Three -> 3
| Four -> 4
| Five -> 5
| Six -> 6
| Seven -> 7
| Eight -> 8
| Nine -> 9
| Ten -> 10
| Jack -> 11
| Queen -> 12
| King -> 13
let (|IsRed|_|) (card:Card) =
match card with
| Hearts _
| Diamonds _ -> Some card
| _ -> None
let (|IsBlack|_|) (card:Card) =
match card with
| IsRed _ -> None
| _ -> Some card
let private canAddToStack (stack: StackCard list) (card:Card) =
if stack = [] && card.Number = King then
true
else
let bottomCard = stack |> List.last
match bottomCard.card, card with
| IsRed a, IsBlack b
| IsBlack a, IsRed b
when a.Number.Ordinal = b.Number.Ordinal + 1
-> true
| _, _ -> false
let private canMoveCardsBetweenStacks sourceStack numCards targetStack game =
// make things a bit easier to call the above function
// by making the arguments the same as the move...() function
let stack = game.stacks[targetStack - 1]
let card =
game.stacks[sourceStack - 1]
|> List.skip ( game.stacks[sourceStack - 1].Length - numCards )
|> List.head
canAddToStack stack card.card
let private addToStack (stackNum:int) (card:Card) (stacks: StackCard list list) =
let updatedStack = stacks[stackNum] @ [ { isFaceUp=true; card=card} ]
stacks |> List.updateAt stackNum updatedStack
let private tableToStack stackNum game =
let stack = game.stacks[stackNum]
match game.table with
| [] -> game // do nothing
| [a]->
{game with
table = [];
stacks = game.stacks |> addToStack stackNum a
}
| a::rest ->
{game with
table = rest;
stacks = game.stacks |> addToStack stackNum a
}
let private flipNext stack =
let numFaceUp =
stack
|> List.filter (fun a -> a.isFaceUp)
|> List.length
match stack.Length, numFaceUp with
| 0, _ -> stack // no cards to flip
| n, 0 -> // none face up
stack
|> List.updateAt
(n - 1)
{stack[n - 1] with isFaceUp=true}
| _, _ -> stack //anything else
let private moveCardsBetweenStacks sourceStack numCards targetStack game =
// remember - on screen we start at one, but lists start at zero
let numCardsInStack = game.stacks[sourceStack - 1].Length
// do the move
let moving = game.stacks[sourceStack - 1] |> List.skip ( numCardsInStack - numCards )
let source = game.stacks[sourceStack - 1] |> List.take ( numCardsInStack - numCards )
let target = game.stacks[targetStack - 1] @ moving
// flip next card?
let sourceFlipped = flipNext source
//reconstruct the game
{ game with
stacks =
game.stacks
|> List.updateAt (sourceStack - 1) sourceFlipped
|> List.updateAt (targetStack - 1) target
}
let private acesStackNum card =
match card with
| Hearts _ -> 0
| Diamonds _ -> 1
| Clubs _ -> 2
| Spades _ -> 3
| Joker _ -> failwith "AAAAH! A Joker!?!?"
let private canAddToAce cards game =
match cards with
| [] -> false
| [card]
| card::_ ->
let stackNum = acesStackNum card
let target = game.aces[stackNum] |> List.rev // (so we can easily see the last card as the "head")
match target, card with
| [], c when c.Number = Ace -> true
| [a], c
| a::_, c
when a.Number.Ordinal = c.Number.Ordinal - 1
-> true
| _ -> false
let private canAddToAceFromStack sourceStack game =
// Make it easier to call the above function for stacks
let cards =
game.stacks[sourceStack - 1]
|> List.map (fun a -> a.card)
|> List.rev
canAddToAce cards game
let private addToAce card game =
let stackNum = acesStackNum card
let target = game.aces[stackNum] @ [card]
{game with
aces =
game.aces
|> List.updateAt stackNum target
}
let private moveToAceFromStack sourceStack game =
match game.stacks[sourceStack - 1] with
| [] -> game
| [a] ->
let addedToAce = addToAce a.card game
{addedToAce with
stacks =
game.stacks
|> List.updateAt (sourceStack - 1) []
}
| a ->
//we need the last card, not the first
let source, moving =
a
|> List.splitAt ( a.Length - 1 )
let sourceFlipped = flipNext source
let addedToAce = addToAce moving.Head.card game
{addedToAce with
stacks =
game.stacks
|> List.updateAt (sourceStack - 1) sourceFlipped
}
let private moveToAceFromTable game =
match game.table with
| [] -> game
| [a] ->
let addedToAce = addToAce a game
{addedToAce with table = [] }
| a::rest ->
let addedToAce = addToAce a game
{addedToAce with table = rest }
// The _external_ arguments for "MoveCards"
type MoveArgs = { sourceStack: int; numCards: int; targetStack: int; }
type SolitaireCommands =
| DrawCards
| TableToStack of int
| MoveCards of MoveArgs
| TableToAce
| StackToAce of int
let applyCommand (cmd: SolitaireCommands) (game: Game) =
match cmd with
| DrawCards
-> game |> drawCards
| TableToStack a
when (a >= 1 && a <= 6)
&& canAddToStack (game.stacks[a - 1]) (game.table.Head)
-> game |> tableToStack (a - 1)
| MoveCards args
when (args.targetStack >= 1 && args.targetStack <= 6)
&& canMoveCardsBetweenStacks args.sourceStack args.numCards args.targetStack game
-> game |> moveCardsBetweenStacks args.sourceStack args.numCards args.targetStack
| TableToAce
when canAddToAce game.table game
-> game |> moveToAceFromTable
| StackToAce sourceStack
when (sourceStack >= 1 && sourceStack <= 6)
&& canAddToAceFromStack sourceStack game
-> game |> moveToAceFromStack sourceStack
| _ -> game
module Solitaire.Update
open System
open Cards
open Solitaire.Model
open Solitaire.Actions
let private (|Number|_|) (ch:Char) =
match Char.GetNumericValue(ch) with
| -1.0 -> None
| a -> a |> int |> Some
let private applyUpdate command multiPhaseGame =
{
multiPhaseGame with
game = multiPhaseGame.game|> applyCommand command
phase = General // all updates move the phase back to General
}
let private nextPhase phase game = {game with phase = phase}
let private updateGameGeneral game keystroke =
match keystroke with
| 'd' -> game |> applyUpdate DrawCards
| 'm' -> game |> nextPhase SelectingSourceStack
| 'a' -> game |> nextPhase SelectingAceSource
| Number a when (a >= 1 && a <= 6)
-> game |> applyUpdate (TableToStack a)
| _ -> game
let private updateGameSourceStack game keystroke =
match keystroke with
| Number stack when (stack >= 1 && stack <= 6)
-> game |> nextPhase (SelectingNumCards stack)
| '\x1B' -> game |> nextPhase General
| _ -> game
let private updateGameNumCards sourceStack game keystroke =
let numCardsInStack =
game.game.stacks[sourceStack - 1]
|> List.filter (fun a -> a.isFaceUp )
|> List.length
match keystroke with
| Number card -> game |> nextPhase (SelectingTargetStack (sourceStack, card))
| 'a' -> game |> nextPhase (SelectingTargetStack (sourceStack, numCardsInStack))
| '\x1B' -> game |> nextPhase SelectingSourceStack
| _ -> game
let private updateGameTargetStack sourceStack numCards game keystroke =
match keystroke with
| Number targetStack when (targetStack >= 1 && targetStack <= 6) ->
game
|> applyUpdate (MoveCards {sourceStack=sourceStack; numCards=numCards; targetStack=targetStack})
| '\x1B' -> // [esc] key
game |> nextPhase (SelectingNumCards sourceStack)
| _ -> game
let private hasWon game =
game.game.aces
|> List.map List.length
|> List.sum
|> (=) 52 // Shortcut:
// It means that we use `=` as a function
// with 52 as the first input
// and the piped value as the second input
let updateAceSourceStack game keystroke =
let updatedGame =
match keystroke with
| Number sourceStack when (sourceStack >= 1 && sourceStack <= 6)
-> game |> applyUpdate (StackToAce sourceStack)
| 't' -> game |> applyUpdate TableToAce
| '\x1B' -> game |> nextPhase General
| _ -> game
// check if the player has won the game after this update
{ updatedGame with phase = if hasWon updatedGame then PlayerHasWon else updatedGame.phase }
let updatePlayerHasWon game keystroke =
match keystroke with
| 'y' ->{game=newDeck |> shuffle |> deal; phase=General}
| _ -> game
let updateGame (game: MultiPhaseGame) keystroke : MultiPhaseGame =
match game.phase with
| General ->
updateGameGeneral game keystroke
| SelectingSourceStack ->
updateGameSourceStack game keystroke
| SelectingNumCards sourceStack ->
updateGameNumCards sourceStack game keystroke
| SelectingTargetStack (sourceStack, numCards) ->
updateGameTargetStack sourceStack numCards game keystroke
| SelectingAceSource ->
updateAceSourceStack game keystroke
| PlayerHasWon ->
updatePlayerHasWon game keystroke
open Cards
open Solitaire
open Solitaire.Model
newDeck
|> shuffle
|> fun cards -> {game=Actions.deal cards; phase=General}
|> loopGame Printing.printScreen Update.updateGame
|> ignore // a program is expected to return `unit` (i.e. nothing), but the above returns a Game
// `ignore()` takes anything as an input and returns `unit`