Allows dynamic adding and switching of buffers (#18)

README.md

@@ -17,7 +17,7 @@ There are some other examples to get you started:
 - **Kitchen sink** ([code](./examples/kitchen-sink) | [sound](https://purescript-wags-kitchen-sink.surge.sh/))
 - **The Well-Typed Klavier** ([code](./examples/wtk) | [sound](https://twitter.com/stronglynormal/status/1382221415802408960))
 
-The **Atari speaks** and **Kitchen sink** examples show how to use `purescript-wags` in a [Halogen](https://github.com/purescript-halogen/purescript-halogen) app.
+The examples also show how to use `purescript-wags` in a [Halogen](https://github.com/purescript-halogen/purescript-halogen) app.
 
 ## Documentation
 

examples/atari-speaks/AtariSpeaks.purs

@@ -136,7 +136,7 @@ handleAction = case _ of
             audioCtx
             "https://freesound.org/data/previews/100/100981_1234256-lq.mp3"
     let
-      ffiAudio = (defaultFFIAudio audioCtx unitCache) { buffers = O.singleton "atar" atar }
+      ffiAudio = (defaultFFIAudio audioCtx unitCache) { buffers = pure $ O.singleton "atar" atar }
     unsubscribe <-
       H.liftEffect
         $ subscribe

examples/drum-machine/DrumMachine.purs

@@ -1,17 +1,22 @@
 module WAGS.Example.DrumMachine where
 
 import Prelude
-import Control.Comonad.Cofree (Cofree, mkCofree)
+import Control.Comonad.Cofree (Cofree, deferCofree, head, mkCofree, tail)
 import Control.Promise (toAffE)
 import Data.Foldable (for_)
+import Data.Identity (Identity(..))
 import Data.Int (floor, toNumber)
 import Data.Maybe (Maybe(..))
-import Data.Tuple.Nested (type (/\))
+import Data.Newtype (unwrap)
+import Data.Tuple.Nested ((/\), type (/\))
 import Effect (Effect)
+import Effect.Aff (launchAff_)
 import Effect.Aff.Class (class MonadAff)
 import Effect.Class (class MonadEffect)
-import Effect.Class.Console as Log
-import FRP.Event (subscribe)
+import Effect.Ref as Ref
+import FRP.Behavior (behavior)
+import FRP.Event (makeEvent, subscribe)
+import FRP.Event.Time (interval)
 import Foreign.Object as O
 import Halogen as H
 import Halogen.Aff (awaitBody, runHalogenAff)
@@ -69,7 +74,9 @@ piece =
           tgFloor = floor (e.time / gap)
 
           crossingDivide = tgFloor /= floor ((e.time + 0.06) / gap)
+
           crossDiff = e.time - lastCrossing
+
           shouldReset = crossingDivide && crossDiff > 0.2
         in
           ichange (scene shouldReset e) $> (if shouldReset then e.time else lastCrossing)
@@ -123,24 +130,75 @@ render state = do
         [ HH.text "Stop audio" ]
     ]
 
+drumCf :: Cofree Identity String
+drumCf =
+  deferCofree \_ ->
+    "https://freesound.org/data/previews/321/321132_1337335-hq.mp3"
+      /\ Identity
+          ( deferCofree \_ ->
+              "https://freesound.org/data/previews/331/331589_5820980-hq.mp3"
+                /\ Identity
+                    ( deferCofree \_ ->
+                        "https://freesound.org/data/previews/84/84478_377011-hq.mp3"
+                          /\ Identity
+                              ( deferCofree \_ ->
+                                  "https://freesound.org/data/previews/270/270156_1125482-hq.mp3"
+                                    /\ Identity
+                                        ( deferCofree \_ ->
+                                            "https://freesound.org/data/previews/207/207956_19852-hq.mp3"
+                                              /\ Identity drumCf
+                                        )
+                              )
+                    )
+          )
+
 handleAction :: forall output m. MonadEffect m => MonadAff m => Action -> H.HalogenM State Action () output m Unit
 handleAction = case _ of
   StartAudio -> do
     audioCtx <- H.liftEffect context
     unitCache <- H.liftEffect makeUnitCache
-    snare <-
+    ibuf <-
       H.liftAff $ toAffE
         $ decodeAudioDataFromUri
             audioCtx
-            "https://freesound.org/data/previews/270/270156_1125482-hq.mp3"
+            (head drumCf)
+    rf <- H.liftEffect (Ref.new (unwrap (tail drumCf)))
+    bf <- H.liftEffect (Ref.new ibuf)
+    ivlsub <-
+      H.liftEffect
+        $ subscribe (interval 1000) \_ -> do
+            cf <- Ref.read rf
+            Ref.write (unwrap (tail cf)) rf
+            launchAff_ do
+              buf <-
+                toAffE
+                  $ decodeAudioDataFromUri
+                      audioCtx
+                      (head cf)
+              H.liftEffect $ Ref.write buf bf
     let
-      ffiAudio = (defaultFFIAudio audioCtx unitCache) { buffers = O.singleton "snare" snare }
+      ffiAudio =
+        (defaultFFIAudio audioCtx unitCache)
+          { buffers =
+            O.singleton "snare"
+              <$> ( behavior \eAToB ->
+                    makeEvent \fB ->
+                      subscribe eAToB \aToB -> Ref.read bf >>= fB <<< aToB
+                )
+          }
     unsubscribe <-
       H.liftEffect
         $ subscribe
             (run (pure unit) (pure unit) { easingAlgorithm } (FFIAudio ffiAudio) piece)
-            (Log.info <<< show)
-    H.modify_ _ { unsubscribe = unsubscribe, audioCtx = Just audioCtx }
+            (const (pure unit)) -- (Log.info <<< show)
+    H.modify_
+      _
+        { unsubscribe =
+          do
+            unsubscribe
+            ivlsub
+        , audioCtx = Just audioCtx
+        }
   StopAudio -> do
     { unsubscribe, audioCtx } <- H.get
     H.liftEffect unsubscribe

examples/failure/Failure.purs

@@ -190,14 +190,15 @@ handleAction = case _ of
     let
       ffiAudio =
         (defaultFFIAudio audioCtx unitCache)
-          { periodicWaves = O.fromFoldable [ "myWavetable" /\ myWave ]
+          { periodicWaves = pure $ O.fromFoldable [ "myWavetable" /\ myWave ]
           , buffers =
-            O.fromFoldable
-              [ "myBuffer" /\ myBuffer
-              , "success" /\ success
-              ]
-          , floatArrays = O.singleton "success" wicked
-          , recorders = O.singleton "success" recorder
+            pure
+              $ O.fromFoldable
+                  [ "myBuffer" /\ myBuffer
+                  , "success" /\ success
+                  ]
+          , floatArrays = pure $ O.singleton "success" wicked
+          , recorders = pure $ O.singleton "success" recorder
           }
     unsubscribeFromWAGS <-
       H.liftEffect

examples/hello-world/HelloWorld.purs

@@ -3,19 +3,28 @@ module WAGS.Example.HelloWorld where
 import Prelude
 
 import Control.Comonad.Cofree (Cofree, mkCofree)
+import Data.Foldable (for_)
 import Data.Functor.Indexed (ivoid)
+import Data.Maybe (Maybe(..))
 import Data.Tuple.Nested (type (/\))
 import Effect (Effect)
+import Effect.Aff.Class (class MonadAff)
+import Effect.Class (class MonadEffect)
 import FRP.Event (subscribe)
+import Halogen as H
+import Halogen.Aff (awaitBody, runHalogenAff)
+import Halogen.HTML as HH
+import Halogen.HTML.Events as HE
+import Halogen.VDom.Driver (runUI)
 import Math (pi, sin)
 import WAGS.Change (ichange)
 import WAGS.Control.Functions.Validated (iloop, (@!>))
 import WAGS.Control.Types (Frame0, Scene)
 import WAGS.Create (icreate)
+import WAGS.Interpret (AudioContext, FFIAudio(..), close, context, defaultFFIAudio, makeUnitCache)
+import WAGS.Run (RunAudio, SceneI, RunEngine, run)
 import WAGS.Create.Optionals (CGain, CSpeaker, CSinOsc, gain, sinOsc, speaker)
 import WAGS.Graph.AudioUnit (TGain, TSinOsc, TSpeaker)
-import WAGS.Interpret (FFIAudio(..), FFIAudio')
-import WAGS.Run (RunAudio, SceneI, RunEngine, run)
 
 type SceneTemplate
   = CSpeaker
@@ -59,11 +68,63 @@ easingAlgorithm =
   in
     fOf 20
 
-myRun :: FFIAudio' -> Effect (Effect Unit)
-myRun ffiAudio =
-  subscribe
-    (run (pure unit) (pure unit) { easingAlgorithm } (FFIAudio ffiAudio) piece)
-    (const $ pure unit)
-
 main :: Effect Unit
-main = pure unit
+main =
+  runHalogenAff do
+    body <- awaitBody
+    runUI component unit body
+
+type State
+  = { unsubscribe :: Effect Unit
+    , audioCtx :: Maybe AudioContext
+    }
+
+data Action
+  = StartAudio
+  | StopAudio
+
+component :: forall query input output m. MonadEffect m => MonadAff m => H.Component query input output m
+component =
+  H.mkComponent
+    { initialState
+    , render
+    , eval: H.mkEval $ H.defaultEval { handleAction = handleAction }
+    }
+
+initialState :: forall input. input -> State
+initialState _ =
+  { unsubscribe: pure unit
+  , audioCtx: Nothing
+  }
+
+render :: forall m. State -> H.ComponentHTML Action () m
+render state = do
+  HH.div_
+    [ HH.h1_
+        [ HH.text "Hello world" ]
+    , HH.button
+        [ HE.onClick \_ -> StartAudio ]
+        [ HH.text "Start audio" ]
+    , HH.button
+        [ HE.onClick \_ -> StopAudio ]
+        [ HH.text "Stop audio" ]
+    ]
+
+handleAction :: forall output m. MonadEffect m => MonadAff m => Action -> H.HalogenM State Action () output m Unit
+handleAction = case _ of
+  StartAudio -> do
+    audioCtx <- H.liftEffect context
+    unitCache <- H.liftEffect makeUnitCache
+    let
+      ffiAudio = defaultFFIAudio audioCtx unitCache
+    unsubscribe <-
+      H.liftEffect
+        $ subscribe
+            (run (pure unit) (pure unit) { easingAlgorithm } (FFIAudio ffiAudio) piece)
+            (const $ pure unit)
+    H.modify_ _ { unsubscribe = unsubscribe, audioCtx = Just audioCtx }
+  StopAudio -> do
+    { unsubscribe, audioCtx } <- H.get
+    H.liftEffect unsubscribe
+    for_ audioCtx (H.liftEffect <<< close)
+    H.modify_ _ { unsubscribe = pure unit, audioCtx = Nothing }

examples/hello-world/index.html

@@ -1,31 +1,6 @@
 <!DOCTYPE html>
 <html>
   <script src="index.js"></script>
-  <script>
-    var offCb = null;
-    var audioCtx = null;
-    function turnOnAudio() {
-      audioCtx = new (window.AudioContext || window.webkitAudioContext)();
-      offCb = PS["WAGS.Example.HelloWorld"].myRun({
-        context: audioCtx,
-        writeHead: 0.0,
-        units: {},
-        microphones: {},
-        recorders: {},
-        buffers: {},
-        floatArrays: {},
-        periodicWaves: {},
-      })();
-    }
-    function turnOffAudio() {
-      offCb ? offCb() : null;
-      offCB = null;
-      audioCtx ? audioCtx.close() : null;
-      audioCtx = null;
-    }
-  </script>
   <body>
-    <button onclick="turnOnAudio();">turn on</button>
-    <button onclick="turnOffAudio();">turn off</button>
   </body>
 </html>

examples/kitchen-sink/KitchenSink.purs

@@ -134,16 +134,17 @@ handleAction = case _ of
     let
       ffiAudio =
         (defaultFFIAudio audioCtx unitCache)
-          { periodicWaves = O.fromFoldable [ "my-wave" /\ myWave ]
+          { periodicWaves = pure $ O.fromFoldable [ "my-wave" /\ myWave ]
           , buffers =
-            O.fromFoldable
-              [ "my-buffer" /\ chimes
-              , "shruti" /\ shruti
-              , "reverb" /\ reverb
-              ]
-          , floatArrays = O.singleton "my-waveshaper" wicked
-          , recorders = O.singleton "my-recorder" recorder
-          , microphone = toNullable microphone
+            pure
+              $ O.fromFoldable
+                  [ "my-buffer" /\ chimes
+                  , "shruti" /\ shruti
+                  , "reverb" /\ reverb
+                  ]
+          , floatArrays = pure $ O.singleton "my-waveshaper" wicked
+          , recorders = pure $ O.singleton "my-recorder" recorder
+          , microphone = pure $ toNullable microphone
           }
     unsubscribeFromWAGS <-
       H.liftEffect

examples/makenna/Makenna.purs

@@ -232,7 +232,7 @@ handleAction = case _ of
         let
           ffiAudio =
             (defaultFFIAudio audioCtx unitCache)
-              { periodicWaves = O.singleton "bday" bday
+              { periodicWaves = pure (O.singleton "bday" bday)
               }
         unsubscribe <-
           subscribe

examples/wtk/WTK/RenderingEnv.purs

@@ -3,13 +3,14 @@ module WAGS.Example.WTK.RenderingEnv where
 import Prelude
 import Data.Int (toNumber)
 import Data.List (List(..), (:), filter, length, drop, zipWith)
+import Data.Maybe (maybe)
 import Data.Set as S
 import Data.Tuple.Nested ((/\), type (/\))
 import FRP.Event.MIDI (MIDIEvent(..))
 import Math (pow)
-import WAGS.Math (calcSlope)
 import WAGS.Example.WTK.Types (KeyUnit, MakeRenderingEnv)
 import WAGS.Graph.AudioUnit (OnOff(..))
+import WAGS.Math (calcSlope)
 
 keyDur :: Number
 keyDur = 1.6
@@ -60,7 +61,7 @@ midiEventsToOnsets = go Nil Nil
   go accOn accOff (_ : b) = go accOn accOff b
 
 makeRenderingEnv :: MakeRenderingEnv
-makeRenderingEnv active trigger time availableKeys currentKeys =
+makeRenderingEnv trigger time availableKeys currentKeys =
   { notesOff
   , onsets
   , newCurrentKeys
@@ -71,7 +72,7 @@ makeRenderingEnv active trigger time availableKeys currentKeys =
   where
   notesOn /\ notesOffAsList =
     midiEventsToOnsets
-      (if active then (map _.value.event trigger) else Nil)
+      (maybe Nil (map _.value.event) trigger)
 
   notesOff = S.fromFoldable notesOffAsList
 

examples/wtk/WTK/TLP.purs

@@ -146,15 +146,15 @@ createFrame _ =
 piece :: { makeRenderingEnv :: MakeRenderingEnv } -> Scene (SceneI Trigger Unit) RunAudio RunEngine Frame0 Unit
 piece { makeRenderingEnv } =
   createFrame
-    @!> iloop \{ time, trigger, active } { currentKeys, availableKeys } -> Ix.do
+    @!> iloop \{ time, trigger } { currentKeys, availableKeys } -> Ix.do
         let
           { notesOff
           , onsets
           , newCurrentKeys
           , newAvailableKeys
           , futureCurrentKeys
           , futureAvailableKeys
-          } = makeRenderingEnv active trigger time availableKeys currentKeys
+          } = makeRenderingEnv trigger time availableKeys currentKeys
         ( playKeys
             { currentTime: time
             , notesOff