0 people like it.

Pong

Pong video game runnable inside fable.io. Controls are "A" for left, and "D" for right.

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
Multiple items
val float : value:'T -> float (requires member op_Explicit)

--------------------
[<Struct>]
type float = System.Double

--------------------
type float<'Measure> =
  float
Multiple items
val int : value:'T -> int (requires member op_Explicit)

--------------------
[<Struct>]
type int = int32

--------------------
type int<'Measure> =
  int
Multiple items
module List

from Microsoft.FSharp.Collections

--------------------
type List<'T> =
  | ( [] )
  | ( :: ) of Head: 'T * Tail: 'T list
    interface IReadOnlyList<'T>
    interface IReadOnlyCollection<'T>
    interface IEnumerable
    interface IEnumerable<'T>
    member GetReverseIndex : rank:int * offset:int -> int
    member GetSlice : startIndex:int option * endIndex:int option -> 'T list
    static member Cons : head:'T * tail:'T list -> 'T list
    member Head : 'T
    member IsEmpty : bool
    member Item : index:int -> 'T with get
    ...
val iteri : action:(int -> 'T -> unit) -> list:'T list -> unit
Multiple items
val ref : value:'T -> 'T ref

--------------------
type 'T ref = Ref<'T>
namespace Microsoft.FSharp.Control
Multiple items
module Set

from Microsoft.FSharp.Collections

--------------------
type Set<'T (requires comparison)> =
  interface IReadOnlyCollection<'T>
  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
  ...

--------------------
new : elements:seq<'T> -> Set<'T>
val empty<'T (requires comparison)> : Set<'T> (requires comparison)
type 'T list = List<'T>
Multiple items
module Event

from Microsoft.FSharp.Control

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

--------------------
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>

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

--------------------
new : unit -> Event<'Delegate,'Args>
val async : AsyncBuilder
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> + 1 overload
  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 Choice : computations:seq<Async<'T option>> -> Async<'T option>
  static member FromBeginEnd : beginAction:(AsyncCallback * obj -> IAsyncResult) * endAction:(IAsyncResult -> 'T) * ?cancelAction:(unit -> unit) -> Async<'T> + 3 overloads
  static member FromContinuations : callback:(('T -> unit) * (exn -> unit) * (OperationCanceledException -> unit) -> unit) -> Async<'T>
  ...

--------------------
type Async<'T> =
static member Async.AwaitEvent : event:IEvent<'Del,'T> * ?cancelAction:(unit -> unit) -> Async<'T> (requires delegate and 'Del :> System.Delegate)
static member Async.Sleep : dueTime:System.TimeSpan -> Async<unit>
static member Async.Sleep : millisecondsDueTime:int -> Async<unit>
val ignore : value:'T -> unit
static member Async.Ignore : computation:Async<'T> -> Async<unit>
static member Async.StartImmediate : computation:Async<unit> * ?cancellationToken:System.Threading.CancellationToken -> unit

More information

Link:http://fssnip.net/aa
Posted:yesterday
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.