{-# LANGUAGE Arrows #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE StandaloneDeriving #-}
module LiveCoding.Vivid where
import Data.Foldable (traverse_)
import GHC.TypeLits (KnownSymbol)
import Vivid
import LiveCoding
import LiveCoding.Handle
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)
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
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
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)
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)
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 -< ()