{-# Language DeriveFunctor #-}
module Csound.Typed.GlobalState.Elements(
IdMap(..), saveId, newIdMapId,
GenMap, newGen, newGenId, nextGlobalGenCounter, newTabOfGens,
WriteGenMap, newWriteGen, newWriteTab,
SfFluid(..), SfSpec(..), SfMap, newSf, sfVar, renderSf,
BandLimited(..), BandLimitedMap(..), BandLimitedId(..),
saveBandLimited, renderBandLimited,
readBandLimited, readHardSyncBandLimited,
StringMap, newString,
MidiType(..), Channel, MidiMap, MidiKey(..), saveMidiInstr,
Globals(..), newPersistentGlobalVar, newClearableGlobalVar,
newPersistentGloabalArrVar,
renderGlobals, bpmVarName, bpmVar,
Instrs(..), saveInstr, getInstrIds,
NamedInstrs(..), saveNamedInstr,
InstrBody, getIn, sendOut, sendChn, sendGlobal, chnPargId,
Event(..),
ChnRef(..), chnRefFromParg, chnRefAlloc, readChn, writeChn, chnUpdateUdo,
subinstr, subinstr_, event_i, event, safeOut, autoOff, changed,
OscListenPorts, getOscPortVar,
MacrosInits, MacrosInit(..), initMacros,
UdoPlugin, addUdoPlugin, getUdoPluginNames,
tabQueuePlugin, tabQueue2Plugin,
zdfPlugin, solinaChorusPlugin, audaciouseqPlugin, adsr140Plugin,
diodePlugin, korg35Plugin, zeroDelayConvolutionPlugin,
pitchShifterDelayPlugin,
analogDelayPlugin, distortionPlugin, envelopeFolollowerPlugin, flangerPlugin, freqShifterPlugin,
loFiPlugin, panTremPlugin, monoTremPlugin, phaserPlugin, pitchShifterPlugin, reversePlugin,
ringModulatorPlugin, stChorusPlugin, stereoPingPongDelayPlugin,
tapeEchoPlugin,
delay1kPlugin,
liveRowPlugin, liveRowsPlugin,
ambiRowPlugin, ambiRowMp3Plugin
) where
import Data.List
import Data.ByteString (ByteString)
import Control.Monad.Trans.State.Strict
import Control.Monad(zipWithM_)
import Data.Default
import qualified Data.Map.Strict as M
import qualified Data.IntMap as IM
import Csound.Dynamic.Types hiding (genId)
import Csound.Dynamic.Build
import Csound.Dynamic.Build.Numeric()
import Csound.Typed.GlobalState.Opcodes
import Data.Text (Text)
import Data.Text qualified as Text
data IdMap a = IdMap
{ forall a. IdMap a -> Map a Int
idMapContent :: M.Map a Int
, forall a. IdMap a -> Int
idMapNewId :: Int
} deriving (IdMap a -> IdMap a -> Bool
(IdMap a -> IdMap a -> Bool)
-> (IdMap a -> IdMap a -> Bool) -> Eq (IdMap a)
forall a. Eq a => IdMap a -> IdMap a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall a. Eq a => IdMap a -> IdMap a -> Bool
== :: IdMap a -> IdMap a -> Bool
$c/= :: forall a. Eq a => IdMap a -> IdMap a -> Bool
/= :: IdMap a -> IdMap a -> Bool
Eq, Eq (IdMap a)
Eq (IdMap a) =>
(IdMap a -> IdMap a -> Ordering)
-> (IdMap a -> IdMap a -> Bool)
-> (IdMap a -> IdMap a -> Bool)
-> (IdMap a -> IdMap a -> Bool)
-> (IdMap a -> IdMap a -> Bool)
-> (IdMap a -> IdMap a -> IdMap a)
-> (IdMap a -> IdMap a -> IdMap a)
-> Ord (IdMap a)
IdMap a -> IdMap a -> Bool
IdMap a -> IdMap a -> Ordering
IdMap a -> IdMap a -> IdMap a
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
forall a. Ord a => Eq (IdMap a)
forall a. Ord a => IdMap a -> IdMap a -> Bool
forall a. Ord a => IdMap a -> IdMap a -> Ordering
forall a. Ord a => IdMap a -> IdMap a -> IdMap a
$ccompare :: forall a. Ord a => IdMap a -> IdMap a -> Ordering
compare :: IdMap a -> IdMap a -> Ordering
$c< :: forall a. Ord a => IdMap a -> IdMap a -> Bool
< :: IdMap a -> IdMap a -> Bool
$c<= :: forall a. Ord a => IdMap a -> IdMap a -> Bool
<= :: IdMap a -> IdMap a -> Bool
$c> :: forall a. Ord a => IdMap a -> IdMap a -> Bool
> :: IdMap a -> IdMap a -> Bool
$c>= :: forall a. Ord a => IdMap a -> IdMap a -> Bool
>= :: IdMap a -> IdMap a -> Bool
$cmax :: forall a. Ord a => IdMap a -> IdMap a -> IdMap a
max :: IdMap a -> IdMap a -> IdMap a
$cmin :: forall a. Ord a => IdMap a -> IdMap a -> IdMap a
min :: IdMap a -> IdMap a -> IdMap a
Ord)
instance Default (IdMap a) where
def :: IdMap a
def = Map a Int -> Int -> IdMap a
forall a. Map a Int -> Int -> IdMap a
IdMap Map a Int
forall a. Default a => a
def Int
1
saveId :: Ord a => a -> State (IdMap a) Int
saveId :: forall a. Ord a => a -> State (IdMap a) Int
saveId a
a = (IdMap a -> (Int, IdMap a)) -> StateT (IdMap a) Identity Int
forall (m :: * -> *) s a. Monad m => (s -> (a, s)) -> StateT s m a
state ((IdMap a -> (Int, IdMap a)) -> StateT (IdMap a) Identity Int)
-> (IdMap a -> (Int, IdMap a)) -> StateT (IdMap a) Identity Int
forall a b. (a -> b) -> a -> b
$ \IdMap a
s ->
case a -> Map a Int -> Maybe Int
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup a
a (IdMap a -> Map a Int
forall a. IdMap a -> Map a Int
idMapContent IdMap a
s) of
Maybe Int
Nothing ->
let newId :: Int
newId = IdMap a -> Int
forall a. IdMap a -> Int
idMapNewId IdMap a
s
s1 :: IdMap a
s1 = IdMap a
s{ idMapContent = M.insert a newId (idMapContent s)
, idMapNewId = succ newId }
in (Int
newId, IdMap a
s1)
Just Int
n -> (Int
n, IdMap a
s)
newIdMapId :: State (IdMap a) Int
newIdMapId :: forall a. State (IdMap a) Int
newIdMapId = (IdMap a -> (Int, IdMap a)) -> StateT (IdMap a) Identity Int
forall (m :: * -> *) s a. Monad m => (s -> (a, s)) -> StateT s m a
state ((IdMap a -> (Int, IdMap a)) -> StateT (IdMap a) Identity Int)
-> (IdMap a -> (Int, IdMap a)) -> StateT (IdMap a) Identity Int
forall a b. (a -> b) -> a -> b
$ \IdMap a
s ->
let newId :: Int
newId = IdMap a -> Int
forall a. IdMap a -> Int
idMapNewId IdMap a
s
s1 :: IdMap a
s1 = IdMap a
s { idMapNewId = succ newId }
in (Int
newId, IdMap a
s1)
type GenMap = IdMap Gen
newGen :: Gen -> State GenMap Int
newGen :: Gen -> State GenMap Int
newGen = Gen -> State GenMap Int
forall a. Ord a => a -> State (IdMap a) Int
saveGenId
newTabOfGens :: [Gen] -> State GenMap Int
newTabOfGens :: [Gen] -> State GenMap Int
newTabOfGens = (Gen -> State GenMap Int
forall a. Ord a => a -> State (IdMap a) Int
saveGenId (Gen -> State GenMap Int)
-> ([Int] -> Gen) -> [Int] -> State GenMap Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Int] -> Gen
forall {a}. Integral a => [a] -> Gen
intTab ([Int] -> State GenMap Int)
-> StateT GenMap Identity [Int] -> State GenMap Int
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<<) (StateT GenMap Identity [Int] -> State GenMap Int)
-> ([Gen] -> StateT GenMap Identity [Int])
-> [Gen]
-> State GenMap Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Gen -> State GenMap Int) -> [Gen] -> StateT GenMap Identity [Int]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM Gen -> State GenMap Int
forall a. Ord a => a -> State (IdMap a) Int
saveGenId
where intTab :: [a] -> Gen
intTab [a]
ns = Int -> GenId -> [Double] -> Maybe Text -> Gen
Gen (Int -> Int
nextPowOfTwo (Int -> Int) -> Int -> Int
forall a b. (a -> b) -> a -> b
$ [a] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
ns) (Int -> GenId
IntGenId (-Int
2)) ((a -> Double) -> [a] -> [Double]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral [a]
ns) Maybe Text
forall a. Maybe a
Nothing
nextPowOfTwo :: Int -> Int
nextPowOfTwo :: Int -> Int
nextPowOfTwo Int
n
| Double
frac Double -> Double -> Bool
forall a. Eq a => a -> a -> Bool
== Double
0 = Int
n
| Bool
otherwise = Int
2 Int -> Int -> Int
forall a b. (Num a, Integral b) => a -> b -> a
^ ((Int
integ :: Int) Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
where
(Int
integ, Double
frac) = (Double -> (Int, Double)
forall b. Integral b => Double -> (b, Double)
forall a b. (RealFrac a, Integral b) => a -> (b, a)
properFraction (Double -> (Int, Double)) -> Double -> (Int, Double)
forall a b. (a -> b) -> a -> b
$ Double -> Double -> Double
forall a. Floating a => a -> a -> a
logBase Double
2 (Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
n)) :: (Int, Double)
saveGenId :: Ord a => a -> State (IdMap a) Int
saveGenId :: forall a. Ord a => a -> State (IdMap a) Int
saveGenId a
a = (IdMap a -> (Int, IdMap a)) -> StateT (IdMap a) Identity Int
forall (m :: * -> *) s a. Monad m => (s -> (a, s)) -> StateT s m a
state ((IdMap a -> (Int, IdMap a)) -> StateT (IdMap a) Identity Int)
-> (IdMap a -> (Int, IdMap a)) -> StateT (IdMap a) Identity Int
forall a b. (a -> b) -> a -> b
$ \IdMap a
s ->
case a -> Map a Int -> Maybe Int
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup a
a (IdMap a -> Map a Int
forall a. IdMap a -> Map a Int
idMapContent IdMap a
s) of
Maybe Int
Nothing ->
let newId :: Int
newId = Int -> Int
nextReadOnlyTableId (Int -> Int) -> Int -> Int
forall a b. (a -> b) -> a -> b
$ IdMap a -> Int
forall a. IdMap a -> Int
idMapNewId IdMap a
s
s1 :: IdMap a
s1 = IdMap a
s{ idMapContent = M.insert a newId (idMapContent s)
, idMapNewId = nextReadOnlyTableId newId }
in (Int
newId, IdMap a
s1)
Just Int
n -> (Int
n, IdMap a
s)
newGenId :: State GenMap Int
newGenId :: State GenMap Int
newGenId = (GenMap -> (Int, GenMap)) -> State GenMap Int
forall (m :: * -> *) s a. Monad m => (s -> (a, s)) -> StateT s m a
state ((GenMap -> (Int, GenMap)) -> State GenMap Int)
-> (GenMap -> (Int, GenMap)) -> State GenMap Int
forall a b. (a -> b) -> a -> b
$ \GenMap
s ->
let newId :: Int
newId = GenMap -> Int
forall a. IdMap a -> Int
idMapNewId GenMap
s
s1 :: GenMap
s1 = GenMap
s { idMapNewId = nextReadOnlyTableId newId }
in (Int
newId, GenMap
s1)
type WriteGenMap = [(Int, Gen)]
newWriteGen :: Gen -> State WriteGenMap E
newWriteGen :: Gen -> State WriteGenMap E
newWriteGen = (Int -> E)
-> StateT WriteGenMap Identity Int -> State WriteGenMap E
forall a b.
(a -> b)
-> StateT WriteGenMap Identity a -> StateT WriteGenMap Identity b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Int -> E
int (StateT WriteGenMap Identity Int -> State WriteGenMap E)
-> (Gen -> StateT WriteGenMap Identity Int)
-> Gen
-> State WriteGenMap E
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Gen -> StateT WriteGenMap Identity Int
saveWriteGenId
newWriteTab :: Int -> State WriteGenMap E
newWriteTab :: Int -> State WriteGenMap E
newWriteTab = Gen -> State WriteGenMap E
newWriteGen (Gen -> State WriteGenMap E)
-> (Int -> Gen) -> Int -> State WriteGenMap E
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Gen
fromSize
where fromSize :: Int -> Gen
fromSize Int
n = Int -> GenId -> [Double] -> Maybe Text -> Gen
Gen Int
n (Int -> GenId
IntGenId Int
2) (Int -> Double -> [Double]
forall a. Int -> a -> [a]
replicate Int
n Double
0) Maybe Text
forall a. Maybe a
Nothing
saveWriteGenId :: Gen -> State WriteGenMap Int
saveWriteGenId :: Gen -> StateT WriteGenMap Identity Int
saveWriteGenId Gen
a = (WriteGenMap -> (Int, WriteGenMap))
-> StateT WriteGenMap Identity Int
forall (m :: * -> *) s a. Monad m => (s -> (a, s)) -> StateT s m a
state ((WriteGenMap -> (Int, WriteGenMap))
-> StateT WriteGenMap Identity Int)
-> (WriteGenMap -> (Int, WriteGenMap))
-> StateT WriteGenMap Identity Int
forall a b. (a -> b) -> a -> b
$ \WriteGenMap
s -> case WriteGenMap
s of
[] -> (Int
initId, [(Int
initId, Gen
a)])
(Int
i,Gen
_):WriteGenMap
_ -> let newId :: Int
newId = Int -> Int
nextWriteTableId Int
i
in (Int
newId, (Int
newId, Gen
a) (Int, Gen) -> WriteGenMap -> WriteGenMap
forall a. a -> [a] -> [a]
: WriteGenMap
s)
where
initId :: Int
initId = Int
tableWriteStep
tableWriteStep :: Int
tableWriteStep :: Int
tableWriteStep = Int
10
nextReadOnlyTableId :: Int -> Int
nextReadOnlyTableId :: Int -> Int
nextReadOnlyTableId Int
x
| Int
y Int -> Int -> Int
forall a. Integral a => a -> a -> a
`mod` Int
tableWriteStep Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 = Int
y Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1
| Bool
otherwise = Int
y
where y :: Int
y = Int
x Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1
nextWriteTableId :: Int -> Int
nextWriteTableId :: Int -> Int
nextWriteTableId Int
x = Int
tableWriteStep Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
x
type StringMap = IdMap Text
newString :: Text -> State StringMap Prim
newString :: Text -> State StringMap Prim
newString = (Int -> Prim)
-> StateT StringMap Identity Int -> State StringMap Prim
forall a b.
(a -> b)
-> StateT StringMap Identity a -> StateT StringMap Identity b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Int -> Prim
PrimInt (StateT StringMap Identity Int -> State StringMap Prim)
-> (Text -> StateT StringMap Identity Int)
-> Text
-> State StringMap Prim
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> StateT StringMap Identity Int
forall a. Ord a => a -> State (IdMap a) Int
saveId
nextGlobalGenCounter :: State Int Int
nextGlobalGenCounter :: State Int Int
nextGlobalGenCounter = (Int -> (Int, Int)) -> State Int Int
forall (m :: * -> *) s a. Monad m => (s -> (a, s)) -> StateT s m a
state ((Int -> (Int, Int)) -> State Int Int)
-> (Int -> (Int, Int)) -> State Int Int
forall a b. (a -> b) -> a -> b
$ \Int
s -> (Int
s, Int
s Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
data SfFluid = SfFluid
{ SfFluid -> Int
sfId :: Int
, SfFluid -> [Var]
sfVars :: [Var] }
data SfSpec = SfSpec
{ SfSpec -> Text
sfName :: Text
, SfSpec -> Int
sfBank :: Int
, SfSpec -> Int
sfProgram :: Int
} deriving (SfSpec -> SfSpec -> Bool
(SfSpec -> SfSpec -> Bool)
-> (SfSpec -> SfSpec -> Bool) -> Eq SfSpec
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: SfSpec -> SfSpec -> Bool
== :: SfSpec -> SfSpec -> Bool
$c/= :: SfSpec -> SfSpec -> Bool
/= :: SfSpec -> SfSpec -> Bool
Eq, Eq SfSpec
Eq SfSpec =>
(SfSpec -> SfSpec -> Ordering)
-> (SfSpec -> SfSpec -> Bool)
-> (SfSpec -> SfSpec -> Bool)
-> (SfSpec -> SfSpec -> Bool)
-> (SfSpec -> SfSpec -> Bool)
-> (SfSpec -> SfSpec -> SfSpec)
-> (SfSpec -> SfSpec -> SfSpec)
-> Ord SfSpec
SfSpec -> SfSpec -> Bool
SfSpec -> SfSpec -> Ordering
SfSpec -> SfSpec -> SfSpec
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
$ccompare :: SfSpec -> SfSpec -> Ordering
compare :: SfSpec -> SfSpec -> Ordering
$c< :: SfSpec -> SfSpec -> Bool
< :: SfSpec -> SfSpec -> Bool
$c<= :: SfSpec -> SfSpec -> Bool
<= :: SfSpec -> SfSpec -> Bool
$c> :: SfSpec -> SfSpec -> Bool
> :: SfSpec -> SfSpec -> Bool
$c>= :: SfSpec -> SfSpec -> Bool
>= :: SfSpec -> SfSpec -> Bool
$cmax :: SfSpec -> SfSpec -> SfSpec
max :: SfSpec -> SfSpec -> SfSpec
$cmin :: SfSpec -> SfSpec -> SfSpec
min :: SfSpec -> SfSpec -> SfSpec
Ord, Int -> SfSpec -> ShowS
[SfSpec] -> ShowS
SfSpec -> String
(Int -> SfSpec -> ShowS)
-> (SfSpec -> String) -> ([SfSpec] -> ShowS) -> Show SfSpec
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> SfSpec -> ShowS
showsPrec :: Int -> SfSpec -> ShowS
$cshow :: SfSpec -> String
show :: SfSpec -> String
$cshowList :: [SfSpec] -> ShowS
showList :: [SfSpec] -> ShowS
Show)
type SfMap = IdMap SfSpec
newSf :: SfSpec -> State SfMap Int
newSf :: SfSpec -> State SfMap Int
newSf = SfSpec -> State SfMap Int
forall a. Ord a => a -> State (IdMap a) Int
saveId
sfVar :: Int -> E
sfVar :: Int -> E
sfVar Int
n = Var -> E
readOnlyVar (Rate -> Text -> Var
VarVerbatim Rate
Ir (Text -> Var) -> Text -> Var
forall a b. (a -> b) -> a -> b
$ Int -> Text
sfEngineName Int
n)
sfEngineName :: Int -> Text
sfEngineName :: Int -> Text
sfEngineName Int
n = Text
"gi_Sf_engine_" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
Text.pack (Int -> String
forall a. Show a => a -> String
show Int
n)
sfInstrName :: Int -> Text
sfInstrName :: Int -> Text
sfInstrName Int
n = Text
"i_Sf_instr_" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
Text.pack (Int -> String
forall a. Show a => a -> String
show Int
n)
renderSf :: Monad m => SfSpec -> Int -> DepT m ()
renderSf :: forall (m :: * -> *). Monad m => SfSpec -> Int -> DepT m ()
renderSf (SfSpec Text
name Int
bank Int
prog) Int
n = Text -> DepT m ()
forall (m :: * -> *). Monad m => Text -> DepT m ()
verbatim (Text -> DepT m ()) -> Text -> DepT m ()
forall a b. (a -> b) -> a -> b
$
[Text] -> Text
Text.unlines
[ Text
engineStr
, Text
loadStr
, Text
selectProgStr
]
where
engineStr :: Text
engineStr = Text
engineName Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" fluidEngine"
loadStr :: Text
loadStr = Text
insName Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" fluidLoad \"" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
name Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\", " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
engineName Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
", 1"
selectProgStr :: Text
selectProgStr = Text
"fluidProgramSelect " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
engineName Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
", 1, " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
insName
Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
", " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
Text.pack (Int -> String
forall a. Show a => a -> String
show Int
bank) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
", " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
Text.pack (Int -> String
forall a. Show a => a -> String
show Int
prog)
engineName :: Text
engineName = Int -> Text
sfEngineName Int
n
insName :: Text
insName = Int -> Text
sfInstrName Int
n
data BandLimited = Saw | Pulse | Square | Triangle | IntegratedSaw | UserGen Gen
deriving (BandLimited -> BandLimited -> Bool
(BandLimited -> BandLimited -> Bool)
-> (BandLimited -> BandLimited -> Bool) -> Eq BandLimited
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: BandLimited -> BandLimited -> Bool
== :: BandLimited -> BandLimited -> Bool
$c/= :: BandLimited -> BandLimited -> Bool
/= :: BandLimited -> BandLimited -> Bool
Eq, Eq BandLimited
Eq BandLimited =>
(BandLimited -> BandLimited -> Ordering)
-> (BandLimited -> BandLimited -> Bool)
-> (BandLimited -> BandLimited -> Bool)
-> (BandLimited -> BandLimited -> Bool)
-> (BandLimited -> BandLimited -> Bool)
-> (BandLimited -> BandLimited -> BandLimited)
-> (BandLimited -> BandLimited -> BandLimited)
-> Ord BandLimited
BandLimited -> BandLimited -> Bool
BandLimited -> BandLimited -> Ordering
BandLimited -> BandLimited -> BandLimited
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
$ccompare :: BandLimited -> BandLimited -> Ordering
compare :: BandLimited -> BandLimited -> Ordering
$c< :: BandLimited -> BandLimited -> Bool
< :: BandLimited -> BandLimited -> Bool
$c<= :: BandLimited -> BandLimited -> Bool
<= :: BandLimited -> BandLimited -> Bool
$c> :: BandLimited -> BandLimited -> Bool
> :: BandLimited -> BandLimited -> Bool
$c>= :: BandLimited -> BandLimited -> Bool
>= :: BandLimited -> BandLimited -> Bool
$cmax :: BandLimited -> BandLimited -> BandLimited
max :: BandLimited -> BandLimited -> BandLimited
$cmin :: BandLimited -> BandLimited -> BandLimited
min :: BandLimited -> BandLimited -> BandLimited
Ord)
data BandLimitedId = SimpleBandLimitedWave Int | UserBandLimitedWave Int
deriving (BandLimitedId -> BandLimitedId -> Bool
(BandLimitedId -> BandLimitedId -> Bool)
-> (BandLimitedId -> BandLimitedId -> Bool) -> Eq BandLimitedId
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: BandLimitedId -> BandLimitedId -> Bool
== :: BandLimitedId -> BandLimitedId -> Bool
$c/= :: BandLimitedId -> BandLimitedId -> Bool
/= :: BandLimitedId -> BandLimitedId -> Bool
Eq, Eq BandLimitedId
Eq BandLimitedId =>
(BandLimitedId -> BandLimitedId -> Ordering)
-> (BandLimitedId -> BandLimitedId -> Bool)
-> (BandLimitedId -> BandLimitedId -> Bool)
-> (BandLimitedId -> BandLimitedId -> Bool)
-> (BandLimitedId -> BandLimitedId -> Bool)
-> (BandLimitedId -> BandLimitedId -> BandLimitedId)
-> (BandLimitedId -> BandLimitedId -> BandLimitedId)
-> Ord BandLimitedId
BandLimitedId -> BandLimitedId -> Bool
BandLimitedId -> BandLimitedId -> Ordering
BandLimitedId -> BandLimitedId -> BandLimitedId
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
$ccompare :: BandLimitedId -> BandLimitedId -> Ordering
compare :: BandLimitedId -> BandLimitedId -> Ordering
$c< :: BandLimitedId -> BandLimitedId -> Bool
< :: BandLimitedId -> BandLimitedId -> Bool
$c<= :: BandLimitedId -> BandLimitedId -> Bool
<= :: BandLimitedId -> BandLimitedId -> Bool
$c> :: BandLimitedId -> BandLimitedId -> Bool
> :: BandLimitedId -> BandLimitedId -> Bool
$c>= :: BandLimitedId -> BandLimitedId -> Bool
>= :: BandLimitedId -> BandLimitedId -> Bool
$cmax :: BandLimitedId -> BandLimitedId -> BandLimitedId
max :: BandLimitedId -> BandLimitedId -> BandLimitedId
$cmin :: BandLimitedId -> BandLimitedId -> BandLimitedId
min :: BandLimitedId -> BandLimitedId -> BandLimitedId
Ord)
bandLimitedIdToExpr :: BandLimitedId -> E
bandLimitedIdToExpr :: BandLimitedId -> E
bandLimitedIdToExpr BandLimitedId
x = case BandLimitedId
x of
SimpleBandLimitedWave Int
simpleId -> Int -> E
int Int
simpleId
UserBandLimitedWave Int
userId -> Exp E -> E
noRate (Exp E -> E) -> Exp E -> E
forall a b. (a -> b) -> a -> b
$ Var -> Exp E
forall a. Var -> MainExp a
ReadVar (Var -> Exp E) -> Var -> Exp E
forall a b. (a -> b) -> a -> b
$ Int -> Var
forall a. Show a => a -> Var
bandLimitedVar Int
userId
bandLimitedVar :: Show a => a -> Var
bandLimitedVar :: forall a. Show a => a -> Var
bandLimitedVar a
userId = VarType -> Rate -> Text -> Var
Var VarType
GlobalVar Rate
Ir (Text
"BandLim" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
Text.pack (a -> String
forall a. Show a => a -> String
show a
userId))
data BandLimitedMap = BandLimitedMap
{ BandLimitedMap -> Map BandLimited BandLimitedId
simpleBandLimitedMap :: M.Map BandLimited BandLimitedId
, BandLimitedMap -> GenMap
vcoInitMap :: GenMap
} deriving (BandLimitedMap -> BandLimitedMap -> Bool
(BandLimitedMap -> BandLimitedMap -> Bool)
-> (BandLimitedMap -> BandLimitedMap -> Bool) -> Eq BandLimitedMap
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: BandLimitedMap -> BandLimitedMap -> Bool
== :: BandLimitedMap -> BandLimitedMap -> Bool
$c/= :: BandLimitedMap -> BandLimitedMap -> Bool
/= :: BandLimitedMap -> BandLimitedMap -> Bool
Eq, Eq BandLimitedMap
Eq BandLimitedMap =>
(BandLimitedMap -> BandLimitedMap -> Ordering)
-> (BandLimitedMap -> BandLimitedMap -> Bool)
-> (BandLimitedMap -> BandLimitedMap -> Bool)
-> (BandLimitedMap -> BandLimitedMap -> Bool)
-> (BandLimitedMap -> BandLimitedMap -> Bool)
-> (BandLimitedMap -> BandLimitedMap -> BandLimitedMap)
-> (BandLimitedMap -> BandLimitedMap -> BandLimitedMap)
-> Ord BandLimitedMap
BandLimitedMap -> BandLimitedMap -> Bool
BandLimitedMap -> BandLimitedMap -> Ordering
BandLimitedMap -> BandLimitedMap -> BandLimitedMap
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
$ccompare :: BandLimitedMap -> BandLimitedMap -> Ordering
compare :: BandLimitedMap -> BandLimitedMap -> Ordering
$c< :: BandLimitedMap -> BandLimitedMap -> Bool
< :: BandLimitedMap -> BandLimitedMap -> Bool
$c<= :: BandLimitedMap -> BandLimitedMap -> Bool
<= :: BandLimitedMap -> BandLimitedMap -> Bool
$c> :: BandLimitedMap -> BandLimitedMap -> Bool
> :: BandLimitedMap -> BandLimitedMap -> Bool
$c>= :: BandLimitedMap -> BandLimitedMap -> Bool
>= :: BandLimitedMap -> BandLimitedMap -> Bool
$cmax :: BandLimitedMap -> BandLimitedMap -> BandLimitedMap
max :: BandLimitedMap -> BandLimitedMap -> BandLimitedMap
$cmin :: BandLimitedMap -> BandLimitedMap -> BandLimitedMap
min :: BandLimitedMap -> BandLimitedMap -> BandLimitedMap
Ord)
instance Default BandLimitedMap where
def :: BandLimitedMap
def = Map BandLimited BandLimitedId -> GenMap -> BandLimitedMap
BandLimitedMap Map BandLimited BandLimitedId
forall a. Default a => a
def GenMap
forall a. Default a => a
def
saveBandLimited :: BandLimited -> State BandLimitedMap BandLimitedId
saveBandLimited :: BandLimited -> State BandLimitedMap BandLimitedId
saveBandLimited BandLimited
x = case BandLimited
x of
BandLimited
Saw -> Int -> Int -> State BandLimitedMap BandLimitedId
forall {m :: * -> *}.
Monad m =>
Int -> Int -> StateT BandLimitedMap m BandLimitedId
simpleWave Int
1 Int
0
BandLimited
IntegratedSaw -> Int -> Int -> State BandLimitedMap BandLimitedId
forall {m :: * -> *}.
Monad m =>
Int -> Int -> StateT BandLimitedMap m BandLimitedId
simpleWave Int
2 Int
1
BandLimited
Pulse -> Int -> Int -> State BandLimitedMap BandLimitedId
forall {m :: * -> *}.
Monad m =>
Int -> Int -> StateT BandLimitedMap m BandLimitedId
simpleWave Int
4 Int
2
BandLimited
Square -> Int -> Int -> State BandLimitedMap BandLimitedId
forall {m :: * -> *}.
Monad m =>
Int -> Int -> StateT BandLimitedMap m BandLimitedId
simpleWave Int
8 Int
3
BandLimited
Triangle -> Int -> Int -> State BandLimitedMap BandLimitedId
forall {m :: * -> *}.
Monad m =>
Int -> Int -> StateT BandLimitedMap m BandLimitedId
simpleWave Int
16 Int
4
UserGen Gen
gen -> Gen -> State BandLimitedMap BandLimitedId
forall {m :: * -> *}.
Monad m =>
Gen -> StateT BandLimitedMap m BandLimitedId
userGen Gen
gen
where
simpleWave :: Int -> Int -> StateT BandLimitedMap m BandLimitedId
simpleWave Int
writeId Int
readId = (BandLimitedMap -> (BandLimitedId, BandLimitedMap))
-> StateT BandLimitedMap m BandLimitedId
forall (m :: * -> *) s a. Monad m => (s -> (a, s)) -> StateT s m a
state ((BandLimitedMap -> (BandLimitedId, BandLimitedMap))
-> StateT BandLimitedMap m BandLimitedId)
-> (BandLimitedMap -> (BandLimitedId, BandLimitedMap))
-> StateT BandLimitedMap m BandLimitedId
forall a b. (a -> b) -> a -> b
$ \BandLimitedMap
blMap ->
if (BandLimited -> Map BandLimited BandLimitedId -> Bool
forall k a. Ord k => k -> Map k a -> Bool
M.member BandLimited
x (BandLimitedMap -> Map BandLimited BandLimitedId
simpleBandLimitedMap BandLimitedMap
blMap))
then (Int -> BandLimitedId
SimpleBandLimitedWave Int
readId, BandLimitedMap
blMap)
else (Int -> BandLimitedId
SimpleBandLimitedWave Int
readId, BandLimitedMap
blMap { simpleBandLimitedMap = M.insert x (SimpleBandLimitedWave writeId) (simpleBandLimitedMap blMap) })
userGen :: Gen -> StateT BandLimitedMap m BandLimitedId
userGen Gen
gen = (BandLimitedMap -> (BandLimitedId, BandLimitedMap))
-> StateT BandLimitedMap m BandLimitedId
forall (m :: * -> *) s a. Monad m => (s -> (a, s)) -> StateT s m a
state ((BandLimitedMap -> (BandLimitedId, BandLimitedMap))
-> StateT BandLimitedMap m BandLimitedId)
-> (BandLimitedMap -> (BandLimitedId, BandLimitedMap))
-> StateT BandLimitedMap m BandLimitedId
forall a b. (a -> b) -> a -> b
$ \BandLimitedMap
blMap ->
let genMap :: GenMap
genMap = BandLimitedMap -> GenMap
vcoInitMap BandLimitedMap
blMap
(Int
newId, GenMap
genMap1) = State GenMap Int -> GenMap -> (Int, GenMap)
forall s a. State s a -> s -> (a, s)
runState (Gen -> State GenMap Int
forall a. Ord a => a -> State (IdMap a) Int
saveId Gen
gen) GenMap
genMap
blMap1 :: BandLimitedMap
blMap1 = BandLimitedMap
blMap { vcoInitMap = genMap1 }
in (Int -> BandLimitedId
UserBandLimitedWave Int
newId, BandLimitedMap
blMap1)
renderBandLimited :: Monad m => GenMap -> BandLimitedMap -> DepT m ()
renderBandLimited :: forall (m :: * -> *).
Monad m =>
GenMap -> BandLimitedMap -> DepT m ()
renderBandLimited GenMap
genMap BandLimitedMap
blMap =
if BandLimitedMap -> Bool
isEmptyBlMap BandLimitedMap
blMap
then () -> DepT m ()
forall a. a -> DepT m a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
else Int -> [(Gen, Int)] -> [(BandLimited, BandLimitedId)] -> DepT m ()
forall {m :: * -> *} {t :: * -> *} {t :: * -> *}.
(Monad m, Foldable t, Foldable t) =>
Int -> t (Gen, Int) -> t (BandLimited, BandLimitedId) -> DepT m ()
render (GenMap -> Int
forall a. IdMap a -> Int
idMapNewId GenMap
genMap) (Map Gen Int -> [(Gen, Int)]
forall k a. Map k a -> [(k, a)]
M.toList (Map Gen Int -> [(Gen, Int)]) -> Map Gen Int -> [(Gen, Int)]
forall a b. (a -> b) -> a -> b
$ GenMap -> Map Gen Int
forall a. IdMap a -> Map a Int
idMapContent (GenMap -> Map Gen Int) -> GenMap -> Map Gen Int
forall a b. (a -> b) -> a -> b
$ BandLimitedMap -> GenMap
vcoInitMap BandLimitedMap
blMap) (Map BandLimited BandLimitedId -> [(BandLimited, BandLimitedId)]
forall k a. Map k a -> [(k, a)]
M.toList (Map BandLimited BandLimitedId -> [(BandLimited, BandLimitedId)])
-> Map BandLimited BandLimitedId -> [(BandLimited, BandLimitedId)]
forall a b. (a -> b) -> a -> b
$ BandLimitedMap -> Map BandLimited BandLimitedId
simpleBandLimitedMap BandLimitedMap
blMap)
where
isEmptyBlMap :: BandLimitedMap -> Bool
isEmptyBlMap BandLimitedMap
m = (Map BandLimited BandLimitedId -> Bool
forall k a. Map k a -> Bool
M.null (Map BandLimited BandLimitedId -> Bool)
-> Map BandLimited BandLimitedId -> Bool
forall a b. (a -> b) -> a -> b
$ BandLimitedMap -> Map BandLimited BandLimitedId
simpleBandLimitedMap BandLimitedMap
m) Bool -> Bool -> Bool
&& (Map Gen Int -> Bool
forall k a. Map k a -> Bool
M.null (Map Gen Int -> Bool) -> Map Gen Int -> Bool
forall a b. (a -> b) -> a -> b
$ GenMap -> Map Gen Int
forall a. IdMap a -> Map a Int
idMapContent (GenMap -> Map Gen Int) -> GenMap -> Map Gen Int
forall a b. (a -> b) -> a -> b
$ BandLimitedMap -> GenMap
vcoInitMap BandLimitedMap
m)
render :: Int -> t (Gen, Int) -> t (BandLimited, BandLimitedId) -> DepT m ()
render Int
lastGenId t (Gen, Int)
gens t (BandLimited, BandLimitedId)
vcos = do
Var -> E -> DepT m ()
forall (m :: * -> *). Monad m => Var -> E -> DepT m ()
writeVar Var
freeVcoVar (E -> DepT m ()) -> E -> DepT m ()
forall a b. (a -> b) -> a -> b
$ Int -> E
int (Int
lastGenId Int -> Int -> Int
forall a. Num a => a -> a -> a
+ t (Gen, Int) -> Int
forall a. t a -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length t (Gen, Int)
gens Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
100)
((Gen, Int) -> DepT m ()) -> t (Gen, Int) -> DepT m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (Int -> (Gen, Int) -> DepT m ()
forall (m :: * -> *). Monad m => Int -> (Gen, Int) -> DepT m ()
renderGen Int
lastGenId) t (Gen, Int)
gens
((BandLimited, BandLimitedId) -> DepT m ())
-> t (BandLimited, BandLimitedId) -> DepT m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (BandLimited, BandLimitedId) -> DepT m ()
forall (m :: * -> *).
Monad m =>
(BandLimited, BandLimitedId) -> DepT m ()
renderVco t (BandLimited, BandLimitedId)
vcos
renderGen :: Monad m => Int -> (Gen, Int) -> DepT m ()
renderGen :: forall (m :: * -> *). Monad m => Int -> (Gen, Int) -> DepT m ()
renderGen Int
lastGenId (Gen
gen, Int
genId) = do
Int -> (Gen, Int) -> DepT m ()
forall (m :: * -> *). Monad m => Int -> (Gen, Int) -> DepT m ()
renderFtgen Int
lastGenId (Gen
gen, Int
genId)
Int -> DepT m ()
forall {m :: * -> *} {a}. (Monad m, Show a) => a -> DepT m ()
renderVcoGen Int
genId
Int -> DepT m ()
forall {m :: * -> *} {a}. (Monad m, Show a) => a -> DepT m ()
renderVcoVarAssignment Int
genId
freeVcoVar :: Var
freeVcoVar = VarType -> Rate -> Text -> Var
Var VarType
GlobalVar Rate
Ir Text
"free_vco"
ftVar :: a -> Var
ftVar a
n = VarType -> Rate -> Text -> Var
Var VarType
GlobalVar Rate
Ir (Text -> Var) -> Text -> Var
forall a b. (a -> b) -> a -> b
$ Text
"vco_table_" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
Text.pack (a -> String
forall a. Show a => a -> String
show a
n)
renderFtgen :: Int -> (Gen, Int) -> DepT m ()
renderFtgen Int
lastGenId (Gen
g, Int
n) = Var -> E -> DepT m ()
forall (m :: * -> *). Monad m => Var -> E -> DepT m ()
writeVar (Int -> Var
forall a. Show a => a -> Var
ftVar Int
n) (E -> DepT m ()) -> E -> DepT m ()
forall a b. (a -> b) -> a -> b
$ E -> Gen -> E
ftgen (Int -> E
int (Int -> E) -> Int -> E
forall a b. (a -> b) -> a -> b
$ Int
lastGenId Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
n) Gen
g
renderVcoGen :: a -> DepT m ()
renderVcoGen a
ftId = do
E
ft <- Var -> DepT m E
forall (m :: * -> *). Monad m => Var -> DepT m E
readVar (a -> Var
forall a. Show a => a -> Var
ftVar a
ftId)
E
free <- Var -> DepT m E
forall (m :: * -> *). Monad m => Var -> DepT m E
readVar Var
freeVcoVar
Var -> E -> DepT m ()
forall (m :: * -> *). Monad m => Var -> E -> DepT m ()
writeVar Var
freeVcoVar (E -> DepT m ()) -> E -> DepT m ()
forall a b. (a -> b) -> a -> b
$ [E] -> E
vco2init [-E
ft, E
free, E
1.05, -E
1, -E
1, E
ft]
renderVcoVarAssignment :: a -> DepT m ()
renderVcoVarAssignment a
n = Var -> E -> DepT m ()
forall (m :: * -> *). Monad m => Var -> E -> DepT m ()
writeVar (a -> Var
forall a. Show a => a -> Var
bandLimitedVar a
n) (E -> DepT m ()) -> DepT m E -> DepT m ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< ((E -> E) -> DepT m E -> DepT m E
forall a b. (a -> b) -> DepT m a -> DepT m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap E -> E
forall a. Num a => a -> a
negate (DepT m E -> DepT m E) -> DepT m E -> DepT m E
forall a b. (a -> b) -> a -> b
$ Var -> DepT m E
forall (m :: * -> *). Monad m => Var -> DepT m E
readVar (a -> Var
forall a. Show a => a -> Var
ftVar a
n))
renderVco :: Monad m => (BandLimited, BandLimitedId) -> DepT m ()
renderVco :: forall (m :: * -> *).
Monad m =>
(BandLimited, BandLimitedId) -> DepT m ()
renderVco (BandLimited
_bandLimited, BandLimitedId
blId) = case BandLimitedId
blId of
SimpleBandLimitedWave Int
waveId -> do
E
free <- Var -> DepT m E
forall (m :: * -> *). Monad m => Var -> DepT m E
readVar Var
freeVcoVar
Var -> E -> DepT m ()
forall (m :: * -> *). Monad m => Var -> E -> DepT m ()
writeVar Var
freeVcoVar (E -> DepT m ()) -> E -> DepT m ()
forall a b. (a -> b) -> a -> b
$ [E] -> E
vco2init [Int -> E
int Int
waveId, E
free]
UserBandLimitedWave Int
_ -> () -> DepT m ()
forall a. a -> DepT m a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
readBandLimited :: Maybe E -> BandLimitedId -> E -> E
readBandLimited :: Maybe E -> BandLimitedId -> E -> E
readBandLimited Maybe E
mphase BandLimitedId
n E
cps = E -> E -> E -> Maybe E -> E
oscilikt E
1 E
cps (E -> E -> E
vco2ft E
cps (BandLimitedId -> E
bandLimitedIdToExpr BandLimitedId
n)) Maybe E
mphase
readHardSyncBandLimited :: Maybe BandLimitedId -> Maybe E -> BandLimitedId -> E -> E -> E
readHardSyncBandLimited :: Maybe BandLimitedId -> Maybe E -> BandLimitedId -> E -> E -> E
readHardSyncBandLimited Maybe BandLimitedId
msmoothShape Maybe E
mphase BandLimitedId
n E
slaveCps E
masterCps = E
smoothWave E -> E -> E
forall a. Num a => a -> a -> a
* BandLimitedId -> E -> E -> E
readShape BandLimitedId
n E
phasorSlave E
slaveCps
where
(E
phasorMaster, E
syncMaster) = E -> E -> Maybe E -> (E, E)
syncphasor E
masterCps E
0 Maybe E
forall a. Maybe a
Nothing
(E
phasorSlave, E
_syncSlave) = E -> E -> Maybe E -> (E, E)
syncphasor E
slaveCps E
syncMaster Maybe E
mphase
smoothWave :: E
smoothWave = case Maybe BandLimitedId
msmoothShape of
Maybe BandLimitedId
Nothing -> E
1
Just BandLimitedId
shape -> BandLimitedId -> E -> E -> E
readShape BandLimitedId
shape E
phasorMaster E
masterCps
readShape :: BandLimitedId -> E -> E -> E
readShape BandLimitedId
shapeId E
phasor E
freq = E -> E -> E
tableikt E
phasor (E -> E -> E
vco2ft E
freq (BandLimitedId -> E
bandLimitedIdToExpr BandLimitedId
shapeId))
type Channel = Int
data MidiType = Massign | Pgmassign (Maybe Int)
deriving (Int -> MidiType -> ShowS
[MidiType] -> ShowS
MidiType -> String
(Int -> MidiType -> ShowS)
-> (MidiType -> String) -> ([MidiType] -> ShowS) -> Show MidiType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> MidiType -> ShowS
showsPrec :: Int -> MidiType -> ShowS
$cshow :: MidiType -> String
show :: MidiType -> String
$cshowList :: [MidiType] -> ShowS
showList :: [MidiType] -> ShowS
Show, MidiType -> MidiType -> Bool
(MidiType -> MidiType -> Bool)
-> (MidiType -> MidiType -> Bool) -> Eq MidiType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: MidiType -> MidiType -> Bool
== :: MidiType -> MidiType -> Bool
$c/= :: MidiType -> MidiType -> Bool
/= :: MidiType -> MidiType -> Bool
Eq, Eq MidiType
Eq MidiType =>
(MidiType -> MidiType -> Ordering)
-> (MidiType -> MidiType -> Bool)
-> (MidiType -> MidiType -> Bool)
-> (MidiType -> MidiType -> Bool)
-> (MidiType -> MidiType -> Bool)
-> (MidiType -> MidiType -> MidiType)
-> (MidiType -> MidiType -> MidiType)
-> Ord MidiType
MidiType -> MidiType -> Bool
MidiType -> MidiType -> Ordering
MidiType -> MidiType -> MidiType
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
$ccompare :: MidiType -> MidiType -> Ordering
compare :: MidiType -> MidiType -> Ordering
$c< :: MidiType -> MidiType -> Bool
< :: MidiType -> MidiType -> Bool
$c<= :: MidiType -> MidiType -> Bool
<= :: MidiType -> MidiType -> Bool
$c> :: MidiType -> MidiType -> Bool
> :: MidiType -> MidiType -> Bool
$c>= :: MidiType -> MidiType -> Bool
>= :: MidiType -> MidiType -> Bool
$cmax :: MidiType -> MidiType -> MidiType
max :: MidiType -> MidiType -> MidiType
$cmin :: MidiType -> MidiType -> MidiType
min :: MidiType -> MidiType -> MidiType
Ord)
data MidiKey = MidiKey MidiType Channel
deriving (Int -> MidiKey -> ShowS
[MidiKey] -> ShowS
MidiKey -> String
(Int -> MidiKey -> ShowS)
-> (MidiKey -> String) -> ([MidiKey] -> ShowS) -> Show MidiKey
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> MidiKey -> ShowS
showsPrec :: Int -> MidiKey -> ShowS
$cshow :: MidiKey -> String
show :: MidiKey -> String
$cshowList :: [MidiKey] -> ShowS
showList :: [MidiKey] -> ShowS
Show, MidiKey -> MidiKey -> Bool
(MidiKey -> MidiKey -> Bool)
-> (MidiKey -> MidiKey -> Bool) -> Eq MidiKey
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: MidiKey -> MidiKey -> Bool
== :: MidiKey -> MidiKey -> Bool
$c/= :: MidiKey -> MidiKey -> Bool
/= :: MidiKey -> MidiKey -> Bool
Eq, Eq MidiKey
Eq MidiKey =>
(MidiKey -> MidiKey -> Ordering)
-> (MidiKey -> MidiKey -> Bool)
-> (MidiKey -> MidiKey -> Bool)
-> (MidiKey -> MidiKey -> Bool)
-> (MidiKey -> MidiKey -> Bool)
-> (MidiKey -> MidiKey -> MidiKey)
-> (MidiKey -> MidiKey -> MidiKey)
-> Ord MidiKey
MidiKey -> MidiKey -> Bool
MidiKey -> MidiKey -> Ordering
MidiKey -> MidiKey -> MidiKey
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
$ccompare :: MidiKey -> MidiKey -> Ordering
compare :: MidiKey -> MidiKey -> Ordering
$c< :: MidiKey -> MidiKey -> Bool
< :: MidiKey -> MidiKey -> Bool
$c<= :: MidiKey -> MidiKey -> Bool
<= :: MidiKey -> MidiKey -> Bool
$c> :: MidiKey -> MidiKey -> Bool
> :: MidiKey -> MidiKey -> Bool
$c>= :: MidiKey -> MidiKey -> Bool
>= :: MidiKey -> MidiKey -> Bool
$cmax :: MidiKey -> MidiKey -> MidiKey
max :: MidiKey -> MidiKey -> MidiKey
$cmin :: MidiKey -> MidiKey -> MidiKey
min :: MidiKey -> MidiKey -> MidiKey
Ord)
type MidiMap m = M.Map MidiKey (DepT m ())
saveMidiInstr :: Monad m => MidiType -> Channel -> DepT m () -> MidiMap m -> MidiMap m
saveMidiInstr :: forall (m :: * -> *).
Monad m =>
MidiType -> Int -> DepT m () -> MidiMap m -> MidiMap m
saveMidiInstr MidiType
ty Int
chn DepT m ()
body = (DepT m () -> DepT m () -> DepT m ())
-> MidiKey
-> DepT m ()
-> Map MidiKey (DepT m ())
-> Map MidiKey (DepT m ())
forall k a. Ord k => (a -> a -> a) -> k -> a -> Map k a -> Map k a
M.insertWith ((DepT m () -> DepT m () -> DepT m ())
-> DepT m () -> DepT m () -> DepT m ()
forall a b c. (a -> b -> c) -> b -> a -> c
flip DepT m () -> DepT m () -> DepT m ()
forall a b. DepT m a -> DepT m b -> DepT m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
(>>)) (MidiType -> Int -> MidiKey
MidiKey MidiType
ty Int
chn) DepT m ()
body
data Globals = Globals
{ Globals -> Int
globalsNewId :: Int
, Globals -> [AllocVar]
globalsVars :: [AllocVar] }
data AllocVar = AllocVar
{ AllocVar -> GlobalVarType
_allocVarType :: GlobalVarType
, AllocVar -> Var
_allocVar :: Var
, AllocVar -> E
_allocVarInit :: E }
| AllocArrVar
{ AllocVar -> Var
_allocArrVar :: Var
, AllocVar -> [E]
_allocArrVarSizes :: [E] }
data GlobalVarType = PersistentGlobalVar | ClearableGlobalVar
deriving (GlobalVarType -> GlobalVarType -> Bool
(GlobalVarType -> GlobalVarType -> Bool)
-> (GlobalVarType -> GlobalVarType -> Bool) -> Eq GlobalVarType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: GlobalVarType -> GlobalVarType -> Bool
== :: GlobalVarType -> GlobalVarType -> Bool
$c/= :: GlobalVarType -> GlobalVarType -> Bool
/= :: GlobalVarType -> GlobalVarType -> Bool
Eq)
instance Default Globals where
def :: Globals
def = Int -> [AllocVar] -> Globals
Globals Int
0 [GlobalVarType -> Var -> E -> AllocVar
AllocVar GlobalVarType
PersistentGlobalVar Var
bpmVar E
110]
bpmVar :: Var
bpmVar :: Var
bpmVar = VarType -> Rate -> Text -> Var
Var VarType
GlobalVar Rate
Kr Text
bpmVarName
bpmVarName :: Text
bpmVarName :: Text
bpmVarName = Text
"gBpmVar"
newGlobalVar :: GlobalVarType -> Rate -> E -> State Globals Var
newGlobalVar :: GlobalVarType -> Rate -> E -> State Globals Var
newGlobalVar GlobalVarType
ty Rate
rate E
initVal = (Globals -> (Var, Globals)) -> State Globals Var
forall (m :: * -> *) s a. Monad m => (s -> (a, s)) -> StateT s m a
state ((Globals -> (Var, Globals)) -> State Globals Var)
-> (Globals -> (Var, Globals)) -> State Globals Var
forall a b. (a -> b) -> a -> b
$ \Globals
s ->
let newId :: Int
newId = Globals -> Int
globalsNewId Globals
s
var :: Var
var = VarType -> Rate -> Text -> Var
Var VarType
GlobalVar Rate
rate (Char -> Text -> Text
Text.cons Char
'g' (String -> Text
Text.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ Int -> String
forall a. Show a => a -> String
show Int
newId))
s1 :: Globals
s1 = Globals
s { globalsNewId = succ newId
, globalsVars = AllocVar ty var initVal : globalsVars s }
in (Var
var, Globals
s1)
newPersistentGlobalVar :: Rate -> E -> State Globals Var
newPersistentGlobalVar :: Rate -> E -> State Globals Var
newPersistentGlobalVar = GlobalVarType -> Rate -> E -> State Globals Var
newGlobalVar GlobalVarType
PersistentGlobalVar
newClearableGlobalVar :: Rate -> E -> State Globals Var
newClearableGlobalVar :: Rate -> E -> State Globals Var
newClearableGlobalVar = GlobalVarType -> Rate -> E -> State Globals Var
newGlobalVar GlobalVarType
ClearableGlobalVar
newPersistentGloabalArrVar :: Rate -> [E] -> State Globals Var
newPersistentGloabalArrVar :: Rate -> [E] -> State Globals Var
newPersistentGloabalArrVar Rate
rate [E]
sizes = (Globals -> (Var, Globals)) -> State Globals Var
forall (m :: * -> *) s a. Monad m => (s -> (a, s)) -> StateT s m a
state ((Globals -> (Var, Globals)) -> State Globals Var)
-> (Globals -> (Var, Globals)) -> State Globals Var
forall a b. (a -> b) -> a -> b
$ \Globals
s ->
let newId :: Int
newId = Globals -> Int
globalsNewId Globals
s
var :: Var
var = VarType -> Rate -> Text -> Var
Var VarType
GlobalVar Rate
rate (Char -> Text -> Text
Text.cons Char
'g' (String -> Text
Text.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ Int -> String
forall a. Show a => a -> String
show Int
newId))
s1 :: Globals
s1 = Globals
s { globalsNewId = succ newId
, globalsVars = AllocArrVar var sizes : globalsVars s }
in (Var
var, Globals
s1)
renderGlobals :: Monad m => Globals -> (DepT m (), DepT m ())
renderGlobals :: forall (m :: * -> *). Monad m => Globals -> (DepT m (), DepT m ())
renderGlobals Globals
a = (DepT m ()
initAll, DepT m ()
clear)
where
initAll :: DepT m ()
initAll = (AllocVar -> DepT m ()) -> [AllocVar] -> DepT m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ AllocVar -> DepT m ()
forall {m :: * -> *}. Monad m => AllocVar -> DepT m ()
initAlloc [AllocVar]
gs
clear :: DepT m ()
clear = (AllocVar -> DepT m ()) -> [AllocVar] -> DepT m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ AllocVar -> DepT m ()
forall {m :: * -> *}. Monad m => AllocVar -> DepT m ()
clearAlloc [AllocVar]
clearable
clearable :: [AllocVar]
clearable = (AllocVar -> Bool) -> [AllocVar] -> [AllocVar]
forall a. (a -> Bool) -> [a] -> [a]
filter AllocVar -> Bool
isClearable [AllocVar]
gs
gs :: [AllocVar]
gs = Globals -> [AllocVar]
globalsVars Globals
a
initAlloc :: AllocVar -> DepT m ()
initAlloc AllocVar
x = case AllocVar
x of
AllocVar GlobalVarType
_ Var
var E
initProc -> Var -> E -> DepT m ()
forall (m :: * -> *). Monad m => Var -> E -> DepT m ()
initVar Var
var E
initProc
AllocArrVar Var
var [E]
sizes -> Var -> [E] -> DepT m ()
forall (m :: * -> *). Monad m => Var -> [E] -> DepT m ()
initArr Var
var [E]
sizes
clearAlloc :: AllocVar -> DepT m ()
clearAlloc AllocVar
x = case AllocVar
x of
AllocVar GlobalVarType
_ Var
var E
initProc -> Var -> E -> DepT m ()
forall (m :: * -> *). Monad m => Var -> E -> DepT m ()
writeVar Var
var E
initProc
AllocArrVar Var
_ [E]
_ -> () -> DepT m ()
forall a. a -> DepT m a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
isClearable :: AllocVar -> Bool
isClearable AllocVar
x = case AllocVar
x of
AllocVar GlobalVarType
ty Var
_ E
_ -> GlobalVarType
ty GlobalVarType -> GlobalVarType -> Bool
forall a. Eq a => a -> a -> Bool
== GlobalVarType
ClearableGlobalVar
AllocVar
_ -> Bool
False
data Instrs = Instrs
{ Instrs -> Map ByteString InstrId
instrsCache :: M.Map ByteString InstrId
, Instrs -> Int
instrsNewId :: Int
, Instrs -> [(InstrId, E)]
instrsContent :: [(InstrId, InstrBody)]
}
instance Default Instrs where
def :: Instrs
def = Map ByteString InstrId -> Int -> [(InstrId, E)] -> Instrs
Instrs Map ByteString InstrId
forall k a. Map k a
M.empty Int
18 []
getInstrIds :: Instrs -> [InstrId]
getInstrIds :: Instrs -> [InstrId]
getInstrIds = ((InstrId, E) -> InstrId) -> [(InstrId, E)] -> [InstrId]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (InstrId, E) -> InstrId
forall a b. (a, b) -> a
fst ([(InstrId, E)] -> [InstrId])
-> (Instrs -> [(InstrId, E)]) -> Instrs -> [InstrId]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Instrs -> [(InstrId, E)]
instrsContent
saveInstr :: InstrBody -> State Instrs InstrId
saveInstr :: E -> State Instrs InstrId
saveInstr E
body = (Instrs -> (InstrId, Instrs)) -> State Instrs InstrId
forall (m :: * -> *) s a. Monad m => (s -> (a, s)) -> StateT s m a
state ((Instrs -> (InstrId, Instrs)) -> State Instrs InstrId)
-> (Instrs -> (InstrId, Instrs)) -> State Instrs InstrId
forall a b. (a -> b) -> a -> b
$ \Instrs
s ->
let h :: ByteString
h = E -> ByteString
hashE E
body
in case ByteString -> Map ByteString InstrId -> Maybe InstrId
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup ByteString
h (Map ByteString InstrId -> Maybe InstrId)
-> Map ByteString InstrId -> Maybe InstrId
forall a b. (a -> b) -> a -> b
$ Instrs -> Map ByteString InstrId
instrsCache Instrs
s of
Just InstrId
n -> (InstrId
n, Instrs
s)
Maybe InstrId
Nothing ->
let newId :: Int
newId = Instrs -> Int
instrsNewId Instrs
s
s1 :: Instrs
s1 = Instrs
s { instrsCache = M.insert h (intInstrId newId) $ instrsCache s
, instrsNewId = succ newId
, instrsContent = (intInstrId newId, body) : instrsContent s }
in (Int -> InstrId
intInstrId Int
newId, Instrs
s1)
newtype NamedInstrs = NamedInstrs { NamedInstrs -> [(Text, E)]
unNamedInstrs :: [(Text, InstrBody)] }
instance Default NamedInstrs where
def :: NamedInstrs
def = [(Text, E)] -> NamedInstrs
NamedInstrs []
saveNamedInstr :: Text -> InstrBody -> State NamedInstrs ()
saveNamedInstr :: Text -> E -> State NamedInstrs ()
saveNamedInstr Text
name E
body = (NamedInstrs -> ((), NamedInstrs)) -> State NamedInstrs ()
forall (m :: * -> *) s a. Monad m => (s -> (a, s)) -> StateT s m a
state ((NamedInstrs -> ((), NamedInstrs)) -> State NamedInstrs ())
-> (NamedInstrs -> ((), NamedInstrs)) -> State NamedInstrs ()
forall a b. (a -> b) -> a -> b
$ \(NamedInstrs [(Text, E)]
xs) -> ((), [(Text, E)] -> NamedInstrs
NamedInstrs ([(Text, E)] -> NamedInstrs) -> [(Text, E)] -> NamedInstrs
forall a b. (a -> b) -> a -> b
$ (Text
name, E
body) (Text, E) -> [(Text, E)] -> [(Text, E)]
forall a. a -> [a] -> [a]
: [(Text, E)]
xs)
getIn :: Monad m => Int -> DepT m [E]
getIn :: forall (m :: * -> *). Monad m => Int -> DepT m [E]
getIn Int
arity
| Int
arity Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 = [E] -> DepT m [E]
forall a. a -> DepT m a
forall (m :: * -> *) a. Monad m => a -> m a
return []
| Bool
otherwise = ((Int -> DepT m [E]) -> Int -> DepT m [E]
forall a b. (a -> b) -> a -> b
$ Int
arity ) ((Int -> DepT m [E]) -> DepT m [E])
-> (Int -> DepT m [E]) -> DepT m [E]
forall a b. (a -> b) -> a -> b
$ MultiOut [E] -> Int -> DepT m [E]
forall (m :: * -> *).
Monad m =>
MultiOut [E] -> MultiOut (DepT m [E])
mdepT (MultiOut [E] -> Int -> DepT m [E])
-> MultiOut [E] -> Int -> DepT m [E]
forall a b. (a -> b) -> a -> b
$ Text -> Specs -> [E] -> MultiOut [E]
mopcs Text
"inch" (Int -> Rate -> [Rate]
forall a. Int -> a -> [a]
replicate Int
arity Rate
Ar, Int -> Rate -> [Rate]
forall a. Int -> a -> [a]
replicate Int
arity Rate
Kr) ((Int -> E) -> [Int] -> [E]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Int -> E
int [Int
1 .. Int
arity])
sendOut :: Monad m => Int -> [E] -> DepT m ()
sendOut :: forall (m :: * -> *). Monad m => Int -> [E] -> DepT m ()
sendOut Int
arity [E]
sigs
| Int
arity Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 = () -> DepT m ()
forall a. a -> DepT m a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
| Bool
otherwise = do
[Var]
vars <- [Rate] -> m [E] -> DepT m [Var]
forall (m :: * -> *). Monad m => [Rate] -> m [E] -> DepT m [Var]
newLocalVars (Int -> Rate -> [Rate]
forall a. Int -> a -> [a]
replicate Int
arity Rate
Ar) ([E] -> m [E]
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ([E] -> m [E]) -> [E] -> m [E]
forall a b. (a -> b) -> a -> b
$ Int -> E -> [E]
forall a. Int -> a -> [a]
replicate Int
arity E
0)
(Var -> E -> DepT m ()) -> [Var] -> [E] -> DepT m ()
forall (m :: * -> *) a b c.
Applicative m =>
(a -> b -> m c) -> [a] -> [b] -> m ()
zipWithM_ Var -> E -> DepT m ()
forall (m :: * -> *). Monad m => Var -> E -> DepT m ()
writeVar [Var]
vars [E]
sigs
[E]
vals <- (Var -> DepT m E) -> [Var] -> DepT m [E]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM Var -> DepT m E
forall (m :: * -> *). Monad m => Var -> DepT m E
readVar [Var]
vars
E -> DepT m ()
forall (m :: * -> *). Monad m => E -> DepT m ()
depT_ (E -> DepT m ()) -> E -> DepT m ()
forall a b. (a -> b) -> a -> b
$ Text -> Spec1 -> [E] -> E
opcsNoInlineArgs Text
name [(Rate
Xr, Int -> Rate -> [Rate]
forall a. Int -> a -> [a]
replicate Int
arity Rate
Ar)] [E]
vals
where
name :: Text
name
| Int
arity Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
1 = Text
"out"
| Int
arity Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
2 = Text
"outs"
| Int
arity Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
4 = Text
"outq"
| Int
arity Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
6 = Text
"outh"
| Int
arity Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
8 = Text
"outo"
| Int
arity Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
16 = Text
"outx"
| Int
arity Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
32 = Text
"out32"
| Bool
otherwise = Text
"outc"
sendGlobal :: Monad m => Int -> [E] -> State Globals ([E], DepT m ())
sendGlobal :: forall (m :: * -> *).
Monad m =>
Int -> [E] -> State Globals ([E], DepT m ())
sendGlobal Int
arityOuts [E]
sigs = do
[Var]
vars <- ((Rate, E) -> State Globals Var)
-> [(Rate, E)] -> StateT Globals Identity [Var]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM ((Rate -> E -> State Globals Var) -> (Rate, E) -> State Globals Var
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Rate -> E -> State Globals Var
newClearableGlobalVar) ([(Rate, E)] -> StateT Globals Identity [Var])
-> [(Rate, E)] -> StateT Globals Identity [Var]
forall a b. (a -> b) -> a -> b
$ Int -> (Rate, E) -> [(Rate, E)]
forall a. Int -> a -> [a]
replicate Int
arityOuts (Rate
Ar, E
0)
([E], DepT m ()) -> State Globals ([E], DepT m ())
forall a. a -> StateT Globals Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return ((Var -> E) -> [Var] -> [E]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Var -> E
readOnlyVar [Var]
vars, (Var -> E -> DepT m ()) -> [Var] -> [E] -> DepT m ()
forall (m :: * -> *) a b c.
Applicative m =>
(a -> b -> m c) -> [a] -> [b] -> m ()
zipWithM_ ((E -> E -> E) -> Var -> E -> DepT m ()
forall (m :: * -> *).
Monad m =>
(E -> E -> E) -> Var -> E -> DepT m ()
appendVarBy E -> E -> E
forall a. Num a => a -> a -> a
(+)) [Var]
vars [E]
sigs)
sendChn :: Monad m => Int -> Int -> [E] -> DepT m ()
sendChn :: forall (m :: * -> *). Monad m => Int -> Int -> [E] -> DepT m ()
sendChn Int
arityIns Int
arityOuts [E]
sigs = ChnRef -> [E] -> DepT m ()
forall (m :: * -> *). Monad m => ChnRef -> [E] -> DepT m ()
writeChn (Int -> Int -> ChnRef
chnRefFromParg (Int -> Int
chnPargId Int
arityIns) Int
arityOuts) [E]
sigs
chnPargId :: Int -> Int
chnPargId :: Int -> Int
chnPargId Int
arityIns = Int
4 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
arityIns
newtype OscListenPorts = OscListenPorts (IM.IntMap Var)
instance Default OscListenPorts where
def :: OscListenPorts
def = IntMap Var -> OscListenPorts
OscListenPorts IntMap Var
forall a. IntMap a
IM.empty
getOscPortVar :: Int -> State (OscListenPorts, Globals) Var
getOscPortVar :: Int -> State (OscListenPorts, Globals) Var
getOscPortVar Int
portId = ((OscListenPorts, Globals) -> (Var, (OscListenPorts, Globals)))
-> State (OscListenPorts, Globals) Var
forall (m :: * -> *) s a. Monad m => (s -> (a, s)) -> StateT s m a
state (((OscListenPorts, Globals) -> (Var, (OscListenPorts, Globals)))
-> State (OscListenPorts, Globals) Var)
-> ((OscListenPorts, Globals) -> (Var, (OscListenPorts, Globals)))
-> State (OscListenPorts, Globals) Var
forall a b. (a -> b) -> a -> b
$ \st :: (OscListenPorts, Globals)
st@(OscListenPorts IntMap Var
m, Globals
globals) -> case Int -> IntMap Var -> Maybe Var
forall a. Int -> IntMap a -> Maybe a
IM.lookup Int
portId IntMap Var
m of
Just Var
a -> (Var
a, (OscListenPorts, Globals)
st)
Maybe Var
Nothing -> IntMap Var -> Globals -> (Var, (OscListenPorts, Globals))
onNothing IntMap Var
m Globals
globals
where
onNothing :: IntMap Var -> Globals -> (Var, (OscListenPorts, Globals))
onNothing IntMap Var
m Globals
globals = (Var
var, (IntMap Var -> OscListenPorts
OscListenPorts IntMap Var
m1, Globals
newGlobals))
where
(Var
var, Globals
newGlobals) = State Globals Var -> Globals -> (Var, Globals)
forall s a. State s a -> s -> (a, s)
runState (Int -> State Globals Var
allocOscPortVar Int
portId) Globals
globals
m1 :: IntMap Var
m1 = Int -> Var -> IntMap Var -> IntMap Var
forall a. Int -> a -> IntMap a -> IntMap a
IM.insert Int
portId Var
var IntMap Var
m
allocOscPortVar :: Int -> State Globals Var
allocOscPortVar :: Int -> State Globals Var
allocOscPortVar Int
oscPort = GlobalVarType -> Rate -> E -> State Globals Var
newGlobalVar GlobalVarType
PersistentGlobalVar Rate
Ir (E -> State Globals Var) -> E -> State Globals Var
forall a b. (a -> b) -> a -> b
$ E -> E
oscInit (Int -> E
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
oscPort)
type MacrosInits = M.Map Text MacrosInit
data MacrosInit
= MacrosInitDouble { MacrosInit -> Text
macrosInitName :: Text, MacrosInit -> Double
macrosInitValueDouble :: Double }
| MacrosInitString { macrosInitName :: Text, MacrosInit -> Text
macrosInitValueString :: Text }
| MacrosInitInt { macrosInitName :: Text, MacrosInit -> Int
macrosInitValueInt :: Int }
deriving (Int -> MacrosInit -> ShowS
[MacrosInit] -> ShowS
MacrosInit -> String
(Int -> MacrosInit -> ShowS)
-> (MacrosInit -> String)
-> ([MacrosInit] -> ShowS)
-> Show MacrosInit
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> MacrosInit -> ShowS
showsPrec :: Int -> MacrosInit -> ShowS
$cshow :: MacrosInit -> String
show :: MacrosInit -> String
$cshowList :: [MacrosInit] -> ShowS
showList :: [MacrosInit] -> ShowS
Show, MacrosInit -> MacrosInit -> Bool
(MacrosInit -> MacrosInit -> Bool)
-> (MacrosInit -> MacrosInit -> Bool) -> Eq MacrosInit
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: MacrosInit -> MacrosInit -> Bool
== :: MacrosInit -> MacrosInit -> Bool
$c/= :: MacrosInit -> MacrosInit -> Bool
/= :: MacrosInit -> MacrosInit -> Bool
Eq, Eq MacrosInit
Eq MacrosInit =>
(MacrosInit -> MacrosInit -> Ordering)
-> (MacrosInit -> MacrosInit -> Bool)
-> (MacrosInit -> MacrosInit -> Bool)
-> (MacrosInit -> MacrosInit -> Bool)
-> (MacrosInit -> MacrosInit -> Bool)
-> (MacrosInit -> MacrosInit -> MacrosInit)
-> (MacrosInit -> MacrosInit -> MacrosInit)
-> Ord MacrosInit
MacrosInit -> MacrosInit -> Bool
MacrosInit -> MacrosInit -> Ordering
MacrosInit -> MacrosInit -> MacrosInit
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
$ccompare :: MacrosInit -> MacrosInit -> Ordering
compare :: MacrosInit -> MacrosInit -> Ordering
$c< :: MacrosInit -> MacrosInit -> Bool
< :: MacrosInit -> MacrosInit -> Bool
$c<= :: MacrosInit -> MacrosInit -> Bool
<= :: MacrosInit -> MacrosInit -> Bool
$c> :: MacrosInit -> MacrosInit -> Bool
> :: MacrosInit -> MacrosInit -> Bool
$c>= :: MacrosInit -> MacrosInit -> Bool
>= :: MacrosInit -> MacrosInit -> Bool
$cmax :: MacrosInit -> MacrosInit -> MacrosInit
max :: MacrosInit -> MacrosInit -> MacrosInit
$cmin :: MacrosInit -> MacrosInit -> MacrosInit
min :: MacrosInit -> MacrosInit -> MacrosInit
Ord)
initMacros :: MacrosInit -> State MacrosInits ()
initMacros :: MacrosInit -> State MacrosInits ()
initMacros MacrosInit
macrosInit = (MacrosInits -> MacrosInits) -> State MacrosInits ()
forall (m :: * -> *) s. Monad m => (s -> s) -> StateT s m ()
modify ((MacrosInits -> MacrosInits) -> State MacrosInits ())
-> (MacrosInits -> MacrosInits) -> State MacrosInits ()
forall a b. (a -> b) -> a -> b
$ \MacrosInits
xs -> Text -> MacrosInit -> MacrosInits -> MacrosInits
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert (MacrosInit -> Text
macrosInitName MacrosInit
macrosInit) MacrosInit
macrosInit MacrosInits
xs
newtype UdoPlugin = UdoPlugin { UdoPlugin -> Text
unUdoPlugin :: Text }
addUdoPlugin :: UdoPlugin -> State [UdoPlugin] ()
addUdoPlugin :: UdoPlugin -> State [UdoPlugin] ()
addUdoPlugin UdoPlugin
a = ([UdoPlugin] -> [UdoPlugin]) -> State [UdoPlugin] ()
forall (m :: * -> *) s. Monad m => (s -> s) -> StateT s m ()
modify (UdoPlugin
a UdoPlugin -> [UdoPlugin] -> [UdoPlugin]
forall a. a -> [a] -> [a]
:)
getUdoPluginNames :: [UdoPlugin] -> [Text]
getUdoPluginNames :: [UdoPlugin] -> [Text]
getUdoPluginNames [UdoPlugin]
xs = [Text] -> [Text]
forall a. Eq a => [a] -> [a]
nub ((UdoPlugin -> Text) -> [UdoPlugin] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap UdoPlugin -> Text
unUdoPlugin [UdoPlugin]
xs)
tabQueuePlugin :: UdoPlugin
tabQueuePlugin = Text -> UdoPlugin
UdoPlugin Text
"tabQueue"
tabQueue2Plugin :: UdoPlugin
tabQueue2Plugin = Text -> UdoPlugin
UdoPlugin Text
"tabQueue2"
zdfPlugin, solinaChorusPlugin, audaciouseqPlugin, adsr140Plugin, diodePlugin, korg35Plugin,
zeroDelayConvolutionPlugin, analogDelayPlugin, distortionPlugin, envelopeFolollowerPlugin,
flangerPlugin, freqShifterPlugin, loFiPlugin, panTremPlugin, monoTremPlugin, phaserPlugin,
pitchShifterPlugin, pitchShifterDelayPlugin, reversePlugin, ringModulatorPlugin, stChorusPlugin,
stereoPingPongDelayPlugin, tapeEchoPlugin, delay1kPlugin,
ambiRowPlugin, ambiRowMp3Plugin, liveRowPlugin, liveRowsPlugin, tabQueuePlugin, tabQueue2Plugin :: UdoPlugin
zdfPlugin :: UdoPlugin
zdfPlugin = Text -> UdoPlugin
UdoPlugin Text
"zdf"
solinaChorusPlugin :: UdoPlugin
solinaChorusPlugin = Text -> UdoPlugin
UdoPlugin Text
"solina_chorus"
audaciouseqPlugin :: UdoPlugin
audaciouseqPlugin = Text -> UdoPlugin
UdoPlugin Text
"audaciouseq"
adsr140Plugin :: UdoPlugin
adsr140Plugin = Text -> UdoPlugin
UdoPlugin Text
"adsr140"
diodePlugin :: UdoPlugin
diodePlugin = Text -> UdoPlugin
UdoPlugin Text
"diode"
korg35Plugin :: UdoPlugin
korg35Plugin = Text -> UdoPlugin
UdoPlugin Text
"korg35"
zeroDelayConvolutionPlugin :: UdoPlugin
zeroDelayConvolutionPlugin = Text -> UdoPlugin
UdoPlugin Text
"zero-delay-convolution"
pitchShifterDelayPlugin :: UdoPlugin
pitchShifterDelayPlugin = Text -> UdoPlugin
UdoPlugin Text
"PitchShifterDelay"
analogDelayPlugin :: UdoPlugin
analogDelayPlugin = Text -> UdoPlugin
UdoPlugin Text
"MultiFX/AnalogDelay"
distortionPlugin :: UdoPlugin
distortionPlugin = Text -> UdoPlugin
UdoPlugin Text
"MultiFX/Distortion"
envelopeFolollowerPlugin :: UdoPlugin
envelopeFolollowerPlugin = Text -> UdoPlugin
UdoPlugin Text
"MultiFX/EnvelopeFollower"
flangerPlugin :: UdoPlugin
flangerPlugin = Text -> UdoPlugin
UdoPlugin Text
"MultiFX/Flanger"
freqShifterPlugin :: UdoPlugin
freqShifterPlugin = Text -> UdoPlugin
UdoPlugin Text
"MultiFX/FreqShifter"
loFiPlugin :: UdoPlugin
loFiPlugin = Text -> UdoPlugin
UdoPlugin Text
"MultiFX/LoFi"
panTremPlugin :: UdoPlugin
panTremPlugin = Text -> UdoPlugin
UdoPlugin Text
"MultiFX/PanTrem"
monoTremPlugin :: UdoPlugin
monoTremPlugin = Text -> UdoPlugin
UdoPlugin Text
"MultiFX/MonoTrem"
phaserPlugin :: UdoPlugin
phaserPlugin = Text -> UdoPlugin
UdoPlugin Text
"MultiFX/Phaser"
pitchShifterPlugin :: UdoPlugin
pitchShifterPlugin = Text -> UdoPlugin
UdoPlugin Text
"MultiFX/PitchShifter"
reversePlugin :: UdoPlugin
reversePlugin = Text -> UdoPlugin
UdoPlugin Text
"MultiFX/Reverse"
ringModulatorPlugin :: UdoPlugin
ringModulatorPlugin = Text -> UdoPlugin
UdoPlugin Text
"MultiFX/RingModulator"
stChorusPlugin :: UdoPlugin
stChorusPlugin = Text -> UdoPlugin
UdoPlugin Text
"MultiFX/StChorus"
stereoPingPongDelayPlugin :: UdoPlugin
stereoPingPongDelayPlugin = Text -> UdoPlugin
UdoPlugin Text
"MultiFX/StereoPingPongDelay"
tapeEchoPlugin :: UdoPlugin
tapeEchoPlugin = Text -> UdoPlugin
UdoPlugin Text
"MultiFX/TapeEcho"
delay1kPlugin :: UdoPlugin
delay1kPlugin = Text -> UdoPlugin
UdoPlugin Text
"Utility/Delay1k"
liveRowPlugin :: UdoPlugin
liveRowPlugin = Text -> UdoPlugin
UdoPlugin Text
"LiveRow"
liveRowsPlugin :: UdoPlugin
liveRowsPlugin = Text -> UdoPlugin
UdoPlugin Text
"LiveRows"
ambiRowPlugin :: UdoPlugin
ambiRowPlugin = Text -> UdoPlugin
UdoPlugin Text
"AmbiRow"
ambiRowMp3Plugin :: UdoPlugin
ambiRowMp3Plugin = Text -> UdoPlugin
UdoPlugin Text
"AmbiRowMp3"