7 people like it.

Pong

Pong video game runnable inside TryFSharp.org. Player 1 keys 'Q' - up, 'A' - down. Player 2 keys 'P' - up, 'L' - down.

Pong game

 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: 

let width, height = 512,384
let move(shape,x,y) = Canvas.SetLeft(shape,float x); Canvas.SetTop(shape,float y)
let read(shape) = Canvas.GetLeft(shape) |> int, Canvas.GetTop(shape) |> int
let rectangle(x,y,w,h) =
    let shape= Rectangle(Width=float w,Height=float h,Fill=SolidColorBrush Colors.White)
    move(shape,x,y)
    shape
let digits = [
    [0b111; 0b001; 0b111; 0b111; 0b101; 0b111; 0b111; 0b111; 0b111; 0b111]
    [0b101; 0b001; 0b001; 0b001; 0b101; 0b100; 0b100; 0b001; 0b101; 0b101]
    [0b101; 0b001; 0b111; 0b111; 0b111; 0b111; 0b111; 0b001; 0b111; 0b111]
    [0b101; 0b001; 0b100; 0b001; 0b001; 0b001; 0b101; 0b001; 0b101; 0b001]
    [0b111; 0b001; 0b111; 0b111; 0b001; 0b111; 0b111; 0b001; 0b111; 0b001]]
let toDigit n =
    let canvas = Canvas()
    digits |> List.iteri (fun y xs ->
        for x = 0 to 2 do    
            if (xs.[n] &&& (1 <<< (2 - x))) <> 0 then
                rectangle(x*10,y*10,10,10) |> canvas.Children.Add
    )
    canvas
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
    )

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

type Pad(keys:Keys,up,down,x,y) =
    let shape = rectangle(x,y,10,60)
    let y = ref y
    member pad.Shape = shape
    member pad.Update () =
        if keys.IsKeyDown up then y := !y - 4
        if keys.IsKeyDown down then y := !y + 4
        move(shape,x,!y)

type Ball(blocks:Rectangle list, win:Event<_>) =
    let bx, by, bdx, bdy = ref (width/2), ref (height/4), ref 1, ref 1
    let shape = rectangle(!bx,!by,10,10)
    let checkBlocks () =
        for block in blocks do
            let x,y = read block
            let w,h = int block.Width, int block.Height
            if !bx >= x && !bx < x + w && !by >= y && !by < y + h then
                if w > h then bdy := - !bdy else bdx := - !bdx 
                by := !by + !bdy*2; bx := !bx + !bdx*2
    member ball.Shape = shape
    member ball.Reset() = bx := width/2; by := height/2; move(shape,!bx,!by)
    member ball.Update() =
        bx := !bx + !bdx*2; by := !by + !bdy*2                               
        checkBlocks()
        move(shape,!bx,!by)
        if !bx < -10 then win.Trigger(0,1)
        if !bx > width then win.Trigger(1,0)

type GameControl() as control=
    inherit UserControl(Width=float width, Height=float height, IsTabStop=true)
    let win = Event<_>()
    let keys = Keys(control)
    let canvas = new Canvas(Background = SolidColorBrush Colors.Black)
    let top, bottom = rectangle(0,10,width,10), rectangle(0,height-20,width,10)
    let pad1, pad2 = Pad(keys,Key.Q,Key.A,10,60), Pad(keys,Key.P,Key.L,width-20,120)
    let ball = Ball([top;bottom;pad1.Shape;pad2.Shape], win)
    let (+.) (container:Panel) item = container.Children.Add item; container
    do  base.Content <- canvas+.top+.bottom+.pad1.Shape+.pad2.Shape+.ball.Shape
    let update () = pad1.Update(); pad2.Update(); ball.Update()
    let rec loop (a,b) = async {
        let subscription = run (1.0/50.0) update 
        let! a',b' = win.Publish |> Async.AwaitEvent        
        subscription.Dispose()
        let a, b = a + a', b + b'
        let a', b' = toDigit a, toDigit b
        move(a',width/2-60,height/3); move(b',width/2+20,height/3)
        a' |> canvas.Children.Add; b' |> canvas.Children.Add
        if a < 9 && b < 9 then
            do! Async.Sleep 2500
            a' |> canvas.Children.Remove |> ignore; b'|> canvas.Children.Remove |> ignore
            ball.Reset()
            do! Async.Sleep 2500
            return! loop(a,b) 
        } 
    do  async { 
        do! control.MouseLeftButtonDown |> Async.AwaitEvent |> Async.Ignore
        do! loop (0,0) }|> Async.StartImmediate
val width : int

Full name: Script.width
val height : int

Full name: Script.height
val move : shape:'a * x:'b * y:'c -> 'd

Full name: Script.move
val shape : 'a
val x : 'b
val y : 'c
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 read : shape:'a -> int * int

Full name: Script.read
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 rectangle : x:'a * y:'b * w:'c * h:'d -> 'e

Full name: Script.rectangle
val x : 'a
val y : 'b
val w : 'c
val h : 'd
val shape : 'e
val digits : int list list

Full name: Script.digits
val toDigit : n:int -> 'a

Full name: Script.toDigit
val n : int
val canvas : 'a
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 list
val x : int
val run : rate:float -> update:'a -> 'b

Full name: Script.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
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 Pad =
  new : keys:Keys * up:IComparable * down:IComparable * x:obj * y:int -> Pad
  member Update : unit -> 'a
  member Shape : obj

Full name: Script.Pad

--------------------
new : keys:Keys * up:IComparable * down:IComparable * x:obj * y:int -> Pad
val up : IComparable
val down : IComparable
val x : obj
val shape : obj
val y : int ref
val pad : Pad
member Pad.Shape : obj

Full name: Script.Pad.Shape
member Pad.Update : unit -> 'a

Full name: Script.Pad.Update
member Keys.IsKeyDown : key:IComparable -> bool
Multiple items
type Ball =
  new : blocks:seq<obj> * win:Event<int * int> -> Ball
  member Reset : unit -> 'a
  member Update : unit -> unit
  member Shape : obj

Full name: Script.Ball

--------------------
new : blocks:seq<obj> * win:Event<int * int> -> Ball
val blocks : seq<obj>
type 'T list = List<'T>

Full name: Microsoft.FSharp.Collections.list<_>
val win : Event<int * int>
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>
val bx : int ref
val by : int ref
val bdx : int ref
val bdy : int ref
val checkBlocks : (unit -> unit)
val block : obj
val w : int
val h : int
val ball : Ball
member Ball.Shape : obj

Full name: Script.Ball.Shape
member Ball.Reset : unit -> 'a

Full name: Script.Ball.Reset
member Ball.Update : unit -> unit

Full name: Script.Ball.Update
member Event.Trigger : arg:'T -> unit
Multiple items
type GameControl =
  inherit obj
  new : unit -> GameControl

Full name: Script.GameControl

--------------------
new : unit -> GameControl
val control : GameControl
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.Sleep : millisecondsDueTime:int -> Async<unit>
val ignore : value:'T -> unit

Full name: Microsoft.FSharp.Core.Operators.ignore
static member Async.Ignore : computation:Async<'T> -> Async<unit>
static member Async.StartImmediate : computation:Async<unit> * ?cancellationToken:Threading.CancellationToken -> unit

More information

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

This web site is created using F# and Suave web server. It is hosted on Azure and the source code is on GitHub. Contributions are welcome!

The first version of fssnip.net has been created by @tomaspetricek back in 2010. This web site is a new, open-source and contribution-friendly version.