Permalink
Switch branches/tags
Nothing to show
Find file Copy path
Fetching contributors…
Cannot retrieve contributors at this time
197 lines (172 sloc) 8.27 KB
#r "../node_modules/fable-core/Fable.Core.dll"
open System
open Fable.Core
open Fable.Import
Node.require.Invoke("core-js") |> ignore
let possibleColors =
[
"Beige"
"Blue"
"Brown"
"Crimson"
"Cyan"
"Grey"
"Green"
"Indigo"
"Lime"
"Magenta"
"Navy"
"Orange"
"Pink"
"Plum"
"Purple"
"Red"
"Silver"
"Yellow"
]
module Model =
open System
type GameBoard = {
Selection : Selection
Board : Tile list list
}
and Tile = {
Row : int
Col : int
HiddenColor : string
CoverColor : string
Status : TileStatus
}
and TileStatus = UnMatched | AttemptingMatch | Matched
and Selection = NoneSelected | OneSelected of Tile | TwoSelected of Tile * Tile
module GameBoard =
let updateTile r c t gb =
let updatedRow = gb.Board.[r] |> List.toArray |> (fun arr -> arr.[c] <- t; arr) |> List.ofArray
{
gb with
Board = gb.Board |> List.toArray |> (fun arr -> arr.[r] <- updatedRow; arr) |> List.ofArray
}
let updateSelected s gb = { gb with Selection = s}
let generateRandomModel n =
let totalTiles = n * n
let rnd = Random()
let rec randomColorsWithIndexes (possIndexes1:Set<int>) (possIndexes2:Set<int>) (possColors:Set<string>) n =
match n with
| 0 -> []
| _ -> let index1 = possIndexes1 |> Set.toList |> (fun l -> l.[rnd.Next(l.Length)])
let index2 = possIndexes2 |> Set.toList |> (fun l -> l.[rnd.Next(l.Length)])
let color = possColors |> Set.toList |> (fun l -> l.[rnd.Next(l.Length)])
let remainingIndexes1 = possIndexes1 |> Set.remove index1
let remainingIndexes2 = possIndexes2 |> Set.remove index2
let remainingColors = possColors |> Set.remove color
(color, index1, index2) :: (randomColorsWithIndexes remainingIndexes1 remainingIndexes2 remainingColors (n - 1))
let tiles =
randomColorsWithIndexes (Set [0 .. (totalTiles / 2) - 1]) ( Set [(totalTiles / 2) .. totalTiles - 1]) (Set possibleColors) (totalTiles / 2)
|> List.collect (fun (c,i1,i2) -> [(c,i1); (c,i2)])
|> List.sortBy (fun (c, i) -> i)
|> List.mapi (fun flatIndex (c, i) ->
({
Row = flatIndex / n
Col = flatIndex % n
HiddenColor = c
CoverColor = "black"
Status = UnMatched
}, flatIndex)
)
|> List.sortBy (fun (t, flatIndex) -> flatIndex)
|> List.map fst
|> List.rev
|> List.fold (fun (rows: Tile list list) tile ->
match rows with
| [] -> [[tile]]
| h :: t when h.Length < n -> (tile :: h) :: t
| _ -> [tile] :: rows
) []
{
Selection = NoneSelected
Board = tiles
}
let modelChangeEvent = new Event<GameBoard>()
module View =
open Model
let gameContainer = Browser.document.getElementById("memory-tiles-container")
let render tileClickCallback startNewGameCallback (gameBoard:GameBoard) =
gameContainer.innerHTML <- ""
let board = gameBoard.Board
for rowIndex in 0.. board.Length - 1 do
let rowDiv = Browser.document.createElement("div")
rowDiv.className <- "row"
rowDiv.style.minHeight <- "100px"
for cIndex in 0..board.[rowIndex].Length - 1 do
let tile = board.[rowIndex].[cIndex]
let tileDiv = Browser.document.createElement("div")
tileDiv.className <- "col-3"
let bc = match tile.Status with
| UnMatched -> tile.CoverColor
| AttemptingMatch -> tile.HiddenColor
| Matched -> tile.HiddenColor
tileDiv.style.backgroundColor <- bc
tileDiv.style.border <- "white solid 4px"
let eventHandler r c d = Func<Browser.MouseEvent, obj>(fun _ -> tileClickCallback r c gameBoard :> obj)
tileDiv.addEventListener_click(eventHandler rowIndex cIndex tileDiv)
rowDiv.appendChild tileDiv |> ignore
gameContainer.appendChild rowDiv |> ignore
let startNewGameButton = Browser.document.createElement("button")
startNewGameButton.addEventListener_click(fun _ -> startNewGameCallback() :> obj)
startNewGameButton.innerText <- "Start Fresh Game"
gameContainer.appendChild startNewGameButton |> ignore
module Controller =
open Model
let tileClick tileRow tileCol (gameBoard: GameBoard) =
let board = gameBoard.Board
let tile = board.[tileRow].[tileCol]
let lastSelection = gameBoard.Selection
if tile.Status = Matched then ()
else
match lastSelection with
| TwoSelected(t1, t2) when t1.Status = Matched && t2.Status = Matched && tile <> t1 && tile <> t2->
gameBoard
|> GameBoard.updateTile tile.Row tile.Col { tile with Status = AttemptingMatch }
|> GameBoard.updateSelected (OneSelected { tile with Status = AttemptingMatch })
|> modelChangeEvent.Trigger
| TwoSelected(t1, t2) when t1.Status = Matched && tile <> t1 && tile <> t2 ->
gameBoard
|> GameBoard.updateTile tile.Row tile.Col { tile with Status = AttemptingMatch }
|> GameBoard.updateTile t2.Row t2.Col { t2 with Status = UnMatched }
|> GameBoard.updateSelected (OneSelected { tile with Status = AttemptingMatch })
|> modelChangeEvent.Trigger
| TwoSelected(t1, t2) when t2.Status = Matched && tile <> t1 && tile <> t2 ->
gameBoard
|> GameBoard.updateTile tile.Row tile.Col { tile with Status = AttemptingMatch }
|> GameBoard.updateTile t1.Row t1.Col { t1 with Status = UnMatched }
|> GameBoard.updateSelected (OneSelected ({ tile with Status = AttemptingMatch }))
|> modelChangeEvent.Trigger
| TwoSelected(t1, t2) when tile <> t1 && tile <> t2 ->
gameBoard
|> GameBoard.updateTile t1.Row t1.Col { t1 with Status = UnMatched }
|> GameBoard.updateTile t2.Row t2.Col { t2 with Status = UnMatched }
|> GameBoard.updateTile tile.Row tile.Col { tile with Status = AttemptingMatch }
|> GameBoard.updateSelected (OneSelected ({ tile with Status = AttemptingMatch }))
|> modelChangeEvent.Trigger
| OneSelected t1 when t1.HiddenColor = tile.HiddenColor && tile <> t1 ->
gameBoard
|> GameBoard.updateTile t1.Row t1.Col { t1 with Status = Matched }
|> GameBoard.updateTile tile.Row tile.Col { tile with Status = Matched }
|> GameBoard.updateSelected (TwoSelected ({ t1 with Status = Matched },{ tile with Status = Matched }))
|> modelChangeEvent.Trigger
| OneSelected t1 when tile <> t1 ->
gameBoard
|> GameBoard.updateTile tile.Row tile.Col { tile with Status = AttemptingMatch }
|> GameBoard.updateSelected (TwoSelected (t1, { tile with Status = AttemptingMatch }))
|> modelChangeEvent.Trigger
| NoneSelected when tile.Status <> Matched ->
gameBoard
|> GameBoard.updateTile tile.Row tile.Col { tile with Status = AttemptingMatch }
|> GameBoard.updateSelected (OneSelected ({ tile with Status = AttemptingMatch }))
|> modelChangeEvent.Trigger
| _ -> ()
let startGame() = modelChangeEvent.Trigger (Model.generateRandomModel 4)
let initialise() =
Model.modelChangeEvent.Publish.Add(fun gameBoard -> View.render tileClick startGame gameBoard)
startGame()
Controller.initialise()