wftpainting.fsx

open System
open System.Collections.Generic
open Fable.Core
open Fable.Core.JsInterop
open Fable.Import.PIXI
open Fable.Import.PIXI.extras
open Fable.Import.Browser
open Fable.Import.JS

let options = [
  Antialias true
  BackgroundColor ( float 0x7A325D )
]
let renderer = WebGLRenderer( window.innerWidth, window.innerHeight, options)

let gameDiv = document.getElementById("game")
gameDiv.appendChild( renderer.view )

// create the root of the scene graph
let mutable stage = new Container()
stage.interactive <- true

let stageW = renderer.width
let stageH = renderer.height
let count = 1000
let half = count / 2


type Easing = float -> float -> float -> float -> float

let distanceBetween2Points (p1:Point) (p2:Point) =
  let tx = p2.x - p1.x
  let ty = p2.y - p1.y
  Math.sqrt( tx * tx + ty * ty)

let easeLinear (t:float) (b:float) (c:float) (d:float) : float =
  c * t / d + b

type CompleteState =
  | Complete
  | NotComplete

[<AbstractClass>]
type Behavior() =
  let mutable _complete = NotComplete
  let mutable _dispose = false
  let mutable _onComplete : (unit -> unit) option = None

  abstract Update : ESprite -> CompleteState

  member self.Complete
    with get() = _complete
    and set(value) =
      _complete <- value

  member self.Dispose
    with get() = _dispose
    and set(value) =
      _dispose <- value

  member self.OnComplete
    with get() =
      _onComplete
    and set(value) =
      _onComplete <- value

and AccelerateBehavior(acc) =
  inherit Behavior()
  let _acc : Point = acc

  override self.Update(s) =
    s.position <- Point( s.position.x * _acc.x, s.position.y + _acc.y )
    Complete

and Fade(easeFunction, duration) =
  inherit Behavior()

  let _easeFunction : Easing = easeFunction
  let _duration : float = duration
  let _start = DateTime.Now

  override self.Update(s) =
    if s.alpha > 0. then
      let newT = DateTime.Now
      let elapsed = newT - _start
      let result = _easeFunction (float elapsed.TotalMilliseconds) 0. 1. _duration
      s.alpha <- 1. - result
      if s.alpha < 0. then
        s.alpha <- 0.
        self.Complete <- Complete

    self.Complete

and AlphaDeath() =
  inherit Behavior()

  override self.Update(s) =
    let complete : bool = s.alpha <= 0.
    if complete then s.Dispose <- true
    Complete


and Blink(freq) =
  inherit Behavior()
  let _freq : float = freq
  let mutable _start = DateTime.Now

  override self.Update(s) =
    let newT = DateTime.Now
    let elapsed = newT - _start
    let complete = elapsed.TotalMilliseconds > _freq
    if complete then
      s.visible <- not s.visible
      _start <- DateTime.Now
    NotComplete // blink never stops

and MoveBehavior(speed) =
  inherit Behavior()
  let _speed : Point = speed

  override self.Update(s) =
    s.position <- Point( s.position.x + _speed.x, s.position.y + _speed.y )
    NotComplete // moves never stops

and MoveTowardsFixedSmooth(p:Point, speed, radius) =
  inherit Behavior()

  override self.Update(s) =
    match self.Complete with
    | Complete ->
      s.position <- p
    | NotComplete ->
      let dist = distanceBetween2Points s.position p
      if dist > radius then // approximate, should use some radius instead
        let sp = s.position
        let newP = Point( sp.x + (p.x - sp.x) / speed, sp.y + (p.y - sp.y) / speed )
        s.position <- newP
      else
      self.Complete <- Complete

    self.Complete

and MoveTowardsMovingSmooth(target:Sprite, speed, radius) =
  inherit Behavior()

  override self.Update(s) =
    match self.Complete with
    | Complete ->
      s.position <- target.position
    | NotComplete ->
      let dist = distanceBetween2Points s.position target.position
      if dist > radius then // approximate, should use some radius instead
        let sp = s.position
        let tp = target.position
        let newP = Point( sp.x + (tp.x - sp.x) / speed, sp.y + (tp.y - sp.y) / speed )
        s.position <- newP
      else
        self.Complete <- Complete

    self.Complete

and MoveTowardsFixed(p:Point, speed, radius) =
  inherit Behavior()

  override self.Update(s) =
    match self.Complete with
    | Complete ->
      s.position <- p
    | NotComplete ->
      let sp = s.position
      let tx = p.x - sp.x
      let ty = p.y - sp.y
      let dist = Math.sqrt( tx * tx + ty * ty)
      if dist > radius then // approximate, should use some radius instead
        let vx = (tx / dist) * speed
        let vy = (ty / dist) * speed
        let newP = Point( sp.x + vx, sp.y + vy)
        s.position <- newP
      else
        self.Complete <- Complete

    self.Complete

and MoveTowardsMoving(target:Sprite, speed, radius) =
  inherit Behavior()

  override self.Update(s) =
    match self.Complete with
    | Complete ->
      s.position <- target.position
    | NotComplete ->
      let sp = s.position
      let tx = target.position.x - sp.x
      let ty = target.position.y - sp.y
      let dist = Math.sqrt( tx * tx + ty * ty)
      if dist > radius *0.5 then // approximate, should use some radius instead
        let vx = (tx / dist) * speed
        let vy = (ty / dist) * speed
        let newP = Point( sp.x + vx, sp.y + vy)
        s.position <- newP
      else
        self.Complete <- Complete

    self.Complete

and KillOffScreen(bounds: Rectangle) =
  inherit Behavior()

  override self.Update(s) =
    let sx = s.position.x
    let sy = s.position.y
    let okToDispose = (sx + s.width) < bounds.x || (sy + s.height) < bounds.y ||(s.y - s.height) >= bounds.height || (sx - s.width) > bounds.width

    if okToDispose then
      s.Dispose <- true
      self.Complete <- Complete

    self.Complete

and ESprite(t:Texture) =
  inherit Sprite(t)

  let mutable _behaviors : Behavior list = []
  let mutable _dispose = false

  member self.Dispose
    with get() = _dispose
    and set(value) =
      _dispose <- value

  member self.Behave(b:Behavior) =
    _behaviors <- b :: _behaviors

  member self.Update() =
    _behaviors <- _behaviors |> List.filter( fun b -> not b.Dispose )
    _behaviors |> Seq.iter( fun b ->
      let complete = b.Update(self)
      match complete with
      | Complete ->
        b.Dispose <- true
        let cbk = b.OnComplete
        if cbk.IsSome then cbk.Value()
      | NotComplete -> ()
    )

  member self.Cleanup() =
    self.parent.removeChild(self)

let mutable nodes : ESprite list = []
let mutable renderTexture = RenderTexture( U2.Case2 renderer, stageW, stageH)
let mutable blackBoard = new Sprite(renderTexture)
blackBoard.position.x <- stageW * 0.5
blackBoard.position.y <- stageH * 0.5
blackBoard.anchor.set(0.5)
stage.addChild(blackBoard)

let rec animate (dt:float) =
  if nodes.Length > 0 then
    console.log(nodes.Length)
    // cleanup
    nodes
      |> List.filter( fun n -> n.Dispose )
      |> List.iter( fun s -> s.Cleanup() |> ignore )

    // keep remaining
    nodes <- nodes |> List.filter( fun n -> not n.Dispose)
    // update
    nodes |> List.iter( fun n -> n.Update() )

  renderTexture.render(displayObject=stage, clear=false)
  renderer.render(stage)
  window.requestAnimationFrame(FrameRequestCallback(animate)) |> ignore


// prepare our ball texture
let g = Graphics()
g.beginFill(float 0xFFFFFF)
g.drawCircle(0.,0.,10.)
g.endFill()
let r = U2.Case2 renderer
let t = g.generateTexture(r,Globals.SCALE_MODES.LINEAR,1.0)

// create a ball
let makeSprite i =
  let dot = ESprite(t)
  dot.anchor.x <- 0.5
  dot.anchor.y <- 0.5
  dot.position <- Point(Math.random() * stageW,stageH * Math.random())
  dot

// prepare our balls
let rec addSprite i =
  let dot = makeSprite i

  // add move
  let dirX = if Math.random() <= 0.5 then 1. else -1.
  let dirY = if Math.random() <= 0.5 then 1. else -1.
  dot.Behave( MoveBehavior(Point(Math.random() * 0.5 *  dirX,Math.random() * 0.5 * dirY)) )

  // kill offscreen
  //let onComplete = fun () -> console.log(sprintf "kof %i" i)
  let kof = KillOffScreen( Rectangle(0.,0., stageW,stageH))
  //kof.OnComplete <- Some(onComplete)
  dot.Behave( kof)

  if i > half then
    dot.tint <- Math.random() * float 0xFFFFFF
    let radius = Math.random()
    dot.scale <- Point(radius, radius)
    dot.alpha <- radius * 0.3
  else
    dot.tint <- Math.random() * float 0xFFFFFF
    let radius = Math.random()
    dot.scale <- Point(radius, radius)
    dot.alpha <- 0.1
  stage.addChild(dot) |> ignore

  nodes <- dot :: nodes
  match i with
  | t when t >= count -> ()
  | _ -> addSprite (i + 1)

// send one half of balls against the other half
let rec prepareHoming i =
  let randomNode1 = nodes |> Seq.skip i |> Seq.take 1 |> Seq.toList
  let randomNode2 = nodes |> Seq.skip (half + i) |> Seq.take 1 |> Seq.toList
  let method1 = Math.random() <= 0.5
  let rn1 = randomNode1.Head
  let target = randomNode2.Head
  let mt = MoveTowardsMoving(target, 50., rn1.width)

  // when dot reaches its goal
  // remove it and its target
  let death = AlphaDeath()
  death.OnComplete <- Some(fun() ->
    console.log(sprintf "alpha death %i" i)
    ())

  mt.OnComplete <- Some(fun() ->
    console.log(sprintf  "%i touched target" i)
    rn1.Behave(Fade(easeLinear, 200.))
    rn1.Behave(death)

    target.Behave(Fade(easeLinear, 400.))
    target.Behave(death)
    ()
  )

  rn1.Behave( mt )
  match i with
  | t when t >= half -> ()
  | _ -> prepareHoming (i + 1)


// prepare our sprites
addSprite 0
// let add some funny homing missiles
prepareHoming 0
// Show Time!
animate 0.