{-# 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
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 :: 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 {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} {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 ()
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))
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) = forall a. a -> Maybe a
Just forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> 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) = forall (m :: * -> *) (a :: [Symbol]).
VividAction m =>
SynthDef a -> m ()
defineSD SynthDef a
synthDef forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. Maybe a
Nothing

    destroyParametrised :: p -> t (Synth args) -> f ()
destroyParametrised p
_ t (Synth args)
synthMaybe = forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ 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 forall a. Eq a => a -> a -> Bool
/= params
paramsNew Bool -> Bool -> Bool
&& SynthDef sdArgs
synthDefOld forall a. Eq a => a -> a -> Bool
== SynthDef sdArgs
synthDefNew = do
          forall (m :: * -> *) params (sdArgs :: [Symbol]).
(VividAction m, Subset (InnerVars params) sdArgs,
 VarList params) =>
Synth sdArgs -> params -> m ()
set Synth sdArgs
synth params
paramsNew
          forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ 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 = forall p (m :: * -> *) h.
(Eq p, Monad m) =>
(p -> m h) -> (p -> h -> m ()) -> p -> p -> h -> m h
defaultChange forall {params} {a :: [Symbol]} {f :: * -> *}.
(Subset (InnerVars params) a, VividAction f, VarList params) =>
(params, SynthDef a, SynthState) -> f (Maybe (Synth a))
createParametrised 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 <- forall a (m :: * -> *). (Data a, Monad m) => Cell m a a
holdFirst -< params
params
  forall h p (m :: * -> *).
(Typeable h, Typeable p, Monad m, Eq p) =>
ParametrisedHandle p m h -> Cell (HandlingStateT m) p h
handlingParametrised 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, 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
  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"
        , forall (x :: Symbol). KnownSymbol x => Float -> I x
I Float
frequency :: I "freq"
        )
      , forall i (a :: [Symbol]) busNum.
(ToSig i a, ToSig busNum a) =>
busNum -> [i] -> SDBody' a [Signal]
out (Int
0 :: Int) [forall (a :: [Symbol]).
Subset '["gate", "fadeSecs"] a =>
SDBody' a Signal
envGate forall i0 (a :: [Symbol]) i1.
(ToSig i0 a, ToSig i1 a) =>
i0 -> i1 -> SDBody' a Signal
~* forall a. Args '["freq"] '["phase"] a => a -> SDBody a Signal
sinOsc (forall s (as :: [Symbol]). ToSig s as => s -> UA "freq" as
freq_ (forall (a :: Symbol). KnownSymbol a => Variable a
V :: V "freq"))]
      , SynthState
Started
      )
  forall (a :: * -> * -> *) b. Arrow a => a b b
returnA -< ()