{-# OPTIONS_HADDOCK show-extensions #-}
{-# LANGUAGE NoRebindableSyntax #-}
{-# LANGUAGE
BangPatterns
, DataKinds
, LambdaCase
, OverloadedStrings
, TypeFamilies, NoMonoLocalBinds
, ViewPatterns
#-}
{-# LANGUAGE NoIncoherentInstances #-}
{-# LANGUAGE NoMonomorphismRestriction #-}
{-# LANGUAGE NoUndecidableInstances #-}
module Vivid.SynthDef (
SynthDef(..)
, UGen(..)
, addUGen
, addMonoUGen
, addPolyUGen
, addOrIncrementMaxLocalBufs
, ToSig(..)
, Signal(..)
, encodeSD
, sd
, sdNamed
, sdPretty
, (?)
, DoneAction(..)
, doneActionNum
, sdLitPretty
, sdToLiteral
, execState
, getCalcRate
, UnaryOp(..)
, uOpToSpecialI
, specialIToUOp
, BinaryOp(..)
, biOpToSpecialI
, specialIToBiOp
, module Vivid.SynthDef.Types
, getSDHashName
, makeSynthDef
, shrinkSDArgs
, SDBody
) where
import Vivid.SC.SynthDef.Literally as Literal
import Vivid.SC.SynthDef.Types (CalculationRate(..), BinaryOp(..), UnaryOp(..))
import Vivid.SynthDef.ToSig
import Vivid.SynthDef.Types
import Vivid.SynthDef.FromUA (SDBody)
import Control.Monad.State (get, put, modify, execState)
import Data.ByteString (ByteString)
import qualified Data.ByteString.UTF8 as UTF8
import Data.Hashable (Hashable, hashWithSalt, hash)
import Data.Int
import Data.List (nub, elemIndex, find)
import Data.Map (Map)
import qualified Data.Map as Map
import Data.Maybe
import Data.Monoid
import Prelude
sdPretty :: SynthDef a -> String
sdPretty :: SynthDef a -> String
sdPretty SynthDef a
synthDef = [String] -> String
unlines ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$ [
String
"Name: " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> SDName -> String
forall a. Show a => a -> String
show (SynthDef a -> SDName
forall (args :: [Symbol]). SynthDef args -> SDName
_sdName SynthDef a
synthDef)
, String
"Args: " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> [(ByteString, Float)] -> String
forall a. Show a => a -> String
show (SynthDef a -> [(ByteString, Float)]
forall (args :: [Symbol]). SynthDef args -> [(ByteString, Float)]
_sdParams SynthDef a
synthDef)
, String
"UGens: "
] [String] -> [String] -> [String]
forall a. Semigroup a => a -> a -> a
<> ((Int, UGen) -> String) -> [(Int, UGen)] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (Int, UGen) -> String
forall a. Show a => a -> String
show (Map Int UGen -> [(Int, UGen)]
forall k a. Map k a -> [(k, a)]
Map.toAscList (SynthDef a -> Map Int UGen
forall (args :: [Symbol]). SynthDef args -> Map Int UGen
_sdUGens SynthDef a
synthDef))
data DoneAction
= DoNothing
| FreeEnclosing
| DoneAction_AsNum Int
deriving (Int -> DoneAction -> String -> String
[DoneAction] -> String -> String
DoneAction -> String
(Int -> DoneAction -> String -> String)
-> (DoneAction -> String)
-> ([DoneAction] -> String -> String)
-> Show DoneAction
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [DoneAction] -> String -> String
$cshowList :: [DoneAction] -> String -> String
show :: DoneAction -> String
$cshow :: DoneAction -> String
showsPrec :: Int -> DoneAction -> String -> String
$cshowsPrec :: Int -> DoneAction -> String -> String
Show, DoneAction -> DoneAction -> Bool
(DoneAction -> DoneAction -> Bool)
-> (DoneAction -> DoneAction -> Bool) -> Eq DoneAction
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DoneAction -> DoneAction -> Bool
$c/= :: DoneAction -> DoneAction -> Bool
== :: DoneAction -> DoneAction -> Bool
$c== :: DoneAction -> DoneAction -> Bool
Eq)
doneActionNum :: DoneAction -> Float
doneActionNum :: DoneAction -> Float
doneActionNum = \case
DoneAction
DoNothing -> Float
0
DoneAction
FreeEnclosing -> Float
2
DoneAction_AsNum Int
n -> Int -> Float
forall a. Enum a => Int -> a
toEnum Int
n
sdToLiteral :: SynthDef a -> Literal.LiteralSynthDef
sdToLiteral :: SynthDef a -> LiteralSynthDef
sdToLiteral theSD :: SynthDef a
theSD@(SynthDef SDName
name [(ByteString, Float)]
params Map Int UGen
ugens) = LiteralSynthDef -> LiteralSynthDef
fixAndSimplify (LiteralSynthDef -> LiteralSynthDef)
-> LiteralSynthDef -> LiteralSynthDef
forall a b. (a -> b) -> a -> b
$
ByteString
-> [Float]
-> [Float]
-> [ParamName]
-> [UGenSpec]
-> [VariantSpec]
-> LiteralSynthDef
LiteralSynthDef
(case SDName
name of
SDName_Named ByteString
s -> ByteString
s
SDName
SDName_Hash -> SynthDef a -> ByteString
forall (a :: [Symbol]). SynthDef a -> ByteString
getSDHashName SynthDef a
theSD
)
([(Int, UGen)] -> [Float]
gatherConstants ([(Int, UGen)] -> [Float]) -> [(Int, UGen)] -> [Float]
forall a b. (a -> b) -> a -> b
$ Map Int UGen -> [(Int, UGen)]
forall k a. Map k a -> [(k, a)]
Map.toAscList Map Int UGen
ugens )
(((ByteString, Float) -> Float) -> [(ByteString, Float)] -> [Float]
forall a b. (a -> b) -> [a] -> [b]
map (ByteString, Float) -> Float
forall a b. (a, b) -> b
snd [(ByteString, Float)]
params)
((ByteString -> Int32 -> ParamName)
-> [ByteString] -> [Int32] -> [ParamName]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (\ByteString
s Int32
i -> ByteString -> Int32 -> ParamName
ParamName ByteString
s Int32
i) (((ByteString, Float) -> ByteString)
-> [(ByteString, Float)] -> [ByteString]
forall a b. (a -> b) -> [a] -> [b]
map (ByteString, Float) -> ByteString
forall a b. (a, b) -> a
fst [(ByteString, Float)]
params) [Int32
0..])
([(ByteString, Float)] -> [(Int, UGen)] -> [UGenSpec]
makeUGenSpecs [(ByteString, Float)]
params ([(Int, UGen)] -> [UGenSpec]) -> [(Int, UGen)] -> [UGenSpec]
forall a b. (a -> b) -> a -> b
$ Map Int UGen -> [(Int, UGen)]
forall k a. Map k a -> [(k, a)]
Map.toAscList Map Int UGen
ugens)
[]
fixAndSimplify :: Literal.LiteralSynthDef -> Literal.LiteralSynthDef
fixAndSimplify :: LiteralSynthDef -> LiteralSynthDef
fixAndSimplify =
LiteralSynthDef -> LiteralSynthDef
replaceBitNot
replaceBitNot :: Literal.LiteralSynthDef -> Literal.LiteralSynthDef
replaceBitNot :: LiteralSynthDef -> LiteralSynthDef
replaceBitNot lsd :: LiteralSynthDef
lsd@(Literal.LiteralSynthDef ByteString
name [Float]
oldConsts [Float]
params [ParamName]
paramNames [UGenSpec]
ugens [VariantSpec]
variants) =
case (UGenSpec -> Bool) -> [UGenSpec] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any UGenSpec -> Bool
isBitNot [UGenSpec]
ugens of
Bool
False -> LiteralSynthDef
lsd
Bool
True ->
ByteString
-> [Float]
-> [Float]
-> [ParamName]
-> [UGenSpec]
-> [VariantSpec]
-> LiteralSynthDef
Literal.LiteralSynthDef ByteString
name [Float]
newConsts [Float]
params [ParamName]
paramNames ((UGenSpec -> UGenSpec) -> [UGenSpec] -> [UGenSpec]
forall a b. (a -> b) -> [a] -> [b]
map UGenSpec -> UGenSpec
replaceIt [UGenSpec]
ugens) [VariantSpec]
variants
where
([Float]
newConsts, (Int -> Int32
forall a. Enum a => Int -> a
toEnum::Int->Int32) -> Int32
negOneLoc) =
case Float -> [Float] -> Maybe Int
forall a. Eq a => a -> [a] -> Maybe Int
elemIndex (-Float
1) [Float]
oldConsts of
Maybe Int
Nothing -> ([Float]
oldConsts [Float] -> [Float] -> [Float]
forall a. Semigroup a => a -> a -> a
<> [(-Float
1)], (forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length::[a]->Int) [Float]
oldConsts)
Just Int
i -> ([Float]
oldConsts, Int
i)
isBitNot :: UGenSpec -> Bool
isBitNot :: UGenSpec -> Bool
isBitNot UGenSpec
ug =
(UGenSpec -> ByteString
Literal._uGenSpec_name UGenSpec
ug ByteString -> ByteString -> Bool
forall a. Eq a => a -> a -> Bool
== ByteString
"UnaryOpUGen")
Bool -> Bool -> Bool
&& (UGenSpec -> Int16
Literal._uGenSpec_specialIndex UGenSpec
ug Int16 -> Int16 -> Bool
forall a. Eq a => a -> a -> Bool
== UnaryOp -> Int16
uOpToSpecialI UnaryOp
BitNot)
replaceIt :: UGenSpec -> UGenSpec
replaceIt :: UGenSpec -> UGenSpec
replaceIt UGenSpec
ugspec = case UGenSpec -> Bool
isBitNot UGenSpec
ugspec of
Bool
False -> UGenSpec
ugspec
Bool
True -> ByteString
-> CalculationRate
-> [InputSpec]
-> [OutputSpec]
-> Int16
-> UGenSpec
UGenSpec
ByteString
"BinaryOpUGen"
(UGenSpec -> CalculationRate
Literal._uGenSpec_calcRate UGenSpec
ugspec)
(UGenSpec -> [InputSpec]
Literal._uGenSpec_inputs UGenSpec
ugspec [InputSpec] -> [InputSpec] -> [InputSpec]
forall a. Semigroup a => a -> a -> a
<>
[Int32 -> InputSpec
InputSpec_Constant Int32
negOneLoc])
(UGenSpec -> [OutputSpec]
Literal._uGenSpec_outputs UGenSpec
ugspec)
(BinaryOp -> Int16
biOpToSpecialI BinaryOp
BitXor)
getSDHashName :: SynthDef a -> ByteString
getSDHashName :: SynthDef a -> ByteString
getSDHashName SynthDef a
theSD =
ByteString
"vivid_" ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> (String -> ByteString
UTF8.fromString (String -> ByteString)
-> (SynthDef a -> String) -> SynthDef a -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> String
forall a. Show a => a -> String
show (Int -> String) -> (SynthDef a -> Int) -> SynthDef a -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SynthDef a -> Int
forall a. Hashable a => a -> Int
hash) SynthDef a
theSD
gatherConstants :: [(Int, UGen)] -> [Float]
gatherConstants :: [(Int, UGen)] -> [Float]
gatherConstants [(Int, UGen)]
ugens =
[Float] -> [Float]
forall a. Eq a => [a] -> [a]
nub [ Float
x | Constant Float
x <- ((Int, UGen) -> [Signal]) -> [(Int, UGen)] -> [Signal]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (UGen -> [Signal]
_ugenIns (UGen -> [Signal])
-> ((Int, UGen) -> UGen) -> (Int, UGen) -> [Signal]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int, UGen) -> UGen
forall a b. (a, b) -> b
snd) [(Int, UGen)]
ugens]
makeUGenSpecs :: [(ByteString, Float)] -> [(Int, UGen)] -> [Literal.UGenSpec]
makeUGenSpecs :: [(ByteString, Float)] -> [(Int, UGen)] -> [UGenSpec]
makeUGenSpecs [(ByteString, Float)]
params [(Int, UGen)]
ugens = case [(ByteString, Float)]
params of
[] -> [UGenSpec]
rest
[(ByteString, Float)]
_ -> UGenSpec
control UGenSpec -> [UGenSpec] -> [UGenSpec]
forall a. a -> [a] -> [a]
: [UGenSpec]
rest
where
control :: UGenSpec
control = ByteString
-> CalculationRate
-> [InputSpec]
-> [OutputSpec]
-> Int16
-> UGenSpec
UGenSpec
(String -> ByteString
UTF8.fromString String
"Control")
CalculationRate
KR
[]
(Int -> OutputSpec -> [OutputSpec]
forall a. Int -> a -> [a]
replicate ((forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length::[a]->Int) [(ByteString, Float)]
params) (CalculationRate -> OutputSpec
OutputSpec CalculationRate
KR))
Int16
0
rest :: [UGenSpec]
rest = ((Int, UGen) -> UGenSpec) -> [(Int, UGen)] -> [UGenSpec]
forall a b. (a -> b) -> [a] -> [b]
map (Int, UGen) -> UGenSpec
makeSpec [(Int, UGen)]
ugens
makeSpec :: (Int, UGen) -> UGenSpec
makeSpec :: (Int, UGen) -> UGenSpec
makeSpec (Int
_, UGen UGenName
name CalculationRate
calcRate [Signal]
ins Int
numOuts) =
let (ByteString
theName, Int16
specialIndex) = case UGenName
name of
UGName_S ByteString
s -> (ByteString
s, Int16
0)
UGName_U UnaryOp
uop -> (String -> ByteString
UTF8.fromString String
"UnaryOpUGen", UnaryOp -> Int16
uOpToSpecialI UnaryOp
uop)
UGName_B BinaryOp
biop -> (String -> ByteString
UTF8.fromString String
"BinaryOpUGen", BinaryOp -> Int16
biOpToSpecialI BinaryOp
biop)
in ByteString
-> CalculationRate
-> [InputSpec]
-> [OutputSpec]
-> Int16
-> UGenSpec
UGenSpec
ByteString
theName
CalculationRate
calcRate
((((Signal -> InputSpec) -> [Signal] -> [InputSpec])
-> [Signal] -> (Signal -> InputSpec) -> [InputSpec]
forall a b c. (a -> b -> c) -> b -> a -> c
flip (Signal -> InputSpec) -> [Signal] -> [InputSpec]
forall a b. (a -> b) -> [a] -> [b]
map) [Signal]
ins ((Signal -> InputSpec) -> [InputSpec])
-> (Signal -> InputSpec) -> [InputSpec]
forall a b. (a -> b) -> a -> b
$ \case
Constant Float
x -> Int32 -> InputSpec
InputSpec_Constant (Int32 -> InputSpec) -> Int32 -> InputSpec
forall a b. (a -> b) -> a -> b
$ Int -> Int32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Int32) -> Int -> Int32
forall a b. (a -> b) -> a -> b
$ Maybe Int -> Int
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe Int -> Int) -> Maybe Int -> Int
forall a b. (a -> b) -> a -> b
$
Float -> [Float] -> Maybe Int
forall a. Eq a => a -> [a] -> Maybe Int
elemIndex Float
x ([Float] -> Maybe Int) -> [Float] -> Maybe Int
forall a b. (a -> b) -> a -> b
$ [(Int, UGen)] -> [Float]
gatherConstants [(Int, UGen)]
ugens
UGOut Int
ugenId Int32
outputNum ->
let inputPosition :: a
inputPosition =
Int -> a
forall a. Enum a => Int -> a
toEnum Int
ugenId a -> a -> a
forall a. Num a => a -> a -> a
+ case [(ByteString, Float)]
params of { [] -> a
0 ; [(ByteString, Float)]
_ -> a
1 }
in Int32 -> Int32 -> InputSpec
InputSpec_UGen Int32
forall a. (Num a, Enum a) => a
inputPosition Int32
outputNum
Param ByteString
s -> Int32 -> Int32 -> InputSpec
InputSpec_UGen Int32
0 ([(ByteString, Float)] -> ByteString -> Int32
forall a. Eq a => [(ByteString, a)] -> ByteString -> Int32
indexOfName [(ByteString, Float)]
params ByteString
s)
)
(Int -> OutputSpec -> [OutputSpec]
forall a. Int -> a -> [a]
replicate Int
numOuts (CalculationRate -> OutputSpec
OutputSpec CalculationRate
calcRate))
Int16
specialIndex
indexOfName :: (Eq a) => [(ByteString, a)] -> ByteString -> Int32
indexOfName :: [(ByteString, a)] -> ByteString -> Int32
indexOfName [(ByteString, a)]
haystack ByteString
key =
let foo :: (ByteString, a)
foo = case ((ByteString, a) -> Bool)
-> [(ByteString, a)] -> Maybe (ByteString, a)
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find ((ByteString -> ByteString -> Bool
forall a. Eq a => a -> a -> Bool
==ByteString
key) (ByteString -> Bool)
-> ((ByteString, a) -> ByteString) -> (ByteString, a) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ByteString, a) -> ByteString
forall a b. (a, b) -> a
fst) [(ByteString, a)]
haystack of
Maybe (ByteString, a)
Nothing -> String -> (ByteString, a)
forall a. HasCallStack => String -> a
error (String -> (ByteString, a)) -> String -> (ByteString, a)
forall a b. (a -> b) -> a -> b
$ String
"missing param: " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> ByteString -> String
forall a. Show a => a -> String
show ByteString
key
Just (ByteString, a)
x -> (ByteString, a)
x
in Int -> Int32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Int32) -> Int -> Int32
forall a b. (a -> b) -> a -> b
$ Maybe Int -> Int
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe Int -> Int) -> Maybe Int -> Int
forall a b. (a -> b) -> a -> b
$ (((ByteString, a) -> [(ByteString, a)] -> Maybe Int)
-> [(ByteString, a)] -> (ByteString, a) -> Maybe Int
forall a b c. (a -> b -> c) -> b -> a -> c
flip (ByteString, a) -> [(ByteString, a)] -> Maybe Int
forall a. Eq a => a -> [a] -> Maybe Int
elemIndex) [(ByteString, a)]
haystack ((ByteString, a) -> Maybe Int) -> (ByteString, a) -> Maybe Int
forall a b. (a -> b) -> a -> b
$ (ByteString, a)
foo
getFreshUGenGraphId :: SDBody' args Int
getFreshUGenGraphId :: SDBody' args Int
getFreshUGenGraphId = do
([Int]
ids, SynthDef args
synthDef, VarSet args
argList) <- StateT
([Int], SynthDef args, VarSet args)
Identity
([Int], SynthDef args, VarSet args)
forall s (m :: * -> *). MonadState s m => m s
get
let (Int
i:[Int]
ds) = case [Int]
ids of
[] -> String -> [Int]
forall a. HasCallStack => String -> a
error String
"You got to the end of an infinite list!"
[Int]
_ -> [Int]
ids
([Int], SynthDef args, VarSet args)
-> StateT ([Int], SynthDef args, VarSet args) Identity ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put ([Int]
ds, SynthDef args
synthDef, VarSet args
argList)
Int -> SDBody' args Int
forall (m :: * -> *) a. Monad m => a -> m a
return Int
i
addUGen :: UGen -> SDBody' args Signal
addUGen :: UGen -> SDBody' args Signal
addUGen = UGen -> SDBody' args Signal
forall (args :: [Symbol]). UGen -> SDBody' args Signal
addMonoUGen
addMonoUGen :: UGen -> SDBody' args Signal
addMonoUGen :: UGen -> SDBody' args Signal
addMonoUGen UGen
ugen = UGen -> SDBody' args [Signal]
forall (args :: [Symbol]). UGen -> SDBody' args [Signal]
addPolyUGen UGen
ugen SDBody' args [Signal]
-> ([Signal] -> SDBody' args Signal) -> SDBody' args Signal
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
[Signal
x] -> Signal -> SDBody' args Signal
forall (m :: * -> *) a. Monad m => a -> m a
return Signal
x
[Signal]
foo -> String -> SDBody' args Signal
forall a. HasCallStack => String -> a
error (String -> SDBody' args Signal) -> String -> SDBody' args Signal
forall a b. (a -> b) -> a -> b
$ String
"that ugen's not mono!: " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> UGen -> String
forall a. Show a => a -> String
show UGen
ugen String -> String -> String
forall a. Semigroup a => a -> a -> a
<> [Signal] -> String
forall a. Show a => a -> String
show [Signal]
foo
addPolyUGen :: UGen -> SDBody' args [Signal]
addPolyUGen :: UGen -> SDBody' args [Signal]
addPolyUGen UGen
ugen = UGen -> SDBody' args [Signal]
forall (args :: [Symbol]). UGen -> SDBody' args [Signal]
addPolyUGen' (UGen -> SDBody' args [Signal]) -> UGen -> SDBody' args [Signal]
forall a b. (a -> b) -> a -> b
$ UGen
ugen
addPolyUGen' :: UGen -> SDBody' args [Signal]
addPolyUGen' :: UGen -> SDBody' args [Signal]
addPolyUGen' UGen
ugen = do
Int
anId <- SDBody' args Int
forall (args :: [Symbol]). SDBody' args Int
getFreshUGenGraphId
(([Int], SynthDef args, VarSet args)
-> ([Int], SynthDef args, VarSet args))
-> StateT ([Int], SynthDef args, VarSet args) Identity ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((([Int], SynthDef args, VarSet args)
-> ([Int], SynthDef args, VarSet args))
-> StateT ([Int], SynthDef args, VarSet args) Identity ())
-> ((SynthDef args -> SynthDef args)
-> ([Int], SynthDef args, VarSet args)
-> ([Int], SynthDef args, VarSet args))
-> (SynthDef args -> SynthDef args)
-> StateT ([Int], SynthDef args, VarSet args) Identity ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (\SynthDef args -> SynthDef args
f ([Int]
a,SynthDef args
b,VarSet args
c)->([Int]
a,SynthDef args -> SynthDef args
f SynthDef args
b,VarSet args
c)) ((SynthDef args -> SynthDef args)
-> StateT ([Int], SynthDef args, VarSet args) Identity ())
-> (SynthDef args -> SynthDef args)
-> StateT ([Int], SynthDef args, VarSet args) Identity ()
forall a b. (a -> b) -> a -> b
$ \SynthDef args
synthDef -> SynthDef args
synthDef { _sdUGens :: Map Int UGen
_sdUGens =
(UGen -> UGen -> UGen)
-> Map Int UGen -> Map Int UGen -> Map Int UGen
forall k a. Ord k => (a -> a -> a) -> Map k a -> Map k a -> Map k a
Map.unionWith (\UGen
_ -> String -> UGen -> UGen
forall a. HasCallStack => String -> a
error String
"dammit keying broken") (SynthDef args -> Map Int UGen
forall (args :: [Symbol]). SynthDef args -> Map Int UGen
_sdUGens SynthDef args
synthDef) (Map Int UGen -> Map Int UGen) -> Map Int UGen -> Map Int UGen
forall a b. (a -> b) -> a -> b
$
Int -> UGen -> Map Int UGen
forall k a. k -> a -> Map k a
Map.singleton Int
anId UGen
ugen
}
[Signal] -> SDBody' args [Signal]
forall (m :: * -> *) a. Monad m => a -> m a
return ([Signal] -> SDBody' args [Signal])
-> [Signal] -> SDBody' args [Signal]
forall a b. (a -> b) -> a -> b
$ (Int32 -> Signal) -> [Int32] -> [Signal]
forall a b. (a -> b) -> [a] -> [b]
map (Int -> Int32 -> Signal
UGOut Int
anId) [Int32
0.. Int -> Int32
forall a. Enum a => Int -> a
toEnum (UGen -> Int
_ugenNumOuts UGen
ugen Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)]
addOrIncrementMaxLocalBufs :: SDBody' args Signal
addOrIncrementMaxLocalBufs :: SDBody' args Signal
addOrIncrementMaxLocalBufs = do
([Int]
ids, SynthDef args
synthDef, VarSet args
argList) <- StateT
([Int], SynthDef args, VarSet args)
Identity
([Int], SynthDef args, VarSet args)
forall s (m :: * -> *). MonadState s m => m s
get
case Map Int UGen -> [(Int, UGen)]
forall k a. Map k a -> [(k, a)]
Map.toList (Map Int UGen -> [(Int, UGen)]) -> Map Int UGen -> [(Int, UGen)]
forall a b. (a -> b) -> a -> b
$ (UGen -> Bool) -> Map Int UGen -> Map Int UGen
forall a k. (a -> Bool) -> Map k a -> Map k a
Map.filter UGen -> Bool
isMLB (Map Int UGen -> Map Int UGen) -> Map Int UGen -> Map Int UGen
forall a b. (a -> b) -> a -> b
$ SynthDef args -> Map Int UGen
forall (args :: [Symbol]). SynthDef args -> Map Int UGen
_sdUGens SynthDef args
synthDef of
[] -> UGen -> SDBody' args Signal
forall (args :: [Symbol]). UGen -> SDBody' args Signal
addMonoUGen (UGen -> SDBody' args Signal) -> UGen -> SDBody' args Signal
forall a b. (a -> b) -> a -> b
$ UGenName -> CalculationRate -> [Signal] -> Int -> UGen
UGen (ByteString -> UGenName
UGName_S ByteString
"MaxLocalBufs") CalculationRate
IR [Float -> Signal
Constant Float
1] Int
1
[(Int
ugIndex, UGen (UGName_S ByteString
"MaxLocalBufs") CalculationRate
IR [Constant Float
numPreviously] Int
1)] -> do
let newUG :: UGen
newUG = UGenName -> CalculationRate -> [Signal] -> Int -> UGen
UGen (ByteString -> UGenName
UGName_S ByteString
"MaxLocalBufs") CalculationRate
IR [Float -> Signal
Constant (Float
numPreviously Float -> Float -> Float
forall a. Num a => a -> a -> a
+ Float
1)] Int
1
newSD :: SynthDef args
newSD = SynthDef args
synthDef { _sdUGens :: Map Int UGen
_sdUGens = Int -> UGen -> Map Int UGen -> Map Int UGen
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert Int
ugIndex UGen
newUG (Map Int UGen -> Map Int UGen) -> Map Int UGen -> Map Int UGen
forall a b. (a -> b) -> a -> b
$ SynthDef args -> Map Int UGen
forall (args :: [Symbol]). SynthDef args -> Map Int UGen
_sdUGens SynthDef args
synthDef }
([Int], SynthDef args, VarSet args)
-> StateT ([Int], SynthDef args, VarSet args) Identity ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put (([Int], SynthDef args, VarSet args)
-> StateT ([Int], SynthDef args, VarSet args) Identity ())
-> ([Int], SynthDef args, VarSet args)
-> StateT ([Int], SynthDef args, VarSet args) Identity ()
forall a b. (a -> b) -> a -> b
$ ([Int]
ids, SynthDef args
forall (args :: [Symbol]). SynthDef args
newSD, VarSet args
argList)
Signal -> SDBody' args Signal
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Signal -> SDBody' args Signal) -> Signal -> SDBody' args Signal
forall a b. (a -> b) -> a -> b
$ Int -> Int32 -> Signal
UGOut Int
ugIndex Int32
0
[(Int, UGen)
e] -> String -> SDBody' args Signal
forall a. HasCallStack => String -> a
error (String -> SDBody' args Signal) -> String -> SDBody' args Signal
forall a b. (a -> b) -> a -> b
$ String
"Incorrectly constructed MLB?: "String -> String -> String
forall a. [a] -> [a] -> [a]
++(Int, UGen) -> String
forall a. Show a => a -> String
show (Int, UGen)
e
[(Int, UGen)]
es -> String -> SDBody' args Signal
forall a. HasCallStack => String -> a
error (String -> SDBody' args Signal) -> String -> SDBody' args Signal
forall a b. (a -> b) -> a -> b
$ String
"Multiple MLB?: "String -> String -> String
forall a. [a] -> [a] -> [a]
++[(Int, UGen)] -> String
forall a. Show a => a -> String
show [(Int, UGen)]
es
where
isMLB :: UGen -> Bool
isMLB = \case
UGen (UGName_S ByteString
"MaxLocalBufs") CalculationRate
_ [Signal]
_ Int
_ -> Bool
True
UGen
_ -> Bool
False
sd :: VarList argList => argList -> SDBody' (InnerVars argList) [Signal] -> SynthDef (InnerVars argList)
sd :: argList
-> SDBody' (InnerVars argList) [Signal]
-> SynthDef (InnerVars argList)
sd argList
params SDBody' (InnerVars argList) [Signal]
theState =
SDName
-> argList
-> SDBody' (InnerVars argList) [Signal]
-> SynthDef (InnerVars argList)
forall argList.
VarList argList =>
SDName
-> argList
-> SDBody' (InnerVars argList) [Signal]
-> SynthDef (InnerVars argList)
makeSynthDef SDName
SDName_Hash argList
params SDBody' (InnerVars argList) [Signal]
theState
sdNamed :: VarList argList => String -> argList -> SDBody' (InnerVars argList) [Signal] -> SynthDef (InnerVars argList)
sdNamed :: String
-> argList
-> SDBody' (InnerVars argList) [Signal]
-> SynthDef (InnerVars argList)
sdNamed String
name argList
params SDBody' (InnerVars argList) [Signal]
theState =
SDName
-> argList
-> SDBody' (InnerVars argList) [Signal]
-> SynthDef (InnerVars argList)
forall argList.
VarList argList =>
SDName
-> argList
-> SDBody' (InnerVars argList) [Signal]
-> SynthDef (InnerVars argList)
makeSynthDef (ByteString -> SDName
SDName_Named (ByteString -> SDName) -> ByteString -> SDName
forall a b. (a -> b) -> a -> b
$ String -> ByteString
UTF8.fromString String
name) argList
params SDBody' (InnerVars argList) [Signal]
theState
makeSynthDef :: VarList argList => SDName -> argList -> SDBody' (InnerVars argList) [Signal] -> SynthDef (InnerVars argList)
makeSynthDef :: SDName
-> argList
-> SDBody' (InnerVars argList) [Signal]
-> SynthDef (InnerVars argList)
makeSynthDef SDName
name argList
params SDBody' (InnerVars argList) [Signal]
theState =
SynthDef (InnerVars argList)
b
where
paramList :: [(String, Float)]
([(String, Float)]
paramList, VarSet (InnerVars argList)
argSet) = argList -> ([(String, Float)], VarSet (InnerVars argList))
forall from. VarList from => from -> TypedVarList (InnerVars from)
makeTypedVarList argList
params
sdBeforeBody :: SynthDef args
sdBeforeBody = SDName -> [(ByteString, Float)] -> Map Int UGen -> SynthDef args
forall (args :: [Symbol]).
SDName -> [(ByteString, Float)] -> Map Int UGen -> SynthDef args
SynthDef SDName
name [ (String -> ByteString
UTF8.fromString String
k, Float
v) | (String
k, Float
v) <- [(String, Float)]
paramList ] Map Int UGen
forall k a. Map k a
Map.empty
([Int]
_,SynthDef (InnerVars argList)
b,VarSet (InnerVars argList)
_) = SDBody' (InnerVars argList) [Signal]
-> ([Int], SynthDef (InnerVars argList),
VarSet (InnerVars argList))
-> ([Int], SynthDef (InnerVars argList),
VarSet (InnerVars argList))
forall s a. State s a -> s -> s
execState SDBody' (InnerVars argList) [Signal]
theState (([Int], SynthDef (InnerVars argList), VarSet (InnerVars argList))
-> ([Int], SynthDef (InnerVars argList),
VarSet (InnerVars argList)))
-> ([Int], SynthDef (InnerVars argList),
VarSet (InnerVars argList))
-> ([Int], SynthDef (InnerVars argList),
VarSet (InnerVars argList))
forall a b. (a -> b) -> a -> b
$
( [Int
0 :: Int ..], SynthDef (InnerVars argList)
forall (args :: [Symbol]). SynthDef args
sdBeforeBody, VarSet (InnerVars argList)
argSet)
(?) :: SDBody' args Signal -> CalculationRate -> SDBody' args Signal
? :: SDBody' args Signal -> CalculationRate -> SDBody' args Signal
(?) SDBody' args Signal
i CalculationRate
calcRate = do
Signal
i' <- SDBody' args Signal
i
case Signal
i' of
UGOut Int
ugId Int32
_o -> (([Int], SynthDef args, VarSet args)
-> ([Int], SynthDef args, VarSet args))
-> StateT ([Int], SynthDef args, VarSet args) Identity ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((([Int], SynthDef args, VarSet args)
-> ([Int], SynthDef args, VarSet args))
-> StateT ([Int], SynthDef args, VarSet args) Identity ())
-> (([Int], SynthDef args, VarSet args)
-> ([Int], SynthDef args, VarSet args))
-> StateT ([Int], SynthDef args, VarSet args) Identity ()
forall a b. (a -> b) -> a -> b
$ (\SynthDef args -> SynthDef args
f ([Int]
a,SynthDef args
b,VarSet args
c)->([Int]
a,SynthDef args -> SynthDef args
f SynthDef args
b,VarSet args
c)) ((SynthDef args -> SynthDef args)
-> ([Int], SynthDef args, VarSet args)
-> ([Int], SynthDef args, VarSet args))
-> (SynthDef args -> SynthDef args)
-> ([Int], SynthDef args, VarSet args)
-> ([Int], SynthDef args, VarSet args)
forall a b. (a -> b) -> a -> b
$ \SynthDef args
synthDef ->
let ugs :: Map Int UGen
ugs = SynthDef args -> Map Int UGen
forall (args :: [Symbol]). SynthDef args -> Map Int UGen
_sdUGens SynthDef args
synthDef
updatedUGens :: Map Int UGen
updatedUGens :: Map Int UGen
updatedUGens = case Int -> Map Int UGen -> Maybe UGen
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Int
ugId Map Int UGen
ugs of
Maybe UGen
Nothing -> String -> Map Int UGen
forall a. HasCallStack => String -> a
error String
"ugen id not found"
Just UGen{} ->
(UGen -> UGen) -> Int -> Map Int UGen -> Map Int UGen
forall k a. Ord k => (a -> a) -> k -> Map k a -> Map k a
Map.adjust (\UGen
ug -> UGen
ug { _ugenCalculationRate :: CalculationRate
_ugenCalculationRate = CalculationRate
calcRate }) Int
ugId Map Int UGen
ugs
in SynthDef args
synthDef { _sdUGens :: Map Int UGen
_sdUGens = Map Int UGen
updatedUGens }
Signal
_ -> () -> StateT ([Int], SynthDef args, VarSet args) Identity ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
Signal -> SDBody' args Signal
forall (m :: * -> *) a. Monad m => a -> m a
return Signal
i'
getCalcRate :: Signal -> SDBody' args CalculationRate
getCalcRate :: Signal -> SDBody' args CalculationRate
getCalcRate = \case
Constant Float
_ -> CalculationRate -> SDBody' args CalculationRate
forall (f :: * -> *) a. Applicative f => a -> f a
pure CalculationRate
IR
Param ByteString
_ -> CalculationRate -> SDBody' args CalculationRate
forall (f :: * -> *) a. Applicative f => a -> f a
pure CalculationRate
KR
UGOut Int
theUG Int32
_ -> do
([Int]
_, SynthDef args
ugenGraph, VarSet args
_) <- StateT
([Int], SynthDef args, VarSet args)
Identity
([Int], SynthDef args, VarSet args)
forall s (m :: * -> *). MonadState s m => m s
get
case Int -> Map Int UGen -> Maybe UGen
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Int
theUG (SynthDef args -> Map Int UGen
forall (args :: [Symbol]). SynthDef args -> Map Int UGen
_sdUGens SynthDef args
ugenGraph) of
Just UGen
ug -> CalculationRate -> SDBody' args CalculationRate
forall (m :: * -> *) a. Monad m => a -> m a
return (CalculationRate -> SDBody' args CalculationRate)
-> CalculationRate -> SDBody' args CalculationRate
forall a b. (a -> b) -> a -> b
$ UGen -> CalculationRate
_ugenCalculationRate UGen
ug
Maybe UGen
Nothing -> String -> SDBody' args CalculationRate
forall a. HasCallStack => String -> a
error String
"that output isn't in the graph!"
shrinkSDArgs :: Subset new old => SynthDef old -> SynthDef new
shrinkSDArgs :: SynthDef old -> SynthDef new
shrinkSDArgs (SynthDef SDName
a [(ByteString, Float)]
b Map Int UGen
c) = SDName -> [(ByteString, Float)] -> Map Int UGen -> SynthDef new
forall (args :: [Symbol]).
SDName -> [(ByteString, Float)] -> Map Int UGen -> SynthDef args
SynthDef SDName
a [(ByteString, Float)]
b Map Int UGen
c
encodeSD :: SynthDef a -> ByteString
encodeSD :: SynthDef a -> ByteString
encodeSD =
SynthDefFile -> ByteString
encodeSynthDefFile (SynthDefFile -> ByteString)
-> (SynthDef a -> SynthDefFile) -> SynthDef a -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [LiteralSynthDef] -> SynthDefFile
SynthDefFile ([LiteralSynthDef] -> SynthDefFile)
-> (SynthDef a -> [LiteralSynthDef]) -> SynthDef a -> SynthDefFile
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (LiteralSynthDef -> [LiteralSynthDef] -> [LiteralSynthDef]
forall a. a -> [a] -> [a]
:[]) (LiteralSynthDef -> [LiteralSynthDef])
-> (SynthDef a -> LiteralSynthDef)
-> SynthDef a
-> [LiteralSynthDef]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SynthDef a -> LiteralSynthDef
forall (a :: [Symbol]). SynthDef a -> LiteralSynthDef
sdToLiteral
instance Hashable (SynthDef a) where
hashWithSalt :: Int -> SynthDef a -> Int
hashWithSalt Int
salt (SynthDef SDName
_name [(ByteString, Float)]
params Map Int UGen
ugens) =
Int -> ByteString -> Int
forall a. Hashable a => Int -> a -> Int
hashWithSalt Int
salt (ByteString -> Int)
-> (SynthDef Any -> ByteString) -> SynthDef Any -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SynthDef Any -> ByteString
forall (a :: [Symbol]). SynthDef a -> ByteString
encodeSD (SynthDef Any -> Int) -> SynthDef Any -> Int
forall a b. (a -> b) -> a -> b
$
SDName -> [(ByteString, Float)] -> Map Int UGen -> SynthDef Any
forall (args :: [Symbol]).
SDName -> [(ByteString, Float)] -> Map Int UGen -> SynthDef args
SynthDef (ByteString -> SDName
SDName_Named ByteString
"VIVID FTW") [(ByteString, Float)]
params Map Int UGen
ugens