3 people like it.
Like the snippet!
Flappy bird with the flappy monad
This is a crazy solution to the flappy bird dojo by Phil Trelford. It defines a custom computation builder to eliminate all mutation of the flappy bird. The script uses WPF and is playable on Windows in F# interactive, just copy the raw version, and for cross-platform implementations download: http://trelford.com/prognet15.zip
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:
|
(Standard flappy bird setup)
/// A flappy bird computation is either a function that does
/// one step of the computation or it is completed. There is
/// also a trick with 'Update' - here, the computation produced
/// a flappy bird state 'Bird' that can be updated by the external
/// world (the world changes the bird when you press a key)
type FlappyComputation =
| Op of (unit -> FlappyComputation)
| End
| Update of Bird * (Bird -> FlappyComputation)
type FlappyBuilder() =
member x.Yield(()) = End
member x.Bind(c:Bird, f:Bird -> _) = Update(c, f)
member x.Delay(f) = f
member x.For(s:seq<_>, f) =
let e = s.GetEnumerator()
let rec loop () =
if e.MoveNext() then
x.Combine(f e.Current, loop)
else End
loop ()
member x.Zero() = End
member x.YieldFrom(e) = e
member x.Combine(c:FlappyComputation, f:unit -> FlappyComputation) : FlappyComputation =
let rec combine = function
| Op g -> Op (fun () -> combine (g()))
| Update(b, g) -> Update(b, fun b -> combine (g b))
| End -> f()
Op (fun () -> combine c)
member x.Run(f) = f()
let flappy = FlappyBuilder()
// Now we can implement flappy bird without mutation!
// The 'flappy' computation can use 'yield' when you do not
// want to do anything, so this is used for sleeping in the
// starting state.
let rec starting () = flappy {
for i in 0 .. 1000 do yield ()
let flappy = { X = 30.0; Y = 150.0; VY = 0.0; IsAlive=true }
yield! running (0, flappy) }
and running (scroll, bird) = flappy {
move bird_sing (bird.X, bird.Y)
for ((x,y),tube1,tube2) in tubes do
let scrollX = float (x + scroll)
if scrollX > bird.X - 10.0 && scrollX < bird.X + 10.0 then
if (bird.Y + bird_sing.Height > float y + 100.0) ||
(bird.Y < float y - 320.0 + tube1.Height) then
yield! dead()
move tube1 (float (x + scroll),float (y-320))
move tube2 (float (x + scroll),float (y+100))
// Let the outside world change our flappy bird!
let! bird = update bird
yield! running (scroll - 1, bird) }
and dead () = flappy {
// Just loop forever in the dead state
yield ()
yield! dead () }
let next t = function
| Op f -> f()
| End -> End
| Update(b, f) -> f (t b)
// The user interaction - this is where we still have a bit of mutation
// When you click, we store a function to update the flappy bird that
// is then called by the runner below (exactly once)
let flapop : ref<Bird -> Bird> = ref id
let flapme () = flapop := (fun flappy -> if flappy.IsAlive then flap flappy else flappy)
let window = Window(Title="Flap me",Width=288.0,Height=440.0)
window.Content <- canvas
window.MouseDown.Add(fun _ -> flapme())
window.KeyDown.Add(fun args -> if args.Key = Key.Space then flapme())
window.Show()
let steps = ref (starting())
CompositionTarget.Rendering.Add(fun _ ->
let next = next (fun b ->
let res = !flapop b
flapop := id
res )
// There is a lot of 'Combine's in the computation expression,
// so we just advance the computation by a large number of steps here
steps :=
!steps |> next |> next |> next |> next |> next |> next |> next
|> next |> next |> next |> next |> next |> next |> next |> next
)
|
#if INTERACTIVE
#r "PresentationCore.dll"
#r "PresentationFramework.dll"
#r "System.Xaml.dll"
#r "UIAutomationTypes.dll"
#r "WindowsBase.dll"
#endif
open System
open System.IO
open System.Windows
open System.Windows.Controls
open System.Windows.Input
open System.Windows.Media
open System.Windows.Media.Imaging
/// Bird type
type Bird = { X:float; Y:float; VY:float; IsAlive:bool }
/// Respond to flap command
let flap (bird:Bird) = { bird with VY = - System.Math.PI }
/// Applies gravity to bird
let gravity (bird:Bird) = { bird with VY = bird.VY + 0.1 }
/// Applies physics to bird
let physics (bird:Bird) = { bird with Y = bird.Y + bird.VY }
/// Updates bird with gravity & physics
let update = gravity >> physics
/// Generates the level's tube positions
let generateLevel n =
let rand = System.Random()
[for i in 1..n -> 50+(i*150), 32+rand.Next(160)]
let level = generateLevel 10
/// Converts specified bitmap to an image
let toImage (bitmap:#BitmapSource) =
let w, h = float bitmap.PixelWidth, float bitmap.PixelHeight
Image(Source=bitmap,Stretch=Stretch.Fill,Width=w,Height=h)
/// Loads image from file if it exists or the url otherwise
let load file url =
let path = Path.Combine(__SOURCE_DIRECTORY__, file)
let uri =
if File.Exists(path)
then Uri(path, UriKind.Relative)
else Uri(url, UriKind.Absolute)
BitmapImage(uri)
let bg =
load "bg.png" "http://flappycreator.com/default/bg.png"
|> toImage
let ground =
load "ground.png" "http://flappycreator.com/default/ground.png"
|> toImage
let tube1 = load "tube1.png" "http://flappycreator.com/default/tube1.png"
let tube2 = load "tube2.png" "http://flappycreator.com/default/tube2.png"
let bird_sing =
load "bird_sing.png" "http://flappycreator.com/default/bird_sing.png"
|> toImage
let canvas = Canvas()
let move image (x,y) =
Canvas.SetLeft(image, x)
Canvas.SetTop(image, y)
let add image (x,y) =
canvas.Children.Add(image) |> ignore
move image (float x, float y)
add bg (0,0)
add bird_sing (30,150)
// Level's tubes
let tubes =
[for (x,y) in level ->
let tube1 = toImage tube1
let tube2 = toImage tube2
add tube1 (x,y-320)
add tube2 (x,y+100)
(x,y), tube1, tube2]
add ground (0,360)
type FlappyComputation =
| Op of (unit -> FlappyComputation)
| End
| Update of Bird * (Bird -> FlappyComputation)
Full name: Script.FlappyComputation
A flappy bird computation is either a function that does
one step of the computation or it is completed. There is
also a trick with 'Update' - here, the computation produced
a flappy bird state 'Bird' that can be updated by the external
world (the world changes the bird when you press a key)
union case FlappyComputation.Op: (unit -> FlappyComputation) -> FlappyComputation
type unit = Unit
Full name: Microsoft.FSharp.Core.unit
union case FlappyComputation.End: FlappyComputation
union case FlappyComputation.Update: Bird * (Bird -> FlappyComputation) -> FlappyComputation
type Bird =
{X: float;
Y: float;
VY: float;
IsAlive: bool;}
Full name: Script.Bird
Bird type
Multiple items
type FlappyBuilder =
new : unit -> FlappyBuilder
member Bind : c:Bird * f:(Bird -> FlappyComputation) -> FlappyComputation
member Combine : c:FlappyComputation * f:(unit -> FlappyComputation) -> FlappyComputation
member Delay : f:'d -> 'd
member For : s:seq<'c> * f:('c -> FlappyComputation) -> FlappyComputation
member Run : f:(unit -> 'a) -> 'a
member Yield : unit -> FlappyComputation
member YieldFrom : e:'b -> 'b
member Zero : unit -> FlappyComputation
Full name: Script.FlappyBuilder
--------------------
new : unit -> FlappyBuilder
val x : FlappyBuilder
member FlappyBuilder.Yield : unit -> FlappyComputation
Full name: Script.FlappyBuilder.Yield
member FlappyBuilder.Bind : c:Bird * f:(Bird -> FlappyComputation) -> FlappyComputation
Full name: Script.FlappyBuilder.Bind
val c : Bird
val f : (Bird -> FlappyComputation)
member FlappyBuilder.Delay : f:'d -> 'd
Full name: Script.FlappyBuilder.Delay
val f : 'd
member FlappyBuilder.For : s:seq<'c> * f:('c -> FlappyComputation) -> FlappyComputation
Full name: Script.FlappyBuilder.For
val s : seq<'c>
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 f : ('c -> FlappyComputation)
val e : Collections.Generic.IEnumerator<'c>
Collections.Generic.IEnumerable.GetEnumerator() : Collections.Generic.IEnumerator<'c>
val loop : (unit -> FlappyComputation)
Collections.IEnumerator.MoveNext() : bool
member FlappyBuilder.Combine : c:FlappyComputation * f:(unit -> FlappyComputation) -> FlappyComputation
property Collections.Generic.IEnumerator.Current: 'c
member FlappyBuilder.Zero : unit -> FlappyComputation
Full name: Script.FlappyBuilder.Zero
member FlappyBuilder.YieldFrom : e:'b -> 'b
Full name: Script.FlappyBuilder.YieldFrom
val e : 'b
member FlappyBuilder.Combine : c:FlappyComputation * f:(unit -> FlappyComputation) -> FlappyComputation
Full name: Script.FlappyBuilder.Combine
val c : FlappyComputation
val f : (unit -> FlappyComputation)
val combine : (FlappyComputation -> FlappyComputation)
val g : (unit -> FlappyComputation)
val b : Bird
val g : (Bird -> FlappyComputation)
member FlappyBuilder.Run : f:(unit -> 'a) -> 'a
Full name: Script.FlappyBuilder.Run
val f : (unit -> 'a)
val flappy : FlappyBuilder
Full name: Script.flappy
val starting : unit -> FlappyComputation
Full name: Script.starting
val i : int
val flappy : Bird
Bird.X: float
Bird.Y: float
val running : scroll:int * bird:Bird -> FlappyComputation
Full name: Script.running
val scroll : int
val bird : Bird
val move : image:UIElement -> x:float * y:float -> unit
Full name: Script.move
val bird_sing : Image
Full name: Script.bird_sing
val x : int
val y : int
val tube1 : Image
val tube2 : Image
val tubes : ((int * int) * Image * Image) list
Full name: Script.tubes
val scrollX : float
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<_>
property FrameworkElement.Height: float
val dead : unit -> FlappyComputation
Full name: Script.dead
val update : (Bird -> Bird)
Full name: Script.update
Updates bird with gravity & physics
val next : t:(Bird -> Bird) -> _arg1:FlappyComputation -> FlappyComputation
Full name: Script.next
val t : (Bird -> Bird)
val flapop : (Bird -> Bird) ref
Full name: Script.flapop
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<_>
val id : x:'T -> 'T
Full name: Microsoft.FSharp.Core.Operators.id
val flapme : unit -> unit
Full name: Script.flapme
Bird.IsAlive: bool
val flap : bird:Bird -> Bird
Full name: Script.flap
Respond to flap command
val window : Window
Full name: Script.window
Multiple items
type Window =
inherit ContentControl
new : unit -> Window
member Activate : unit -> bool
member AllowsTransparency : bool with get, set
member Close : unit -> unit
member DialogResult : Nullable<bool> with get, set
member DragMove : unit -> unit
member Hide : unit -> unit
member Icon : ImageSource with get, set
member IsActive : bool
member Left : float with get, set
...
Full name: System.Windows.Window
--------------------
Window() : unit
property ContentControl.Content: obj
val canvas : Canvas
Full name: Script.canvas
event UIElement.MouseDown: IEvent<MouseButtonEventHandler,MouseButtonEventArgs>
member IObservable.Add : callback:('T -> unit) -> unit
event UIElement.KeyDown: IEvent<KeyEventHandler,KeyEventArgs>
val args : KeyEventArgs
property KeyEventArgs.Key: Key
type Key =
| None = 0
| Cancel = 1
| Back = 2
| Tab = 3
| LineFeed = 4
| Clear = 5
| Return = 6
| Enter = 6
| Pause = 7
| Capital = 8
...
Full name: System.Windows.Input.Key
field Key.Space = 18
Window.Show() : unit
val steps : FlappyComputation ref
Full name: Script.steps
type CompositionTarget =
inherit DispatcherObject
member Dispose : unit -> unit
member RootVisual : Visual with get, set
member TransformFromDevice : Matrix
member TransformToDevice : Matrix
static event Rendering : EventHandler
Full name: System.Windows.Media.CompositionTarget
event CompositionTarget.Rendering: IEvent<EventHandler,EventArgs>
val next : (FlappyComputation -> FlappyComputation)
val res : Bird
More information