2 people like it.

Minesweeper Kata 2

Solution to Minesweeper Kata second challenge at Goto Copenhagen 2012 conference "Programming with the Stars" track. Runnable at http://tryfsharp.org.

  1: 
  2: 
  3: 
  4: 
  5: 
  6: 
  7: 
  8: 
  9: 
 10: 
 11: 
 12: 
 13: 
 14: 
 15: 
 16: 
 17: 
 18: 
 19: 
 20: 
 21: 
 22: 
 23: 
 24: 
 25: 
 26: 
 27: 
 28: 
 29: 
 30: 
 31: 
 32: 
 33: 
 34: 
 35: 
 36: 
 37: 
 38: 
 39: 
 40: 
 41: 
 42: 
 43: 
 44: 
 45: 
 46: 
 47: 
 48: 
 49: 
 50: 
 51: 
 52: 
 53: 
 54: 
 55: 
 56: 
 57: 
 58: 
 59: 
 60: 
 61: 
 62: 
 63: 
 64: 
 65: 
 66: 
 67: 
 68: 
 69: 
 70: 
 71: 
 72: 
 73: 
 74: 
 75: 
 76: 
 77: 
 78: 
 79: 
 80: 
 81: 
 82: 
 83: 
 84: 
 85: 
 86: 
 87: 
 88: 
 89: 
 90: 
 91: 
 92: 
 93: 
 94: 
 95: 
 96: 
 97: 
 98: 
 99: 
100: 
101: 
102: 
103: 
104: 
105: 
106: 
107: 
108: 
109: 
110: 
111: 
112: 
113: 
114: 
115: 
116: 
117: 
118: 
119: 
120: 
121: 
122: 
123: 
124: 
125: 
126: 
127: 
128: 
#if INTERACTIVE
#else
namespace MinesweeperGame
#endif

module Game =
    let compute (lines:string[]) =
        let value c = 
            match c with
            | '*' -> 1
            | '.' -> 0
            | _ -> failwith "Unexpected value"
        let count (x,y) =
            [-1,-1; 0,-1; 1,-1
             -1, 0;       1, 0
             -1, 1; 0, 1; 1, 1]
            |> List.sumBy (fun (dx,dy) ->
                let x, y = x + dx, y + dy
                if y>=0 && y<lines.Length && x>=0 && x<lines.[y].Length
                then lines.[y].[x] |> value
                else 0
            )
        lines |> Array.mapi (fun y line ->
            line.ToCharArray() |> Array.mapi (fun x c ->
                let neighbours = count(x,y)    
                match c with
                | '*' -> c
                | '.' when neighbours > 0 -> '0' + char (neighbours)
                | '.' -> ' '
                | _ -> failwith "Unexpected value"  
            )
        )        

[<AutoOpen>]
module Algorithm =
    let flood canFill fill (x,y) =
        let rec next = function
            | [] -> ()
            | ps ->     
                let qs = 
                    ps 
                    |> List.filter canFill           
                    |> List.collect (fun (x,y) -> 
                        [(x-1,y);(x+1,y);(x,y-1);(x,y+1)]
                    )                
                ps |> List.iter fill
                qs |> next
        next [(x,y)]

open System
open System.Windows
open System.Windows.Controls
open System.Windows.Media

type Minefield (lines:char[][]) as grid =
    inherit Grid()       
    do  for line in lines do grid.RowDefinitions.Add(RowDefinition()) 
        for _ in lines.[0] do grid.ColumnDefinitions.Add(ColumnDefinition())
    let squares =
        lines |> Array.mapi (fun y line ->         
            line |> Array.mapi (fun x c ->            
                let square = Button()            
                Grid.SetColumn(square,x)
                Grid.SetRow(square,y)            
                grid.Children.Add square
                c, square
            )       
        )
    let iter f =
        squares |> Array.iteri (fun y line ->
            line |> Array.iteri (fun x (c,square) ->f (x,y) (c,square))
        )
    let reveal (square:Button) c =
        square.Content <- c.ToString()
        square.Background <- SolidColorBrush Colors.Transparent
        square.Tag <- 1
    let isInRange (x,y) =
        y >= 0  && y < squares.Length &&
        x >= 0  && x < squares.[0].Length
    let canFill (x,y) = 
        isInRange (x,y) &&
        squares.[y].[x] |> fst |> ((=) ' ') &&
        ((squares.[y].[x] |> snd).Tag) = null
    let fill (x,y) = 
        if isInRange (x,y) then
            let c, square = squares.[y].[x] 
            reveal square c
    let mutable disposables = []
    let remember d = disposables <- d::disposables
    let listen (x,y) (c,square:Button) =
        square.Click |> Observable.subscribe (fun _ ->               
            if c = ' ' then flood canFill fill (x,y)  
            if c = '*' then reveal square '※'
            else reveal square c            
        ) |> remember
    do  iter listen
    interface IDisposable with
        member field.Dispose() =
            for d in disposables do d.Dispose()

type GameControl() =
    inherit UserControl(Width = 300.0, Height = 400.0)
    let minefield = "*...
....
.*..
...."
    let options = System.StringSplitOptions.RemoveEmptyEntries
    let lines = minefield.Split([|'\r';'\n'|], options)    
    let grid = new Minefield(Game.compute lines)
    do  base.Content <- grid

#if INTERACTIVE
open Microsoft.TryFSharp
App.Dispatch (fun() -> 
    App.Console.ClearCanvas()
    let canvas = App.Console.Canvas
    canvas.Background <- SolidColorBrush Colors.Black
    let control = GameControl()    
    control |> canvas.Children.Add
    App.Console.CanvasPosition <- CanvasPosition.Right
    control.Focus() |> ignore
)
#else
type App() as app = 
    inherit Application()
    let main = new GameControl()
    do app.Startup.Add(fun _ -> app.RootVisual <- GameControl())
#endif
val compute : lines:string [] -> char [] []

Full name: Script.Game.compute
val lines : string []
Multiple items
val string : value:'T -> string

Full name: Microsoft.FSharp.Core.Operators.string

--------------------
type string = System.String

Full name: Microsoft.FSharp.Core.string
val value : (char -> int)
val c : char
val failwith : message:string -> 'T

Full name: Microsoft.FSharp.Core.Operators.failwith
val count : (int * int -> int)
val x : int
val y : int
Multiple items
module List

from Microsoft.FSharp.Collections

--------------------
type List<'T> =
  | ( [] )
  | ( :: ) of Head: 'T * Tail: 'T list
  interface IEnumerable
  interface IEnumerable<'T>
  member Head : 'T
  member IsEmpty : bool
  member Item : index:int -> 'T with get
  member Length : int
  member Tail : 'T list
  static member Cons : head:'T * tail:'T list -> 'T list
  static member Empty : 'T list

Full name: Microsoft.FSharp.Collections.List<_>
val sumBy : projection:('T -> 'U) -> list:'T list -> 'U (requires member ( + ) and member get_Zero)

Full name: Microsoft.FSharp.Collections.List.sumBy
val dx : int
val dy : int
property System.Array.Length: int
module Array

from Microsoft.FSharp.Collections
val mapi : mapping:(int -> 'T -> 'U) -> array:'T [] -> 'U []

Full name: Microsoft.FSharp.Collections.Array.mapi
val line : string
System.String.ToCharArray() : char []
System.String.ToCharArray(startIndex: int, length: int) : char []
val neighbours : int
Multiple items
val char : value:'T -> char (requires member op_Explicit)

Full name: Microsoft.FSharp.Core.Operators.char

--------------------
type char = System.Char

Full name: Microsoft.FSharp.Core.char
Multiple items
type AutoOpenAttribute =
  inherit Attribute
  new : unit -> AutoOpenAttribute
  new : path:string -> AutoOpenAttribute
  member Path : string

Full name: Microsoft.FSharp.Core.AutoOpenAttribute

--------------------
new : unit -> AutoOpenAttribute
new : path:string -> AutoOpenAttribute
val flood : canFill:(int * int -> bool) -> fill:(int * int -> unit) -> x:int * y:int -> unit

Full name: Script.Algorithm.flood
val canFill : (int * int -> bool)
val fill : (int * int -> unit)
val next : ((int * int) list -> unit)
val ps : (int * int) list
val qs : (int * int) list
val filter : predicate:('T -> bool) -> list:'T list -> 'T list

Full name: Microsoft.FSharp.Collections.List.filter
val collect : mapping:('T -> 'U list) -> list:'T list -> 'U list

Full name: Microsoft.FSharp.Collections.List.collect
val iter : action:('T -> unit) -> list:'T list -> unit

Full name: Microsoft.FSharp.Collections.List.iter
namespace System
namespace System.Windows
namespace System.Media
Multiple items
type Minefield =
  inherit obj
  interface IDisposable
  new : lines:char [] [] -> Minefield

Full name: Script.Minefield

--------------------
new : lines:char [] [] -> Minefield
val lines : char [] []
Multiple items
val char : value:'T -> char (requires member op_Explicit)

Full name: Microsoft.FSharp.Core.Operators.char

--------------------
type char = Char

Full name: Microsoft.FSharp.Core.char
val grid : Minefield
type Array =
  member Clone : unit -> obj
  member CopyTo : array:Array * index:int -> unit + 1 overload
  member GetEnumerator : unit -> IEnumerator
  member GetLength : dimension:int -> int
  member GetLongLength : dimension:int -> int64
  member GetLowerBound : dimension:int -> int
  member GetUpperBound : dimension:int -> int
  member GetValue : [<ParamArray>] indices:int[] -> obj + 7 overloads
  member Initialize : unit -> unit
  member IsFixedSize : bool
  ...

Full name: System.Array
val iteri : action:(int -> 'T -> unit) -> array:'T [] -> unit

Full name: Microsoft.FSharp.Collections.Array.iteri
val fst : tuple:('T1 * 'T2) -> 'T1

Full name: Microsoft.FSharp.Core.Operators.fst
val snd : tuple:('T1 * 'T2) -> 'T2

Full name: Microsoft.FSharp.Core.Operators.snd
module Observable

from Microsoft.FSharp.Control
val subscribe : callback:('T -> unit) -> source:IObservable<'T> -> IDisposable

Full name: Microsoft.FSharp.Control.Observable.subscribe
type IDisposable =
  member Dispose : unit -> unit

Full name: System.IDisposable
override Minefield.Dispose : unit -> unit

Full name: Script.Minefield.Dispose
Multiple items
type GameControl =
  inherit obj
  new : unit -> GameControl

Full name: Script.GameControl

--------------------
new : unit -> GameControl
type StringSplitOptions =
  | None = 0
  | RemoveEmptyEntries = 1

Full name: System.StringSplitOptions
field StringSplitOptions.RemoveEmptyEntries = 1
module Game

from Script

More information

Link:http://fssnip.net/cc
Posted:11 years ago
Author:Phillip Trelford
Tags: kata , silverlight , game