{-# 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.Hashable

import Control.Monad.Trans.State.Strict
import Control.Monad(zipWithM_)
import Data.Default
import qualified Data.Map 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

-- tables of identifiers

data IdMap a = IdMap
    { IdMap a -> Map a Int
idMapContent :: M.Map a Int
    , 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
/= :: IdMap a -> IdMap a -> Bool
$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
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
min :: IdMap a -> IdMap a -> IdMap a
$cmin :: forall a. Ord a => IdMap a -> IdMap a -> IdMap a
max :: IdMap a -> IdMap a -> IdMap a
$cmax :: forall a. Ord a => IdMap a -> IdMap a -> IdMap a
>= :: 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
$c< :: forall a. Ord a => IdMap a -> IdMap a -> Bool
compare :: IdMap a -> IdMap a -> Ordering
$ccompare :: forall a. Ord a => IdMap a -> IdMap a -> Ordering
$cp1Ord :: forall a. Ord a => Eq (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 :: a -> State (IdMap a) Int
saveId a
a = (IdMap a -> (Int, IdMap a)) -> State (IdMap a) Int
forall (m :: * -> *) s a. Monad m => (s -> (a, s)) -> StateT s m a
state ((IdMap a -> (Int, IdMap a)) -> State (IdMap a) Int)
-> (IdMap a -> (Int, IdMap a)) -> State (IdMap a) 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 :: Map a Int
idMapContent = a -> Int -> Map a Int -> Map a Int
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert a
a Int
newId (IdMap a -> Map a Int
forall a. IdMap a -> Map a Int
idMapContent IdMap a
s)
                         , idMapNewId :: Int
idMapNewId = Int -> Int
forall a. Enum a => a -> a
succ Int
newId }
            in  (Int
newId, IdMap a
s1)
        Just Int
n  -> (Int
n, IdMap a
s)

newIdMapId :: State (IdMap a) Int
newIdMapId :: State (IdMap a) Int
newIdMapId = (IdMap a -> (Int, IdMap a)) -> State (IdMap a) Int
forall (m :: * -> *) s a. Monad m => (s -> (a, s)) -> StateT s m a
state ((IdMap a -> (Int, IdMap a)) -> State (IdMap a) Int)
-> (IdMap a -> (Int, IdMap a)) -> State (IdMap a) 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 :: Int
idMapNewId = Int -> Int
forall a. Enum a => a -> a
succ Int
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)
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 String -> Gen
Gen (Int -> Int
nextPowOfTwo (Int -> Int) -> Int -> Int
forall a b. (a -> b) -> a -> b
$ [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
ns) (Int -> GenId
IntGenId (-Int
2)) ((a -> Double) -> [a] -> [Double]
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 String
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 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 :: a -> State (IdMap a) Int
saveGenId a
a = (IdMap a -> (Int, IdMap a)) -> State (IdMap a) Int
forall (m :: * -> *) s a. Monad m => (s -> (a, s)) -> StateT s m a
state ((IdMap a -> (Int, IdMap a)) -> State (IdMap a) Int)
-> (IdMap a -> (Int, IdMap a)) -> State (IdMap a) 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 :: Map a Int
idMapContent = a -> Int -> Map a Int -> Map a Int
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert a
a Int
newId (IdMap a -> Map a Int
forall a. IdMap a -> Map a Int
idMapContent IdMap a
s)
                         , idMapNewId :: Int
idMapNewId = Int -> Int
nextReadOnlyTableId Int
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 :: Int
idMapNewId = Int -> Int
nextReadOnlyTableId Int
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 (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 String -> Gen
Gen Int
n (Int -> GenId
IntGenId Int
2) (Int -> Double -> [Double]
forall a. Int -> a -> [a]
replicate Int
n Double
0) Maybe String
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 String

newString :: String -> State StringMap Prim
newString :: String -> State StringMap Prim
newString = (Int -> Prim)
-> StateT StringMap Identity Int -> State StringMap Prim
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Int -> Prim
PrimInt (StateT StringMap Identity Int -> State StringMap Prim)
-> (String -> StateT StringMap Identity Int)
-> String
-> State StringMap Prim
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> 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 -> String
sfName    :: String
    , 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
/= :: SfSpec -> SfSpec -> Bool
$c/= :: SfSpec -> SfSpec -> Bool
== :: SfSpec -> SfSpec -> Bool
$c== :: 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
min :: SfSpec -> SfSpec -> SfSpec
$cmin :: SfSpec -> SfSpec -> SfSpec
max :: SfSpec -> SfSpec -> SfSpec
$cmax :: SfSpec -> SfSpec -> SfSpec
>= :: SfSpec -> SfSpec -> Bool
$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
compare :: SfSpec -> SfSpec -> Ordering
$ccompare :: SfSpec -> SfSpec -> Ordering
$cp1Ord :: Eq 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
showList :: [SfSpec] -> ShowS
$cshowList :: [SfSpec] -> ShowS
show :: SfSpec -> String
$cshow :: SfSpec -> String
showsPrec :: Int -> SfSpec -> ShowS
$cshowsPrec :: Int -> 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 -> String -> Var
VarVerbatim Rate
Ir (String -> Var) -> String -> Var
forall a b. (a -> b) -> a -> b
$ Int -> String
sfEngineName Int
n)

sfEngineName :: Int -> String
sfEngineName :: Int -> String
sfEngineName Int
n = String
"gi_Sf_engine_" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
n

sfInstrName :: Int -> String
sfInstrName :: Int -> String
sfInstrName Int
n = String
"i_Sf_instr_" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
n

renderSf :: Monad m => SfSpec -> Int -> DepT m ()
renderSf :: SfSpec -> Int -> DepT m ()
renderSf (SfSpec String
name Int
bank Int
prog) Int
n = String -> DepT m ()
forall (m :: * -> *). Monad m => String -> DepT m ()
verbatim (String -> DepT m ()) -> String -> DepT m ()
forall a b. (a -> b) -> a -> b
$
    String
engineStr String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"\n" String -> ShowS
forall a. [a] -> [a] -> [a]
++
    String
loadStr   String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"\n" String -> ShowS
forall a. [a] -> [a] -> [a]
++
    String
selectProgStr String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"\n"
    where
        engineStr :: String
engineStr = String
engineName String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" fluidEngine"
        loadStr :: String
loadStr   = String
insName String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" fluidLoad \"" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
name String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"\", " String -> ShowS
forall a. [a] -> [a] -> [a]
++  String
engineName String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
", 1"
        selectProgStr :: String
selectProgStr = String
"fluidProgramSelect " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
engineName String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
", 1, " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
insName
            String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
", " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
bank String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
", " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
prog

        engineName :: String
engineName = Int -> String
sfEngineName Int
n
        insName :: String
insName    = Int -> String
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
/= :: BandLimited -> BandLimited -> Bool
$c/= :: BandLimited -> BandLimited -> Bool
== :: BandLimited -> BandLimited -> Bool
$c== :: 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
min :: BandLimited -> BandLimited -> BandLimited
$cmin :: BandLimited -> BandLimited -> BandLimited
max :: BandLimited -> BandLimited -> BandLimited
$cmax :: BandLimited -> BandLimited -> BandLimited
>= :: BandLimited -> BandLimited -> Bool
$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
compare :: BandLimited -> BandLimited -> Ordering
$ccompare :: BandLimited -> BandLimited -> Ordering
$cp1Ord :: Eq 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
/= :: BandLimitedId -> BandLimitedId -> Bool
$c/= :: BandLimitedId -> BandLimitedId -> Bool
== :: BandLimitedId -> BandLimitedId -> Bool
$c== :: 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
min :: BandLimitedId -> BandLimitedId -> BandLimitedId
$cmin :: BandLimitedId -> BandLimitedId -> BandLimitedId
max :: BandLimitedId -> BandLimitedId -> BandLimitedId
$cmax :: BandLimitedId -> BandLimitedId -> BandLimitedId
>= :: BandLimitedId -> BandLimitedId -> Bool
$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
compare :: BandLimitedId -> BandLimitedId -> Ordering
$ccompare :: BandLimitedId -> BandLimitedId -> Ordering
$cp1Ord :: Eq 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 :: a -> Var
bandLimitedVar a
userId = VarType -> Rate -> String -> Var
Var VarType
GlobalVar Rate
Ir (String
"BandLim" String -> ShowS
forall a. [a] -> [a] -> [a]
++ 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
/= :: BandLimitedMap -> BandLimitedMap -> Bool
$c/= :: BandLimitedMap -> BandLimitedMap -> Bool
== :: BandLimitedMap -> BandLimitedMap -> Bool
$c== :: 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
min :: BandLimitedMap -> BandLimitedMap -> BandLimitedMap
$cmin :: BandLimitedMap -> BandLimitedMap -> BandLimitedMap
max :: BandLimitedMap -> BandLimitedMap -> BandLimitedMap
$cmax :: BandLimitedMap -> BandLimitedMap -> BandLimitedMap
>= :: BandLimitedMap -> BandLimitedMap -> Bool
$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
compare :: BandLimitedMap -> BandLimitedMap -> Ordering
$ccompare :: BandLimitedMap -> BandLimitedMap -> Ordering
$cp1Ord :: Eq 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 :: Map BandLimited BandLimitedId
simpleBandLimitedMap = BandLimited
-> BandLimitedId
-> Map BandLimited BandLimitedId
-> Map BandLimited BandLimitedId
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert BandLimited
x (Int -> BandLimitedId
SimpleBandLimitedWave Int
writeId) (BandLimitedMap -> Map BandLimited BandLimitedId
simpleBandLimitedMap BandLimitedMap
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 :: GenMap
vcoInitMap = GenMap
genMap1 }
            in  (Int -> BandLimitedId
UserBandLimitedWave Int
newId, BandLimitedMap
blMap1)


renderBandLimited :: Monad m => GenMap -> BandLimitedMap -> DepT m ()
renderBandLimited :: GenMap -> BandLimitedMap -> DepT m ()
renderBandLimited GenMap
genMap BandLimitedMap
blMap =
    if BandLimitedMap -> Bool
isEmptyBlMap BandLimitedMap
blMap
        then () -> DepT m ()
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 (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 :: 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 -> String -> Var
Var VarType
GlobalVar Rate
Ir String
"free_vco"
        ftVar :: a -> Var
ftVar a
n = VarType -> Rate -> String -> Var
Var VarType
GlobalVar Rate
Ir (String -> Var) -> String -> Var
forall a b. (a -> b) -> a -> b
$ String
"vco_table_" String -> ShowS
forall a. [a] -> [a] -> [a]
++ 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 (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 :: (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 (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
showList :: [MidiType] -> ShowS
$cshowList :: [MidiType] -> ShowS
show :: MidiType -> String
$cshow :: MidiType -> String
showsPrec :: Int -> MidiType -> ShowS
$cshowsPrec :: Int -> MidiType -> ShowS
Show, MidiType -> MidiType -> Bool
(MidiType -> MidiType -> Bool)
-> (MidiType -> MidiType -> Bool) -> Eq MidiType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: MidiType -> MidiType -> Bool
$c/= :: MidiType -> MidiType -> Bool
== :: MidiType -> MidiType -> Bool
$c== :: 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
min :: MidiType -> MidiType -> MidiType
$cmin :: MidiType -> MidiType -> MidiType
max :: MidiType -> MidiType -> MidiType
$cmax :: MidiType -> MidiType -> MidiType
>= :: MidiType -> MidiType -> Bool
$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
compare :: MidiType -> MidiType -> Ordering
$ccompare :: MidiType -> MidiType -> Ordering
$cp1Ord :: Eq 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
showList :: [MidiKey] -> ShowS
$cshowList :: [MidiKey] -> ShowS
show :: MidiKey -> String
$cshow :: MidiKey -> String
showsPrec :: Int -> MidiKey -> ShowS
$cshowsPrec :: Int -> MidiKey -> ShowS
Show, MidiKey -> MidiKey -> Bool
(MidiKey -> MidiKey -> Bool)
-> (MidiKey -> MidiKey -> Bool) -> Eq MidiKey
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: MidiKey -> MidiKey -> Bool
$c/= :: MidiKey -> MidiKey -> Bool
== :: MidiKey -> MidiKey -> Bool
$c== :: 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
min :: MidiKey -> MidiKey -> MidiKey
$cmin :: MidiKey -> MidiKey -> MidiKey
max :: MidiKey -> MidiKey -> MidiKey
$cmax :: MidiKey -> MidiKey -> MidiKey
>= :: MidiKey -> MidiKey -> Bool
$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
compare :: MidiKey -> MidiKey -> Ordering
$ccompare :: MidiKey -> MidiKey -> Ordering
$cp1Ord :: Eq MidiKey
Ord)

type MidiMap m = M.Map MidiKey (DepT m ())

saveMidiInstr :: Monad m => MidiType -> Channel -> DepT m () -> MidiMap m -> MidiMap m
saveMidiInstr :: 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 () -> MidiMap m -> MidiMap 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 (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
/= :: GlobalVarType -> GlobalVarType -> Bool
$c/= :: GlobalVarType -> GlobalVarType -> Bool
== :: GlobalVarType -> GlobalVarType -> Bool
$c== :: 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 -> String -> Var
Var VarType
GlobalVar Rate
Kr String
bpmVarName

bpmVarName :: String
bpmVarName :: String
bpmVarName = String
"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 -> String -> Var
Var VarType
GlobalVar Rate
rate (Char
'g' Char -> ShowS
forall a. a -> [a] -> [a]
: Int -> String
forall a. Show a => a -> String
show Int
newId)
        s1 :: Globals
s1    = Globals
s { globalsNewId :: Int
globalsNewId = Int -> Int
forall a. Enum a => a -> a
succ Int
newId
                  , globalsVars :: [AllocVar]
globalsVars  = GlobalVarType -> Var -> E -> AllocVar
AllocVar GlobalVarType
ty Var
var E
initVal AllocVar -> [AllocVar] -> [AllocVar]
forall a. a -> [a] -> [a]
: Globals -> [AllocVar]
globalsVars Globals
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 -> String -> Var
Var VarType
GlobalVar Rate
rate (Char
'g' Char -> ShowS
forall a. a -> [a] -> [a]
: Int -> String
forall a. Show a => a -> String
show Int
newId)
        s1 :: Globals
s1    = Globals
s { globalsNewId :: Int
globalsNewId = Int -> Int
forall a. Enum a => a -> a
succ Int
newId
                  , globalsVars :: [AllocVar]
globalsVars  = Var -> [E] -> AllocVar
AllocArrVar Var
var [E]
sizes AllocVar -> [AllocVar] -> [AllocVar]
forall a. a -> [a] -> [a]
: Globals -> [AllocVar]
globalsVars Globals
s }
    in (Var
var, Globals
s1)

renderGlobals :: Monad m => Globals -> (DepT m (), DepT m ())
renderGlobals :: 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 (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 -> IntMap InstrId
instrsCache   :: IM.IntMap InstrId
    , Instrs -> Int
instrsNewId   :: Int
    , Instrs -> [(InstrId, E)]
instrsContent :: [(InstrId, InstrBody)]
    }

instance Default Instrs where
    def :: Instrs
def = IntMap InstrId -> Int -> [(InstrId, E)] -> Instrs
Instrs IntMap InstrId
forall a. IntMap a
IM.empty Int
18 []

getInstrIds :: Instrs -> [InstrId]
getInstrIds :: Instrs -> [InstrId]
getInstrIds = ((InstrId, E) -> InstrId) -> [(InstrId, E)] -> [InstrId]
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 :: Int
h = E -> Int
forall a. Hashable a => a -> Int
hash E
body
    in  case Int -> IntMap InstrId -> Maybe InstrId
forall a. Int -> IntMap a -> Maybe a
IM.lookup Int
h (IntMap InstrId -> Maybe InstrId)
-> IntMap InstrId -> Maybe InstrId
forall a b. (a -> b) -> a -> b
$ Instrs -> IntMap 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 :: IntMap InstrId
instrsCache   = Int -> InstrId -> IntMap InstrId -> IntMap InstrId
forall a. Int -> a -> IntMap a -> IntMap a
IM.insert Int
h (Int -> InstrId
intInstrId Int
newId) (IntMap InstrId -> IntMap InstrId)
-> IntMap InstrId -> IntMap InstrId
forall a b. (a -> b) -> a -> b
$ Instrs -> IntMap InstrId
instrsCache Instrs
s
                              , instrsNewId :: Int
instrsNewId   = Int -> Int
forall a. Enum a => a -> a
succ Int
newId
                              , instrsContent :: [(InstrId, E)]
instrsContent = (Int -> InstrId
intInstrId Int
newId, E
body) (InstrId, E) -> [(InstrId, E)] -> [(InstrId, E)]
forall a. a -> [a] -> [a]
: Instrs -> [(InstrId, E)]
instrsContent Instrs
s }
                in  (Int -> InstrId
intInstrId Int
newId, Instrs
s1)

{-
saveCachedInstr :: InstrBody -> State Instrs InstrId
saveCachedInstr name body = state $ \s ->
    case IM.lookup name $ instrsCache s of
        Just n  -> (n, s)
        Nothing ->
            let newId   = instrsNewId s
                s1      = s { instrsCache   = IM.insert name (intInstrId newId) $ instrsCache s
                            , instrsNewId   = succ newId
                            , instrsContent = (intInstrId newId, body) : instrsContent s }
            in  (intInstrId newId, s1)

newInstrId :: State Instrs InstrId
newInstrId = state $ \s ->
    let newId   = instrsNewId s
        s1      = s { instrsNewId = succ newId }
    in  (intInstrId newId, s1)

saveInstrById :: InstrId -> InstrBody -> State Instrs ()
saveInstrById instrId body = state $ \s ->
    let s1 = s { instrsContent = (instrId, body) : instrsContent s }
    in  ((), s1)

saveInstr :: InstrBody -> State Instrs InstrId
saveInstr body = do
    newId <- newInstrId
    saveInstrById newId body
    return newId
-}

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

newtype NamedInstrs = NamedInstrs { NamedInstrs -> [(String, E)]
unNamedInstrs :: [(String, InstrBody)] }

instance Default NamedInstrs where
    def :: NamedInstrs
def = [(String, E)] -> NamedInstrs
NamedInstrs []

saveNamedInstr :: String -> InstrBody -> State NamedInstrs ()
saveNamedInstr :: String -> E -> State NamedInstrs ()
saveNamedInstr String
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 [(String, E)]
xs) -> ((), [(String, E)] -> NamedInstrs
NamedInstrs ([(String, E)] -> NamedInstrs) -> [(String, E)] -> NamedInstrs
forall a b. (a -> b) -> a -> b
$ (String
name, E
body) (String, E) -> [(String, E)] -> [(String, E)]
forall a. a -> [a] -> [a]
: [(String, E)]
xs)

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

getIn :: Monad m => Int -> DepT m [E]
getIn :: 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 (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
$ String -> Specs -> [E] -> MultiOut [E]
mopcs String
"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 (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 :: 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 (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 (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)
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
$ String -> Spec1 -> [E] -> E
opcsNoInlineArgs String
name [(Rate
Xr, Int -> Rate -> [Rate]
forall a. Int -> a -> [a]
replicate Int
arity Rate
Ar)] [E]
vals
    where
        name :: String
name
            | Int
arity Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
1 = String
"out"
            | Int
arity Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
2 = String
"outs"
            | Int
arity Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
4 = String
"outq"
            | Int
arity Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
6 = String
"outh"
            | Int
arity Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
8 = String
"outo"
            | Int
arity Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
16 = String
"outx"
            | Int
arity Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
32 = String
"out32"
            | Bool
otherwise = String
"outc"

sendGlobal :: Monad m => Int -> [E] -> State Globals ([E], DepT m ())
sendGlobal :: 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)
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 (m :: * -> *) a. Monad m => a -> m a
return ((Var -> E) -> [Var] -> [E]
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 :: 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 String MacrosInit

data MacrosInit
    = MacrosInitDouble { MacrosInit -> String
macrosInitName :: String, MacrosInit -> Double
macrosInitValueDouble :: Double }
    | MacrosInitString { macrosInitName :: String, MacrosInit -> String
macrosInitValueString :: String }
    | MacrosInitInt    { macrosInitName :: String, 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
showList :: [MacrosInit] -> ShowS
$cshowList :: [MacrosInit] -> ShowS
show :: MacrosInit -> String
$cshow :: MacrosInit -> String
showsPrec :: Int -> MacrosInit -> ShowS
$cshowsPrec :: Int -> MacrosInit -> ShowS
Show, MacrosInit -> MacrosInit -> Bool
(MacrosInit -> MacrosInit -> Bool)
-> (MacrosInit -> MacrosInit -> Bool) -> Eq MacrosInit
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: MacrosInit -> MacrosInit -> Bool
$c/= :: MacrosInit -> MacrosInit -> Bool
== :: MacrosInit -> MacrosInit -> Bool
$c== :: 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
min :: MacrosInit -> MacrosInit -> MacrosInit
$cmin :: MacrosInit -> MacrosInit -> MacrosInit
max :: MacrosInit -> MacrosInit -> MacrosInit
$cmax :: MacrosInit -> MacrosInit -> MacrosInit
>= :: MacrosInit -> MacrosInit -> Bool
$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
compare :: MacrosInit -> MacrosInit -> Ordering
$ccompare :: MacrosInit -> MacrosInit -> Ordering
$cp1Ord :: Eq 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 -> String -> MacrosInit -> MacrosInits -> MacrosInits
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert (MacrosInit -> String
macrosInitName MacrosInit
macrosInit)  MacrosInit
macrosInit MacrosInits
xs

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

newtype UdoPlugin  = UdoPlugin { UdoPlugin -> String
unUdoPlugin :: String }

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] -> [String]
getUdoPluginNames :: [UdoPlugin] -> [String]
getUdoPluginNames [UdoPlugin]
xs = [String] -> [String]
forall a. Eq a => [a] -> [a]
nub ((UdoPlugin -> String) -> [UdoPlugin] -> [String]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap UdoPlugin -> String
unUdoPlugin [UdoPlugin]
xs)

-- tabQueue

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

analogDelayPlugin :: UdoPlugin
analogDelayPlugin = String -> UdoPlugin
UdoPlugin String
"MultiFX/AnalogDelay"
distortionPlugin :: UdoPlugin
distortionPlugin = String -> UdoPlugin
UdoPlugin String
"MultiFX/Distortion"
envelopeFolollowerPlugin :: UdoPlugin
envelopeFolollowerPlugin = String -> UdoPlugin
UdoPlugin String
"MultiFX/EnvelopeFollower"
flangerPlugin :: UdoPlugin
flangerPlugin = String -> UdoPlugin
UdoPlugin String
"MultiFX/Flanger"
freqShifterPlugin :: UdoPlugin
freqShifterPlugin = String -> UdoPlugin
UdoPlugin String
"MultiFX/FreqShifter"
loFiPlugin :: UdoPlugin
loFiPlugin = String -> UdoPlugin
UdoPlugin String
"MultiFX/LoFi"
panTremPlugin :: UdoPlugin
panTremPlugin = String -> UdoPlugin
UdoPlugin String
"MultiFX/PanTrem"
monoTremPlugin :: UdoPlugin
monoTremPlugin = String -> UdoPlugin
UdoPlugin String
"MultiFX/MonoTrem"
phaserPlugin :: UdoPlugin
phaserPlugin = String -> UdoPlugin
UdoPlugin String
"MultiFX/Phaser"
pitchShifterPlugin :: UdoPlugin
pitchShifterPlugin = String -> UdoPlugin
UdoPlugin String
"MultiFX/PitchShifter"
reversePlugin :: UdoPlugin
reversePlugin = String -> UdoPlugin
UdoPlugin String
"MultiFX/Reverse"
ringModulatorPlugin :: UdoPlugin
ringModulatorPlugin = String -> UdoPlugin
UdoPlugin String
"MultiFX/RingModulator"
stChorusPlugin :: UdoPlugin
stChorusPlugin = String -> UdoPlugin
UdoPlugin String
"MultiFX/StChorus"
stereoPingPongDelayPlugin :: UdoPlugin
stereoPingPongDelayPlugin = String -> UdoPlugin
UdoPlugin String
"MultiFX/StereoPingPongDelay"

tapeEchoPlugin :: UdoPlugin
tapeEchoPlugin = String -> UdoPlugin
UdoPlugin String
"MultiFX/TapeEcho"

delay1kPlugin :: UdoPlugin
delay1kPlugin = String -> UdoPlugin
UdoPlugin String
"Utility/Delay1k"

liveRowPlugin :: UdoPlugin
liveRowPlugin = String -> UdoPlugin
UdoPlugin String
"LiveRow"    -- live like trigger, mono
liveRowsPlugin :: UdoPlugin
liveRowsPlugin = String -> UdoPlugin
UdoPlugin String
"LiveRows"  --                    stereo

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