3 people like it.

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

 Link: http://fssnip.net/s7 Posted: 6 years ago Author: Tomas Petricek Tags: flappy bird , monad