{- | Support for [@vivid@](https://hackage.haskell.org/package/vivid),
a Haskell library for [SuperCollider](https://supercollider.github.io/).

With this module, you can create cells corresponding to synthesizers.

The synthesizers automatically start and stop on reload.
-}

{-# LANGUAGE Arrows #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE StandaloneDeriving #-}
module LiveCoding.Vivid where

-- base
import Data.Foldable (traverse_)
import GHC.TypeLits (KnownSymbol)

-- vivid
import Vivid

-- essence-of-live-coding
import LiveCoding.Handle
import LiveCoding

{- | Whether a synthesizer should currently be running or not.

Typically, you will either statically supply the value and change it in the code to start and stop the synth,
or you can connect another cell to it.
-}
data SynthState
  = Started
  | Stopped
  deriving (SynthState -> SynthState -> Bool
(SynthState -> SynthState -> Bool)
-> (SynthState -> SynthState -> Bool) -> Eq SynthState
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SynthState -> SynthState -> Bool
$c/= :: SynthState -> SynthState -> Bool
== :: SynthState -> SynthState -> Bool
$c== :: SynthState -> SynthState -> Bool
Eq)

{- | A 'ParametrisedHandle' corresponding to one @vivid@/@SuperCollider@ synthesizer.

Usually, you will want to use 'liveSynth' instead, it is easier to handle.
-}
vividHandleParametrised
  :: (VividAction m, Eq params, VarList params, Subset (InnerVars params) args, Elem "gate" args)
  => ParametrisedHandle (params, SynthDef args, SynthState) m (Maybe (Synth args))
vividHandleParametrised :: ParametrisedHandle
  (params, SynthDef args, SynthState) m (Maybe (Synth args))
vividHandleParametrised = ParametrisedHandle :: forall p (m :: * -> *) h.
(p -> m h)
-> (p -> p -> h -> m h)
-> (p -> h -> m ())
-> ParametrisedHandle p m h
ParametrisedHandle { (params, SynthDef args, SynthState) -> m (Maybe (Synth args))
(params, SynthDef args, SynthState) -> Maybe (Synth args) -> m ()
(params, SynthDef args, SynthState)
-> (params, SynthDef args, SynthState)
-> Maybe (Synth args)
-> m (Maybe (Synth args))
forall (args :: [Symbol]) (t :: * -> *) (f :: * -> *) p.
(Elem "gate" args, Foldable t, VividAction f) =>
p -> t (Synth args) -> f ()
forall params (a :: [Symbol]) (f :: * -> *).
(Subset (InnerVars params) a, VividAction f, VarList params) =>
(params, SynthDef a, SynthState) -> f (Maybe (Synth a))
forall params (args :: [Symbol]) (m :: * -> *).
(Subset (InnerVars params) args, Elem "gate" args, Eq params,
 VividAction m, VarList params) =>
(params, SynthDef args, SynthState)
-> (params, SynthDef args, SynthState)
-> Maybe (Synth args)
-> m (Maybe (Synth args))
createParametrised :: (params, SynthDef args, SynthState) -> m (Maybe (Synth args))
changeParametrised :: (params, SynthDef args, SynthState)
-> (params, SynthDef args, SynthState)
-> Maybe (Synth args)
-> m (Maybe (Synth args))
destroyParametrised :: (params, SynthDef args, SynthState) -> Maybe (Synth args) -> m ()
changeParametrised :: forall params (args :: [Symbol]) (m :: * -> *).
(Subset (InnerVars params) args, Elem "gate" args, Eq params,
 VividAction m, VarList params) =>
(params, SynthDef args, SynthState)
-> (params, SynthDef args, SynthState)
-> Maybe (Synth args)
-> m (Maybe (Synth args))
destroyParametrised :: forall (args :: [Symbol]) (t :: * -> *) (f :: * -> *) p.
(Elem "gate" args, Foldable t, VividAction f) =>
p -> t (Synth args) -> f ()
createParametrised :: forall params (a :: [Symbol]) (f :: * -> *).
(Subset (InnerVars params) a, VividAction f, VarList params) =>
(params, SynthDef a, SynthState) -> f (Maybe (Synth a))
.. }
  where
    createParametrised :: (params, SynthDef a, SynthState) -> f (Maybe (Synth a))
createParametrised (params
params, SynthDef a
synthDef, SynthState
Started) = Synth a -> Maybe (Synth a)
forall a. a -> Maybe a
Just (Synth a -> Maybe (Synth a)) -> f (Synth a) -> f (Maybe (Synth a))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> SynthDef a -> params -> f (Synth a)
forall (m :: * -> *) params (args :: [Symbol]).
(VividAction m, VarList params, Subset (InnerVars params) args) =>
SynthDef args -> params -> m (Synth args)
synth SynthDef a
synthDef params
params
    createParametrised (params
params, SynthDef a
synthDef, SynthState
Stopped) = SynthDef a -> f ()
forall (m :: * -> *) (a :: [Symbol]).
VividAction m =>
SynthDef a -> m ()
defineSD SynthDef a
synthDef f () -> f (Maybe (Synth a)) -> f (Maybe (Synth a))
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Maybe (Synth a) -> f (Maybe (Synth a))
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe (Synth a)
forall a. Maybe a
Nothing

    destroyParametrised :: p -> t (Synth args) -> f ()
destroyParametrised p
_ t (Synth args)
synthMaybe = (Synth args -> f ()) -> t (Synth args) -> f ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ Synth args -> f ()
forall (args :: [Symbol]) (m :: * -> *).
(Elem "gate" args, VividAction m) =>
Synth args -> m ()
release t (Synth args)
synthMaybe

    -- Only the synth parameters changed and it's still running.
    -- So simply set new parameters without stopping it.
    changeParametrised :: (params, SynthDef args, SynthState)
-> (params, SynthDef args, SynthState)
-> Maybe (Synth args)
-> m (Maybe (Synth args))
changeParametrised (params
paramsOld, SynthDef args
synthDefOld, SynthState
Started) (params
paramsNew, SynthDef args
synthDefNew, SynthState
Started) (Just Synth args
synth)
      | params
paramsOld params -> params -> Bool
forall a. Eq a => a -> a -> Bool
/= params
paramsNew Bool -> Bool -> Bool
&& SynthDef args
synthDefOld SynthDef args -> SynthDef args -> Bool
forall a. Eq a => a -> a -> Bool
== SynthDef args
synthDefNew = do
          Synth args -> params -> m ()
forall (m :: * -> *) params (sdArgs :: [Symbol]).
(VividAction m, Subset (InnerVars params) sdArgs,
 VarList params) =>
Synth sdArgs -> params -> m ()
set Synth args
synth params
paramsNew
          Maybe (Synth args) -> m (Maybe (Synth args))
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (Synth args) -> m (Maybe (Synth args)))
-> Maybe (Synth args) -> m (Maybe (Synth args))
forall a b. (a -> b) -> a -> b
$ Synth args -> Maybe (Synth args)
forall a. a -> Maybe a
Just Synth args
synth
    -- Synthdef or start/stop state changed, need to release and reinitialise
    changeParametrised (params, SynthDef args, SynthState)
old (params, SynthDef args, SynthState)
new Maybe (Synth args)
synth = ((params, SynthDef args, SynthState) -> m (Maybe (Synth args)))
-> ((params, SynthDef args, SynthState)
    -> Maybe (Synth args) -> m ())
-> (params, SynthDef args, SynthState)
-> (params, SynthDef args, SynthState)
-> Maybe (Synth args)
-> m (Maybe (Synth args))
forall p (m :: * -> *) h.
(Eq p, Monad m) =>
(p -> m h) -> (p -> h -> m ()) -> p -> p -> h -> m h
defaultChange (params, SynthDef args, SynthState) -> m (Maybe (Synth args))
forall params (a :: [Symbol]) (f :: * -> *).
(Subset (InnerVars params) a, VividAction f, VarList params) =>
(params, SynthDef a, SynthState) -> f (Maybe (Synth a))
createParametrised (params, SynthDef args, SynthState) -> Maybe (Synth args) -> m ()
forall (args :: [Symbol]) (t :: * -> *) (f :: * -> *) p.
(Elem "gate" args, Foldable t, VividAction f) =>
p -> t (Synth args) -> f ()
destroyParametrised (params, SynthDef args, SynthState)
old (params, SynthDef args, SynthState)
new Maybe (Synth args)
synth

deriving instance Data SynthState
deriving instance KnownSymbol a => Data (I a)

{- | Create a synthesizer.

When you add 'liveSynth' to your live program,
it will be started upon reload immediately.

Feed the definition of the synthesizer and its current intended state to this cell.
The input has the form @(params, sdbody, synthState)@.

* A change in @params@ will reload the synthesizer quickly,
  unless the types of the parameters change.
* A change in the @sdbody :: 'SDBody' ...@ or the _types_ of the @params@ will 'release' the synthesizer and start a new one.
* The input @synthState :: 'SynthState'@ represent whether the synthesizer should currently be running or not.
  Changes in it quickly start or stop it.
  * When it is started, @'Just' synth@ is returned, where @synth@ represents the running synthesizer.
  * When it is stopped, 'Nothing' is returned.

You have to use 'envGate' in your @sdbody@,
or another way of gating your output signals
in order to ensure release of the synths without clipping.

For an example, have a look at the source code of 'sine'.
-}
liveSynth
  :: ( VividAction m
     , Eq params, Typeable params, VarList params
     , Typeable (InnerVars params), Subset (InnerVars params) (InnerVars params)
     , Elem "gate" (InnerVars params), Data params
     )
  => Cell (HandlingStateT m)
       (params, SDBody' (InnerVars params) [Signal], SynthState)
       (Maybe (Synth (InnerVars params)))
liveSynth :: Cell
  (HandlingStateT m)
  (params, SDBody' (InnerVars params) [Signal], SynthState)
  (Maybe (Synth (InnerVars params)))
liveSynth = proc (params
params, SDBody' (InnerVars params) [Signal]
sdbody, SynthState
synthstate) -> do
  params
paramsFirstValue <- Cell (HandlingStateT m) params params
forall a (m :: * -> *). (Data a, Monad m) => Cell m a a
holdFirst -< params
params
  ParametrisedHandle
  (params, SynthDef (InnerVars params), SynthState)
  m
  (Maybe (Synth (InnerVars params)))
-> Cell
     (HandlingStateT m)
     (params, SynthDef (InnerVars params), SynthState)
     (Maybe (Synth (InnerVars params)))
forall h p (m :: * -> *).
(Typeable h, Typeable p, Monad m, Eq p) =>
ParametrisedHandle p m h -> Cell (HandlingStateT m) p h
handlingParametrised ParametrisedHandle
  (params, SynthDef (InnerVars params), SynthState)
  m
  (Maybe (Synth (InnerVars params)))
forall (m :: * -> *) params (args :: [Symbol]).
(VividAction m, Eq params, VarList params,
 Subset (InnerVars params) args, Elem "gate" args) =>
ParametrisedHandle
  (params, SynthDef args, SynthState) m (Maybe (Synth args))
vividHandleParametrised -< (params
params, params
-> SDBody' (InnerVars params) [Signal]
-> SynthDef (InnerVars params)
forall argList.
VarList argList =>
argList
-> SDBody' (InnerVars argList) [Signal]
-> SynthDef (InnerVars argList)
sd params
paramsFirstValue SDBody' (InnerVars params) [Signal]
sdbody, SynthState
synthstate)

-- | Example sine synthesizer that creates a sine wave at the given input frequency.
sine :: (VividAction m) => Cell (HandlingStateT m) Float ()
sine :: Cell (HandlingStateT m) Float ()
sine = proc Float
frequency -> do
  Cell
  (HandlingStateT m)
  ((I "gate", I "fadeSecs", I "freq"),
   StateT
     ([Int], SynthDef '["gate", "fadeSecs", "freq"],
      VarSet '["gate", "fadeSecs", "freq"])
     Identity
     [Signal],
   SynthState)
  (Maybe (Synth '["gate", "fadeSecs", "freq"]))
forall (m :: * -> *) params.
(VividAction m, Eq params, Typeable params, VarList params,
 Typeable (InnerVars params),
 Subset (InnerVars params) (InnerVars params),
 Elem "gate" (InnerVars params), Data params) =>
Cell
  (HandlingStateT m)
  (params, SDBody' (InnerVars params) [Signal], SynthState)
  (Maybe (Synth (InnerVars params)))
liveSynth -<
    (
      ( I "gate"
1 :: I "gate"
      , I "fadeSecs"
2 :: I "fadeSecs"
      , Float -> I "freq"
forall (x :: Symbol). KnownSymbol x => Float -> I x
I Float
frequency :: I "freq"
      )
    , Int
-> [SDBody' '["gate", "fadeSecs", "freq"] Signal]
-> StateT
     ([Int], SynthDef '["gate", "fadeSecs", "freq"],
      VarSet '["gate", "fadeSecs", "freq"])
     Identity
     [Signal]
forall i (a :: [Symbol]) busNum.
(ToSig i a, ToSig busNum a) =>
busNum -> [i] -> SDBody' a [Signal]
out (Int
0 :: Int) [SDBody' '["gate", "fadeSecs", "freq"] Signal
forall (a :: [Symbol]).
Subset '["gate", "fadeSecs"] a =>
SDBody' a Signal
envGate SDBody' '["gate", "fadeSecs", "freq"] Signal
-> SDBody' '["gate", "fadeSecs", "freq"] Signal
-> SDBody' '["gate", "fadeSecs", "freq"] Signal
forall i0 (a :: [Symbol]) i1.
(ToSig i0 a, ToSig i1 a) =>
i0 -> i1 -> SDBody' a Signal
~* UA "freq" '["gate", "fadeSecs", "freq"]
-> SDBody (UA "freq" '["gate", "fadeSecs", "freq"]) Signal
forall a. Args '["freq"] '["phase"] a => a -> SDBody a Signal
sinOsc (V "freq" -> UA "freq" '["gate", "fadeSecs", "freq"]
forall s (as :: [Symbol]). ToSig s as => s -> UA "freq" as
freq_ (V "freq"
forall (a :: Symbol). KnownSymbol a => Variable a
V :: V "freq"))]
    , SynthState
Started)
  Cell (HandlingStateT m) () ()
forall (a :: * -> * -> *) b. Arrow a => a b b
returnA -< ()