6 people like it.

Berzerk

Zombie state machine code sample. Use arrow keys to move humanoid. Robots activate when in range of humanoids. Try it out in the browser with 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: 
201: 
202: 
203: 
204: 
205: 
206: 
#if INTERACTIVE
#else
namespace Berzerk
#endif

open System
open System.Windows
open System.Windows.Controls
open System.Windows.Input
open System.Windows.Media
open System.Windows.Media.Imaging

type Keys (control:Control) =
    let mutable keysDown = Set.empty
    do  control.KeyDown.Add (fun e -> keysDown <- keysDown.Add e.Key)
    do  control.KeyUp.Add (fun e -> keysDown <- keysDown.Remove e.Key)
    member keys.IsKeyDown key = keysDown.Contains key

[<AutoOpen>] 
module Imaging =
    let toInt (color:Color) = 
        (int color.A <<< 24) ||| 
        (int color.R <<< 16) ||| 
        (int color.G <<< 8)  ||| 
        (int color.B)
    let toBitmap color width (xs:int list) =
        let on = color |> toInt
        let off = Colors.Black |> toInt
        let toColor = function true -> on | false -> off
        let bitmap = WriteableBitmap(width, xs.Length)
        let pixels = bitmap.Pixels
        xs |> List.iteri (fun y xs ->
            for x = 0 to width-1 do
                let bit = 1 <<< (width - 1 - x) 
                pixels.[x+y*width] <- xs &&& bit = bit |> toColor
        )
        bitmap
    let toImage (bitmap:#BitmapSource) =
        let w = bitmap.GetValue(BitmapSource.PixelWidthProperty) :?> int
        let h = bitmap.GetValue(BitmapSource.PixelHeightProperty) :?> int
        Image(Source=bitmap,Stretch=Stretch.Fill,Width=float w,Height=float h) 
    let rotate xs =
        List.tail xs |> List.fold (fun ys xs ->
            List.zip xs ys
            |> List.map (fun (x,y) -> x::y)
        ) (List.head xs |> List.map (fun x -> [x]))
        |> List.map List.rev    

[<AutoOpen>]
module Game = 
    let rand = Random()
    let run rate update =
        let rate = TimeSpan.FromSeconds(rate)
        let lastUpdate = ref DateTime.Now
        let residual = ref (TimeSpan())
        CompositionTarget.Rendering.Subscribe (fun _ -> 
            let now = DateTime.Now
            residual := !residual + (now - !lastUpdate)
            while !residual > rate do
                update(); residual := !residual - rate
            lastUpdate := now
        )
    let move element (x,y) =
        Canvas.SetLeft(element, x)
        Canvas.SetTop(element, y)

[<AutoOpen>]
module Bits =
    let robot_bits = [ 
        0b00111100
        0b01100110
        0b11111111
        0b10111101
        0b10111101
        0b00111100
        0b00100100
        0b01100110
        ]

    let humanoid_bits = [
        [0b001100; 0b001100]
        [0b001100; 0b001100]
        [0b000000; 0b000000]
        [0b011111; 0b011111]
        [0b101100; 0b101100]
        [0b001100; 0b001100]
        [0b010010; 0b110100]
        [0b100010; 0b000100]
        ] 

type State = { mutable Image:Image; mutable X:float; mutable Y:float }

[<AutoOpen>]
module Robot =
    let random_pause state n = seq {
        let count = (rand.Next(10))
        for i = 1 to count do yield ()
    }

    let wait target state range = seq {
        let distance () = 
            let dx = (target.X - state.X)
            let dy = (target.Y - state.Y)
            sqrt(dx * dx + dy * dy) 
        while distance() > 50.0 do yield ()
    }

    let home target state n = seq {
        let dx = if target.X < state.X then -0.5 else 0.5
        let dy = if target.Y < state.Y then -0.5 else 0.5
        for i = 1 to n do          
            state.X <- state.X + dx
            state.Y <- state.Y + dy
            yield ()
        }

    let zombie target state = seq {
        yield! random_pause state 10
        while true do
            yield! wait target state 50.0
            yield! home target state 10
        }

type GameControl() as control =
    inherit UserControl(Width=200.0, Height=150.0,IsTabStop=true)
    let keys = Keys control
    let grid = Grid()
    let canvas = Canvas(Background = SolidColorBrush Colors.Black)
    do  grid.RenderTransform <- ScaleTransform(ScaleX=4.0,ScaleY=4.0)
    do  grid.Children.Add canvas
    do  control.Content <- grid
   
    let humanoids = 
        humanoid_bits |> rotate
        |> List.map (toBitmap Colors.Yellow 6 >> toImage)
    
    let humanoid = {Image=humanoids.[0]; X=control.Width/2.0; Y=control.Height/2.0}
    do  move humanoid.Image (humanoid.X,humanoid.Y)
    do  canvas.Children.Add humanoid.Image

    let robot = toBitmap Colors.Red 8 robot_bits
    let mutable robots = [
        for i = 1 to 5 do 
            let image = robot |> toImage
            let x = rand.Next(int control.Width - 8) |> float
            let y = rand.Next(int control.Height - 8) |> float
            move image (x,y)
            canvas.Children.Add(image)
            let state = { Image=image; X=x; Y=y }
            let machine = (zombie humanoid state)
            yield state, machine.GetEnumerator()
        ]

    let moveRobots () =
        robots <- robots |> List.filter (fun (state,machine) -> 
            let alive = machine.MoveNext()
            if alive then
                move state.Image (state.X, state.Y)
            alive
        )

    let update () =
        if keys.IsKeyDown Key.Up    then humanoid.Y <- humanoid.Y - 1.0
        if keys.IsKeyDown Key.Down  then humanoid.Y <- humanoid.Y + 1.0
        if keys.IsKeyDown Key.Left  then humanoid.X <- humanoid.X - 1.0
        if keys.IsKeyDown Key.Right then humanoid.X <- humanoid.X + 1.0
        move humanoid.Image (humanoid.X,humanoid.Y)       
        moveRobots ()

    let createMessage text =
        let t = TextBlock(Text=text, Foreground=SolidColorBrush Colors.White)
        t.HorizontalAlignment <- HorizontalAlignment.Center
        t.VerticalAlignment <- VerticalAlignment.Center
        t        

    let rec loop () = async {
        let t = createMessage "Click to Start"
        grid.Children.Add t
        do! control.MouseLeftButtonDown |> Async.AwaitEvent |> Async.Ignore
        grid.Children.Remove t |> ignore
        let _ = run (1.0/50.0) update
        do! Async.Sleep(-1)
        return! loop ()
        }
    do  loop () |> Async.StartImmediate

    let canvas = Canvas(Background = SolidColorBrush Colors.Black)
    do  canvas.RenderTransform <- ScaleTransform(ScaleX=4.0,ScaleY=4.0)

#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
namespace System
namespace System.Windows
namespace System.Media
Multiple items
type Keys =
  new : control:obj -> Keys
  member IsKeyDown : key:IComparable -> bool

Full name: Script.Keys

--------------------
new : control:obj -> Keys
val control : obj
namespace Microsoft.FSharp.Control
val mutable keysDown : Set<IComparable>
Multiple items
module Set

from Microsoft.FSharp.Collections

--------------------
type Set<'T (requires comparison)> =
  interface IComparable
  interface IEnumerable
  interface IEnumerable<'T>
  interface ICollection<'T>
  new : elements:seq<'T> -> Set<'T>
  member Add : value:'T -> Set<'T>
  member Contains : value:'T -> bool
  override Equals : obj -> bool
  member IsProperSubsetOf : otherSet:Set<'T> -> bool
  member IsProperSupersetOf : otherSet:Set<'T> -> bool
  ...

Full name: Microsoft.FSharp.Collections.Set<_>

--------------------
new : elements:seq<'T> -> Set<'T>
val empty<'T (requires comparison)> : Set<'T> (requires comparison)

Full name: Microsoft.FSharp.Collections.Set.empty
member Set.Add : value:'T -> Set<'T>
member Set.Remove : value:'T -> Set<'T>
val keys : Keys
member Keys.IsKeyDown : key:IComparable -> bool

Full name: Script.Keys.IsKeyDown
val key : IComparable
member Set.Contains : value:'T -> bool
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 toInt : color:'a -> int

Full name: Script.Imaging.toInt
val color : 'a
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<_>
val toBitmap : color:'a -> width:int -> xs:int list -> 'b

Full name: Script.Imaging.toBitmap
val width : int
val xs : int list
type 'T list = List<'T>

Full name: Microsoft.FSharp.Collections.list<_>
val on : int
val off : int
val toColor : (bool -> int)
val bitmap : 'b
property List.Length: int
val pixels : obj
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 iteri : action:(int -> 'T -> unit) -> list:'T list -> unit

Full name: Microsoft.FSharp.Collections.List.iteri
val y : int
val xs : int
val x : int
val bit : int
val toImage : bitmap:'a -> 'b

Full name: Script.Imaging.toImage
val bitmap : 'a
val w : int
val h : int
Multiple items
val float : value:'T -> float (requires member op_Explicit)

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

--------------------
type float = Double

Full name: Microsoft.FSharp.Core.float

--------------------
type float<'Measure> = float

Full name: Microsoft.FSharp.Core.float<_>
val rotate : xs:'a list list -> 'a list list

Full name: Script.Imaging.rotate
val xs : 'a list list
val tail : list:'T list -> 'T list

Full name: Microsoft.FSharp.Collections.List.tail
val fold : folder:('State -> 'T -> 'State) -> state:'State -> list:'T list -> 'State

Full name: Microsoft.FSharp.Collections.List.fold
val ys : 'a list list
val xs : 'a list
val zip : list1:'T1 list -> list2:'T2 list -> ('T1 * 'T2) list

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

Full name: Microsoft.FSharp.Collections.List.map
val x : 'a
val y : 'a list
val head : list:'T list -> 'T

Full name: Microsoft.FSharp.Collections.List.head
val rev : list:'T list -> 'T list

Full name: Microsoft.FSharp.Collections.List.rev
val rand : Random

Full name: Script.Game.rand
Multiple items
type Random =
  new : unit -> Random + 1 overload
  member Next : unit -> int + 2 overloads
  member NextBytes : buffer:byte[] -> unit
  member NextDouble : unit -> float

Full name: System.Random

--------------------
Random() : unit
Random(Seed: int) : unit
val run : rate:float -> update:'a -> 'b

Full name: Script.Game.run
val rate : float
val update : 'a
val rate : TimeSpan
Multiple items
type TimeSpan =
  struct
    new : ticks:int64 -> TimeSpan + 3 overloads
    member Add : ts:TimeSpan -> TimeSpan
    member CompareTo : value:obj -> int + 1 overload
    member Days : int
    member Duration : unit -> TimeSpan
    member Equals : value:obj -> bool + 1 overload
    member GetHashCode : unit -> int
    member Hours : int
    member Milliseconds : int
    member Minutes : int
    ...
  end

Full name: System.TimeSpan

--------------------
TimeSpan()
TimeSpan(ticks: int64) : unit
TimeSpan(hours: int, minutes: int, seconds: int) : unit
TimeSpan(days: int, hours: int, minutes: int, seconds: int) : unit
TimeSpan(days: int, hours: int, minutes: int, seconds: int, milliseconds: int) : unit
TimeSpan.FromSeconds(value: float) : TimeSpan
val lastUpdate : DateTime ref
Multiple items
val ref : value:'T -> 'T ref

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

--------------------
type 'T ref = Ref<'T>

Full name: Microsoft.FSharp.Core.ref<_>
Multiple items
type DateTime =
  struct
    new : ticks:int64 -> DateTime + 10 overloads
    member Add : value:TimeSpan -> DateTime
    member AddDays : value:float -> DateTime
    member AddHours : value:float -> DateTime
    member AddMilliseconds : value:float -> DateTime
    member AddMinutes : value:float -> DateTime
    member AddMonths : months:int -> DateTime
    member AddSeconds : value:float -> DateTime
    member AddTicks : value:int64 -> DateTime
    member AddYears : value:int -> DateTime
    ...
  end

Full name: System.DateTime

--------------------
DateTime()
   (+0 other overloads)
DateTime(ticks: int64) : unit
   (+0 other overloads)
DateTime(ticks: int64, kind: DateTimeKind) : unit
   (+0 other overloads)
DateTime(year: int, month: int, day: int) : unit
   (+0 other overloads)
DateTime(year: int, month: int, day: int, calendar: Globalization.Calendar) : unit
   (+0 other overloads)
DateTime(year: int, month: int, day: int, hour: int, minute: int, second: int) : unit
   (+0 other overloads)
DateTime(year: int, month: int, day: int, hour: int, minute: int, second: int, kind: DateTimeKind) : unit
   (+0 other overloads)
DateTime(year: int, month: int, day: int, hour: int, minute: int, second: int, calendar: Globalization.Calendar) : unit
   (+0 other overloads)
DateTime(year: int, month: int, day: int, hour: int, minute: int, second: int, millisecond: int) : unit
   (+0 other overloads)
DateTime(year: int, month: int, day: int, hour: int, minute: int, second: int, millisecond: int, kind: DateTimeKind) : unit
   (+0 other overloads)
property DateTime.Now: DateTime
val residual : TimeSpan ref
val move : element:'a -> x:'b * y:'c -> 'd

Full name: Script.Game.move
val element : 'a
val x : 'b
val y : 'c
val robot_bits : int list

Full name: Script.Bits.robot_bits
val humanoid_bits : int list list

Full name: Script.Bits.humanoid_bits
type State =
  {mutable Image: obj;
   mutable X: float;
   mutable Y: float;}

Full name: Script.State
State.Image: obj
State.X: float
State.Y: float
val random_pause : state:'a -> n:'b -> seq<unit>

Full name: Script.Robot.random_pause
val state : 'a
val n : 'b
Multiple items
val seq : sequence:seq<'T> -> seq<'T>

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

--------------------
type seq<'T> = Collections.Generic.IEnumerable<'T>

Full name: Microsoft.FSharp.Collections.seq<_>
val count : int
Random.Next() : int
Random.Next(maxValue: int) : int
Random.Next(minValue: int, maxValue: int) : int
val i : int
val wait : target:State -> state:State -> range:'a -> seq<unit>

Full name: Script.Robot.wait
val target : State
val state : State
val range : 'a
val distance : (unit -> float)
val dx : float
val dy : float
val sqrt : value:'T -> 'U (requires member Sqrt)

Full name: Microsoft.FSharp.Core.Operators.sqrt
val home : target:State -> state:State -> n:int -> seq<unit>

Full name: Script.Robot.home
val n : int
val zombie : target:State -> state:State -> seq<unit>

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

Full name: Script.GameControl

--------------------
new : unit -> GameControl
val control : GameControl
val filter : predicate:('T -> bool) -> list:'T list -> 'T list

Full name: Microsoft.FSharp.Collections.List.filter
namespace System.Text
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)
static member Async.Ignore : computation:Async<'T> -> Async<unit>
val ignore : value:'T -> unit

Full name: Microsoft.FSharp.Core.Operators.ignore
static member Async.Sleep : millisecondsDueTime:int -> Async<unit>
static member Async.StartImmediate : computation:Async<unit> * ?cancellationToken:Threading.CancellationToken -> unit

More information

Link:http://fssnip.net/ca
Posted:12 years ago
Author:Phillip Trelford
Tags: game , silverlight