{-# Language DeriveFunctor #-}
module Csound.Typed.GlobalState.Elements(
    -- * Identifiers
    IdMap(..), saveId, newIdMapId,
    -- ** Gens
    GenMap, newGen, newGenId, nextGlobalGenCounter, newTabOfGens,
    WriteGenMap, newWriteGen, newWriteTab,
    -- Sf2
    SfFluid(..), SfSpec(..), SfMap, newSf, sfVar, renderSf,
    -- ** Band-limited waveforms
    BandLimited(..), BandLimitedMap(..), BandLimitedId(..),
    saveBandLimited, renderBandLimited,
    readBandLimited, readHardSyncBandLimited,

    -- ** String arguments
    StringMap, newString,
    -- * Midi
    MidiType(..), Channel, MidiMap, MidiKey(..), saveMidiInstr,
    -- * Global variables
    Globals(..), newPersistentGlobalVar, newClearableGlobalVar,
    newPersistentGloabalArrVar,
    renderGlobals, bpmVarName, bpmVar,
    -- * Instruments
    Instrs(..), saveInstr, getInstrIds, -- newInstrId, saveInstrById, saveInstr, CacheName, makeCacheName, saveCachedInstr, getInstrIds,
    -- * Named instruments
    NamedInstrs(..), saveNamedInstr,
    -- * Src
    InstrBody, getIn, sendOut, sendChn, sendGlobal, chnPargId,
    Event(..),
    ChnRef(..), chnRefFromParg, chnRefAlloc, readChn, writeChn, chnUpdateUdo,
    subinstr, subinstr_, event_i, event, safeOut, autoOff, changed,
    -- * OSC listen ports
    OscListenPorts, getOscPortVar,
    -- * Macros inits
    MacrosInits, MacrosInit(..), initMacros,
    -- * Udo plugins
    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

-- tables of identifiers

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)

-- gens

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)

-- writeable gens

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

-- strings

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

-- gen counter

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)

-- sf

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

-- band-limited waveforms (used with vco2init)

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))

----------------------------------------------------------
-- Midi

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

-- global variables

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

-----------------------------------------------------------------
-- instrs

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)

-----------------------------------------------------------------
-- named instrs

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)

-----------------------------------------------------------------
-- sound sources

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

-- scaleVolumeFactor :: E -> E
-- scaleVolumeFactor = (setRate Ir (C.midiVolumeFactor (pn 1)) * )

-- guis

--------------------------------------------------------
-- Osc listeners

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)

----------------------------------------------------------
-- macros arguments

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

--------------------------------------------------------
-- Udo plugins

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)

-- tabQueue

tabQueuePlugin :: UdoPlugin
tabQueuePlugin  = Text -> UdoPlugin
UdoPlugin Text
"tabQueue"
tabQueue2Plugin :: UdoPlugin
tabQueue2Plugin = Text -> UdoPlugin
UdoPlugin Text
"tabQueue2"

----------------------------------------------------------
-- Steven Yi wonderful UDOs

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"               -- Zero delay filters
solinaChorusPlugin :: UdoPlugin
solinaChorusPlugin  = Text -> UdoPlugin
UdoPlugin Text
"solina_chorus"     -- solina chorus
audaciouseqPlugin :: UdoPlugin
audaciouseqPlugin   = Text -> UdoPlugin
UdoPlugin Text
"audaciouseq"       -- audacious 10 band EQ
adsr140Plugin :: UdoPlugin
adsr140Plugin       = Text -> UdoPlugin
UdoPlugin Text
"adsr140"           -- adsr with retriggering
diodePlugin :: UdoPlugin
diodePlugin         = Text -> UdoPlugin
UdoPlugin Text
"diode"             -- diode ladder filter
korg35Plugin :: UdoPlugin
korg35Plugin        = Text -> UdoPlugin
UdoPlugin Text
"korg35"            -- korg 35 filter
zeroDelayConvolutionPlugin :: UdoPlugin
zeroDelayConvolutionPlugin = Text -> UdoPlugin
UdoPlugin Text
"zero-delay-convolution"  -- zero delay convolutio by Victor Lazzarini
pitchShifterDelayPlugin :: UdoPlugin
pitchShifterDelayPlugin = Text -> UdoPlugin
UdoPlugin Text
"PitchShifterDelay" -- pitch shifter delay

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"    -- live like trigger, mono
liveRowsPlugin :: UdoPlugin
liveRowsPlugin = Text -> UdoPlugin
UdoPlugin Text
"LiveRows"  --                    stereo

ambiRowPlugin :: UdoPlugin
ambiRowPlugin = Text -> UdoPlugin
UdoPlugin Text
"AmbiRow"        -- ambi trigger, wav
ambiRowMp3Plugin :: UdoPlugin
ambiRowMp3Plugin = Text -> UdoPlugin
UdoPlugin Text
"AmbiRowMp3"  --               mp3