FCards - On the Web

24. Display the game on the Web

So far we’ve managed to set up a dynamic website, but it doesn’t do much, or have anything to do with our game.

Now we’ll swap in our game’s model, and build some simple view for it. This work will all be in the Main.fs module.

The Game Model

Good news! The Game type is perfect as the Model. So we can just delete the SimpleModel type and change the App at the bottom.

open Solitaire.Model

...

type MyApp() =
  inherit ProgramComponent<Game, SimpleMessage>()

  override this.Program =
    Program.mkSimple initialise update view

Exercise: initialise the model

Write the initialise function so that it returns our starting game.

See an answer

let initialise args = 
  newDeck 
  |> shuffle 
  |> deal
  |> applyCommand DrawCards   //  just so we can see something on the table in our view

The Game View

This may get a bit busy with a lot of square brackets.

TIP: Bolero/Blazor html functions generally have a standard format that takes a list of HTML attributes and a list of HTML child nodes There are a lot of HTML functions that are named after HTML elements; e.g. div(), li(), ul(), and text().

div [ ...  attributes of the div ... ] [ ... things inside the div ... ]

div [ Attr.Classes ["jumbo"; "sparkly"] ] [ text "Hello" ] // <div class="jumbo sparkly">Hello</div>

text "Hello"
|> div [ Attr.Classes ["jumbo"; "sparkly"] ]               // <div class="jumbo sparkly">Hello</div>

// or maybe a list
game.deck                                                  // Card list
|> List.map (fun card -> li [] [ text (card.ToString()) ]  // `li` list
|> ul []                                                   // <ul> <li>♣Q</li> ... </ul>

There are a few bits to the view, so we’ll break it down in a similar way we did when we created the printing module.

We can use divs to group parts together into layers:

     ______(topHalf)________________________________________
    | _________________________     ______________________  |
    ||   Stacks                |   |     Aces             | |
    ||                         |   |                      | |
    ||_________________________|   |______________________| |
    |_______________________________________________________|

     _______________________________________________________
    |      Table                                            |
    |_______________________________________________________|

     _______________________________________________________
    |      Deck                                             |
    |_______________________________________________________|

let viewMain game dispatch = 
  let stacks = viewStacks game
  let aces = viewAces game
  let table = viewTable game
  let deck = viewDeck game
  let topHalf = div [Attr.Classes ["topHalf"]] [stacks; aces]
  div [Attr.Classes ["game"]] [topHalf; table; deck]

… and use some CSS to shape them up using classes. I won’t go into the CSS as that’s a whole other topic, but I will include it at the bottom of the chapter.

Exercise: Sub-views

To create the sub-view for printing out the table we can do something similar to below

type CardDisplay = {
  card: Card
  isFaceUp: bool
}

let viewCardBack = span [ ] [ text "[###]"] 

let viewCard (cardDisplay: CardDisplay) =
  match cardDisplay with 
  | {isFaceUp=false} -> viewCardBack
  | {card=card} -> 
    let txt = text $"[{card}]"
    let colorAttr = 
      match card with 
      | IsRed _ -> ["red"]
      | IsBlack _ -> ["black"]
      | _ -> []
      |> Attr.Classes
    span [ colorAttr ] [txt]

let viewTable game =
  match game.table with 
    | [] -> []
    | [a] -> [viewCard {card=a; isFaceUp=true}]
    | topcard::rest -> 
        let facedowns = List.init rest.Length (fun _ -> viewCardBack)
        facedowns @ [viewCard {card=topcard;isFaceUp=true}]
  |> List.map ( fun a -> li [] [a])
  |> ul []
  |> fun a -> [ h3 [] [text "Table"]; a]
  |> div [ Attr.Classes ["table"] ]

TIP: You can match on just part or a record.
Notice that in viewCard() we match on isFaceUp being false, and then on the second line we can deconstruct just the part of the record that we’re interested in (the card part)

Write the sub-view functions for viewDeck, viewAces, and viewStacks.

To make things a little easier I used a one-line function to wrap a thing in a list

let wrap = List.singleton  // shortcut to wrap a thing in a list

See an answer for viewDeck

let viewDeck game =
  game.deck
  |> List.map ( fun card -> card |> viewCardBack |> wrap |> li [] )
  |> ul []
  |> fun a -> [ h3 [] [text "Deck"]; a]
  |> div [ Attr.Classes ["deck"] ]

See an answer for viewAces

let suits = [SYMBOL_HEART; SYMBOL_DIAMOND; SYMBOL_CLUB; SYMBOL_SPADE]

let viewAces game =
  game.aces
  |> List.mapi (fun i stack -> 
    stack
    |> List.map ( fun card -> card |> viewCard |> wrap |> li [] )
    |> ul []
    |> fun x -> [h4 [] [suits[i] |> text]; x]
    |> div []
  )
  |> div [ Attr.Classes ["aces"] ]

See an answer for viewStacks

let viewStacks game =
  game.stacks
  |> List.mapi (fun i stack -> 
    stack
    |> List.map ( fun card -> card |> viewStackCard |> wrap |> li [] )
    |> ul []
    |> fun x -> [h4 [] [(i + 1).ToString() |> text]; x]
    |> div []
  )
  |> div [ Attr.Classes ["stacks"] ]

Result

Solitaire at ch 24

Code so far

Website/Startup.fs

namespace Solitaire.Website

open System
open System.Net.Http
open Microsoft.AspNetCore.Components.WebAssembly.Hosting
open Microsoft.Extensions.DependencyInjection

module Program =

  [<EntryPoint>]
  let Main args =
    let builder = WebAssemblyHostBuilder.CreateDefault(args)
    builder.Services.AddScoped<HttpClient>(
      fun _ -> new HttpClient(BaseAddress = Uri builder.HostEnvironment.BaseAddress)
      ) 
      |> ignore
    builder.RootComponents.Add<Main.MyApp>("#main")
    builder.Build().RunAsync() |> ignore
    0

Website/Main.fs

module Solitaire.Website.Main

open Elmish
open Bolero
open Bolero.Html
open Cards
open Solitaire.Model
open Solitaire.Actions
open Solitaire.Website.Views


type SimpleMessage =  // must be a DU
  | DoNothing

let initialise args = 
  newDeck 
  |> shuffle 
  |> deal
  |> applyCommand DrawCards
  
let update message model = model


type MyApp() =
  inherit ProgramComponent<Game, SimpleMessage>()

  override this.Program =
    Program.mkSimple initialise update viewMain

Website/views.fs

module Solitaire.Website.Views

open Bolero
open Bolero.Html
open Cards
open Solitaire.Model

let suits = [SYMBOL_HEART; SYMBOL_DIAMOND; SYMBOL_CLUB; SYMBOL_SPADE]

let wrap = List.singleton  // shortcut to wrap a thing in a list

type CardDisplay = {
  card: Card
  isFaceUp: bool
}

let viewCardBack = span [ ] [ text "[###]"] 

let viewCard (cardDisplay: CardDisplay) =
  match cardDisplay with 
  | {isFaceUp=false} -> viewCardBack
  | {card=card} -> 
    let txt = text $"[{card}]"
    let colorAttr = 
      match card with 
      | IsRed _ -> ["red"]
      | IsBlack _ -> ["black"]
      | _ -> []
      |> Attr.Classes
    span [ colorAttr ] [txt]

let viewStacks game =
  game.stacks
  |> List.mapi (fun i stack -> 
    stack
    |> List.map ( fun card -> { card=card.card; isFaceUp=card.isFaceUp } |> viewCard |> wrap |> li [] )
    |> ul []
    |> fun x -> [h4 [] [(i + 1).ToString() |> text]; x]
    |> div []
  )
  |> div [ Attr.Classes ["stacks"] ]

let viewAces game =
  game.aces
  |> List.mapi (fun i stack -> 
    stack
    |> List.map ( fun card -> {card=card; isFaceUp=true} |> viewCard |> wrap |> li [] )
    |> ul []
    |> fun x -> [h4 [] [suits[i] |> text]; x]
    |> div []
  )
  |> div [ Attr.Classes ["aces"] ]

let viewTable game =
  match game.table with 
    | [] -> []
    | [a] -> [viewCard {card=a; isFaceUp=true}]
    | topcard::rest -> 
        let facedowns = List.init rest.Length (fun _ -> viewCardBack)
        facedowns @ [viewCard {card=topcard;isFaceUp=true}]
  |> List.map ( fun a -> li [] [a])
  |> ul []
  |> fun a -> [ h3 [] [text "Table"]; a]
  |> div [ Attr.Classes ["table"] ]

let viewDeck game =
  List.init game.deck.Length ( fun _ -> viewCardBack |> wrap |> li [] )
  |> ul []
  |> fun a -> [ h3 [] [text "Deck"]; a]
  |> div [ Attr.Classes ["deck"] ]

let viewMain game dispatch = 
  let stacks = viewStacks game
  let aces = viewAces game
  let table = viewTable game
  let deck = viewDeck game
  let topHalf = div [Attr.Classes ["topHalf"]] [stacks; aces]
  div [Attr.Classes ["game"]] [topHalf; table; deck]

Website/wwwroot/index.html

<html>
  <head>
    <title>Solitaire</title>
    <link rel="stylesheet" href="solitaire.css">
  </head>
  <body>
    <h1>Solitaire</h1>
    <div id="main">Loading...</div>

    <script src="_framework/blazor.webassembly.js"></script>    
  </body>
</html>

Website/wwwroot/solitaire.css

h2, h3, h4 {
  color: #777;
}
ul{
  margin: 0;
  padding: 0;
}
li{
  list-style-type: none;
}

.game{
  display: flex;
  flex-direction: column;
  color: #777;
}
.topHalf{
  display: flex;
  align-content: space-between;

}
.stacks, .aces{
  display: flex;
  margin: 1em;
  align-content: space-between;
  flex-grow: 1;
  text-align: center;
}
.stacks > *, .aces > * {
  flex-grow: 1;
}

.table ul, .deck ul {
  display: flex;
  flex-direction: row;
}

.deck ul, .table ul{
  margin-left: 1.2em;
}
.deck li, .table li {
  margin-left: -1.2em;
  background: white;
}


.red {
  color: red;
}
.black {
  color: black;
}