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: 
129: 
130: 
131: 
132: 
133: 
134: 
135: 
136: 
137: 
138: 
139: 
140: 
141: 
142: 
143: 
144: 
145: 
146: 
147: 
148: 
149: 
150: 
151: 
152: 
153: 
154: 
155: 
156: 
157: 
158: 
159: 
160: 
161: 
162: 
163: 
164: 
165: 
166: 
167: 
168: 
169: 
170: 
171: 
172: 
173: 
174: 
175: 
176: 
177: 
178: 
179: 
180: 
181: 
182: 
183: 
184: 
185: 
186: 
187: 
188: 
189: 
190: 
191: 
192: 
193: 
194: 
195: 
196: 
197: 
198: 
199: 
200: 
#if INTERACTIVE
#else
namespace MinesweeperGame
#endif

module Value =
    let count (chars:char[][]) (x,y) =
        [-1,-1; 0,-1; 1,-1
         -1, 0;       1, 0
         -1, 1; 0, 1; 1, 1]
        |> List.filter (fun (dx,dy) ->
            let x, y = x + dx, y + dy
            y>=0 && y<chars.Length && 
            x>=0 && x<chars.[y].Length &&
            chars.[y].[x] = '*'
        )
        |> List.length
    let from chars (x,y) c =
        let neighbours = count chars (x,y)
        match c with
        | '*' -> c
        | '.' when neighbours > 0 -> '0' + char (neighbours)
        | '.' -> ' '
        | _ -> new System.ArgumentException("Unexpected character") |> raise

[<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)]

type SquareState = { Value:char; mutable IsShowing:bool }
type SquareInfo = { X:int; Y:int; Value:char }

type Minefield (squares:SquareState[][]) =
    let height, width = squares.Length, squares.[0].Length
    let isInRange (x,y) =
        y >= 0  && y < height &&
        x >= 0  && x < width
    let surroundingSquares (x,y) =
        let values = System.Collections.Generic.List<_>()
        let canFill (x,y) = 
            isInRange (x,y) &&
            squares.[y].[x].Value=' ' &&
            not squares.[y].[x].IsShowing
        let fill (x,y) = 
            if isInRange (x,y) then
                let square = squares.[y].[x]
                if not square.IsShowing then
                    square.IsShowing <- true
                    values.Add(x,y,square.Value)
        flood canFill fill (x,y)
        values |> Seq.toList |> Seq.distinct |> Seq.toArray
    let mines =
        squares |> Array.mapi (fun y row -> 
            row |> Array.mapi (fun x square -> 
                (x,y,'*'), (square.Value = '*')
            )
        )
        |> Array.concat
        |> Array.filter snd
        |> Array.map fst
    let reveal (x,y) =
        let square = squares.[y].[x]
        if square.IsShowing
        then [||]
        else
            match square.Value with
            | '*' -> mines
            | ' ' -> surroundingSquares (x,y)
            |  c  ->
                square.IsShowing <- true
                [|x,y,c|]
        |> Array.map (fun (x,y,c) -> { X=x; Y=y; Value=c })
    new (chars:char[][]) =
        Minefield(
            chars |> Array.mapi (fun y row ->
                row |> Array.mapi (fun x c -> 
                    let value = Value.from chars (x,y) c
                    { Value=value; IsShowing=false} )
            ))
    member field.Mines = mines.Length
    member field.Width = width
    member field.Height = height
    member field.Reveal(x,y) = reveal (x,y)

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

type GameView (minefield:Minefield) as grid =
    inherit Grid()
    let completed = Event<_>()
    do  for i in 1..minefield.Height do
            grid.RowDefinitions.Add(RowDefinition()) 
        for i in 1..minefield.Width do 
            grid.ColumnDefinitions.Add(ColumnDefinition())
    let init f =
        [| for y in 0..minefield.Height-1 ->
            [| for x in 0..minefield.Width-1 -> f (x,y) |] |]
    let iteri f squares =
        squares |> Array.iteri (fun y line ->
            line |> Array.iteri (fun x square -> f (x,y) square)
        )
    let addSquare (x,y) =
        let square = Button()
        square.FontFamily <- FontFamily("Courier New")
        square.FontSize <- 24.0
        square.FontWeight <- FontWeights.ExtraBold
        Grid.SetColumn(square,x)
        Grid.SetRow(square,y)
        grid.Children.Add square |> ignore
        square
    let squares = init addSquare
    let reveal (square:Button) c =
        square.Content <- c.ToString()
        square.Background <- SolidColorBrush Colors.Transparent
    let mutable disposables = []
    let remember d = disposables <- d::disposables
    let mutable revealedCount = 0
    let subscribe (x,y) (square:Button) =
        square.Click |> Observable.subscribe (fun _ ->
            let revealed = minefield.Reveal (x,y)
            for {X=x;Y=y;Value=c} in revealed do reveal (squares.[y].[x]) c
            revealedCount <- revealedCount + revealed.Length
            if revealed.Length > 0 && revealed.[0].Value = '*' 
            then completed.Trigger(false)
            let total = minefield.Width * minefield.Height
            if total - revealedCount = minefield.Mines
            then completed.Trigger(true)
        ) |> remember
    do  iteri subscribe squares
    member this.Completed = completed.Publish
    member this.Dispose() = (this :> IDisposable).Dispose()
    interface IDisposable with
        member field.Dispose() =
            for d in disposables do d.Dispose()

type GameControl() as control =
    inherit UserControl(Width = 300.0, Height = 400.0)
    let minefield = "*...
                     ....
                     .*..
                     ...."
    let chars = 
        let options = System.StringSplitOptions.RemoveEmptyEntries
        minefield.Split([|'\r';'\n'|], options)
        |> Array.map (fun line -> line.Trim().ToCharArray() )
    let grid = new Grid()
    do  control.Content <- grid
    do  async {
        while true do
            let minefield = Minefield(chars)
            let game = new GameView(minefield)
            grid.Children.Add(game) |> ignore
            let! cleared = game.Completed |> Async.AwaitEvent
            game.IsHitTestVisible <- false
            let message =
                if cleared then "Game won"
                else "Game lost"
            let text = TextBlock(Text=message)
            text.FontFamily <-FontFamily("Courier New")
            text.FontSize <- 24.0
            text.FontWeight <- FontWeights.ExtraBold
            text.HorizontalAlignment <- HorizontalAlignment.Center
            text.VerticalAlignment <- VerticalAlignment.Center
            grid.Children.Add(text) |> ignore
            let! _ = control.MouseLeftButtonDown |> Async.AwaitEvent
            grid.Children.Remove(text) |> ignore
            grid.Children.Remove(game) |> ignore
            game.Dispose()
        } |> Async.StartImmediate
    
#if INTERACTIVE
open Microsoft.TryFSharp
App.Dispatch (fun() -> 
    App.Console.ClearCanvas()
    let canvas = App.Console.Canvas
    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 count : chars:char [] [] -> x:int * y:int -> int

Full name: Script.Value.count
val chars : char [] []
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
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 filter : predicate:('T -> bool) -> list:'T list -> 'T list

Full name: Microsoft.FSharp.Collections.List.filter
val dx : int
val dy : int
property System.Array.Length: int
val length : list:'T list -> int

Full name: Microsoft.FSharp.Collections.List.length
val from : chars:char [] [] -> x:int * y:int -> c:char -> char

Full name: Script.Value.from
val c : char
val neighbours : int
namespace System
Multiple items
type ArgumentException =
  inherit SystemException
  new : unit -> ArgumentException + 4 overloads
  member GetObjectData : info:SerializationInfo * context:StreamingContext -> unit
  member Message : string
  member ParamName : string

Full name: System.ArgumentException

--------------------
System.ArgumentException() : unit
System.ArgumentException(message: string) : unit
System.ArgumentException(message: string, innerException: exn) : unit
System.ArgumentException(message: string, paramName: string) : unit
System.ArgumentException(message: string, paramName: string, innerException: exn) : unit
val raise : exn:System.Exception -> 'T

Full name: Microsoft.FSharp.Core.Operators.raise
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 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
type SquareState =
  {Value: char;
   mutable IsShowing: bool;}

Full name: Script.SquareState
Multiple items
SquareState.Value: char

--------------------
module Value

from Script
SquareState.IsShowing: bool
type bool = System.Boolean

Full name: Microsoft.FSharp.Core.bool
type SquareInfo =
  {X: int;
   Y: int;
   Value: char;}

Full name: Script.SquareInfo
SquareInfo.X: int
Multiple items
val int : value:'T -> int (requires member op_Explicit)

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

--------------------
type int = int32

Full name: Microsoft.FSharp.Core.int

--------------------
type int<'Measure> = int

Full name: Microsoft.FSharp.Core.int<_>
SquareInfo.Y: int
Multiple items
SquareInfo.Value: char

--------------------
module Value

from Script
Multiple items
type Minefield =
  new : squares:SquareState [] [] -> Minefield
  new : chars:char [] [] -> Minefield
  member Reveal : x:int * y:int -> SquareInfo []
  member Height : int
  member Mines : int
  member Width : int

Full name: Script.Minefield

--------------------
new : chars:char [] [] -> Minefield
new : squares:SquareState [] [] -> Minefield
val squares : SquareState [] []
val height : int
val width : int
val isInRange : (int * int -> bool)
val surroundingSquares : (int * int -> (int * int * char) [])
val values : System.Collections.Generic.List<int * int * char>
namespace System.Collections
namespace System.Collections.Generic
Multiple items
type List<'T> =
  new : unit -> List<'T> + 2 overloads
  member Add : item:'T -> unit
  member AddRange : collection:IEnumerable<'T> -> unit
  member AsReadOnly : unit -> ReadOnlyCollection<'T>
  member BinarySearch : item:'T -> int + 2 overloads
  member Capacity : int with get, set
  member Clear : unit -> unit
  member Contains : item:'T -> bool
  member ConvertAll<'TOutput> : converter:Converter<'T, 'TOutput> -> List<'TOutput>
  member CopyTo : array:'T[] -> unit + 2 overloads
  ...
  nested type Enumerator

Full name: System.Collections.Generic.List<_>

--------------------
System.Collections.Generic.List() : unit
System.Collections.Generic.List(capacity: int) : unit
System.Collections.Generic.List(collection: System.Collections.Generic.IEnumerable<'T>) : unit
module Value

from Script
val not : value:bool -> bool

Full name: Microsoft.FSharp.Core.Operators.not
val square : SquareState
System.Collections.Generic.List.Add(item: int * int * char) : unit
SquareState.Value: char
module Seq

from Microsoft.FSharp.Collections
val toList : source:seq<'T> -> 'T list

Full name: Microsoft.FSharp.Collections.Seq.toList
val distinct : source:seq<'T> -> seq<'T> (requires equality)

Full name: Microsoft.FSharp.Collections.Seq.distinct
val toArray : source:seq<'T> -> 'T []

Full name: Microsoft.FSharp.Collections.Seq.toArray
val mines : (int * int * char) []
module Array

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

Full name: Microsoft.FSharp.Collections.Array.mapi
val row : SquareState []
val concat : arrays:seq<'T []> -> 'T []

Full name: Microsoft.FSharp.Collections.Array.concat
val filter : predicate:('T -> bool) -> array:'T [] -> 'T []

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

Full name: Microsoft.FSharp.Core.Operators.snd
val map : mapping:('T -> 'U) -> array:'T [] -> 'U []

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

Full name: Microsoft.FSharp.Core.Operators.fst
val reveal : (int * int -> SquareInfo [])
val row : char []
val value : char
val field : Minefield
member Minefield.Mines : int

Full name: Script.Minefield.Mines
member Minefield.Width : int

Full name: Script.Minefield.Width
member Minefield.Height : int

Full name: Script.Minefield.Height
member Minefield.Reveal : x:int * y:int -> SquareInfo []

Full name: Script.Minefield.Reveal
namespace System.Windows
namespace System.Media
Multiple items
type GameView =
  inherit obj
  interface IDisposable
  new : minefield:Minefield -> GameView
  member Dispose : unit -> 'a
  member Completed : 'a

Full name: Script.GameView

--------------------
new : minefield:Minefield -> GameView
val minefield : Minefield
val grid : GameView
Multiple items
module Event

from Microsoft.FSharp.Control

--------------------
type Event<'T> =
  new : unit -> Event<'T>
  member Trigger : arg:'T -> unit
  member Publish : IEvent<'T>

Full name: Microsoft.FSharp.Control.Event<_>

--------------------
type Event<'Delegate,'Args (requires delegate and 'Delegate :> Delegate)> =
  new : unit -> Event<'Delegate,'Args>
  member Trigger : sender:obj * args:'Args -> unit
  member Publish : IEvent<'Delegate,'Args>

Full name: Microsoft.FSharp.Control.Event<_,_>

--------------------
new : unit -> Event<'T>

--------------------
new : unit -> Event<'Delegate,'Args>
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 ignore : value:'T -> unit

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

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

Full name: Microsoft.FSharp.Control.Observable.subscribe
member GameView.Completed : 'a

Full name: Script.GameView.Completed
member GameView.Dispose : unit -> 'a

Full name: Script.GameView.Dispose
type IDisposable =
  member Dispose : unit -> unit

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

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

Full name: Script.GameControl

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

Full name: System.StringSplitOptions
field StringSplitOptions.RemoveEmptyEntries = 1
val async : AsyncBuilder

Full name: Microsoft.FSharp.Core.ExtraTopLevelOperators.async
Multiple items
type Async
static member AsBeginEnd : computation:('Arg -> Async<'T>) -> ('Arg * AsyncCallback * obj -> IAsyncResult) * (IAsyncResult -> 'T) * (IAsyncResult -> unit)
static member AwaitEvent : event:IEvent<'Del,'T> * ?cancelAction:(unit -> unit) -> Async<'T> (requires delegate and 'Del :> Delegate)
static member AwaitIAsyncResult : iar:IAsyncResult * ?millisecondsTimeout:int -> Async<bool>
static member AwaitTask : task:Task<'T> -> Async<'T>
static member AwaitWaitHandle : waitHandle:WaitHandle * ?millisecondsTimeout:int -> Async<bool>
static member CancelDefaultToken : unit -> unit
static member Catch : computation:Async<'T> -> Async<Choice<'T,exn>>
static member FromBeginEnd : beginAction:(AsyncCallback * obj -> IAsyncResult) * endAction:(IAsyncResult -> 'T) * ?cancelAction:(unit -> unit) -> Async<'T>
static member FromBeginEnd : arg:'Arg1 * beginAction:('Arg1 * AsyncCallback * obj -> IAsyncResult) * endAction:(IAsyncResult -> 'T) * ?cancelAction:(unit -> unit) -> Async<'T>
static member FromBeginEnd : arg1:'Arg1 * arg2:'Arg2 * beginAction:('Arg1 * 'Arg2 * AsyncCallback * obj -> IAsyncResult) * endAction:(IAsyncResult -> 'T) * ?cancelAction:(unit -> unit) -> Async<'T>
static member FromBeginEnd : arg1:'Arg1 * arg2:'Arg2 * arg3:'Arg3 * beginAction:('Arg1 * 'Arg2 * 'Arg3 * AsyncCallback * obj -> IAsyncResult) * endAction:(IAsyncResult -> 'T) * ?cancelAction:(unit -> unit) -> Async<'T>
static member FromContinuations : callback:(('T -> unit) * (exn -> unit) * (OperationCanceledException -> unit) -> unit) -> Async<'T>
static member Ignore : computation:Async<'T> -> Async<unit>
static member OnCancel : interruption:(unit -> unit) -> Async<IDisposable>
static member Parallel : computations:seq<Async<'T>> -> Async<'T []>
static member RunSynchronously : computation:Async<'T> * ?timeout:int * ?cancellationToken:CancellationToken -> 'T
static member Sleep : millisecondsDueTime:int -> Async<unit>
static member Start : computation:Async<unit> * ?cancellationToken:CancellationToken -> unit
static member StartAsTask : computation:Async<'T> * ?taskCreationOptions:TaskCreationOptions * ?cancellationToken:CancellationToken -> Task<'T>
static member StartChild : computation:Async<'T> * ?millisecondsTimeout:int -> Async<Async<'T>>
static member StartChildAsTask : computation:Async<'T> * ?taskCreationOptions:TaskCreationOptions -> Async<Task<'T>>
static member StartImmediate : computation:Async<unit> * ?cancellationToken:CancellationToken -> unit
static member StartWithContinuations : computation:Async<'T> * continuation:('T -> unit) * exceptionContinuation:(exn -> unit) * cancellationContinuation:(OperationCanceledException -> unit) * ?cancellationToken:CancellationToken -> unit
static member SwitchToContext : syncContext:SynchronizationContext -> Async<unit>
static member SwitchToNewThread : unit -> Async<unit>
static member SwitchToThreadPool : unit -> Async<unit>
static member TryCancelled : computation:Async<'T> * compensation:(OperationCanceledException -> unit) -> Async<'T>
static member CancellationToken : Async<CancellationToken>
static member DefaultCancellationToken : CancellationToken

Full name: Microsoft.FSharp.Control.Async

--------------------
type Async<'T>

Full name: Microsoft.FSharp.Control.Async<_>
static member Async.AwaitEvent : event:IEvent<'Del,'T> * ?cancelAction:(unit -> unit) -> Async<'T> (requires delegate and 'Del :> Delegate)
namespace System.Text
static member Async.StartImmediate : computation:Async<unit> * ?cancellationToken:Threading.CancellationToken -> unit

More information

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