Mahjong solitaire puzzle game in F#/WPF

So, a little learning experiment in F#/WPF.

It's a Mahjong solitaire puzzle, with the (already somewhat familiar) "programming languages" twist.

The images on the stones correspond to different programming languages. The player can open a web page with the information about the language on the currently selected stone, by clicking an URL in the status bar.

In the cheap pun tradition the code name for the game would be "Mahjolon" (Mahjong, Babylon, many languages... see?)

Being a side effect of slow background learning of F#, it's neither idiomatic nor elegant, not a "tutorial" or anything... not "how to do things", but rather "how I did them at the first attempt".

In fact, it's even not a program, but a script (.fsx) with everything lumped together - the result of experimental type of development, when you write small pieces of code, evaluate them on the fly in the REPL (AKA "F# interactive") and almost instantly see what happens.

But I figured I'd reflect on this anyway, so here we go (btw, the code is available on github).

We have the following files (all in the same folder):

• mahjong.fsx - the game script itself. It can be run, for example, by opening it in Visual Studio (I used Visual Studio 2010), pressing Ctrl+Alt+F to open F# interactive, Ctrl+A to select all code and then Alt+Enter to evaluate it.
• mahjong.xaml - the minimal WPF XAML file with the main (and only) window layout
• languages.txt - the list of programming language name/URL pairs in every line, separated by "|", e.g:

http://en.wikipedia.org/wiki/Lua_(programming_language)|Lua http://en.wikipedia.org/wiki/Erlang_(programming_language)|Erlang http://en.wikipedia.org/wiki/Clojure|Clojure http://factorcode.org/|Factor

• layouts.txt - text file, describing different initial board layouts
• stones_bg.png - sprite atlas for stone backgrounds (normal stone and a selected one)

• stones_fg.png - sprite atlas with stone "faces", that are in my case programming language logos

The script itself, mahjong.fsx goes like this.

Imports

At the beginning, we import the used assemblies, the "script way". The ones here are needed in order to use WPF.

#r "WindowsBase"
#r "PresentationCore"
#r "PresentationFramework"
#r "System.Xaml"

open System
open System.Windows
open System.Windows.Controls
open System.Windows.Shapes
open System.Windows.Media
open System.Windows.Media.Imaging
open System.Windows.Markup
open System.Xml
open System.IO

Here we first tell which (WPF) assemblies we will use, and then import a few particular namespaces from those assemblies.

General utilities

F# has an extensive set of library functions for manipulating with containers, but sometimes it's not enough and we'd want to define our own.

The first one tries to apply function to the argument until it returns Some() option (or the number of attempts reaches maxDepth, in which case the total result is None). It's a recursive function, using tail recursion. We'll need it for e.g. trying to shuffle the stones in such a way that the board is solvable.

module Utils =

  let rec tryApply maxDepth f arg = 
    match maxDepth, (f arg) with
    | 0, _ -> None
    | _, Some s -> Some s
    | _, None -> tryApply (maxDepth - 1) f arg

Now we use F# ability to extend existing modules and add some extra array manipulation functions.

Function choosei is the same as Array.choose, but also passes the index into the predicate:

module Array =
  let choosei f (array: _[]) =
    let res = new System.Collections.Generic.List<_>()
    for i = 0 to array.Length - 1 do 
      let x = array.[i] 
      match f (i, x) with
      | Some v -> res.Add(v)
      | None -> ignore()
    res.ToArray()

It is implemented by peeking into the source code of the core F# library and modifying it to our needs (that's why it might seem weird at the first glance... the core F# library code tries to do things in a way that has a good enough performance, which may not necessarily look like very idiomatic F#).

Function shuffle returns a shuffled array. Internally, it creates the copy of the input array and after that does the good old in-place Fischer-Yites shuffling.

  let shuffle arr =
    let a = arr |> Array.copy
    let rand = new System.Random()
    let flip i _ =
      let j = rand.Next(i, Array.length arr)
      let tmp = a.[i]
      a.[i] <- a.[j]
      a.[j] <- tmp
    a |> Array.iteri flip
    a

The function tryFindLastIndexi searches for the last element in the array satisfying the given predicate, returning None if there is no such element, and Some(el) if it is found:

  let tryFindLastIndexi f (array : _[]) = 
    let rec searchFrom n = 
      if n < 0 then None 
      elif f n array.[n] then Some n else searchFrom (n - 1)
    searchFrom (array.Length - 1)

Function replicate takes a subarray of the given input array, repeats it numTimes times in a row and returns the resulting array.

  let replicate firstElem numElem numTimes arr = 
    let res = Array.zeroCreate (numElem*numTimes) 
    for i in [0..(numTimes - 1)] do Array.blit arr 0 res (i*numElem) numElem 
    res

The last utility function, fullPath is rather a hack, applicable only when we are doing this kind of quick-and-dirty REPL development. It returns a full path to file, assuming that this file is located in the same folder as the current script (which later will be used to load data files for the game).

let fullPath file = __SOURCE_DIRECTORY__ + "/"+ file

Types

Here are the custom types our code will work with.

The first one, SpriteAtlas is used to bundle together information about a "sprite sheet" (we have two of these - for background and foreground stone image components):

type SpriteAtlas = { 
  File: string
  Cols: int
  Rows: int
  FrameWidth: float
  FrameHeight: float
}

The next, a discriminated union called StoneState, describes the possible three states in which every stone can be. Note that the stone becomes "Hidden" after the player "removes" it.

type StoneState =
  | Visible
  | Selected
  | Hidden

The main data structure, Game is a bundle of all data describing one game session. Most of it is mutable (changes during a single game session).

Note, that even though some of the fields may not appear to be mutable, in fact they are! This is one of the darker sides of the language. Since arrays and .NET objects are implicitly mutable, you basically never know if their elements have been changed or not.

Thus, only StoneCoords are never de-facto changed after the object of type Game is created.

type Game = { 
  StoneCoords: (int*int*int)[]
  StoneIDs: int[]
  StoneStates: StoneState[]
  StoneControls: (Rectangle*Rectangle)[] 
  mutable Moves: int list
  mutable CurSelected: int option
  mutable NumHiddenLayers: int
}

Global constants

Since a quick-and-dirty approach does not completely intolerate hardcoded values, we have a few here as well.

To somewhat silence the feeling of guilt I've tried making them more explicit by bundling all together and naming with caps.

let STONE_EXTENTS = 66., 78.
let STONE_3D_OFFSET = -7., -11.

let MAIN_WINDOW_XAML = "mahjong.xaml"
let LAYOUTS_FILE = "layouts.txt"
let LANGUAGES_FILE = "languages.txt"

let BG_ATLAS = { File = "stones_bg.png"; Cols = 2; Rows = 1; FrameWidth = 75.; FrameHeight = 90.; }
let FG_ATLAS = { File = "stones_fg.png"; Cols = 12; Rows = 10; FrameWidth = 64.; FrameHeight = 60.; }

let MAX_ARRANGE_ATTEMPTS = 50
let ABOUT_URL = @"http://en.wikipedia.org/wiki/Mahjong_solitaire"

Loading data from files

There are two types of game data that we load from files: board layout description and stone face description (the name of the corresponding programming language and URL of what is usually a Wikipedia page).

The following are the functions that are reading these data from files and parse them into data structures to be used by the game logic.

The file layouts.txt has data about several initial board layouts and looks like this:

Each 2x2 ASCII cell corresponds to one stone, and the number inside the cell equals to the highest stone level at the corresponding location. Since there should always be a stone below another stone (except for level 0), such representation describes the board non-ambiguously.

Note that the 2x2 cell representation is used in order to be able to describe those stones which have a half-stone position offset (in any or both directions).

So, the following function, parseLayouts, converts the text representation of a single board layout into array of tuples (column, row, layer) for every stone on the board. The column and row are using the same 0.5-base coordinate system (i.e. one stone occupies 2x2 cells).

The function internally uses an array (doing destructive updates on it), "peeling" out the stone coordinates layer-by-layer, starting from the top one.

let parseLayout (str:string) =   
  let charToLayer ch = 
    match Int32.TryParse(string ch) with
    | (true, n) -> n
    | _ -> -1
  let strToRow (s:string) =
    s.TrimEnd(' ').ToCharArray()
    |> Array.map charToLayer 
  let layout = 
    str.Split('\n') 
    |> Array.map strToRow
    |> Array.filter (fun r -> r.Length <> 0)
  let maxLayer = 
    layout 
    |> Array.maxBy Array.max 
    |> Array.max
  seq {
    let l = Array.copy layout
    let blockOffs = [|0, 0; 1, 0; 0, 1; 1, 1|]
    for layer in maxLayer .. -1 .. 1 do
      for row in 0 .. layout.Length - 2 do
        for col in 0 .. layout.[row].Length - 2 do
        let isBlock = Array.forall (fun (x,y) -> l.[row + x].[col + y] = layer) blockOffs
        if isBlock then
          yield (col, row, layer)
          blockOffs |> Array.iter (fun (x, y) -> l.[row + x].[col + y] <- layer - 1) 
  } |> Seq.toArray

Then, the value layouts would contain the list of possible boards. It takes the input file, splits out the board descriptions and parses every of them:

let layouts = 
  let splitSections (res, s) (line:string) = 
    if line.StartsWith("-") then (s::res, "") else (res, s + "\n" + line)
  seq {
      use sr = new StreamReader(fullPath LAYOUTS_FILE)
      while not sr.EndOfStream do yield sr.ReadLine()
  } |> Seq.fold splitSections ([],"") 
    |> fst 
    |> List.rev 
    |> List.filter (fun l -> l.Length > 0) 
    |> List.toArray 
    |> Array.choosei (function | i, x when i%2 = 1 -> Some x | _ -> None)
    |> Array.map parseLayout
    |> Array.map (Array.sortBy (fun (x, y, h) -> x + y + h*1000))

Another value, languages contains the array of Name/URL tuples for all the possible stone faces.

let languages = 
  seq {
        use sr = new StreamReader(fullPath LANGUAGES_FILE)
        while not sr.EndOfStream do yield sr.ReadLine()
    } 
    |> Seq.map (fun s -> s.Trim().Split('|'))
    |> Seq.filter (fun el -> el.Length = 2)
    |> Seq.map (fun el -> (el.[0], el.[1]))
    |> Seq.toArray

Game logic (functional part)

The function isFree is used to find out if stone with given coordinates is "free", i.e. it can be removed from the board. By Mahjong solitaire rules, the stone is free when it does not have other stones on top of it and also there is no other stones to either left or right side (or both).

This function is somewhat unusual - instead of immediately returning true/false it returns another function instead, and that function can be used to test if the stone is free.

The reason for this is that we employ here a technique called memoization: we internally create a hash map that given the cell coordinates (in 0.5-stone based coordinate system) gives us the index of the stone, this hash map is "remembered" via a closure and can be reused for all the subsequent lookups.

The function that is returned also takes the array of current stone states, so that we are taking into account already removed stones (they should not block anything).

let isFree coords = 
  //  create hash table with coordinates to quickly find neighbors
  let m = System.Collections.Generic.Dictionary()
  let addStone i (x, y, h) = 
    [|0, 0; 1, 0; 0, 1; 1, 1|]
    |> Array.iter (fun (dx, dy) -> m.Add((x + dx, y + dy, h), i))
  coords |> Array.iteri addStone
  fun (states:StoneState[]) stoneID ->
    let (x, y, h) = coords.[stoneID]
    let isBlockedBy offsets = 
      let isBlocking (dx, dy, dh) =
        let key = (x + dx, y + dy, h + dh)
        if m.ContainsKey key then states.[m.[key]] <> Hidden else false
      offsets |> List.exists isBlocking
    let top = [0, 0, 1; 0, 1, 1; 1, 0, 1; 1, 1, 1]
    let left = [-1, 0, 0; -1, 1, 0]
    let right = [2, 0, 0; 2, 1, 0]
    not (isBlockedBy top || (isBlockedBy left && isBlockedBy right))

The next function, getFree uses the previous one to get the current list of free stones. Note that F# would "take care" that the costly isFree coords is called only once and it's just the the resulting function that is reapplied (curried) to all of the coordinates.

let getFree coords (states:StoneState[]) =
  [0 .. states.Length - 1]
  |> List.filter (fun i -> states.[i] <> Hidden)
  |> List.filter (isFree coords states)

The function getMatches returns the list of stones that can be removed: they are both free and have a matching pair which is also free:

let getMatches (ids:int[]) coords states = 
  let free = getFree coords states 
  free
  |> Set.ofList 
  |> Set.filter (fun i -> 
    (List.sumBy (function 
      | a when ids.[a] = ids.[i] -> 1 
      | _ -> 0) free) > 1)
  |> Seq.toList

The next two functions, arrangeRandom and tryArrangeSolvable, both shuffle the given arrays of stones in a random way.

The difference between them is that the first one is doing this plain randomly, while the second one tries to create the order that is both random and solvable.

Most of the existing Mahjong Solitaire implementations have a "shuffle" button, but many of them do it without caring if the resulting shuffled layout is actually solvable at all. Which can be very annoying.

So the "shuffle solvable" algorithm does the following:

1. finds all the face type pairs that are left to be removed on the board and shuffles them
2. "clears" all the visible stones
3. takes a random pair of "free" stones (those that can be removed)
4. assigns the next face type from the array found at the step 1 to the chosen random pair of free stones
5. goes to the step 3, until all of the remaining stones are assigned faces or until there is only one free stone left (in which case the algorithm fails)

It is possible, that the current board layout does not allow to create the solvable position at all (as a simple example, imagine that there are only two stones left, one on top of another).

That's why the shuffling is attempted several times before giving up. In case when there is only one free stone remains on step 5, we don't know for sure if that's because of the unsolvable layout or because of the way we've been choosing the stone pairs on step 3.

let arrangeRandom (coords:(int*int*int)[]) (stoneTypes:int[]) = 
  Some(stoneTypes |> Array.shuffle)

let tryArrangeSolvable (coords:(int*int*int)[]) (stoneTypes:int[]) = 
  let stonePairTypes =
    stoneTypes
    |> Array.sort
    |> Array.choosei (function | i, x when i%2 = 0 -> Some x | _ -> None)
    |> Array.shuffle
  let isFree' = isFree coords
  let s = seq { 
    let states = [|for x in 1 .. coords.Length do yield Visible|]    
    for c in stonePairTypes do
      let nextFree = 
        [0..(coords.Length - 1)]
        |> List.filter (fun x -> states.[x] = Visible)
        |> List.filter (isFree' states)
        |> List.toArray
        |> Array.shuffle
        |> Seq.truncate 2
        |> Seq.map (fun x -> (x, c))
      nextFree |> Seq.iteri (fun i (x, c) -> states.[x] <- Hidden)
      yield! nextFree
  } 
  let ids = s |> Seq.toArray |> Array.sortBy fst |> Array.map snd 
  let numStones = Seq.length stoneTypes
  if ids.Length <> numStones then None else Some ids

Then, the shuffleVisible function does the actual shuffling via a "shuffle function" (that can be one of the two previous functions) provided as an argument:

let shuffleVisible coords (ids:int[]) (states:StoneState[]) shuffleFn =
  let isVisible = (function | i, id when states.[i] = Visible -> Some id | _ -> None)
  let shuffled = 
    ids
    |> Array.choosei isVisible
    |> Utils.tryApply MAX_ARRANGE_ATTEMPTS (shuffleFn (Array.choosei isVisible coords))
  match shuffled with
  | Some (s:int[]) -> 
    ids 
    |> Array.zip3 states [|0..(states.Length - 1)|] 
    |> Array.filter (fun (st, _, _) -> st = Visible)
    |> Array.iteri (fun i (_, idx, _) -> ids.[idx] <- s.[i])
    true
  | None -> 
    MessageBox.Show "Not possible to create solvable position!" |> ignore
    false

Function getMaxLayer just returns the highest layer number used in the current board layout:

let getMaxLayer coords = 
  let  _, _, m = coords |> Array.maxBy (fun (_, _, h) -> h)
  m

UI/Drawing

We'll have a minimalistic GUI with a main menu and a status bar. The layout is described in a XAML file (mahjong.xaml) that goes like this:

<Window xmlns="http://schemas.microsoft.com/winfx/2006/xaml/presentation"
        xmlns:x="http://schemas.microsoft.com/winfx/2006/xaml"
        Title="F#/WPF Mahjong Solitaire" Background="#4f3d22" Width="1024" Height="768">
  <Grid>
    <Grid.RowDefinitions>
      <RowDefinition Height="Auto"/>
      <RowDefinition Height="*"/>
      <RowDefinition Height="Auto"/>
    </Grid.RowDefinitions>
    <Menu  Grid.Row="0">
      <MenuItem Header="Game">
        <MenuItem Header="New">
          <MenuItem Name="MenuRandom" Header="Random"/>
          <Separator/>
          <MenuItem Name="MenuTurtle" Header="Turtle"/>
          <MenuItem Name="MenuDragon" Header="Dragon"/>
          <MenuItem Name="MenuCrab" Header="Crab"/>
          <MenuItem Name="MenuSpider" Header="Spider"/>
        </MenuItem>
        <Separator/>
        <MenuItem Name="MenuUndo" Header="Undo"/>
        <MenuItem Name="MenuShuffle" Header="Shuffle"/>
        <MenuItem Name="MenuShuffleSolvable" Header="Shuffle Solvable"/>
        <Separator/>
        <MenuItem Name="MenuExit" Header="Exit"/>
      </MenuItem>
      <MenuItem Header="View">
        <MenuItem Name="MenuShowFree" Header="Show Free"/>
        <MenuItem Name="MenuShowMatches" Header="Show Matches"/>
        <Separator/>
        <MenuItem Name="MenuHideLayer" Header="Hide layer"/>
        <MenuItem Name="MenuUnhideLayer" Header="Unhide layer"/>
      </MenuItem>
      <MenuItem Header="Help">
        <MenuItem Name="MenuAbout" Header="About"/>
      </MenuItem>
    </Menu>
    <Canvas Grid.Row="1" Name="BoardCanvas" Margin="35,60,30,50" />
    <StatusBar Grid.Row="2">
      <StatusBarItem>
        <Button Name="StoneInfoURL">
          <Button.Template>
            <ControlTemplate TargetType="{x:Type Button}">
              <ContentPresenter/>
            </ControlTemplate>
          </Button.Template>
          <TextBlock Name="StoneName" Cursor="Hand" VerticalAlignment="Bottom"
                     Foreground="Blue" TextDecorations="Underline"/>
        </Button>
      </StatusBarItem>
    </StatusBar>
  </Grid>
</Window>

We load the XAML file, creating the corresponding WPF Window object named window and call Show() to it:

let loadXamlWindow (filename:string) =
  let reader = XmlReader.Create(filename)
  XamlReader.Load(reader) :?> Window

let window = loadXamlWindow(fullPath MAIN_WINDOW_XAML)
window.Show()

The next function, spriteBrush, creates a WPF image brush corresponding to the given frame in the given sprite atlas:

let spriteBrush atlas id =
  let imgSource = new BitmapImage(new Uri(fullPath atlas.File))
  let stoneW, stoneH = 1./(float atlas.Cols), 1./(float atlas.Rows)
  let viewBox = new Rect(stoneW*(float (id % atlas.Cols)), 
                         stoneH*(float (id / atlas.Cols)), stoneW, stoneH)
  new ImageBrush(ImageSource = imgSource, Viewbox = viewBox)

We will represent every stone's visual with a pair of WPF Rectangle objects: one for the background image, and one for the face image on top of it (yes, it's far from being an efficient/elegant way of doing this, but it will do for now).

The next function, updateStoneControl takes this pair of Rectangle's and changes their brushes such that the stone visual corresponds to both stone face type and stone state:

let updateStoneControl stoneControl id state = 
  let (bg:Rectangle), (fg:Rectangle) = stoneControl
  let spriteID = if state = Selected then 1 else 0
  let selBrush = spriteBrush BG_ATLAS spriteID
  match state with
  | Hidden -> bg.Fill <- null; fg.Fill <- null
  | _ -> bg.Fill <- selBrush
  let imgBrush = 
    match state with
    | Hidden -> null
    | _ -> spriteBrush FG_ATLAS id
  fg.Fill <- imgBrush

Similarly, setStoneOpacity updates only transparency for the given stone visual (we'll need it for the "hide layer" feature):

let setStoneOpacity opacity (fg:Rectangle, bg:Rectangle) =
    fg.Opacity <- opacity; bg.Opacity <- opacity;

Function getStoneLocation computes the position of the stone visuals on the canvas, given the stone coordinates in the 0.5-based coordinate system. It takes into account the layer number as well, simulating the "3D offset" (the higher the layer is, the bigger is the offset):

let getStoneLocation (i, j, layer) =
  let lx, ly = STONE_3D_OFFSET
  let sx, sy = STONE_EXTENTS
  let x = (float i)*sx*0.5 + (float layer)*lx
  let y = (float j)*sy*0.5 + (float layer)*ly
  (x, y, sx - lx, sy - ly)

Finally, the very function that creates the initial pairs of WPF Rectangle's for every stone, createStoneControls.

It adds the rectangles as children to the "BoardCanvas", the Canvas control that is described in the XAML file and created when the XAML was loaded:

let createStoneControls stoneDataArr =
  let createControlPair (id, (i, j, layer)) =
    let (x, y, _, _) = getStoneLocation(i, j, layer)
    let bg = new Rectangle(Width = BG_ATLAS.FrameWidth, Height = BG_ATLAS.FrameHeight)
    Canvas.SetLeft(bg, x)
    Canvas.SetTop(bg, y)   
    let fg = new Rectangle(Width = FG_ATLAS.FrameWidth, Height = FG_ATLAS.FrameHeight)
    Canvas.SetLeft(fg, x + 2.)
    Canvas.SetTop(fg, y + 10.)
    let controls = (bg, fg)
    updateStoneControl controls id Visible
    controls

  let canvas = window.FindName("BoardCanvas") :?> Canvas
  canvas.Children.Clear()
  stoneDataArr 
    |> Array.map createControlPair 
    |> Array.map (fun (bg, fg) -> 
                    canvas.Children.Add(bg) |> ignore
                    canvas.Children.Add(fg) |> ignore
                    (bg, fg))

Game logic (imperative part)

What comes next is imperative code that implements player actions via mutating the current game state object (of type Game, described earlier).

The first function, newGame, returns a new pristine game state object with given board layout. That (mutable) object, game is further created.

There is also a helper function startGame, which wraps the new game object creation.

let newGame layoutID =
  let coords = layouts.[layoutID]
  let states = Array.init coords.Length (fun _ -> Visible)
  let ids = 
    [|0..(Array.length languages - 1)|] 
    |> Array.shuffle 
    |> Array.replicate 0 ((Array.length coords)/4) 4
  shuffleVisible coords ids states tryArrangeSolvable |> ignore
  let controls = 
    coords
    |> Array.zip ids
    |> createStoneControls
  { StoneCoords =  coords
    StoneStates = states
    CurSelected = None
    Moves = []
    StoneIDs = ids
    NumHiddenLayers = 0
    StoneControls = controls }

let mutable game = newGame ((new System.Random()).Next(0, Array.length layouts))

let startGame id = 
  fun _ -> game <- newGame id

The next bunch of functions do not do much per se, wrapping different possible player actions:

• shuffleStones - shuffling the visible stones via given shuffle method
• setStoneState - change the state of the given stone
• undoMove - undo the last move
• unselectAll - unselects all the currently selected stones
• showFreeStones - select all the stones that are currently "free"
• showMatchingStones - select all the stones that are both "free" and have free matching stones

Every of them has explicit "update the stone visual" as the last step, because every of these actions would affect stones appearence in some way.

Now, while this is straightforward, it does not seem to be elegant at all. It feels that there should be some better way of handling the propagation of state change to get reflected by the visual appearance. But let's return to it later and stick to what kind of works for now.

let shuffleStones shuffleFn = 
  let shuffled = shuffleVisible game.StoneCoords game.StoneIDs game.StoneStates shuffleFn
  //  update stone controls
  game.StoneStates 
  |> Array.iteri (fun i state -> updateStoneControl game.StoneControls.[i] game.StoneIDs.[i] state)
  shuffled

let setStoneState state idx =
  game.StoneStates.[idx] <- state
  updateStoneControl game.StoneControls.[idx] game.StoneIDs.[idx] state

let undoMove () = 
  match game.Moves with
  | a::b::rest -> game.Moves <- rest; setStoneState Visible a; setStoneState Visible b;
  | _ -> ()

let unselectAll () = 
    game.CurSelected <- None
    [|0 .. game.StoneCoords.Length - 1|] 
    |> Array.filter (fun i -> game.StoneStates.[i] <> Hidden) 
    |> Array.iter (setStoneState Visible)

let showFreeStones () =  
  unselectAll ()
  getFree game.StoneCoords game.StoneStates |> List.iter (setStoneState Selected)

let showMatchingStones () = 
  unselectAll ()
  getMatches game.StoneIDs game.StoneCoords game.StoneStates |> List.iter (setStoneState Selected)

Function hideLayers changes the transparency of +/-delta given stone layers, such that it's possible to see what's beneath the top layers.

This feature tries to make our Mahjong Solitaire puzzle into a game with full information (otherwise it generally would not be possible to deterministically come up with a proper stone removal strategy without seeing what's beneath the top stones).

let hideLayers delta = 
  let newHiddenLayers = game.NumHiddenLayers + delta
  let maxLayer = getMaxLayer game.StoneCoords
  if newHiddenLayers >= 0 && newHiddenLayers < maxLayer then
    game.NumHiddenLayers <- newHiddenLayers
    game.StoneCoords |> Array.iteri (fun i (_, _, h) -> 
      let alpha = (if h <= maxLayer - newHiddenLayers then 1.0 else 0.2)
      setStoneOpacity alpha game.StoneControls.[i])

removeStonePair removes the given (matching) pair of stones and also analyses the board layout after that, reacting correspondingly:

let removeStonePair s1 s2 = 
  unselectAll () 
  setStoneState Hidden s1 
  setStoneState Hidden s2 
  game.Moves <- s1::s2::game.Moves;
  if (game.StoneStates |> Array.forall (fun st -> st = Hidden)) then 
    MessageBox.Show "Amazing, you've won in this impossible game!" |> ignore
    startGame 0 |> ignore
  elif ((getMatches game.StoneIDs game.StoneCoords game.StoneStates).Length = 0) then 
    if (shuffleStones tryArrangeSolvable) then
      MessageBox.Show "No more possible moves. Shuffling the remaining stones." |> ignore
    else
      MessageBox.Show "No more possible moves and not possible to shuffle." |> ignore
      startGame 0 |> ignore

Function clickStone handles the event of a stone with given index having been clicked. Depending on the context, that can result in either selecting the stone, or stone pair removal, or unselecting all the stones etc.

let clickStone stone = 
  let selectStone s =
    setStoneState Selected s
    game.CurSelected <- Some(s)
    let url, lang = languages.[game.StoneIDs.[s]]
    let status = window.FindName("StoneName") :?> TextBlock
    status.Text <- lang
  let s = match stone with
              | Some stoneIdx when (isFree game.StoneCoords game.StoneStates stoneIdx) -> Some stoneIdx
              | _ -> None
  match s, game.CurSelected with
  | Some c, Some s when c = s -> unselectAll ()
  | Some c, Some s when game.StoneIDs.[c] = game.StoneIDs.[s] -> removeStonePair c s
  | Some c, None -> selectStone c
  | _, _ -> unselectAll ()

UI/Input

The final part is responsible for the input: mouse clicks on the board and menu item clicks.

The mouse clicks are handled by attaching custom function (handleMouseClick) to the stream of filtered "mouse down" events sent to the board canvas control:

let handleMouseClick (mx, my) = 
  let stone = 
    game.StoneCoords 
    |> Array.map getStoneLocation
    |> Array.tryFindLastIndexi (fun n (x, y, w, h) -> 
      game.StoneStates.[n] <> Hidden && mx > x && my > y && mx < x + w && my < y + h)
  clickStone stone

let events = 
  let canvas = window.FindName("BoardCanvas") :?> Canvas
  window.MouseDown
  |> Event.filter (fun mi -> (mi.ChangedButton = Input.MouseButton.Left && 
                              mi.ButtonState = Input.MouseButtonState.Pressed))
  |> Event.map (fun mi -> (mi.GetPosition(canvas).X, mi.GetPosition(canvas).Y))
  |> Event.add handleMouseClick

Menu item clicks are bound to the corresponding functions (the binding itself happens via a helper function bindMenuItem):

let bindMenuItem (name, fn) =
  let menuItem = window.FindName(name) :?> MenuItem
  menuItem.Click.Add(fun _ -> fn ())

[ "MenuUndo", undoMove
  "MenuShuffleSolvable", fun _ -> shuffleStones tryArrangeSolvable |> ignore
  "MenuShuffle", fun _ -> shuffleStones arrangeRandom |> ignore
  "MenuShowFree", showFreeStones
  "MenuShowMatches", showMatchingStones
  "MenuHideLayer", fun _ -> hideLayers 1
  "MenuUnhideLayer", fun _ -> hideLayers -1
  "MenuRandom", startGame ((new System.Random()).Next(0, Array.length layouts))
  "MenuTurtle", startGame 0
  "MenuDragon", startGame 1
  "MenuCrab", startGame 2
  "MenuSpider", startGame 3
  "MenuExit", window.Close
  "MenuAbout", fun _ -> Diagnostics.Process.Start ABOUT_URL |> ignore
] |> List.iter bindMenuItem

The final few lines add the handler for a click on the currently selected stone URL "button" in the status bar (that would open a web-browser with the linked page):

let stoneURL = window.FindName("StoneInfoURL") :?> Button
stoneURL.Click.Add(fun _ -> 
                    match game.CurSelected with
                    | Some sel -> Diagnostics.Process.Start (fst languages.[game.StoneIDs.[sel]]) |> ignore
                    | None -> ())

That's all. There are many questions unanswered and things to improve here. I hope to address some of them later.