Bells on klank.dev

Bells.purs

module Klank.Dev where

import Prelude
import Color (rgba)
import Control.Monad.Reader (Reader, ask, asks, runReader)
import Data.Generic.Rep (class Generic)
import Data.Generic.Rep.Show (genericShow)
import Data.Int (toNumber)
import Data.List (List(..), catMaybes, fold, (:))
import Data.Maybe (Maybe(..), isJust)
import Data.NonEmpty (NonEmpty, (:|))
import Data.Set (isEmpty)
import Data.Traversable (sequence)
import Data.Tuple (Tuple(..))
import Data.Typelevel.Num (D2)
import FRP.Behavior (Behavior)
import FRP.Behavior.Audio (AV(..), AudioUnit, CanvasInfo(..), EngineInfo, defaultExporter, playBuf_, runInBrowser_, speaker)
import FRP.Behavior.Mouse (buttons, position)
import FRP.Event.Mouse (Mouse, getMouse)
import Graphics.Drawing (Drawing, Point, circle, fillColor, filled, rectangle)
import Math (pow)
import Type.Klank.Dev (Klank', defaultEngineInfo, klank, makeBuffersKeepingCache)

engineInfo =
  defaultEngineInfo
    { msBetweenSamples = 40
    , msBetweenPings = 35
    } ::
    EngineInfo

data Direction
  = NorthWest
  | SouthWest
  | NorthEast
  | SouthEast

derive instance genericDirection :: Generic Direction _

instance showDirection :: Show Direction where
  show = genericShow

data Coord
  = Xc
  | Yc

type CircleInfo
  = { direction :: Direction
    , generation :: Int
    , startPos :: Point
    , currentPos :: Point
    , radius :: Number
    , startOpacity :: Number
    , currentOpacity :: Number
    , startTime :: Number
    }

type Acc
  = { circles :: List CircleInfo
    , prevClick :: Boolean
    }

type UpdateEnv
  = { time :: Number
    , mouseDown :: Maybe Point
    , w :: Number
    , h :: Number
    , circs :: List CircleInfo
    }

type UpdateR
  = Reader UpdateEnv

calcSlope :: Number -> Number -> Number -> Number -> Number -> Number
calcSlope x0 y0 x1 y1 x
  | x0 == x1 = y0
  | otherwise =
    let
      m = (y1 - y0) / (x1 - x0)

      b = y0 - m * x0
    in
      m * x + b

directions :: List Direction
directions = NorthWest : SouthWest : NorthEast : SouthEast : Nil

inRadius :: Point -> CircleInfo -> Boolean
inRadius { x, y } { currentPos, radius } = (((y - currentPos.y) `pow` 2.0) + ((x - currentPos.x) `pow` 2.0)) `pow` 0.5 < radius

dirToNumber :: Direction -> Coord -> Number
dirToNumber NorthWest Xc = -1.0

dirToNumber NorthWest Yc = -1.0

dirToNumber SouthWest Xc = -1.0

dirToNumber SouthWest Yc = 1.0

dirToNumber NorthEast Xc = 1.0

dirToNumber NorthEast Yc = -1.0

dirToNumber SouthEast Xc = 1.0

dirToNumber SouthEast Yc = 1.0

timeAlive = 4.0 :: Number

advance :: CircleInfo -> UpdateR CircleInfo
advance circle@{ direction
, generation
, startPos
, currentPos
, startOpacity
, startTime
} = do
  { time, w, h } <- ask
  pure
    $ circle
        { currentPos =
          if generation == 0 then
            currentPos
          else
            { x:
                startPos.x
                  + ((time - startTime) * w * 0.1)
                  * (toNumber (generation + 1))
                  * dirToNumber direction Xc
            , y:
                startPos.y
                  + ((time - startTime) * h * 0.1)
                  * (toNumber (generation + 1))
                  * dirToNumber direction Yc
            }
        , currentOpacity =
          if generation == 0 then
            1.0
          else
            calcSlope startTime
              startOpacity
              (startTime + timeAlive)
              0.0
              time
        }

accountForClick :: CircleInfo -> UpdateR (List CircleInfo)
accountForClick circle = do
  { mouseDown } <- ask
  case mouseDown of
    Nothing -> pure mempty
    Just { x, y }
      | inRadius { x, y } circle -> do
        { time } <- ask
        pure
          $ map
              ( circle
                  { direction = _
                  , generation = circle.generation + 1
                  , startPos = circle.currentPos
                  , startOpacity = circle.currentOpacity * 0.8
                  , radius = circle.radius * 0.8
                  , startTime = time
                  }
              )
              directions
      | otherwise -> pure mempty

treatCircle ::
  CircleInfo ->
  UpdateR (List CircleInfo)
treatCircle circle = do
  { time } <- ask
  if circle.generation /= 0
    && timeAlive
    + circle.startTime
    <= time then
    pure mempty
  else
    append
      <$> (pure <$> advance circle)
      <*> (accountForClick circle)

makeCircles :: UpdateR (List CircleInfo)
makeCircles =
  asks _.circs
    >>= map join
    <<< sequence
    <<< map treatCircle

background :: Number -> Number -> Drawing
background w h =
  filled
    (fillColor $ rgba 0 0 0 1.0)
    (rectangle 0.0 0.0 w h)

circlesToDrawing ::
  Number ->
  Number ->
  List CircleInfo ->
  Drawing
circlesToDrawing w h =
  append (background w h)
    <<< fold
    <<< map go
  where
  go { currentPos: { x, y }
  , currentOpacity
  , radius
  } =
    filled
      (fillColor $ rgba 255 255 255 currentOpacity)
      (circle x y radius)

toNel :: forall a. Semiring a => List a -> NonEmpty List a
toNel Nil = zero :| Nil

toNel (a : b) = a :| b

directionToPitchOffset :: Direction -> Number
directionToPitchOffset NorthEast = 0.0

directionToPitchOffset NorthWest = 0.25

directionToPitchOffset SouthEast = 0.5

directionToPitchOffset SouthWest = 0.75

circlesToSounds ::
  Number ->
  List CircleInfo ->
  NonEmpty List (AudioUnit D2)
circlesToSounds time = toNel <<< catMaybes <<< map go
  where
  go { startTime, startPos, direction, generation }
    | generation == 0 = Nothing
    | otherwise =
      Just
        $ playBuf_
            ( show startTime
                <> show startPos
                <> show direction
                <> show generation
            )
            "ring"
            ( toNumber generation
                + directionToPitchOffset direction
            )

scene ::
  Mouse ->
  Acc ->
  CanvasInfo ->
  Number ->
  Behavior (AV D2 Acc)
scene mouse acc ci'@(CanvasInfo { w, h, boundingClientRect }) time =
  go
    <$> ( (map <<< map)
          ( \{ x, y } ->
              { x: toNumber x - boundingClientRect.x
              , y: toNumber y - boundingClientRect.y
              }
          )
          (position mouse)
      )
    <*> click
  where
  go pos cl =
    let
      mouseDown
        | isJust pos
            && cl
            && not acc.prevClick = pos
        | otherwise = Nothing

      newAcc =
        { prevClick: cl
        , circles:
            case acc.circles of
              Nil ->
                pure
                  { direction: NorthWest
                  , generation: 0
                  , startPos: { x: w * 0.5, y: h * 0.5 }
                  , currentPos: { x: w * 0.5, y: h * 0.5 }
                  , radius: (min w h) * 0.15
                  , startOpacity: 1.0
                  , currentOpacity: 1.0
                  , startTime: 0.0
                  }
              circs -> runReader makeCircles { time, mouseDown, w, h, circs }
        }
    in
      AV
        ( Just
            $ speaker
                (circlesToSounds time newAcc.circles)
        )
        (Just $ circlesToDrawing w h newAcc.circles)
        newAcc

  click = map (not <<< isEmpty) $ buttons mouse

main :: Klank' Acc
main =
  klank
    { accumulator =
      \res _ ->
        res
          { circles: Nil, prevClick: false
          }
    , run = runInBrowser_ (scene <$> getMouse)
    , exporter = defaultExporter
    , buffers =
      makeBuffersKeepingCache
        [ Tuple
            "ring"
            "https://freesound.org/data/previews/411/411089_5121236-hq.mp3"
        ]
    }