mrange/0_README.md

## 0_README.md

      
    Raw
  

              0_README.md
            
          
    Landing a rocket

How to run


WPF requires a Windows box
Install dotnet: https://dotnet.microsoft.com/en-us/download
Create a folder named for example: FsLanding
Create file in the folder named: FsLanding.fsproj and copy the content of 1_FsLanding.fsproj below into that file
Create file in the folder named: Program.fs and copy the content of 2_Program.fs below into that file
Launch the application in Visual Studio or through the command line dotnet run from the folder FsLanding


## 1_FsLanding.fsproj
<Project Sdk="Microsoft.NET.Sdk">

  <PropertyGroup>
    <OutputType>WinExe</OutputType>
    <TargetFramework>net6.0-windows</TargetFramework>
    <UseWPF>true</UseWPF>
  </PropertyGroup>

  <ItemGroup>
    <Compile Include="Program.fs" />
  </ItemGroup>

</Project>

## 2_Program.fs
// Hi!. The particle system is defined at row: 236+

// `open` are F# version of C# `using`
open System
open System.Collections.Generic
open System.Diagnostics
open System.Globalization
open System.Numerics

open System.Windows
open System.Windows.Input
open System.Windows.Media
open System.Windows.Media.Animation

open FSharp.Core.Printf

type V1 = float32
type V2 = Vector2

// F# inline is sometimes used for performance but often
//  it's used to get access to more advanced generics than
//  supported by .NET CLR
//  x here can be any type that supports conversion to float32
let inline v1 x           = float32 x
let inline v2 x y         = V2 (float32 x, float32 y)
let v2_0                  = v2 0.F 0.F
let inline clamp v i x    = max i (min v x)
let inline clamp2 v i x   = V2.Max (i, V2.Min(v, x))
let tanh_approx x         =
  // tanh is (exp(x) − exp(−x)) / (exp(x) + exp(−x))
  // But exp is pretty expensive. Following is s decent approx
  let x2 = x*x
  clamp (x*(27.F+x2)/(27.F+9.F*x2)) -1.F 1.F

[<RequireQualifiedAccess>]
type Color =
  | Gray
  | Green
  | Red
  | White
  | Yellow
let noColor : Color option = Some Color.Gray

// Define a particle record
//  Mass is stored in difference ways to avoid recomputing it
//  Current is the current position
//  Previous is the previous position
//  The speed then implicitly is Current-Previous
//  This representation is used in something called Verlet Integration
//  Verlet Integration avoids needing to update the speed vector
//  when computing the constraints
//  It doesn't produce accurate physics but it looks believable
//  which is good enough for this program
//  Verlet Integration is described with some detail here:
//    https://en.wikipedia.org/wiki/Verlet_integration
type Particle =
  {
    Color             : Color option
    Mass              : V1
    SqrtMass          : V1
    InvertedMass      : V1
    mutable Current   : V2
    mutable Previous  : V2
  }

  // Verlet step moves the particle with inertia and gravity
  member x.Step (gravity : V1) =
    // InvertedMass of 0 means this is a fixed particle of infinite
    //  mass. These particles don't move
    if x.InvertedMass > 0.F then
      let c = x.Current
      let g = v2 0.F gravity
      x.Current   <- g + c + (c - x.Previous)
      x.Previous  <- c

// Makes a particle given mass, position x,y and velocity vx,vy
let inline mkParticle pc mass x y vx vy : Particle =
  let m = v1 mass
  let c = v2 x y
  let v = v2 vx vy
  {
    Color         = pc
    Mass          = m
    InvertedMass  = 1.F/m
    SqrtMass      = sqrt m
    Current       = c
    Previous      = c - v
  }

// Makes a fix particle position x,y
//  a fix particle has infinite mass and doesn't move
//  used as an anchor point for other particles and constraints
let inline mkFixParticle pc x y = mkParticle pc infinityf x y 0.F 0.F

module Details =
  let inline adapt f    = OptimizedClosures.FSharpFunc<V1, V1, V1>.Adapt f
  let stickActivation   = adapt (fun l d -> d)
  let ropeActivation    = adapt (fun l d -> if d > 0.F then d else 0.F)
  let springActivation f= adapt (fun l d -> d*tanh_approx (f*(abs d/l)))
  let epsilon           = 0.0001F
  let epsilonSquared    = epsilon*epsilon

  let rec isPressed (pressed : HashSet<Key>) (keys : Key array) i =
    if i < keys.Length then
      if pressed.Contains keys.[i] then
        true
      else
        isPressed pressed keys (i + 1)
    else
      false
open Details

// Defines a constraint which is either a stick or a rope
//  a stick tries to make sure that the distance between two particles
//  are the Length value
//  a rope tries to makes sure that distance between two particles
//  are at most the Length value
type Constraint =
  {
    Color           : Color option
    Activation      : OptimizedClosures.FSharpFunc<V1, V1, V1>
    Length          : V1
    Left            : Particle
    Right           : Particle
  }

  // After the verlet step most constraints are "over stretched"
  //  Relax moves the two particles so that the constraint is "relaxed"
  //  again. This will in turn make other constraints "over stretched"
  //  but it turns out applying Relax over and over moves the system
  //  to a relaxed state
  member x.Relax () =
    // Bunch of math but the intent is this:
    //  compute the distance between the two particles in the constraint
    //  if the distance is not the right distance
    //  then move the two particles towards or away from eachother
    //  so that the distance is correct
    //  The comparitive mass of the particles is used to make sure
    //  that a small particle moves more than the bigger one it's
    //  connected to
    let l  = x.Left
    let r  = x.Right
    let lc = l.Current
    let rc = r.Current

    let diff  = lc - rc
    let len   = diff.Length ()
    let ldiff = len - x.Length
    let adiff = x.Activation.Invoke (x.Length, ldiff)
    if abs adiff > epsilon then
      let imass = 0.5F/(l.InvertedMass + r.InvertedMass)
      let mdiff = (imass*adiff/len)*diff
      let loff  = l.InvertedMass * mdiff
      let roff  = r.InvertedMass * mdiff

      l.Current <- lc - loff
      r.Current <- rc + roff

// Makes a stick constraint between two particles
let inline mkStick c (l : Particle) (r : Particle) : Constraint =
  {
    Color       = c
    Activation  = stickActivation
    Length      = (l.Current - r.Current).Length ()
    Left        = l
    Right       = r
  }

// Makes a spring constraint between two particles
let inline mkSpring c f (l : Particle) (r : Particle) : Constraint =
  {
    Color       = c
    Activation  = springActivation f
    Length      = (l.Current - r.Current).Length ()
    Left        = l
    Right       = r
  }

// Makes a rope constraint between two particles
//  allows making the rope a bit longer than the initial distance
let inline mkRope c extraLength (l : Particle) (r : Particle) : Constraint =
  {
    Color       = c
    Activation= ropeActivation
    Length    = (1.F + abs (float32 extraLength))*(l.Current - r.Current).Length ()
    Left      = l
    Right     = r
  }

// Defines a global constraint that forces all particles inside a box
type GlobalConstraint =
  {
    Variant : bool
    Min     : V2
    Max     : V2
  }

  // If the current particle position is outside the box
  //  force it into the box again
  member x.Relax (ps : Particle array) =
    for p in ps do
      let c   = p.Current
      let nc  =
        if x.Variant then
          let di  = c - x.Min
          let dx  = x.Max - c
          if di.X >= 0.F && dx.X >= 0.F && di.Y >= 0.F && dx.Y >= 0.F then
            let ddx = if di.X < dx.X then -di.X else dx.X
            let ddy = if di.Y < dx.Y then -di.Y else dx.Y
            if abs ddx < abs ddy then
              v2 (c.X + ddx) c.Y
            else
              v2 c.X (c.Y + ddy)
          else
            c
        else
          clamp2 c x.Min x.Max
      let ls  = (nc - c).LengthSquared ()
      // Faking friction
      if ls > epsilonSquared then
        let v   = nc - p.Previous
        let nv  = 0.9F * v
        p.Current   <- nc
        p.Previous  <- nc - nv

// Creates a global contraint
let mkGlobalConstraint v x0 y0 x1 y1 : GlobalConstraint =
  {
    Variant = v
    Min     = v2 (min x0 x1) (min y0 y1)
    Max     = v2 (max x0 x1) (max y0 y1)
  }

// Defines a rocket that fires either forward or reverse
//  depending on what keys are pressed
//  The rocket gets the same position as the particle it's connected
//  to and the rocket direction is computed with the help of the
//  anchor particle.
type Rocket =
  {
    Perpendicular : bool
    ConnectedTo   : Particle
    AnchoredTo    : Particle
    Force         : V1
    ForwardWhen   : Key       array
    ReverseWhen   : Key       array
  }

  member x.ForceVector (pressed : HashSet<Key>) =
    let forceVector () =
      // Compute the difference between the connected to
      //  and anchor particle. Normalize it ie make the length == 1
      let d = V2.Normalize (x.ConnectedTo.Current - x.AnchoredTo.Current)
        // the force vector
      if x.Perpendicular then
        // The rocket direction is perpendicular to the difference
        let n = v2 d.Y -d.X
        x.Force*n
      else
        // The rocket direction is tangential to the difference
        x.Force*d

    // Is any of the forward keys pressed?
    if isPressed pressed x.ForwardWhen 0 then
      forceVector ()
    // Is any of the reverse keys pressed?
    elif isPressed pressed x.ReverseWhen 0 then
      -forceVector ()
    // If neither then rocket is idle
    else
      v2_0

// Creates a rocket
let mkRocket
  perpendicular
  connectedTo
  anchoredTo
  force
  forwardWhen
  reverseWhen : Rocket =
  {
    Perpendicular = perpendicular
    ConnectedTo   = connectedTo
    AnchoredTo    = anchoredTo
    Force         = force
    ForwardWhen   = forwardWhen
    ReverseWhen   = reverseWhen
  }

// Creates a box of particles and constraints
let mkBox pc cc mass size x y vx vy : Particle array* Constraint array =
  let inline p x y = mkParticle pc (0.25F*mass) x y vx vy
  let hsz = 0.5F*size
  let p00 = p (x - hsz) (y - hsz)
  let p01 = p (x - hsz) (y + hsz)
  let p10 = p (x + hsz) (y - hsz)
  let p11 = p (x + hsz) (y + hsz)
  let ps = [|p00; p01; p11; p10|]
  let inline stick cc i j = mkStick cc ps.[i] ps.[j]
  let nc = noColor
  let cs =
    [|
      stick cc 0 1
      stick cc 1 2
      stick cc 2 3
      stick cc 3 0
      stick nc 0 2
      stick nc 1 3
    |]
  ps, cs

// The global constraint is a box that the particles has to stay within
let globalConstraints =
  [|
    mkGlobalConstraint false -600.F -1000.F  600.F  400.F
    mkGlobalConstraint true  -480.F 401.F -380.F 0.F
    mkGlobalConstraint true  -300.F 401.F -200.F 0.F
  |]

let mkRocketShip off =
  let nc                            = noColor
  let pc                            = noColor
  let cc                            = Some Color.Yellow
  let topParticle                   = mkParticle pc 1.F   0.F  (-200.F + off)  0.F 0.F
  let bottomParticle                = mkParticle pc 20.F  0.F  (  85.F + off)  0.F 0.F
  let leftLegParticle               = mkParticle pc 1.F -85.F  ( 150.F + off)  0.F 0.F
  let rightLegParticle              = mkParticle pc 1.F  85.F  ( 150.F + off)  0.F 0.F
  let boxParticles, boxConstraints  = mkBox pc cc 20.F 100.F 0.F off 0.F 0.F

  let particles =
    [|
      topParticle
      leftLegParticle
      rightLegParticle
      bottomParticle
      yield! boxParticles
    |]

  let constraints =
    [|
      // Top
      mkStick   cc        topParticle       boxParticles.[0]
      mkStick   cc        topParticle       boxParticles.[3]

      // Rocket
      mkStick   nc        bottomParticle    topParticle
      mkStick   nc        bottomParticle    boxParticles.[1]
      mkStick   nc        bottomParticle    boxParticles.[2]

      // Left left
      mkStick    cc       leftLegParticle   boxParticles.[1]
      mkSpring   cc 4.F   leftLegParticle   bottomParticle

      // Right left
      mkStick    cc       rightLegParticle  boxParticles.[2]
      mkSpring   cc 4.F   rightLegParticle  bottomParticle

      yield! boxConstraints
    |]

  let rockets =
    [|
      // Add 2 rockets to the box ship
      mkRocket true  topParticle    bottomParticle   2.F    [|Key.Left|] [|Key.Right|]
      mkRocket false bottomParticle topParticle     -15.F   [|Key.Up|]   [||]
    |]

  bottomParticle, particles, constraints, rockets

let mkBoxShip off =
  let nc                            = noColor
  let pc                            = noColor
  let cc                            = Some Color.Yellow
  let boxParticles, boxConstraints  = mkBox pc cc 20.F 100.F 0.F 0.F 0.F 0.F
  let leftLegParticle               = mkParticle pc 1.F -55.F  ( 150.F + off)  0.F 0.F
  let rightLegParticle              = mkParticle pc 1.F  55.F  ( 150.F + off)  0.F 0.F
  let bottomParticle                = boxParticles.[1]

  let rot = Matrix3x2.CreateRotation (v1 (-Math.PI / 4.))
  let tra = Matrix3x2.CreateTranslation (v2 0.F (off - 50.F))
  let full= rot*tra
  for bp in boxParticles do
    bp.Current  <- V2.Transform (bp.Current , full)
    bp.Previous <- V2.Transform (bp.Previous, full)

  let particles =
    [|
      leftLegParticle
      rightLegParticle
      yield! boxParticles
    |]

  let constraints =
    [|
      // Left left
      mkStick    cc       leftLegParticle   boxParticles.[0]
      mkSpring   cc 4.F   leftLegParticle   bottomParticle
      // Right left
      mkStick    cc       rightLegParticle  boxParticles.[2]
      mkSpring   cc 4.F   rightLegParticle  bottomParticle

      yield! boxConstraints
    |]

  let rockets =
    [|
      // Add 2 rockets to the box ship
      mkRocket true  boxParticles.[0]     boxParticles.[2] -5.F  [|Key.Up; Key.Right|]   [||]
      mkRocket true  boxParticles.[2]     boxParticles.[0]  5.F  [|Key.Up; Key.Left |]  [||]
    |]

  bottomParticle, particles, constraints, rockets

// Creates a small system of particles and constraints
let particles, constraints, rockets =
  let pc                            = noColor
  let cc                            = Some Color.Yellow
  let rc                            = Some Color.Gray
  let off                           = 250.F


  let shipConnectParticles, shipParticles, shipConstraints, shipRockets = mkBoxShip off

  let del0Particles, del0Constraints= mkBox pc cc 20.F 40.F 120.F (120.F + off) 0.F 0.F
  let del1Particles, del1Constraints= mkBox pc cc 20.F 40.F 240.F (120.F + off) 0.F 0.F

  let particles =
    [|
      yield! shipParticles
      yield! del0Particles
      yield! del1Particles
    |]

  let constraints =
    [|
      yield! shipConstraints
      mkRope rc 0.F   shipConnectParticles  del0Particles.[2]
      mkRope rc 0.F   del0Particles.[0]     del1Particles.[2]
      yield! del0Constraints
      yield! del1Constraints
    |]

  let rockets =
    [|
      yield! shipRockets
    |]

  particles, constraints, rockets

// Creates a CanvasElement class that will act like a canvas for us
//  We override the OnRender method to draw graphics. In order to make the graphics
//  animate we have a time animation that invalidates the element which forces a redraw
type CanvasElement () =
  class
    // This is how in F# we inherit, this is typically not done as much
    //  as in C# but in order to be part of WPF Visual tree we need to
    //  inherit UIElement
    inherit UIElement ()

    // Declaring a DependencyProperty member for Time
    //  This is WPF magic but it's created so that we can create
    //  an "animation" of the time value.
    //  This will help use do smooth updates.
    //  Nothing like web requestAnimationFrame in WPF AFAIK
    static let timeProperty =
      let pc = PropertyChangedCallback CanvasElement.TimePropertyChanged
      let md = PropertyMetadata (0., pc)
      DependencyProperty.Register ("Time", typeof<float>, typeof<CanvasElement>, md)

    // Freezing resources prevents updates of WPF Resources
    //  Can help WPF optimize rendering
    //  #Freezable is like C# constraint : where T : Freezable
    let freeze (f : #Freezable) =
      f.Freeze ()
      f

    // Helper function to create pens
    let makePen thickness brush =
      Pen (Thickness = thickness, Brush = brush) |> freeze

    // Help text
    let helpText =
      FormattedText (   "Use arrow keys to fire rockets. Drive responsibly"
                      , CultureInfo.InvariantCulture
                      , FlowDirection.LeftToRight
                      , Typeface "Arial"
                      , 36.0
                      , Brushes.Gray
                      , 1.0
                      )

    // Some pens to draw lines with
    let pens        =
      [|
        Color.Gray  , Brushes.Gray
        Color.Green , Brushes.Green
        Color.Red   , Brushes.Red
        Color.White , Brushes.White
        Color.Yellow, Brushes.Yellow
      |]
      |> Array.map (fun (k, v) -> k, makePen 2. v)
      |> dict

    // Currently pressed key
    let mutable pressed = HashSet<Key>()

    // More WPF dependency property magic
    //  Not very interesting but this becomes member function in the class
    static member TimePropertyChanged (d : DependencyObject) (e : DependencyPropertyChangedEventArgs) =
      let g = d :?> CanvasElement
      // Whenever time change we invalidate the entire canvas element
      g.InvalidateVisual ()

    // Idiomatically WPF Dependency properties should be readonly
    //  static fields. However, F# don't allow us to declare that
    //  Luckily it seems static readonly properties works fine
    static member TimeProperty = timeProperty

    // Store pressed key
    override x.OnKeyDown e =
      pressed.Add e.Key |> ignore

    // Reset pressed key
    override x.OnKeyUp e =
      pressed.Remove e.Key |> ignore

    // Gets the Time dependency property
    member x.Time = x.GetValue CanvasElement.TimeProperty :?> float

    // Create an animation that animates a floating point from 0 to 1E9
    //  over 1E9 seconds thus the time. This animation is then hooked onto the Time property
    //  Basically more WPF magic
    member x.Start () =
      // Initial time value
      let b   = 0.
      // End time, application animation stops after approx 30 years
      let e   = 1E9
      let dur = Duration (TimeSpan.FromSeconds (e - b))
      let ani = DoubleAnimation (b, e, dur) |> freeze
      // Animating Time property
      x.BeginAnimation (CanvasElement.TimeProperty, ani);

    // Finally we get to the good stuff!
    //  dc is a DeviceContext, basically a canvas we can draw on
    override x.OnRender dc =
      // Get the current time, will change over time (hohoh)
      let time  = x.Time
      // This is the size of the canvas in pixels
      let rs    = x.RenderSize

      let center= v2 (0.5*rs.Width) (0.5*rs.Height)

      for _ = 1 to 1 do
        // Apply rocket force
        for r in rockets do
          let f = (r.ForceVector pressed)
          let p = r.ConnectedTo
          p.Current <- p.Current + f*p.InvertedMass

        // Apply the verlet step to all particles
        for p in particles do
          p.Step 0.1F

        // Relax all constraints 5 times
        //  If you relax less times the system becomes more "bouncy"
        //  More times makes it more "stiff"
        for _ = 1 to 5 do
          for gc in globalConstraints do
            gc.Relax particles
          for c in constraints do
            c.Relax ()

      // Draw the instructions
      dc.DrawText (helpText, new Point(0, 0))

      // inline here allows us to create helper function that
      //  uses a local variable without the overhead of creating
      //  a new function object
      //  Creating a bunch of objects during drawing can lead
      //  to GC which we like to avoid
      let inline toPoint (p : Particle) =
        let pos = p.Current + center
        Point (float pos.X, float pos.Y)

      // Draw all constraints
      for c in constraints do
        match c.Color with
        | None -> ()
        | Some cc ->
          let pen = pens.[cc]
          dc.DrawLine (pen , toPoint c.Left, toPoint c.Right)

      // Draw all particles
      for p in particles do
        match p.Color with
        | None    -> ()
        | Some pc ->
          let r, b =
            if p.InvertedMass = 0.F then
              10., Brushes.White
            else
              let r = 3.F + p.SqrtMass |> float
              r, Brushes.Black
          dc.DrawEllipse (b, pens.[pc], toPoint p, r, r)

      // Shadowing the previous toPoint function is fine in F#
      let inline toPoint (p : V2) =
        let pos = p + center
        Point (float pos.X, float pos.Y)

      // Draw all rockets
      let forcePen = pens.[Color.Red]
      for r in rockets do
        let cto = r.ConnectedTo
        let c   = cto.Current
        let f   = -10.F*r.ForceVector pressed
        let pt0 = toPoint c
        let pt1 = toPoint (c + f)
        let pen = forcePen
        dc.DrawLine (pen, pt0, pt1)

      // Draws the Global Constraint (surrounding box)
      let globalPen0 = pens.[Color.Green]
      let globalPen1 = pens.[Color.Gray]
      for gc in globalConstraints do
        let p = if gc.Variant then globalPen1 else globalPen0
        dc.DrawRectangle (null, p, Rect(toPoint gc.Min, toPoint gc.Max))
  end

// Tells F# that this method is the main entry point
[<EntryPoint>]
// More 1990s magic! Basically in Windows there's a requirement that
//  UI controls runs in something called a Single Threaded Apartment.
//  So we tell .NET that the thread that calls main should be in a
//  Single Threaded Apartment.
//  Basically MS idea in 1990s on how to solve the problem of writing
//  multi threaded applications.
//  The .NET equivalent to apartments could be SynchronizationContext
[<STAThread>]
let main argv =
  // Sets up the main window
  let window  = Window (Title = "FsLanding", Background = Brushes.Black)
  // Creates our canvas
  let element = CanvasElement ()
  // Makes our canvas the content of the Window
  window.Content <- element
  // Make element focusable to be able to capture key strokes
  element.Focusable <- true
  element.Focus () |> ignore
  // Starts the time animation
  element.Start ()
  // Shows the Window
  window.ShowDialog () |> ignore
  0
	<Project Sdk="Microsoft.NET.Sdk">

	<PropertyGroup>
	<OutputType>WinExe</OutputType>
	<TargetFramework>net6.0-windows</TargetFramework>
	<UseWPF>true</UseWPF>
	</PropertyGroup>

	<ItemGroup>
	<Compile Include="Program.fs" />
	</ItemGroup>

	</Project>
	// Hi!. The particle system is defined at row: 236+

	// `open` are F# version of C# `using`
	open System
	open System.Collections.Generic
	open System.Diagnostics
	open System.Globalization
	open System.Numerics

	open System.Windows
	open System.Windows.Input
	open System.Windows.Media
	open System.Windows.Media.Animation

	open FSharp.Core.Printf

	type V1 = float32
	type V2 = Vector2

	// F# inline is sometimes used for performance but often
	// it's used to get access to more advanced generics than
	// supported by .NET CLR
	// x here can be any type that supports conversion to float32
	let inline v1 x = float32 x
	let inline v2 x y = V2 (float32 x, float32 y)
	let v2_0 = v2 0.F 0.F
	let inline clamp v i x = max i (min v x)
	let inline clamp2 v i x = V2.Max (i, V2.Min(v, x))
	let tanh_approx x =
	// tanh is (exp(x) − exp(−x)) / (exp(x) + exp(−x))
	// But exp is pretty expensive. Following is s decent approx
	let x2 = x*x
	clamp (x(27.F+x2)/(27.F+9.Fx2)) -1.F 1.F

	[<RequireQualifiedAccess>]
	type Color =
	\| Gray
	\| Green
	\| Red
	\| White
	\| Yellow
	let noColor : Color option = Some Color.Gray

	// Define a particle record
	// Mass is stored in difference ways to avoid recomputing it
	// Current is the current position
	// Previous is the previous position
	// The speed then implicitly is Current-Previous
	// This representation is used in something called Verlet Integration
	// Verlet Integration avoids needing to update the speed vector
	// when computing the constraints
	// It doesn't produce accurate physics but it looks believable
	// which is good enough for this program
	// Verlet Integration is described with some detail here:
	// https://en.wikipedia.org/wiki/Verlet_integration
	type Particle =
	{
	Color : Color option
	Mass : V1
	SqrtMass : V1
	InvertedMass : V1
	mutable Current : V2
	mutable Previous : V2
	}

	// Verlet step moves the particle with inertia and gravity
	member x.Step (gravity : V1) =
	// InvertedMass of 0 means this is a fixed particle of infinite
	// mass. These particles don't move
	if x.InvertedMass > 0.F then
	let c = x.Current
	let g = v2 0.F gravity
	x.Current <- g + c + (c - x.Previous)
	x.Previous <- c

	// Makes a particle given mass, position x,y and velocity vx,vy
	let inline mkParticle pc mass x y vx vy : Particle =
	let m = v1 mass
	let c = v2 x y
	let v = v2 vx vy
	{
	Color = pc
	Mass = m
	InvertedMass = 1.F/m
	SqrtMass = sqrt m
	Current = c
	Previous = c - v
	}

	// Makes a fix particle position x,y
	// a fix particle has infinite mass and doesn't move
	// used as an anchor point for other particles and constraints
	let inline mkFixParticle pc x y = mkParticle pc infinityf x y 0.F 0.F

	module Details =
	let inline adapt f = OptimizedClosures.FSharpFunc<V1, V1, V1>.Adapt f
	let stickActivation = adapt (fun l d -> d)
	let ropeActivation = adapt (fun l d -> if d > 0.F then d else 0.F)
	let springActivation f= adapt (fun l d -> dtanh_approx (f(abs d/l)))
	let epsilon = 0.0001F
	let epsilonSquared = epsilon*epsilon

	let rec isPressed (pressed : HashSet<Key>) (keys : Key array) i =
	if i < keys.Length then
	if pressed.Contains keys.[i] then
	true
	else
	isPressed pressed keys (i + 1)
	else
	false
	open Details

	// Defines a constraint which is either a stick or a rope
	// a stick tries to make sure that the distance between two particles
	// are the Length value
	// a rope tries to makes sure that distance between two particles
	// are at most the Length value
	type Constraint =
	{
	Color : Color option
	Activation : OptimizedClosures.FSharpFunc<V1, V1, V1>
	Length : V1
	Left : Particle
	Right : Particle
	}

	// After the verlet step most constraints are "over stretched"
	// Relax moves the two particles so that the constraint is "relaxed"
	// again. This will in turn make other constraints "over stretched"
	// but it turns out applying Relax over and over moves the system
	// to a relaxed state
	member x.Relax () =
	// Bunch of math but the intent is this:
	// compute the distance between the two particles in the constraint
	// if the distance is not the right distance
	// then move the two particles towards or away from eachother
	// so that the distance is correct
	// The comparitive mass of the particles is used to make sure
	// that a small particle moves more than the bigger one it's
	// connected to
	let l = x.Left
	let r = x.Right
	let lc = l.Current
	let rc = r.Current

	let diff = lc - rc
	let len = diff.Length ()
	let ldiff = len - x.Length
	let adiff = x.Activation.Invoke (x.Length, ldiff)
	if abs adiff > epsilon then
	let imass = 0.5F/(l.InvertedMass + r.InvertedMass)
	let mdiff = (imassadiff/len)diff
	let loff = l.InvertedMass * mdiff
	let roff = r.InvertedMass * mdiff

	l.Current <- lc - loff
	r.Current <- rc + roff

	// Makes a stick constraint between two particles
	let inline mkStick c (l : Particle) (r : Particle) : Constraint =
	{
	Color = c
	Activation = stickActivation
	Length = (l.Current - r.Current).Length ()
	Left = l
	Right = r
	}

	// Makes a spring constraint between two particles
	let inline mkSpring c f (l : Particle) (r : Particle) : Constraint =
	{
	Color = c
	Activation = springActivation f
	Length = (l.Current - r.Current).Length ()
	Left = l
	Right = r
	}

	// Makes a rope constraint between two particles
	// allows making the rope a bit longer than the initial distance
	let inline mkRope c extraLength (l : Particle) (r : Particle) : Constraint =
	{
	Color = c
	Activation= ropeActivation
	Length = (1.F + abs (float32 extraLength))*(l.Current - r.Current).Length ()
	Left = l
	Right = r
	}

	// Defines a global constraint that forces all particles inside a box
	type GlobalConstraint =
	{
	Variant : bool
	Min : V2
	Max : V2
	}

	// If the current particle position is outside the box
	// force it into the box again
	member x.Relax (ps : Particle array) =
	for p in ps do
	let c = p.Current
	let nc =
	if x.Variant then
	let di = c - x.Min
	let dx = x.Max - c
	if di.X >= 0.F && dx.X >= 0.F && di.Y >= 0.F && dx.Y >= 0.F then
	let ddx = if di.X < dx.X then -di.X else dx.X
	let ddy = if di.Y < dx.Y then -di.Y else dx.Y
	if abs ddx < abs ddy then
	v2 (c.X + ddx) c.Y
	else
	v2 c.X (c.Y + ddy)
	else
	c
	else
	clamp2 c x.Min x.Max
	let ls = (nc - c).LengthSquared ()
	// Faking friction
	if ls > epsilonSquared then
	let v = nc - p.Previous
	let nv = 0.9F * v
	p.Current <- nc
	p.Previous <- nc - nv

	// Creates a global contraint
	let mkGlobalConstraint v x0 y0 x1 y1 : GlobalConstraint =
	{
	Variant = v
	Min = v2 (min x0 x1) (min y0 y1)
	Max = v2 (max x0 x1) (max y0 y1)
	}

	// Defines a rocket that fires either forward or reverse
	// depending on what keys are pressed
	// The rocket gets the same position as the particle it's connected
	// to and the rocket direction is computed with the help of the
	// anchor particle.
	type Rocket =
	{
	Perpendicular : bool
	ConnectedTo : Particle
	AnchoredTo : Particle
	Force : V1
	ForwardWhen : Key array
	ReverseWhen : Key array
	}

	member x.ForceVector (pressed : HashSet<Key>) =
	let forceVector () =
	// Compute the difference between the connected to
	// and anchor particle. Normalize it ie make the length == 1
	let d = V2.Normalize (x.ConnectedTo.Current - x.AnchoredTo.Current)
	// the force vector
	if x.Perpendicular then
	// The rocket direction is perpendicular to the difference
	let n = v2 d.Y -d.X
	x.Force*n
	else
	// The rocket direction is tangential to the difference
	x.Force*d

	// Is any of the forward keys pressed?
	if isPressed pressed x.ForwardWhen 0 then
	forceVector ()
	// Is any of the reverse keys pressed?
	elif isPressed pressed x.ReverseWhen 0 then
	-forceVector ()
	// If neither then rocket is idle
	else
	v2_0

	// Creates a rocket
	let mkRocket
	perpendicular
	connectedTo
	anchoredTo
	force
	forwardWhen
	reverseWhen : Rocket =
	{
	Perpendicular = perpendicular
	ConnectedTo = connectedTo
	AnchoredTo = anchoredTo
	Force = force
	ForwardWhen = forwardWhen
	ReverseWhen = reverseWhen
	}

	// Creates a box of particles and constraints
	let mkBox pc cc mass size x y vx vy : Particle array* Constraint array =
	let inline p x y = mkParticle pc (0.25F*mass) x y vx vy
	let hsz = 0.5F*size
	let p00 = p (x - hsz) (y - hsz)
	let p01 = p (x - hsz) (y + hsz)
	let p10 = p (x + hsz) (y - hsz)
	let p11 = p (x + hsz) (y + hsz)
	let ps = [\|p00; p01; p11; p10\|]
	let inline stick cc i j = mkStick cc ps.[i] ps.[j]
	let nc = noColor
	let cs =
	[\|
	stick cc 0 1
	stick cc 1 2
	stick cc 2 3
	stick cc 3 0
	stick nc 0 2
	stick nc 1 3
	\|]
	ps, cs

	// The global constraint is a box that the particles has to stay within
	let globalConstraints =
	[\|
	mkGlobalConstraint false -600.F -1000.F 600.F 400.F
	mkGlobalConstraint true -480.F 401.F -380.F 0.F
	mkGlobalConstraint true -300.F 401.F -200.F 0.F
	\|]

	let mkRocketShip off =
	let nc = noColor
	let pc = noColor
	let cc = Some Color.Yellow
	let topParticle = mkParticle pc 1.F 0.F (-200.F + off) 0.F 0.F
	let bottomParticle = mkParticle pc 20.F 0.F ( 85.F + off) 0.F 0.F
	let leftLegParticle = mkParticle pc 1.F -85.F ( 150.F + off) 0.F 0.F
	let rightLegParticle = mkParticle pc 1.F 85.F ( 150.F + off) 0.F 0.F
	let boxParticles, boxConstraints = mkBox pc cc 20.F 100.F 0.F off 0.F 0.F

	let particles =
	[\|
	topParticle
	leftLegParticle
	rightLegParticle
	bottomParticle
	yield! boxParticles
	\|]

	let constraints =
	[\|
	// Top
	mkStick cc topParticle boxParticles.[0]
	mkStick cc topParticle boxParticles.[3]

	// Rocket
	mkStick nc bottomParticle topParticle
	mkStick nc bottomParticle boxParticles.[1]
	mkStick nc bottomParticle boxParticles.[2]

	// Left left
	mkStick cc leftLegParticle boxParticles.[1]
	mkSpring cc 4.F leftLegParticle bottomParticle

	// Right left
	mkStick cc rightLegParticle boxParticles.[2]
	mkSpring cc 4.F rightLegParticle bottomParticle

	yield! boxConstraints
	\|]

	let rockets =
	[\|
	// Add 2 rockets to the box ship
	mkRocket true topParticle bottomParticle 2.F [\|Key.Left\|] [\|Key.Right\|]
	mkRocket false bottomParticle topParticle -15.F [\|Key.Up\|] [\|\|]
	\|]

	bottomParticle, particles, constraints, rockets

	let mkBoxShip off =
	let nc = noColor
	let pc = noColor
	let cc = Some Color.Yellow
	let boxParticles, boxConstraints = mkBox pc cc 20.F 100.F 0.F 0.F 0.F 0.F
	let leftLegParticle = mkParticle pc 1.F -55.F ( 150.F + off) 0.F 0.F
	let rightLegParticle = mkParticle pc 1.F 55.F ( 150.F + off) 0.F 0.F
	let bottomParticle = boxParticles.[1]

	let rot = Matrix3x2.CreateRotation (v1 (-Math.PI / 4.))
	let tra = Matrix3x2.CreateTranslation (v2 0.F (off - 50.F))
	let full= rot*tra
	for bp in boxParticles do
	bp.Current <- V2.Transform (bp.Current , full)
	bp.Previous <- V2.Transform (bp.Previous, full)

	let particles =
	[\|
	leftLegParticle
	rightLegParticle
	yield! boxParticles
	\|]

	let constraints =
	[\|
	// Left left
	mkStick cc leftLegParticle boxParticles.[0]
	mkSpring cc 4.F leftLegParticle bottomParticle
	// Right left
	mkStick cc rightLegParticle boxParticles.[2]
	mkSpring cc 4.F rightLegParticle bottomParticle

	yield! boxConstraints
	\|]

	let rockets =
	[\|
	// Add 2 rockets to the box ship
	mkRocket true boxParticles.[0] boxParticles.[2] -5.F [\|Key.Up; Key.Right\|] [\|\|]
	mkRocket true boxParticles.[2] boxParticles.[0] 5.F [\|Key.Up; Key.Left \|] [\|\|]
	\|]

	bottomParticle, particles, constraints, rockets

	// Creates a small system of particles and constraints
	let particles, constraints, rockets =
	let pc = noColor
	let cc = Some Color.Yellow
	let rc = Some Color.Gray
	let off = 250.F


	let shipConnectParticles, shipParticles, shipConstraints, shipRockets = mkBoxShip off

	let del0Particles, del0Constraints= mkBox pc cc 20.F 40.F 120.F (120.F + off) 0.F 0.F
	let del1Particles, del1Constraints= mkBox pc cc 20.F 40.F 240.F (120.F + off) 0.F 0.F

	let particles =
	[\|
	yield! shipParticles
	yield! del0Particles
	yield! del1Particles
	\|]

	let constraints =
	[\|
	yield! shipConstraints
	mkRope rc 0.F shipConnectParticles del0Particles.[2]
	mkRope rc 0.F del0Particles.[0] del1Particles.[2]
	yield! del0Constraints
	yield! del1Constraints
	\|]

	let rockets =
	[\|
	yield! shipRockets
	\|]

	particles, constraints, rockets

	// Creates a CanvasElement class that will act like a canvas for us
	// We override the OnRender method to draw graphics. In order to make the graphics
	// animate we have a time animation that invalidates the element which forces a redraw
	type CanvasElement () =
	class
	// This is how in F# we inherit, this is typically not done as much
	// as in C# but in order to be part of WPF Visual tree we need to
	// inherit UIElement
	inherit UIElement ()

	// Declaring a DependencyProperty member for Time
	// This is WPF magic but it's created so that we can create
	// an "animation" of the time value.
	// This will help use do smooth updates.
	// Nothing like web requestAnimationFrame in WPF AFAIK
	static let timeProperty =
	let pc = PropertyChangedCallback CanvasElement.TimePropertyChanged
	let md = PropertyMetadata (0., pc)
	DependencyProperty.Register ("Time", typeof<float>, typeof<CanvasElement>, md)

	// Freezing resources prevents updates of WPF Resources
	// Can help WPF optimize rendering
	// #Freezable is like C# constraint : where T : Freezable
	let freeze (f : #Freezable) =
	f.Freeze ()
	f

	// Helper function to create pens
	let makePen thickness brush =
	Pen (Thickness = thickness, Brush = brush) \|> freeze

	// Help text
	let helpText =
	FormattedText ( "Use arrow keys to fire rockets. Drive responsibly"
	, CultureInfo.InvariantCulture
	, FlowDirection.LeftToRight
	, Typeface "Arial"
	, 36.0
	, Brushes.Gray
	, 1.0
	)

	// Some pens to draw lines with
	let pens =
	[\|
	Color.Gray , Brushes.Gray
	Color.Green , Brushes.Green
	Color.Red , Brushes.Red
	Color.White , Brushes.White
	Color.Yellow, Brushes.Yellow
	\|]
	\|> Array.map (fun (k, v) -> k, makePen 2. v)
	\|> dict

	// Currently pressed key
	let mutable pressed = HashSet<Key>()

	// More WPF dependency property magic
	// Not very interesting but this becomes member function in the class
	static member TimePropertyChanged (d : DependencyObject) (e : DependencyPropertyChangedEventArgs) =
	let g = d :?> CanvasElement
	// Whenever time change we invalidate the entire canvas element
	g.InvalidateVisual ()

	// Idiomatically WPF Dependency properties should be readonly
	// static fields. However, F# don't allow us to declare that
	// Luckily it seems static readonly properties works fine
	static member TimeProperty = timeProperty

	// Store pressed key
	override x.OnKeyDown e =
	pressed.Add e.Key \|> ignore

	// Reset pressed key
	override x.OnKeyUp e =
	pressed.Remove e.Key \|> ignore

	// Gets the Time dependency property
	member x.Time = x.GetValue CanvasElement.TimeProperty :?> float

	// Create an animation that animates a floating point from 0 to 1E9
	// over 1E9 seconds thus the time. This animation is then hooked onto the Time property
	// Basically more WPF magic
	member x.Start () =
	// Initial time value
	let b = 0.
	// End time, application animation stops after approx 30 years
	let e = 1E9
	let dur = Duration (TimeSpan.FromSeconds (e - b))
	let ani = DoubleAnimation (b, e, dur) \|> freeze
	// Animating Time property
	x.BeginAnimation (CanvasElement.TimeProperty, ani);

	// Finally we get to the good stuff!
	// dc is a DeviceContext, basically a canvas we can draw on
	override x.OnRender dc =
	// Get the current time, will change over time (hohoh)
	let time = x.Time
	// This is the size of the canvas in pixels
	let rs = x.RenderSize

	let center= v2 (0.5rs.Width) (0.5rs.Height)

	for _ = 1 to 1 do
	// Apply rocket force
	for r in rockets do
	let f = (r.ForceVector pressed)
	let p = r.ConnectedTo
	p.Current <- p.Current + f*p.InvertedMass

	// Apply the verlet step to all particles
	for p in particles do
	p.Step 0.1F

	// Relax all constraints 5 times
	// If you relax less times the system becomes more "bouncy"
	// More times makes it more "stiff"
	for _ = 1 to 5 do
	for gc in globalConstraints do
	gc.Relax particles
	for c in constraints do
	c.Relax ()

	// Draw the instructions
	dc.DrawText (helpText, new Point(0, 0))

	// inline here allows us to create helper function that
	// uses a local variable without the overhead of creating
	// a new function object
	// Creating a bunch of objects during drawing can lead
	// to GC which we like to avoid
	let inline toPoint (p : Particle) =
	let pos = p.Current + center
	Point (float pos.X, float pos.Y)

	// Draw all constraints
	for c in constraints do
	match c.Color with
	\| None -> ()
	\| Some cc ->
	let pen = pens.[cc]
	dc.DrawLine (pen , toPoint c.Left, toPoint c.Right)

	// Draw all particles
	for p in particles do
	match p.Color with
	\| None -> ()
	\| Some pc ->
	let r, b =
	if p.InvertedMass = 0.F then
	10., Brushes.White
	else
	let r = 3.F + p.SqrtMass \|> float
	r, Brushes.Black
	dc.DrawEllipse (b, pens.[pc], toPoint p, r, r)

	// Shadowing the previous toPoint function is fine in F#
	let inline toPoint (p : V2) =
	let pos = p + center
	Point (float pos.X, float pos.Y)

	// Draw all rockets
	let forcePen = pens.[Color.Red]
	for r in rockets do
	let cto = r.ConnectedTo
	let c = cto.Current
	let f = -10.F*r.ForceVector pressed
	let pt0 = toPoint c
	let pt1 = toPoint (c + f)
	let pen = forcePen
	dc.DrawLine (pen, pt0, pt1)

	// Draws the Global Constraint (surrounding box)
	let globalPen0 = pens.[Color.Green]
	let globalPen1 = pens.[Color.Gray]
	for gc in globalConstraints do
	let p = if gc.Variant then globalPen1 else globalPen0
	dc.DrawRectangle (null, p, Rect(toPoint gc.Min, toPoint gc.Max))
	end

	// Tells F# that this method is the main entry point
	[<EntryPoint>]
	// More 1990s magic! Basically in Windows there's a requirement that
	// UI controls runs in something called a Single Threaded Apartment.
	// So we tell .NET that the thread that calls main should be in a
	// Single Threaded Apartment.
	// Basically MS idea in 1990s on how to solve the problem of writing
	// multi threaded applications.
	// The .NET equivalent to apartments could be SynchronizationContext
	[<STAThread>]
	let main argv =
	// Sets up the main window
	let window = Window (Title = "FsLanding", Background = Brushes.Black)
	// Creates our canvas
	let element = CanvasElement ()
	// Makes our canvas the content of the Window
	window.Content <- element
	// Make element focusable to be able to capture key strokes
	element.Focusable <- true
	element.Focus () \|> ignore
	// Starts the time animation
	element.Start ()
	// Shows the Window
	window.ShowDialog () \|> ignore
	0