Skip to content

Instantly share code, notes, and snippets.

@paf31
Last active February 2, 2018 23:28
Show Gist options
  • Save paf31/ff1e87f0872d2d891e77d209d8f7706d to your computer and use it in GitHub Desktop.
Save paf31/ff1e87f0872d2d891e77d209d8f7706d to your computer and use it in GitHub Desktop.
Try Behaviors
module Main where
import Prelude
import Color (white)
import Color.Scheme.MaterialDesign (blueGrey)
import Control.Monad.Eff (Eff)
import Control.MonadZero (guard)
import Data.Array (sortBy, (..))
import Data.Foldable (foldMap)
import Data.Int (toNumber)
import Data.Maybe (fromJust, maybe)
import Data.Set (isEmpty)
import FRP (FRP)
import FRP.Behavior (Behavior, animate, derivative', fixB, integral')
import FRP.Behavior.Mouse (buttons)
import FRP.Behavior.Mouse as Mouse
import FRP.Behavior.Time as Time
import FRP.Event (Event)
import FRP.Try (defaultMain)
import Global (infinity)
import Graphics.Drawing (Drawing, circle, fillColor, filled, lineWidth, outlineColor, outlined, rectangle, render, scale, translate)
type Circle = { x :: Number, y :: Number, size :: Number }
scene :: { w :: Number, h :: Number } -> Behavior Drawing
scene { w, h } = pure background <> map renderCircles circles where
background :: Drawing
background = filled (fillColor blueGrey) (rectangle 0.0 0.0 w h)
scaleFactor :: Number
scaleFactor = max w h / 16.0
renderCircle :: Circle -> Drawing
renderCircle { x, y, size } =
scale scaleFactor scaleFactor <<< translate x y <<< scale size size $
outlined
(outlineColor white <> lineWidth ((1.0 + size * 2.0) / scaleFactor))
(circle 0.0 0.0 0.5)
renderCircles :: Array Circle -> Drawing
renderCircles = foldMap renderCircle
seconds :: Behavior Number
seconds = map ((_ / 1000.0) <<< toNumber) Time.millisSinceEpoch
-- `swell` is an interactive function of time defined by a differential equation:
--
-- d^2s/dt^2
-- | mouse down = ⍺ - βs
-- | mouse up = ɣ - δs - ε ds/dt
--
-- So the function exhibits either decay or growth depending on if
-- the mouse is pressed or not.
--
-- We can solve the differential equation using an integral and a fixed point.
swell :: Behavior Number
swell =
fixB 2.0 \b ->
integral' 2.0 seconds $
fixB 0.0 \db ->
integral' 0.0 seconds $
f <$> buttons <*> b <*> db
where
f bs s ds | isEmpty bs = -8.0 * (s - 1.0) - ds * 2.0
| otherwise = 2.0 * (4.0 - s)
circles :: Behavior (Array Circle)
circles = toCircles <$> Mouse.position <*> swell where
toCircles m sw =
do
i <- 0 .. 16
j <- 0 .. 16
let x = toNumber i
y = toNumber j
d = dist x y m
size = (1.0 + sw) / (d + 1.5) - 0.2
guard $ size > 0.0
pure { x
, y
, size
}
where
dist x y = maybe infinity \{ x: mx, y: my } ->
let dx = x - toNumber mx / scaleFactor
dy = y - toNumber my / scaleFactor
in dx * dx + dy * dy
main = defaultMain (scene { w: 800.0, h:600.0 })
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment