Pong

 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: 

Skip module definition on TryFSharp.org

open System
open System.Windows
open System.Windows.Controls
open System.Windows.Input
open System.Windows.Media
open System.Windows.Shapes

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 run rate update =
    let rate = TimeSpan.FromSeconds(rate)
    let lastUpdate = ref DateTime.Now
    let residual = ref (TimeSpan())
    CompositionTarget.Rendering.Add (fun _ -> 
        let now = DateTime.Now
        residual := !residual + (now - !lastUpdate)
        while !residual > rate do
            update(); residual := !residual - rate
        lastUpdate := now
    )

type KeyState (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 this.IsKeyDown key = keysDown.Contains key

type Pad(keys:KeyState,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) =
    let bx, by, bdx, bdy = ref (width/2), ref (height/4), ref 1, ref 1
    let shape = rectangle(!bx,!by,10,10)
    member ball.Shape = shape
    member ball.Update() =
        bx := !bx + !bdx*2
        by := !by + !bdy*2
        move(shape,!bx,!by)                       
        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

type GameControl() as control=
    inherit UserControl(Width=float width, Height=float height, IsTabStop=true)
    let keys = KeyState(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])
    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()
    do  async { 
        do! control.MouseLeftButtonDown |> Async.AwaitEvent |> Async.Ignore
        run (1.0/50.0) update 
        } |> Async.StartImmediate

Run script on TryFSharp.org

#if INTERACTIVE
#else
module Play
#endif

namespace System

namespace System.Windows

namespace System.Media

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 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 KeyState =
  new : control:obj -> KeyState
  member IsKeyDown : key:IComparable -> bool

Full name: Script.KeyState

--------------------
new : control:obj -> KeyState

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 this : KeyState

member KeyState.IsKeyDown : key:IComparable -> bool

Full name: Script.KeyState.IsKeyDown

val key : IComparable

member Set.Contains : value:'T -> bool

Multiple items
type Pad =
  new : keys:KeyState * up:IComparable * down:IComparable * x:obj * y:int -> Pad
  member Update : unit -> 'a
  member Shape : obj

Full name: Script.Pad

--------------------
new : keys:KeyState * up:IComparable * down:IComparable * x:obj * y:int -> Pad

val keys : KeyState

val up : IComparable

val down : IComparable

val x : obj

val y : int

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 KeyState.IsKeyDown : key:IComparable -> bool

Multiple items
type Ball =
  new : blocks:seq<obj> -> Ball
  member Update : unit -> unit
  member Shape : obj

Full name: Script.Ball

--------------------
new : blocks:seq<obj> -> Ball

val blocks : seq<obj>

type 'T list = List<'T>

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

val bx : int ref

val by : int ref

val bdx : int ref

val bdy : int ref

val ball : Ball

member Ball.Shape : obj

Full name: Script.Ball.Shape

member Ball.Update : unit -> unit

Full name: Script.Ball.Update

val block : obj

val x : int

val w : int

val h : int

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.Ignore : computation:Async<'T> -> Async<unit>

static member Async.StartImmediate : computation:Async<unit> * ?cancellationToken:Threading.CancellationToken -> unit

#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
)
#endif