{-# OPTIONS_HADDOCK show-extensions #-}
{-# LANGUAGE
DataKinds
, KindSignatures
, OverloadedStrings
, TypeFamilies, NoMonoLocalBinds
#-}
{-# LANGUAGE NoIncoherentInstances #-}
{-# LANGUAGE NoMonomorphismRestriction #-}
{-# LANGUAGE NoUndecidableInstances #-}
module Vivid.SynthDef.Types (
Signal(..)
, SynthDef(..)
, SDName(..)
, SDBody'
, zoomSDBody
, zoomSynthDef
, UGen(..)
, UGenName(..)
, module Vivid.SynthDef.TypesafeArgs
) where
import Vivid.SC.SynthDef.Types (CalculationRate(..), UnaryOp(..), BinaryOp(..))
import Vivid.SynthDef.TypesafeArgs
import Control.Monad.State (State, get, runState, put)
import Data.ByteString (ByteString)
import Data.Int (Int32)
import Data.Map (Map)
import GHC.TypeLits
import Prelude
data Signal
= Constant Float
| Param ByteString
| UGOut Int Int32
deriving (Int -> Signal -> ShowS
[Signal] -> ShowS
Signal -> String
(Int -> Signal -> ShowS)
-> (Signal -> String) -> ([Signal] -> ShowS) -> Show Signal
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Signal] -> ShowS
$cshowList :: [Signal] -> ShowS
show :: Signal -> String
$cshow :: Signal -> String
showsPrec :: Int -> Signal -> ShowS
$cshowsPrec :: Int -> Signal -> ShowS
Show, Signal -> Signal -> Bool
(Signal -> Signal -> Bool)
-> (Signal -> Signal -> Bool) -> Eq Signal
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Signal -> Signal -> Bool
$c/= :: Signal -> Signal -> Bool
== :: Signal -> Signal -> Bool
$c== :: Signal -> Signal -> Bool
Eq)
data SynthDef (args :: [Symbol]) = SynthDef {
SynthDef args -> SDName
_sdName :: SDName
,SynthDef args -> [(ByteString, Float)]
_sdParams :: [(ByteString, Float)]
,SynthDef args -> Map Int UGen
_sdUGens :: Map Int UGen
}
deriving (Int -> SynthDef args -> ShowS
[SynthDef args] -> ShowS
SynthDef args -> String
(Int -> SynthDef args -> ShowS)
-> (SynthDef args -> String)
-> ([SynthDef args] -> ShowS)
-> Show (SynthDef args)
forall (args :: [Symbol]). Int -> SynthDef args -> ShowS
forall (args :: [Symbol]). [SynthDef args] -> ShowS
forall (args :: [Symbol]). SynthDef args -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SynthDef args] -> ShowS
$cshowList :: forall (args :: [Symbol]). [SynthDef args] -> ShowS
show :: SynthDef args -> String
$cshow :: forall (args :: [Symbol]). SynthDef args -> String
showsPrec :: Int -> SynthDef args -> ShowS
$cshowsPrec :: forall (args :: [Symbol]). Int -> SynthDef args -> ShowS
Show)
data SDName
= SDName_Named ByteString
| SDName_Hash
deriving (Int -> SDName -> ShowS
[SDName] -> ShowS
SDName -> String
(Int -> SDName -> ShowS)
-> (SDName -> String) -> ([SDName] -> ShowS) -> Show SDName
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SDName] -> ShowS
$cshowList :: [SDName] -> ShowS
show :: SDName -> String
$cshow :: SDName -> String
showsPrec :: Int -> SDName -> ShowS
$cshowsPrec :: Int -> SDName -> ShowS
Show, SDName -> SDName -> Bool
(SDName -> SDName -> Bool)
-> (SDName -> SDName -> Bool) -> Eq SDName
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SDName -> SDName -> Bool
$c/= :: SDName -> SDName -> Bool
== :: SDName -> SDName -> Bool
$c== :: SDName -> SDName -> Bool
Eq, ReadPrec [SDName]
ReadPrec SDName
Int -> ReadS SDName
ReadS [SDName]
(Int -> ReadS SDName)
-> ReadS [SDName]
-> ReadPrec SDName
-> ReadPrec [SDName]
-> Read SDName
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [SDName]
$creadListPrec :: ReadPrec [SDName]
readPrec :: ReadPrec SDName
$creadPrec :: ReadPrec SDName
readList :: ReadS [SDName]
$creadList :: ReadS [SDName]
readsPrec :: Int -> ReadS SDName
$creadsPrec :: Int -> ReadS SDName
Read, Eq SDName
Eq SDName
-> (SDName -> SDName -> Ordering)
-> (SDName -> SDName -> Bool)
-> (SDName -> SDName -> Bool)
-> (SDName -> SDName -> Bool)
-> (SDName -> SDName -> Bool)
-> (SDName -> SDName -> SDName)
-> (SDName -> SDName -> SDName)
-> Ord SDName
SDName -> SDName -> Bool
SDName -> SDName -> Ordering
SDName -> SDName -> SDName
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: SDName -> SDName -> SDName
$cmin :: SDName -> SDName -> SDName
max :: SDName -> SDName -> SDName
$cmax :: SDName -> SDName -> SDName
>= :: SDName -> SDName -> Bool
$c>= :: SDName -> SDName -> Bool
> :: SDName -> SDName -> Bool
$c> :: SDName -> SDName -> Bool
<= :: SDName -> SDName -> Bool
$c<= :: SDName -> SDName -> Bool
< :: SDName -> SDName -> Bool
$c< :: SDName -> SDName -> Bool
compare :: SDName -> SDName -> Ordering
$ccompare :: SDName -> SDName -> Ordering
$cp1Ord :: Eq SDName
Ord)
data UGen
= UGen {
UGen -> UGenName
_ugenName :: UGenName
,UGen -> CalculationRate
_ugenCalculationRate :: CalculationRate
,UGen -> [Signal]
_ugenIns :: [Signal]
,UGen -> Int
_ugenNumOuts :: Int
}
deriving (Int -> UGen -> ShowS
[UGen] -> ShowS
UGen -> String
(Int -> UGen -> ShowS)
-> (UGen -> String) -> ([UGen] -> ShowS) -> Show UGen
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UGen] -> ShowS
$cshowList :: [UGen] -> ShowS
show :: UGen -> String
$cshow :: UGen -> String
showsPrec :: Int -> UGen -> ShowS
$cshowsPrec :: Int -> UGen -> ShowS
Show, UGen -> UGen -> Bool
(UGen -> UGen -> Bool) -> (UGen -> UGen -> Bool) -> Eq UGen
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UGen -> UGen -> Bool
$c/= :: UGen -> UGen -> Bool
== :: UGen -> UGen -> Bool
$c== :: UGen -> UGen -> Bool
Eq)
data UGenName
= UGName_S ByteString
| UGName_U UnaryOp
| UGName_B BinaryOp
deriving (Int -> UGenName -> ShowS
[UGenName] -> ShowS
UGenName -> String
(Int -> UGenName -> ShowS)
-> (UGenName -> String) -> ([UGenName] -> ShowS) -> Show UGenName
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UGenName] -> ShowS
$cshowList :: [UGenName] -> ShowS
show :: UGenName -> String
$cshow :: UGenName -> String
showsPrec :: Int -> UGenName -> ShowS
$cshowsPrec :: Int -> UGenName -> ShowS
Show, UGenName -> UGenName -> Bool
(UGenName -> UGenName -> Bool)
-> (UGenName -> UGenName -> Bool) -> Eq UGenName
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UGenName -> UGenName -> Bool
$c/= :: UGenName -> UGenName -> Bool
== :: UGenName -> UGenName -> Bool
$c== :: UGenName -> UGenName -> Bool
Eq)
type SDBody' (args :: [Symbol])
= State ([Int], SynthDef args, VarSet args)
zoomSynthDef :: (Subset a b) => SynthDef a -> SynthDef b
zoomSynthDef :: SynthDef a -> SynthDef b
zoomSynthDef (SynthDef SDName
a [(ByteString, Float)]
b Map Int UGen
c) = SDName -> [(ByteString, Float)] -> Map Int UGen -> SynthDef b
forall (args :: [Symbol]).
SDName -> [(ByteString, Float)] -> Map Int UGen -> SynthDef args
SynthDef SDName
a [(ByteString, Float)]
b Map Int UGen
c
zoomSDBody :: (Subset inner outer) => SDBody' inner a -> SDBody' outer a
zoomSDBody :: SDBody' inner a -> SDBody' outer a
zoomSDBody SDBody' inner a
x = do
([Int]
initA,SynthDef outer
initB,VarSet outer
_) <- StateT
([Int], SynthDef outer, VarSet outer)
Identity
([Int], SynthDef outer, VarSet outer)
forall s (m :: * -> *). MonadState s m => m s
get
let cheatSD :: SynthDef a -> SynthDef b
cheatSD :: SynthDef a -> SynthDef b
cheatSD (SynthDef SDName
a [(ByteString, Float)]
b Map Int UGen
c) = SDName -> [(ByteString, Float)] -> Map Int UGen -> SynthDef b
forall (args :: [Symbol]).
SDName -> [(ByteString, Float)] -> Map Int UGen -> SynthDef args
SynthDef SDName
a [(ByteString, Float)]
b Map Int UGen
c
let (a
val,([Int]
a,SynthDef inner
b,VarSet inner
_)) = SDBody' inner a
-> ([Int], SynthDef inner, VarSet inner)
-> (a, ([Int], SynthDef inner, VarSet inner))
forall s a. State s a -> s -> (a, s)
runState SDBody' inner a
x ([Int]
initA, SynthDef outer -> SynthDef inner
forall (a :: [Symbol]) (b :: [Symbol]). SynthDef a -> SynthDef b
cheatSD SynthDef outer
initB,VarSet inner
forall (s :: [Symbol]). VarSet s
VarSet)
([Int], SynthDef outer, VarSet outer)
-> StateT ([Int], SynthDef outer, VarSet outer) Identity ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put ([Int]
a, SynthDef inner -> SynthDef outer
forall (a :: [Symbol]) (b :: [Symbol]).
Subset a b =>
SynthDef a -> SynthDef b
zoomSynthDef SynthDef inner
b, VarSet outer
forall (s :: [Symbol]). VarSet s
VarSet)
a -> SDBody' outer a
forall (m :: * -> *) a. Monad m => a -> m a
return a
val