{-# LANGUAGE Arrows #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE StandaloneDeriving #-}

{- | 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.
-}
module LiveCoding.Vivid where

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

-- vivid
import Vivid

-- essence-of-live-coding

import LiveCoding
import LiveCoding.Handle

{- | 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
$c== :: SynthState -> SynthState -> Bool
== :: SynthState -> SynthState -> Bool
$c/= :: SynthState -> SynthState -> Bool
/= :: 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 :: 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 = 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} {sdArgs :: [Symbol]} {m :: * -> *}.
(Subset (InnerVars params) sdArgs, Elem "gate" sdArgs, Eq params,
 VividAction m, VarList params) =>
(params, SynthDef sdArgs, SynthState)
-> (params, SynthDef sdArgs, SynthState)
-> Maybe (Synth sdArgs)
-> m (Maybe (Synth sdArgs))
forall {params} {a :: [Symbol]} {f :: * -> *}.
(Subset (InnerVars params) a, VividAction f, VarList params) =>
(params, SynthDef a, SynthState) -> f (Maybe (Synth a))
createParametrised :: forall {params} {a :: [Symbol]} {f :: * -> *}.
(Subset (InnerVars params) a, VividAction f, VarList params) =>
(params, SynthDef a, SynthState) -> f (Maybe (Synth a))
destroyParametrised :: forall {args :: [Symbol]} {t :: * -> *} {f :: * -> *} {p}.
(Elem "gate" args, Foldable t, VividAction f) =>
p -> t (Synth args) -> f ()
changeParametrised :: forall {params} {sdArgs :: [Symbol]} {m :: * -> *}.
(Subset (InnerVars params) sdArgs, Elem "gate" sdArgs, Eq params,
 VividAction m, VarList params) =>
(params, SynthDef sdArgs, SynthState)
-> (params, SynthDef sdArgs, SynthState)
-> Maybe (Synth sdArgs)
-> m (Maybe (Synth sdArgs))
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 ()
..}
  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 (a :: [Symbol]). 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 a b. f a -> f b -> f b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Maybe (Synth a) -> f (Maybe (Synth a))
forall a. a -> f 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 sdArgs, SynthState)
-> (params, SynthDef sdArgs, SynthState)
-> Maybe (Synth sdArgs)
-> m (Maybe (Synth sdArgs))
changeParametrised (params
paramsOld, SynthDef sdArgs
synthDefOld, SynthState
Started) (params
paramsNew, SynthDef sdArgs
synthDefNew, SynthState
Started) (Just Synth sdArgs
synth)
      | params
paramsOld params -> params -> Bool
forall a. Eq a => a -> a -> Bool
/= params
paramsNew Bool -> Bool -> Bool
&& SynthDef sdArgs
synthDefOld SynthDef sdArgs -> SynthDef sdArgs -> Bool
forall a. Eq a => a -> a -> Bool
== SynthDef sdArgs
synthDefNew = do
          Synth sdArgs -> params -> m ()
forall (m :: * -> *) params (sdArgs :: [Symbol]).
(VividAction m, Subset (InnerVars params) sdArgs,
 VarList params) =>
Synth sdArgs -> params -> m ()
set Synth sdArgs
synth params
paramsNew
          Maybe (Synth sdArgs) -> m (Maybe (Synth sdArgs))
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (Synth sdArgs) -> m (Maybe (Synth sdArgs)))
-> Maybe (Synth sdArgs) -> m (Maybe (Synth sdArgs))
forall a b. (a -> b) -> a -> b
$ Synth sdArgs -> Maybe (Synth sdArgs)
forall a. a -> Maybe a
Just Synth sdArgs
synth
    -- Synthdef or start/stop state changed, need to release and reinitialise
    changeParametrised (params, SynthDef sdArgs, SynthState)
old (params, SynthDef sdArgs, SynthState)
new Maybe (Synth sdArgs)
synth = ((params, SynthDef sdArgs, SynthState) -> m (Maybe (Synth sdArgs)))
-> ((params, SynthDef sdArgs, SynthState)
    -> Maybe (Synth sdArgs) -> m ())
-> (params, SynthDef sdArgs, SynthState)
-> (params, SynthDef sdArgs, SynthState)
-> Maybe (Synth sdArgs)
-> m (Maybe (Synth sdArgs))
forall p (m :: * -> *) h.
(Eq p, Monad m) =>
(p -> m h) -> (p -> h -> m ()) -> p -> p -> h -> m h
defaultChange (params, SynthDef sdArgs, SynthState) -> m (Maybe (Synth sdArgs))
forall {params} {a :: [Symbol]} {f :: * -> *}.
(Subset (InnerVars params) a, VividAction f, VarList params) =>
(params, SynthDef a, SynthState) -> f (Maybe (Synth a))
createParametrised (params, SynthDef sdArgs, SynthState)
-> Maybe (Synth sdArgs) -> m ()
forall {args :: [Symbol]} {t :: * -> *} {f :: * -> *} {p}.
(Elem "gate" args, Foldable t, VividAction f) =>
p -> t (Synth args) -> f ()
destroyParametrised (params, SynthDef sdArgs, SynthState)
old (params, SynthDef sdArgs, SynthState)
new Maybe (Synth sdArgs)
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 :: 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 = 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 :: forall (m :: * -> *).
VividAction m =>
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"]))
Cell
  (HandlingStateT m)
  ((I "gate", I "fadeSecs", I "freq"),
   SDBody' (InnerVars (I "gate", I "fadeSecs", I "freq")) [Signal],
   SynthState)
  (Maybe (Synth (InnerVars (I "gate", I "fadeSecs", I "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 -< ()