purescript FRP.purs

-- any type that has a value, eg Number, is kind `*`
-- Behavior is a type constructor aka "Higher Kinded Type"
-- This is a function that takes an `a`, a type variable
-- and returns a `Behavior`
-- so it has kind `* -> *`

newtype Behavior a = Behavior { at :: Number -> a}
at :: forall a. Behavior a -> Time -> a

-- this function lets us reify a value `a` at time `t`
at (Behavior {at: bat}) t = bat t


-- in a pure language, we must carefully manage side-effects,
-- so the compiler knows where the program touches the outside world
-- Here, we define the type of a method that renders to an HTML canvas
class Renderable a where
    render :: forall eff. Context2D -> a -> Eff (canvas :: CANVAS | eff) Unit


newtype Rectangle = Rectangle { x :: Number, y :: Number, w :: Number
                              , h :: Number, c :: Color
                              }

-- let's make our rectangle renderable!
instance renderableRectangle :: Renderable Rectangle where
    render ctx (Rectangle {x,y,w,h,c}) = void do
        setFillStyle c ctx
        fillPath ctx $ rect ctx
            { x: x
            , y: y
            , w: w
            , h: h
            }

-- we can define a recursive function to make a list of renderable types
-- as renderable itself
instance renderableList :: Renderable a => Renderable (List a) where
    render ctx renderables = go renderables where
        go Nil = do
            pure unit
        go (b : bs) = void do
            render ctx b
            go bs

-- now let's run an animation. Dropped frames will not impact
-- rectangle location accuracy since behaviors are continuous
main = void $ unsafePartial do
    Just canvas <- getCanvasElementById "canvas"
    w <- window
    ctx <- getContext2D canvas
    width <- getCanvasWidth canvas
    height <- getCanvasHeight canvas
    let sample t = Rectangle { x: 0.01*t
                              , y: 250.0
                              , w: 10.0
                              , h: 300.0
                              , c: "red"
                              }

    let b = Behavior { at: sample }
                            
    animationLoop {w:w, ctx:ctx, width:width, height:height, b:b} 0.0