FCards - Solitaire

module Cards
open System

//COLOR CODES
let COLOR_DEFAULT = "\x1B[0m"
let COLOR_RED = "\x1B[91m"
let COLOR_BLACK = "\x1B[90m"

let SYMBOL_HEART = "\u2665"
let SYMBOL_DIAMOND = "\u2666"
let SYMBOL_CLUB = "\u2663"
let SYMBOL_SPADE = "\u2660"

type CardNumber =
  | Two 
  | Three
  | Four
  | Five
  | Six
  | Seven
  | Eight
  | Nine
  | Ten
  | Jack
  | Queen
  | King
  | Ace
  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 "

type Card = 
  | Hearts of CardNumber
  | Diamonds of CardNumber
  | Clubs of CardNumber
  | Spades of CardNumber
  | Joker
  with  
    override this.ToString() = 
      match this with 
      | Hearts x -> $"{COLOR_RED}{SYMBOL_HEART}{x}{COLOR_DEFAULT}"
      | Diamonds x -> $"{COLOR_RED}{SYMBOL_DIAMOND}{x}{COLOR_DEFAULT}"
      | Clubs x ->  $"{COLOR_BLACK}{SYMBOL_CLUB}{x}{COLOR_DEFAULT}"
      | Spades x ->  $"{COLOR_BLACK}{SYMBOL_SPADE}{x}{COLOR_DEFAULT}"
      | Joker -> "Jok"

let printOut (hand: 'a seq) =  
  "[" + String.Join("] [", hand) + "]"

let newDeck = 
  let suits = [Hearts; Diamonds; Clubs; Spades]
  let numbers = [
    Two; Three; Four; Five; Six; Seven; Eight; Nine; Ten;
    Jack; Queen; King; Ace
  ]
  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
}

module Solitaire.Printing

open System
open Cards
open Solitaire.Model

let clearLine = "\x1B[K"

let printHeader game =
  printfn "%s============ Solitaire =============" clearLine
  game

let printStacks game = 
  printfn "%s| 1  |  2  |  3  |  4  |  5  |  6  |" clearLine
  [0..19] |> List.iter (fun cardNum ->
    [0..5] |> List.map (fun stackNum ->
      if game.stacks[stackNum].Length > cardNum then 
        game.stacks[stackNum][cardNum]
        |> sprintf "[%O]"
      else
        // the stack is out of cards
          "     "         
    )
    |> fun strings -> String.Join (" ", strings)
    |> printfn "%s%s" clearLine
  )
  game //pass it on to the next function

let printTable game =
  let tableLine = 
    match game.table with 
    | []  -> ""
    | a -> 
      String.init a.Length (fun _ -> "[")
      + a.Head.ToString()
      + "]"
  printfn "%s" clearLine //spacer
  printfn "%sTable: %s" clearLine tableLine
  game

let printDeck game =
  let deckLine = String.init game.deck.Length (fun _ -> "[") 
  printfn "%sDeck:  %s###]" clearLine deckLine
  game

let printCommands game =
  printfn "%s<d>raw cards, <1-6> put on stack, <q>uit" clearLine
  game

let printMoveToTop game =
  let maxCardInAnyStack = 
    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
  game

let printScreen game = 
  game 
  |> printMoveToTop
  |> printHeader
  |> printStacks
  |> printTable
  |> printDeck
  |> printCommands

module Solitaire.Actions

open System
open Cards
open Solitaire.Model

let deal shuffledDeck = 
  let emptyGame = {
    deck = shuffledDeck
    table = []
    stacks = []
  }
  [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}) 
        {
          stacks = game.stacks @ [ newStack ]
          deck = game.deck |> List.skip i
          table = []
        }
      
      ) emptyGame

let (|Number|_|) (ch:Char) =
  match Char.GetNumericValue(ch) with
  | -1.0 -> None
  | a -> a |> int |> Some

let drawCards game =
  let withEnoughCardsToDraw =
    match game.deck.Length with
    | n when n < 3 -> 
      // create a new game that's just like the old one
      //  but with the following differences.
      //  (really useful if you have a lot of parts but only want to change a couple)
      {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 //(new cards on top)
    deck = withEnoughCardsToDraw.deck |> List.skip cardsToTake
  }


// a helper to add a card to a numbered stack
let addToStack (stackNum:int) (card:Card) (stacks: StackCard list list) =
  let updatedStack = stacks[stackNum] @ [ { isFaceUp=true; card=card} ]
  stacks |> List.updateAt stackNum updatedStack

let tableToStack stackNum game =
  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 
    }

type SolitaireCommands = 
  | DrawCards
  | TableToStack of int

let applyCommand (cmd: SolitaireCommands) (game: Game) =
  match cmd with 
  | DrawCards -> game |> drawCards
  | TableToStack a -> game |> tableToStack (a - 1)

let updateGame game command =
  match command with 
  | 'd' -> game |> applyCommand DrawCards
  | Number a when (a >= 1 && a <= 6) -> game |> applyCommand (TableToStack a)
  | _ -> game

open Cards
open Solitaire

newDeck 
  |> shuffle 
  |> Actions.deal 
  |> loopGame Printing.printScreen Actions.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`