{-# Language TupleSections #-}
module Csound.Typed.GlobalState.GE(
    GE, Dep, History(..), withOptions, withHistory, getOptions, evalGE, execGE,
    getHistory, putHistory,
    -- * Globals
    onGlobals, bpmVar,
    -- * Midi
    MidiAssign(..), Msg(..), renderMidiAssign, saveMidi, saveToMidiInstr,
    MidiCtrl(..), saveMidiCtrl, renderMidiCtrl,
    -- * Instruments
    saveAlwaysOnInstr, onInstr, saveUserInstr0, getSysExpr,
    -- * Named instruments
    saveNamedInstr,
    -- * Total duration
    TotalDur(..), pureGetTotalDurForF0, getTotalDurForTerminator,
    setDurationForce, setDuration, setDurationToInfinite,
    -- * Notes
    addNote,
    -- * GEN routines
    GenId,
    saveGen, saveTabs, getNextGlobalGenId,
    saveWriteGen, saveWriteTab,
    -- * Sf2
    saveSf, sfTable,
    -- * Band-limited waves
    saveBandLimitedWave,
    -- * Strings
    saveStr,
    -- * Cache
    GetCache, SetCache, withCache,
    -- * Guis
    newGuiHandle, saveGuiRoot, saveDefKeybdPanel, appendToGui,
    newGuiVar, getPanels, guiHandleToVar,
    guiInstrExp,
    listenKeyEvt, Key(..), KeyEvt(..), Guis(..),
    getKeyEventListener,
    -- * OSC
    getOscPortHandle,
    -- * Macros
    MacrosInit(..), readMacrosDouble, readMacrosString, readMacrosInt,
    -- * Cabbage Guis
    cabbage,
    -- * Hrtf pan
    simpleHrtfmove, simpleHrtfstat,
    -- * Udo plugins
    addUdoPlugin, renderUdoPlugins
) where

import Paths_csound_expression_typed

import Control.Applicative
import Control.Monad
import Data.Boolean
import Data.Default
import qualified Data.IntMap as IM
import qualified Data.Map    as M

import Control.Monad.IO.Class
import Control.Monad.Trans.Class
import Control.Monad.Trans.State.Strict
import Control.Monad.Trans.Reader

import Csound.Dynamic hiding (readMacrosDouble, readMacrosString, readMacrosInt)
import qualified Csound.Dynamic as D(readMacrosDouble, readMacrosString, readMacrosInt)

import Csound.Typed.GlobalState.Options
import Csound.Typed.GlobalState.Cache
import Csound.Typed.GlobalState.Elements hiding(saveNamedInstr, addUdoPlugin)
import Csound.Typed.Constants(infiniteDur)
import Csound.Typed.GlobalState.Opcodes(hrtfmove, hrtfstat, primInstrId)

import Csound.Typed.Gui.Gui(Panel(..), Win(..), GuiNode, GuiHandle(..), restoreTree, guiMap, mapGuiOnPanel, defText)
import qualified Csound.Typed.Gui.Cabbage.CabbageLang as Cabbage
import qualified Csound.Typed.Gui.Cabbage.Cabbage     as Cabbage

import qualified Csound.Typed.GlobalState.Elements as E(saveNamedInstr, addUdoPlugin)

type Dep a = DepT GE a

-- global side effects
newtype GE a = GE { GE a -> ReaderT Options (StateT History IO) a
unGE :: ReaderT Options (StateT History IO) a }

runGE :: GE a -> Options -> History -> IO (a, History)
runGE :: GE a -> Options -> History -> IO (a, History)
runGE (GE ReaderT Options (StateT History IO) a
f) Options
opt History
hist = StateT History IO a -> History -> IO (a, History)
forall s (m :: * -> *) a. StateT s m a -> s -> m (a, s)
runStateT (ReaderT Options (StateT History IO) a
-> Options -> StateT History IO a
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT ReaderT Options (StateT History IO) a
f Options
opt) History
hist

evalGE :: Options -> GE a -> IO a
evalGE :: Options -> GE a -> IO a
evalGE Options
options GE a
a = ((a, History) -> a) -> IO (a, History) -> IO a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (a, History) -> a
forall a b. (a, b) -> a
fst (IO (a, History) -> IO a) -> IO (a, History) -> IO a
forall a b. (a -> b) -> a -> b
$ GE a -> Options -> History -> IO (a, History)
forall a. GE a -> Options -> History -> IO (a, History)
runGE GE a
a Options
options History
forall a. Default a => a
def

execGE :: Options -> GE a -> IO History
execGE :: Options -> GE a -> IO History
execGE Options
options GE a
a = ((a, History) -> History) -> IO (a, History) -> IO History
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (a, History) -> History
forall a b. (a, b) -> b
snd (IO (a, History) -> IO History) -> IO (a, History) -> IO History
forall a b. (a -> b) -> a -> b
$ GE a -> Options -> History -> IO (a, History)
forall a. GE a -> Options -> History -> IO (a, History)
runGE GE a
a Options
options History
forall a. Default a => a
def

instance Functor GE where
    fmap :: (a -> b) -> GE a -> GE b
fmap a -> b
f = ReaderT Options (StateT History IO) b -> GE b
forall a. ReaderT Options (StateT History IO) a -> GE a
GE (ReaderT Options (StateT History IO) b -> GE b)
-> (GE a -> ReaderT Options (StateT History IO) b) -> GE a -> GE b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> b)
-> ReaderT Options (StateT History IO) a
-> ReaderT Options (StateT History IO) b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f (ReaderT Options (StateT History IO) a
 -> ReaderT Options (StateT History IO) b)
-> (GE a -> ReaderT Options (StateT History IO) a)
-> GE a
-> ReaderT Options (StateT History IO) b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GE a -> ReaderT Options (StateT History IO) a
forall a. GE a -> ReaderT Options (StateT History IO) a
unGE

instance Applicative GE where
    pure :: a -> GE a
pure = a -> GE a
forall (m :: * -> *) a. Monad m => a -> m a
return
    <*> :: GE (a -> b) -> GE a -> GE b
(<*>) = GE (a -> b) -> GE a -> GE b
forall (m :: * -> *) a b. Monad m => m (a -> b) -> m a -> m b
ap

instance Monad GE where
    return :: a -> GE a
return = ReaderT Options (StateT History IO) a -> GE a
forall a. ReaderT Options (StateT History IO) a -> GE a
GE (ReaderT Options (StateT History IO) a -> GE a)
-> (a -> ReaderT Options (StateT History IO) a) -> a -> GE a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> ReaderT Options (StateT History IO) a
forall (m :: * -> *) a. Monad m => a -> m a
return
    GE a
ma >>= :: GE a -> (a -> GE b) -> GE b
>>= a -> GE b
mf = ReaderT Options (StateT History IO) b -> GE b
forall a. ReaderT Options (StateT History IO) a -> GE a
GE (ReaderT Options (StateT History IO) b -> GE b)
-> ReaderT Options (StateT History IO) b -> GE b
forall a b. (a -> b) -> a -> b
$ GE a -> ReaderT Options (StateT History IO) a
forall a. GE a -> ReaderT Options (StateT History IO) a
unGE GE a
ma ReaderT Options (StateT History IO) a
-> (a -> ReaderT Options (StateT History IO) b)
-> ReaderT Options (StateT History IO) b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= GE b -> ReaderT Options (StateT History IO) b
forall a. GE a -> ReaderT Options (StateT History IO) a
unGE (GE b -> ReaderT Options (StateT History IO) b)
-> (a -> GE b) -> a -> ReaderT Options (StateT History IO) b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> GE b
mf

instance MonadIO GE where
    liftIO :: IO a -> GE a
liftIO = ReaderT Options (StateT History IO) a -> GE a
forall a. ReaderT Options (StateT History IO) a -> GE a
GE (ReaderT Options (StateT History IO) a -> GE a)
-> (IO a -> ReaderT Options (StateT History IO) a) -> IO a -> GE a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IO a -> ReaderT Options (StateT History IO) a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO a -> ReaderT Options (StateT History IO) a)
-> (IO a -> IO a) -> IO a -> ReaderT Options (StateT History IO) a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IO a -> IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO

data History = History
    { History -> GenMap
genMap            :: GenMap
    , History -> WriteGenMap
writeGenMap       :: WriteGenMap
    , History -> Int
globalGenCounter  :: Int
    , History -> StringMap
stringMap         :: StringMap
    , History -> SfMap
sfMap             :: SfMap
    , History -> MidiMap GE
midiMap           :: MidiMap GE
    , History -> Globals
globals           :: Globals
    , History -> Instrs
instrs            :: Instrs
    , History -> [UdoPlugin]
udoPlugins        :: [UdoPlugin]
    , History -> NamedInstrs
namedInstrs       :: NamedInstrs
    , History -> [MidiAssign]
midis             :: [MidiAssign]
    , History -> [MidiCtrl]
midiCtrls         :: [MidiCtrl]
    , History -> Maybe TotalDur
totalDur          :: Maybe TotalDur
    , History -> [InstrId]
alwaysOnInstrs    :: [InstrId]
    , History -> [(InstrId, CsdEvent)]
notes             :: [(InstrId, CsdEvent)]
    , History -> Dep ()
userInstr0        :: Dep ()
    , History -> BandLimitedMap
bandLimitedMap    :: BandLimitedMap
    , History -> Cache GE
cache             :: Cache GE
    , History -> Guis
guis              :: Guis
    , History -> OscListenPorts
oscListenPorts    :: OscListenPorts
    , History -> Maybe Lang
cabbageGui        :: Maybe Cabbage.Lang
    , History -> MacrosInits
macrosInits       :: MacrosInits }

instance Default History where
    def :: History
def = GenMap
-> WriteGenMap
-> Int
-> StringMap
-> SfMap
-> MidiMap GE
-> Globals
-> Instrs
-> [UdoPlugin]
-> NamedInstrs
-> [MidiAssign]
-> [MidiCtrl]
-> Maybe TotalDur
-> [InstrId]
-> [(InstrId, CsdEvent)]
-> Dep ()
-> BandLimitedMap
-> Cache GE
-> Guis
-> OscListenPorts
-> Maybe Lang
-> MacrosInits
-> History
History GenMap
forall a. Default a => a
def WriteGenMap
forall a. Default a => a
def Int
forall a. Default a => a
def StringMap
forall a. Default a => a
def SfMap
forall a. Default a => a
def MidiMap GE
forall a. Default a => a
def Globals
forall a. Default a => a
def Instrs
forall a. Default a => a
def [UdoPlugin]
forall a. Default a => a
def NamedInstrs
forall a. Default a => a
def [MidiAssign]
forall a. Default a => a
def [MidiCtrl]
forall a. Default a => a
def Maybe TotalDur
forall a. Default a => a
def [InstrId]
forall a. Default a => a
def [(InstrId, CsdEvent)]
forall a. Default a => a
def (() -> Dep ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()) BandLimitedMap
forall a. Default a => a
def Cache GE
forall a. Default a => a
def Guis
forall a. Default a => a
def OscListenPorts
forall a. Default a => a
def Maybe Lang
forall a. Default a => a
def MacrosInits
forall a. Default a => a
def

data Msg = Msg
data MidiAssign = MidiAssign MidiType Channel InstrId
data MidiCtrl   = MidiCtrl E E E

renderMidiAssign :: Monad m => MidiAssign -> DepT m ()
renderMidiAssign :: MidiAssign -> DepT m ()
renderMidiAssign (MidiAssign MidiType
ty Int
chn InstrId
instrId) = case MidiType
ty of
    MidiType
Massign         -> Int -> InstrId -> DepT m ()
forall (m :: * -> *). Monad m => Int -> InstrId -> DepT m ()
massign Int
chn InstrId
instrId
    Pgmassign Maybe Int
mn    -> Int -> InstrId -> Maybe Int -> DepT m ()
forall (m :: * -> *).
Monad m =>
Int -> InstrId -> Maybe Int -> DepT m ()
pgmassign Int
chn InstrId
instrId Maybe Int
mn
    where
        massign :: Int -> InstrId -> DepT m ()
massign Int
n InstrId
instr = E -> DepT m ()
forall (m :: * -> *). Monad m => E -> DepT m ()
depT_ (E -> DepT m ()) -> E -> DepT m ()
forall a b. (a -> b) -> a -> b
$ Name -> Spec1 -> [E] -> E
opcs Name
"massign" [(Rate
Xr, [Rate
Ir,Rate
Ir])] [Int -> E
int Int
n, Prim -> E
prim (Prim -> E) -> Prim -> E
forall a b. (a -> b) -> a -> b
$ InstrId -> Prim
PrimInstrId InstrId
instr]
        pgmassign :: Int -> InstrId -> Maybe Int -> DepT m ()
pgmassign Int
pgm InstrId
instr Maybe Int
mchn = E -> DepT m ()
forall (m :: * -> *). Monad m => E -> DepT m ()
depT_ (E -> DepT m ()) -> E -> DepT m ()
forall a b. (a -> b) -> a -> b
$ Name -> Spec1 -> [E] -> E
opcs Name
"pgmassign" [(Rate
Xr, [Rate
Ir,Rate
Ir,Rate
Ir])] ([Int -> E
int Int
pgm, Prim -> E
prim (Prim -> E) -> Prim -> E
forall a b. (a -> b) -> a -> b
$ InstrId -> Prim
PrimInstrId InstrId
instr] [E] -> [E] -> [E]
forall a. [a] -> [a] -> [a]
++ [E] -> (Int -> [E]) -> Maybe Int -> [E]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] (E -> [E]
forall (m :: * -> *) a. Monad m => a -> m a
return (E -> [E]) -> (Int -> E) -> Int -> [E]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> E
int) Maybe Int
mchn)

renderMidiCtrl :: Monad m => MidiCtrl -> DepT m ()
renderMidiCtrl :: MidiCtrl -> DepT m ()
renderMidiCtrl (MidiCtrl E
chno E
ctrlno E
val) = E -> E -> E -> DepT m ()
forall (m :: * -> *). Monad m => E -> E -> E -> DepT m ()
initc7 E
chno E
ctrlno E
val
    where
        initc7 :: Monad m => E -> E -> E -> DepT m ()
        initc7 :: E -> E -> E -> DepT m ()
initc7 E
a E
b E
c = E -> DepT m ()
forall (m :: * -> *). Monad m => E -> DepT m ()
depT_ (E -> DepT m ()) -> E -> DepT m ()
forall a b. (a -> b) -> a -> b
$ Name -> Spec1 -> [E] -> E
opcs Name
"initc7" [(Rate
Xr, [Rate
Ir, Rate
Ir, Rate
Ir])] [E
a, E
b, E
c]

data TotalDur = ExpDur E | InfiniteDur

getTotalDurForTerminator :: GE E
getTotalDurForTerminator :: GE E
getTotalDurForTerminator = (History -> E) -> GE History -> GE E
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Maybe TotalDur -> E
getTotalDurForTerminator' (Maybe TotalDur -> E)
-> (History -> Maybe TotalDur) -> History -> E
forall b c a. (b -> c) -> (a -> b) -> a -> c
. History -> Maybe TotalDur
totalDur) GE History
getHistory

pureGetTotalDurForF0 :: Maybe TotalDur -> Double
pureGetTotalDurForF0 :: Maybe TotalDur -> Double
pureGetTotalDurForF0 = TotalDur -> Double
forall a p. Num a => p -> a
toDouble (TotalDur -> Double)
-> (Maybe TotalDur -> TotalDur) -> Maybe TotalDur -> Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TotalDur -> (TotalDur -> TotalDur) -> Maybe TotalDur -> TotalDur
forall b a. b -> (a -> b) -> Maybe a -> b
maybe TotalDur
InfiniteDur TotalDur -> TotalDur
forall a. a -> a
id
    where
        toDouble :: p -> a
toDouble p
x = case p
x of
            p
_           -> a
forall a. Num a => a
infiniteDur

getTotalDurForTerminator' :: Maybe TotalDur -> E
getTotalDurForTerminator' :: Maybe TotalDur -> E
getTotalDurForTerminator' = TotalDur -> E
toExpr (TotalDur -> E)
-> (Maybe TotalDur -> TotalDur) -> Maybe TotalDur -> E
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TotalDur -> (TotalDur -> TotalDur) -> Maybe TotalDur -> TotalDur
forall b a. b -> (a -> b) -> Maybe a -> b
maybe TotalDur
InfiniteDur TotalDur -> TotalDur
forall a. a -> a
id
    where
        toExpr :: TotalDur -> E
toExpr TotalDur
x = case TotalDur
x of
            TotalDur
InfiniteDur -> E
forall a. Num a => a
infiniteDur
            ExpDur E
e    -> E
e

setDurationToInfinite :: GE ()
setDurationToInfinite :: GE ()
setDurationToInfinite = TotalDur -> GE ()
setTotalDur TotalDur
InfiniteDur

setDuration :: E -> GE ()
setDuration :: E -> GE ()
setDuration = TotalDur -> GE ()
setTotalDur (TotalDur -> GE ()) -> (E -> TotalDur) -> E -> GE ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. E -> TotalDur
ExpDur

setDurationForce :: E -> GE ()
setDurationForce :: E -> GE ()
setDurationForce = TotalDur -> GE ()
setTotalDur (TotalDur -> GE ()) -> (E -> TotalDur) -> E -> GE ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. E -> TotalDur
ExpDur

saveStr :: String -> GE E
saveStr :: Name -> GE E
saveStr = (Prim -> E) -> GE Prim -> GE E
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Prim -> E
prim (GE Prim -> GE E) -> (Name -> GE Prim) -> Name -> GE E
forall b c a. (b -> c) -> (a -> b) -> a -> c
. State StringMap Prim -> GE Prim
forall b. State StringMap b -> GE b
onStringMap (State StringMap Prim -> GE Prim)
-> (Name -> State StringMap Prim) -> Name -> GE Prim
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Name -> State StringMap Prim
newString
    where onStringMap :: State StringMap b -> GE b
onStringMap = (History -> StringMap)
-> (StringMap -> History -> History) -> State StringMap b -> GE b
forall a b.
(History -> a) -> (a -> History -> History) -> State a b -> GE b
onHistory History -> StringMap
stringMap (\StringMap
val History
h -> History
h{ stringMap :: StringMap
stringMap = StringMap
val })

getNextGlobalGenId :: GE Int
getNextGlobalGenId :: GE Int
getNextGlobalGenId = (History -> Int)
-> (Int -> History -> History) -> State Int Int -> GE Int
forall a b.
(History -> a) -> (a -> History -> History) -> State a b -> GE b
onHistory History -> Int
globalGenCounter (\Int
a History
h -> History
h{ globalGenCounter :: Int
globalGenCounter = Int
a }) State Int Int
nextGlobalGenCounter

saveGen :: Gen -> GE Int
saveGen :: Gen -> GE Int
saveGen = State GenMap Int -> GE Int
forall a. State GenMap a -> GE a
onGenMap (State GenMap Int -> GE Int)
-> (Gen -> State GenMap Int) -> Gen -> GE Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Gen -> State GenMap Int
newGen

onGenMap :: State GenMap a -> GE a
onGenMap :: State GenMap a -> GE a
onGenMap = (History -> GenMap)
-> (GenMap -> History -> History) -> State GenMap a -> GE a
forall a b.
(History -> a) -> (a -> History -> History) -> State a b -> GE b
onHistory History -> GenMap
genMap (\GenMap
val History
h -> History
h{ genMap :: GenMap
genMap = GenMap
val })

saveWriteGen :: Gen -> GE E
saveWriteGen :: Gen -> GE E
saveWriteGen = State WriteGenMap E -> GE E
forall a. State WriteGenMap a -> GE a
onWriteGenMap (State WriteGenMap E -> GE E)
-> (Gen -> State WriteGenMap E) -> Gen -> GE E
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Gen -> State WriteGenMap E
newWriteGen

saveWriteTab :: Int -> GE E
saveWriteTab :: Int -> GE E
saveWriteTab = State WriteGenMap E -> GE E
forall a. State WriteGenMap a -> GE a
onWriteGenMap (State WriteGenMap E -> GE E)
-> (Int -> State WriteGenMap E) -> Int -> GE E
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> State WriteGenMap E
newWriteTab

onWriteGenMap :: State WriteGenMap a -> GE a
onWriteGenMap :: State WriteGenMap a -> GE a
onWriteGenMap = (History -> WriteGenMap)
-> (WriteGenMap -> History -> History)
-> State WriteGenMap a
-> GE a
forall a b.
(History -> a) -> (a -> History -> History) -> State a b -> GE b
onHistory History -> WriteGenMap
writeGenMap (\WriteGenMap
val History
h -> History
h{ writeGenMap :: WriteGenMap
writeGenMap = WriteGenMap
val })

saveTabs :: [Gen] -> GE E
saveTabs :: [Gen] -> GE E
saveTabs = State GenMap E -> GE E
forall a. State GenMap a -> GE a
onGenMap (State GenMap E -> GE E)
-> ([Gen] -> State GenMap E) -> [Gen] -> GE E
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> E) -> State GenMap Int -> State GenMap E
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Int -> E
int (State GenMap Int -> State GenMap E)
-> ([Gen] -> State GenMap Int) -> [Gen] -> State GenMap E
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Gen] -> State GenMap Int
newTabOfGens

onSfMap :: State SfMap a -> GE a
onSfMap :: State SfMap a -> GE a
onSfMap = (History -> SfMap)
-> (SfMap -> History -> History) -> State SfMap a -> GE a
forall a b.
(History -> a) -> (a -> History -> History) -> State a b -> GE b
onHistory History -> SfMap
sfMap (\SfMap
val History
h -> History
h{ sfMap :: SfMap
sfMap = SfMap
val })

saveSf :: SfSpec -> GE Int
saveSf :: SfSpec -> GE Int
saveSf = State SfMap Int -> GE Int
forall a. State SfMap a -> GE a
onSfMap (State SfMap Int -> GE Int)
-> (SfSpec -> State SfMap Int) -> SfSpec -> GE Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SfSpec -> State SfMap Int
newSf

sfTable :: History -> [(SfSpec, Int)]
sfTable :: History -> [(SfSpec, Int)]
sfTable = Map SfSpec Int -> [(SfSpec, Int)]
forall k a. Map k a -> [(k, a)]
M.toList (Map SfSpec Int -> [(SfSpec, Int)])
-> (History -> Map SfSpec Int) -> History -> [(SfSpec, Int)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SfMap -> Map SfSpec Int
forall a. IdMap a -> Map a Int
idMapContent (SfMap -> Map SfSpec Int)
-> (History -> SfMap) -> History -> Map SfSpec Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. History -> SfMap
sfMap

saveBandLimitedWave :: BandLimited -> GE BandLimitedId
saveBandLimitedWave :: BandLimited -> GE BandLimitedId
saveBandLimitedWave = State BandLimitedMap BandLimitedId -> GE BandLimitedId
forall b. State BandLimitedMap b -> GE b
onBandLimitedMap (State BandLimitedMap BandLimitedId -> GE BandLimitedId)
-> (BandLimited -> State BandLimitedMap BandLimitedId)
-> BandLimited
-> GE BandLimitedId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BandLimited -> State BandLimitedMap BandLimitedId
saveBandLimited
    where onBandLimitedMap :: State BandLimitedMap b -> GE b
onBandLimitedMap = (History -> BandLimitedMap)
-> (BandLimitedMap -> History -> History)
-> State BandLimitedMap b
-> GE b
forall a b.
(History -> a) -> (a -> History -> History) -> State a b -> GE b
onHistory
                (\History
a -> (History -> BandLimitedMap
bandLimitedMap History
a))
                (\(BandLimitedMap
blm) History
h -> History
h { bandLimitedMap :: BandLimitedMap
bandLimitedMap = BandLimitedMap
blm})

setTotalDur :: TotalDur -> GE ()
setTotalDur :: TotalDur -> GE ()
setTotalDur = State (Maybe TotalDur) () -> GE ()
forall b. State (Maybe TotalDur) b -> GE b
onTotalDur (State (Maybe TotalDur) () -> GE ())
-> (TotalDur -> State (Maybe TotalDur) ()) -> TotalDur -> GE ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Maybe TotalDur -> Maybe TotalDur) -> State (Maybe TotalDur) ()
forall (m :: * -> *) s. Monad m => (s -> s) -> StateT s m ()
modify ((Maybe TotalDur -> Maybe TotalDur) -> State (Maybe TotalDur) ())
-> (TotalDur -> Maybe TotalDur -> Maybe TotalDur)
-> TotalDur
-> State (Maybe TotalDur) ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe TotalDur -> Maybe TotalDur -> Maybe TotalDur
forall a b. a -> b -> a
const (Maybe TotalDur -> Maybe TotalDur -> Maybe TotalDur)
-> (TotalDur -> Maybe TotalDur)
-> TotalDur
-> Maybe TotalDur
-> Maybe TotalDur
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TotalDur -> Maybe TotalDur
forall a. a -> Maybe a
Just
    where onTotalDur :: State (Maybe TotalDur) b -> GE b
onTotalDur = (History -> Maybe TotalDur)
-> (Maybe TotalDur -> History -> History)
-> State (Maybe TotalDur) b
-> GE b
forall a b.
(History -> a) -> (a -> History -> History) -> State a b -> GE b
onHistory History -> Maybe TotalDur
totalDur (\Maybe TotalDur
a History
h -> History
h { totalDur :: Maybe TotalDur
totalDur = Maybe TotalDur
a })

saveMidi :: MidiAssign -> GE ()
saveMidi :: MidiAssign -> GE ()
saveMidi MidiAssign
ma = State [MidiAssign] () -> GE ()
forall b. State [MidiAssign] b -> GE b
onMidis (State [MidiAssign] () -> GE ()) -> State [MidiAssign] () -> GE ()
forall a b. (a -> b) -> a -> b
$ ([MidiAssign] -> [MidiAssign]) -> State [MidiAssign] ()
forall (m :: * -> *) s. Monad m => (s -> s) -> StateT s m ()
modify (MidiAssign
maMidiAssign -> [MidiAssign] -> [MidiAssign]
forall a. a -> [a] -> [a]
: )
    where onMidis :: State [MidiAssign] b -> GE b
onMidis = (History -> [MidiAssign])
-> ([MidiAssign] -> History -> History)
-> State [MidiAssign] b
-> GE b
forall a b.
(History -> a) -> (a -> History -> History) -> State a b -> GE b
onHistory History -> [MidiAssign]
midis (\[MidiAssign]
a History
h -> History
h { midis :: [MidiAssign]
midis = [MidiAssign]
a })

saveToMidiInstr :: MidiType -> Channel -> Dep () -> GE ()
saveToMidiInstr :: MidiType -> Int -> Dep () -> GE ()
saveToMidiInstr MidiType
ty Int
chn Dep ()
expr = (MidiMap GE -> MidiMap GE) -> GE ()
onMidiMap (MidiType -> Int -> Dep () -> MidiMap GE -> MidiMap GE
forall (m :: * -> *).
Monad m =>
MidiType -> Int -> DepT m () -> MidiMap m -> MidiMap m
saveMidiInstr MidiType
ty Int
chn Dep ()
expr)
    where onMidiMap :: (MidiMap GE -> MidiMap GE) -> GE ()
onMidiMap = (History -> MidiMap GE)
-> (MidiMap GE -> History -> History)
-> (MidiMap GE -> MidiMap GE)
-> GE ()
forall a.
(History -> a) -> (a -> History -> History) -> (a -> a) -> GE ()
modifyHistoryField History -> MidiMap GE
midiMap (\MidiMap GE
a History
h -> History
h { midiMap :: MidiMap GE
midiMap = MidiMap GE
a })

saveMidiCtrl :: MidiCtrl -> GE ()
saveMidiCtrl :: MidiCtrl -> GE ()
saveMidiCtrl MidiCtrl
ma = State [MidiCtrl] () -> GE ()
forall b. State [MidiCtrl] b -> GE b
onMidis (State [MidiCtrl] () -> GE ()) -> State [MidiCtrl] () -> GE ()
forall a b. (a -> b) -> a -> b
$ ([MidiCtrl] -> [MidiCtrl]) -> State [MidiCtrl] ()
forall (m :: * -> *) s. Monad m => (s -> s) -> StateT s m ()
modify (MidiCtrl
maMidiCtrl -> [MidiCtrl] -> [MidiCtrl]
forall a. a -> [a] -> [a]
: )
    where onMidis :: State [MidiCtrl] b -> GE b
onMidis = (History -> [MidiCtrl])
-> ([MidiCtrl] -> History -> History) -> State [MidiCtrl] b -> GE b
forall a b.
(History -> a) -> (a -> History -> History) -> State a b -> GE b
onHistory History -> [MidiCtrl]
midiCtrls (\[MidiCtrl]
a History
h -> History
h { midiCtrls :: [MidiCtrl]
midiCtrls = [MidiCtrl]
a })

saveUserInstr0 :: Dep () -> GE ()
saveUserInstr0 :: Dep () -> GE ()
saveUserInstr0 Dep ()
expr = State (Dep ()) () -> GE ()
forall b. State (Dep ()) b -> GE b
onUserInstr0 (State (Dep ()) () -> GE ()) -> State (Dep ()) () -> GE ()
forall a b. (a -> b) -> a -> b
$ (Dep () -> Dep ()) -> State (Dep ()) ()
forall (m :: * -> *) s. Monad m => (s -> s) -> StateT s m ()
modify ( Dep () -> Dep () -> Dep ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Dep ()
expr)
    where onUserInstr0 :: State (Dep ()) b -> GE b
onUserInstr0 = (History -> Dep ())
-> (Dep () -> History -> History) -> State (Dep ()) b -> GE b
forall a b.
(History -> a) -> (a -> History -> History) -> State a b -> GE b
onHistory History -> Dep ()
userInstr0 (\Dep ()
a History
h -> History
h { userInstr0 :: Dep ()
userInstr0 = Dep ()
a })

getSysExpr :: InstrId -> GE (Dep ())
getSysExpr :: InstrId -> GE (Dep ())
getSysExpr InstrId
terminatorInstrId = do
    Dep ()
e1 <- (History -> Dep ()) -> GE (Dep ())
forall a. (History -> a) -> GE a
withHistory ((History -> Dep ()) -> GE (Dep ()))
-> (History -> Dep ()) -> GE (Dep ())
forall a b. (a -> b) -> a -> b
$ Globals -> Dep ()
clearGlobals (Globals -> Dep ()) -> (History -> Globals) -> History -> Dep ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. History -> Globals
globals
    E
dt <- GE E
getTotalDurForTerminator
    let e2 :: Dep ()
e2 = Event -> Dep ()
forall (m :: * -> *). Monad m => Event -> DepT m ()
event_i (Event -> Dep ()) -> Event -> Dep ()
forall a b. (a -> b) -> a -> b
$ E -> E -> E -> [E] -> Event
Event (InstrId -> E
primInstrId InstrId
terminatorInstrId) E
dt E
0.01 []
    Dep () -> GE (Dep ())
forall (m :: * -> *) a. Monad m => a -> m a
return (Dep () -> GE (Dep ())) -> Dep () -> GE (Dep ())
forall a b. (a -> b) -> a -> b
$ Dep ()
e1 Dep () -> Dep () -> Dep ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Dep ()
e2
    where clearGlobals :: Globals -> Dep ()
clearGlobals = (Dep (), Dep ()) -> Dep ()
forall a b. (a, b) -> b
snd ((Dep (), Dep ()) -> Dep ())
-> (Globals -> (Dep (), Dep ())) -> Globals -> Dep ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Globals -> (Dep (), Dep ())
forall (m :: * -> *). Monad m => Globals -> (DepT m (), DepT m ())
renderGlobals

saveAlwaysOnInstr :: InstrId -> GE ()
saveAlwaysOnInstr :: InstrId -> GE ()
saveAlwaysOnInstr InstrId
instrId = State [InstrId] () -> GE ()
forall b. State [InstrId] b -> GE b
onAlwaysOnInstrs (State [InstrId] () -> GE ()) -> State [InstrId] () -> GE ()
forall a b. (a -> b) -> a -> b
$ ([InstrId] -> [InstrId]) -> State [InstrId] ()
forall (m :: * -> *) s. Monad m => (s -> s) -> StateT s m ()
modify (InstrId
instrId InstrId -> [InstrId] -> [InstrId]
forall a. a -> [a] -> [a]
: )
    where onAlwaysOnInstrs :: State [InstrId] b -> GE b
onAlwaysOnInstrs = (History -> [InstrId])
-> ([InstrId] -> History -> History) -> State [InstrId] b -> GE b
forall a b.
(History -> a) -> (a -> History -> History) -> State a b -> GE b
onHistory History -> [InstrId]
alwaysOnInstrs (\[InstrId]
a History
h -> History
h { alwaysOnInstrs :: [InstrId]
alwaysOnInstrs = [InstrId]
a })

addNote :: InstrId -> CsdEvent -> GE ()
addNote :: InstrId -> CsdEvent -> GE ()
addNote InstrId
instrId CsdEvent
evt = (History -> History) -> GE ()
modifyHistory ((History -> History) -> GE ()) -> (History -> History) -> GE ()
forall a b. (a -> b) -> a -> b
$ \History
h -> History
h { notes :: [(InstrId, CsdEvent)]
notes = (InstrId
instrId, CsdEvent
evt) (InstrId, CsdEvent)
-> [(InstrId, CsdEvent)] -> [(InstrId, CsdEvent)]
forall a. a -> [a] -> [a]
: History -> [(InstrId, CsdEvent)]
notes History
h }

{-
setMasterInstrId :: InstrId -> GE ()
setMasterInstrId masterId = onMasterInstrId $ put masterId
    where onMasterInstrId = onHistory masterInstrId (\a h -> h { masterInstrId = a })
-}
----------------------------------------------------------------------
-- state modifiers

withOptions :: (Options -> a) -> GE a
withOptions :: (Options -> a) -> GE a
withOptions Options -> a
f = ReaderT Options (StateT History IO) a -> GE a
forall a. ReaderT Options (StateT History IO) a -> GE a
GE (ReaderT Options (StateT History IO) a -> GE a)
-> ReaderT Options (StateT History IO) a -> GE a
forall a b. (a -> b) -> a -> b
$ (Options -> a) -> ReaderT Options (StateT History IO) a
forall (m :: * -> *) r a. Monad m => (r -> a) -> ReaderT r m a
asks Options -> a
f

getOptions :: GE Options
getOptions :: GE Options
getOptions = (Options -> Options) -> GE Options
forall a. (Options -> a) -> GE a
withOptions Options -> Options
forall a. a -> a
id

getHistory :: GE History
getHistory :: GE History
getHistory = ReaderT Options (StateT History IO) History -> GE History
forall a. ReaderT Options (StateT History IO) a -> GE a
GE (ReaderT Options (StateT History IO) History -> GE History)
-> ReaderT Options (StateT History IO) History -> GE History
forall a b. (a -> b) -> a -> b
$ StateT History IO History
-> ReaderT Options (StateT History IO) History
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift StateT History IO History
forall (m :: * -> *) s. Monad m => StateT s m s
get

putHistory :: History -> GE ()
putHistory :: History -> GE ()
putHistory History
h = ReaderT Options (StateT History IO) () -> GE ()
forall a. ReaderT Options (StateT History IO) a -> GE a
GE (ReaderT Options (StateT History IO) () -> GE ())
-> ReaderT Options (StateT History IO) () -> GE ()
forall a b. (a -> b) -> a -> b
$ StateT History IO () -> ReaderT Options (StateT History IO) ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (StateT History IO () -> ReaderT Options (StateT History IO) ())
-> StateT History IO () -> ReaderT Options (StateT History IO) ()
forall a b. (a -> b) -> a -> b
$ History -> StateT History IO ()
forall (m :: * -> *) s. Monad m => s -> StateT s m ()
put History
h

withHistory :: (History -> a) -> GE a
withHistory :: (History -> a) -> GE a
withHistory History -> a
f = ReaderT Options (StateT History IO) a -> GE a
forall a. ReaderT Options (StateT History IO) a -> GE a
GE (ReaderT Options (StateT History IO) a -> GE a)
-> ReaderT Options (StateT History IO) a -> GE a
forall a b. (a -> b) -> a -> b
$ StateT History IO a -> ReaderT Options (StateT History IO) a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (StateT History IO a -> ReaderT Options (StateT History IO) a)
-> StateT History IO a -> ReaderT Options (StateT History IO) a
forall a b. (a -> b) -> a -> b
$ (History -> a) -> StateT History IO History -> StateT History IO a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap History -> a
f StateT History IO History
forall (m :: * -> *) s. Monad m => StateT s m s
get

modifyHistory :: (History -> History) -> GE ()
modifyHistory :: (History -> History) -> GE ()
modifyHistory = ReaderT Options (StateT History IO) () -> GE ()
forall a. ReaderT Options (StateT History IO) a -> GE a
GE (ReaderT Options (StateT History IO) () -> GE ())
-> ((History -> History) -> ReaderT Options (StateT History IO) ())
-> (History -> History)
-> GE ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StateT History IO () -> ReaderT Options (StateT History IO) ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (StateT History IO () -> ReaderT Options (StateT History IO) ())
-> ((History -> History) -> StateT History IO ())
-> (History -> History)
-> ReaderT Options (StateT History IO) ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (History -> History) -> StateT History IO ()
forall (m :: * -> *) s. Monad m => (s -> s) -> StateT s m ()
modify

modifyHistoryField :: (History -> a) -> (a -> History -> History) -> (a -> a) -> GE ()
modifyHistoryField :: (History -> a) -> (a -> History -> History) -> (a -> a) -> GE ()
modifyHistoryField History -> a
getter a -> History -> History
setter a -> a
f = (History -> History) -> GE ()
modifyHistory (\History
h -> a -> History -> History
setter (a -> a
f (a -> a) -> a -> a
forall a b. (a -> b) -> a -> b
$ History -> a
getter History
h) History
h)

modifyWithHistory :: (History -> (a, History)) -> GE a
modifyWithHistory :: (History -> (a, History)) -> GE a
modifyWithHistory History -> (a, History)
f = ReaderT Options (StateT History IO) a -> GE a
forall a. ReaderT Options (StateT History IO) a -> GE a
GE (ReaderT Options (StateT History IO) a -> GE a)
-> ReaderT Options (StateT History IO) a -> GE a
forall a b. (a -> b) -> a -> b
$ StateT History IO a -> ReaderT Options (StateT History IO) a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (StateT History IO a -> ReaderT Options (StateT History IO) a)
-> StateT History IO a -> ReaderT Options (StateT History IO) a
forall a b. (a -> b) -> a -> b
$ (History -> (a, History)) -> StateT History IO a
forall (m :: * -> *) s a. Monad m => (s -> (a, s)) -> StateT s m a
state History -> (a, History)
f

-- update fields

onHistory :: (History -> a) -> (a -> History -> History) -> State a b -> GE b
onHistory :: (History -> a) -> (a -> History -> History) -> State a b -> GE b
onHistory History -> a
getter a -> History -> History
setter State a b
st = ReaderT Options (StateT History IO) b -> GE b
forall a. ReaderT Options (StateT History IO) a -> GE a
GE (ReaderT Options (StateT History IO) b -> GE b)
-> ReaderT Options (StateT History IO) b -> GE b
forall a b. (a -> b) -> a -> b
$ (Options -> StateT History IO b)
-> ReaderT Options (StateT History IO) b
forall r (m :: * -> *) a. (r -> m a) -> ReaderT r m a
ReaderT ((Options -> StateT History IO b)
 -> ReaderT Options (StateT History IO) b)
-> (Options -> StateT History IO b)
-> ReaderT Options (StateT History IO) b
forall a b. (a -> b) -> a -> b
$ \Options
_ -> (History -> IO (b, History)) -> StateT History IO b
forall s (m :: * -> *) a. (s -> m (a, s)) -> StateT s m a
StateT ((History -> IO (b, History)) -> StateT History IO b)
-> (History -> IO (b, History)) -> StateT History IO b
forall a b. (a -> b) -> a -> b
$ \History
history ->
    let (b
res, a
s1) = State a b -> a -> (b, a)
forall s a. State s a -> s -> (a, s)
runState State a b
st (History -> a
getter History
history)
    in  (b, History) -> IO (b, History)
forall (m :: * -> *) a. Monad m => a -> m a
return (b
res, a -> History -> History
setter a
s1 History
history)

type UpdField a b = State a b -> GE b

onInstr :: UpdField Instrs a
onInstr :: UpdField Instrs a
onInstr = (History -> Instrs)
-> (Instrs -> History -> History) -> UpdField Instrs a
forall a b.
(History -> a) -> (a -> History -> History) -> State a b -> GE b
onHistory History -> Instrs
instrs (\Instrs
a History
h -> History
h { instrs :: Instrs
instrs = Instrs
a })

onGlobals :: UpdField Globals a
onGlobals :: UpdField Globals a
onGlobals = (History -> Globals)
-> (Globals -> History -> History) -> UpdField Globals a
forall a b.
(History -> a) -> (a -> History -> History) -> State a b -> GE b
onHistory History -> Globals
globals (\Globals
a History
h -> History
h { globals :: Globals
globals = Globals
a })

----------------------------------------------------------------------
-- named instruments

saveNamedInstr :: String -> InstrBody -> GE ()
saveNamedInstr :: Name -> E -> GE ()
saveNamedInstr Name
name E
body = State NamedInstrs () -> GE ()
forall b. State NamedInstrs b -> GE b
onNamedInstrs (State NamedInstrs () -> GE ()) -> State NamedInstrs () -> GE ()
forall a b. (a -> b) -> a -> b
$ Name -> E -> State NamedInstrs ()
E.saveNamedInstr Name
name E
body
    where onNamedInstrs :: State NamedInstrs b -> GE b
onNamedInstrs = (History -> NamedInstrs)
-> (NamedInstrs -> History -> History)
-> State NamedInstrs b
-> GE b
forall a b.
(History -> a) -> (a -> History -> History) -> State a b -> GE b
onHistory History -> NamedInstrs
namedInstrs (\NamedInstrs
a History
h -> History
h { namedInstrs :: NamedInstrs
namedInstrs = NamedInstrs
a })

----------------------------------------------------------------------
-- cache

-- midi functions

type GetCache a b = a -> Cache GE -> Maybe b

fromCache :: GetCache a b -> a -> GE (Maybe b)
fromCache :: GetCache a b -> a -> GE (Maybe b)
fromCache GetCache a b
f a
key = (History -> Maybe b) -> GE (Maybe b)
forall a. (History -> a) -> GE a
withHistory ((History -> Maybe b) -> GE (Maybe b))
-> (History -> Maybe b) -> GE (Maybe b)
forall a b. (a -> b) -> a -> b
$ GetCache a b
f a
key (Cache GE -> Maybe b)
-> (History -> Cache GE) -> History -> Maybe b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. History -> Cache GE
cache

type SetCache a b = a -> b -> Cache GE -> Cache GE

toCache :: SetCache a b -> a -> b -> GE ()
toCache :: SetCache a b -> a -> b -> GE ()
toCache SetCache a b
f a
key b
val = (History -> History) -> GE ()
modifyHistory ((History -> History) -> GE ()) -> (History -> History) -> GE ()
forall a b. (a -> b) -> a -> b
$ \History
h -> History
h { cache :: Cache GE
cache = SetCache a b
f a
key b
val (History -> Cache GE
cache History
h) }

withCache :: TotalDur -> GetCache key val -> SetCache key val -> key -> GE val -> GE val
withCache :: TotalDur
-> GetCache key val -> SetCache key val -> key -> GE val -> GE val
withCache TotalDur
dur GetCache key val
lookupResult SetCache key val
saveResult key
key GE val
getResult = do
    Maybe val
ma <- GetCache key val -> key -> GE (Maybe val)
forall a b. GetCache a b -> a -> GE (Maybe b)
fromCache GetCache key val
lookupResult key
key
    val
res <- case Maybe val
ma of
        Just val
a      -> val -> GE val
forall (m :: * -> *) a. Monad m => a -> m a
return val
a
        Maybe val
Nothing     -> do
            val
r <- GE val
getResult
            SetCache key val -> key -> val -> GE ()
forall a b. SetCache a b -> a -> b -> GE ()
toCache SetCache key val
saveResult key
key val
r
            val -> GE val
forall (m :: * -> *) a. Monad m => a -> m a
return val
r
    TotalDur -> GE ()
setTotalDur TotalDur
dur
    val -> GE val
forall (m :: * -> *) a. Monad m => a -> m a
return val
res

--------------------------------------------------------
-- guis

data Guis = Guis
    { Guis -> Int
guiStateNewId     :: Int
    , Guis -> Dep ()
guiStateInstr     :: DepT GE ()
    , Guis -> [GuiNode]
guiStateToDraw    :: [GuiNode]
    , Guis -> [Panel]
guiStateRoots     :: [Panel]
    , Guis -> KeyCodeMap
guiKeyEvents      :: KeyCodeMap }

-- it maps integer key codes to global variables
-- that acts like sensors.
type KeyCodeMap = IM.IntMap Var

instance Default Guis where
    def :: Guis
def = Int -> Dep () -> [GuiNode] -> [Panel] -> KeyCodeMap -> Guis
Guis Int
0 (() -> Dep ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()) [] [] KeyCodeMap
forall a. Default a => a
def

newGuiHandle :: GE GuiHandle
newGuiHandle :: GE GuiHandle
newGuiHandle = (History -> (GuiHandle, History)) -> GE GuiHandle
forall a. (History -> (a, History)) -> GE a
modifyWithHistory ((History -> (GuiHandle, History)) -> GE GuiHandle)
-> (History -> (GuiHandle, History)) -> GE GuiHandle
forall a b. (a -> b) -> a -> b
$ \History
h ->
    let (Int
n, Guis
g') = Guis -> (Int, Guis)
bumpGuiStateId (Guis -> (Int, Guis)) -> Guis -> (Int, Guis)
forall a b. (a -> b) -> a -> b
$ History -> Guis
guis History
h
    in  (Int -> GuiHandle
GuiHandle Int
n, History
h{ guis :: Guis
guis = Guis
g' })

guiHandleToVar :: GuiHandle -> Var
guiHandleToVar :: GuiHandle -> Var
guiHandleToVar (GuiHandle Int
n) = VarType -> Rate -> Name -> Var
Var VarType
GlobalVar Rate
Ir (Char
'h' Char -> Name -> Name
forall a. a -> [a] -> [a]
: Int -> Name
forall a. Show a => a -> Name
show Int
n)

newGuiVar :: GE (Var, GuiHandle)
newGuiVar :: GE (Var, GuiHandle)
newGuiVar = (Var -> GuiHandle -> (Var, GuiHandle))
-> GE Var -> GE GuiHandle -> GE (Var, GuiHandle)
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 (,) (UpdField Globals Var
forall a. UpdField Globals a
onGlobals UpdField Globals Var -> UpdField Globals Var
forall a b. (a -> b) -> a -> b
$ Rate -> E -> State Globals Var
newPersistentGlobalVar Rate
Kr E
0) GE GuiHandle
newGuiHandle

modifyGuis :: (Guis -> Guis) -> GE ()
modifyGuis :: (Guis -> Guis) -> GE ()
modifyGuis Guis -> Guis
f = (History -> History) -> GE ()
modifyHistory ((History -> History) -> GE ()) -> (History -> History) -> GE ()
forall a b. (a -> b) -> a -> b
$ \History
h -> History
h{ guis :: Guis
guis = Guis -> Guis
f (Guis -> Guis) -> Guis -> Guis
forall a b. (a -> b) -> a -> b
$ History -> Guis
guis History
h }

appendToGui :: GuiNode -> DepT GE () -> GE ()
appendToGui :: GuiNode -> Dep () -> GE ()
appendToGui GuiNode
gui Dep ()
act = (Guis -> Guis) -> GE ()
modifyGuis ((Guis -> Guis) -> GE ()) -> (Guis -> Guis) -> GE ()
forall a b. (a -> b) -> a -> b
$ \Guis
st -> Guis
st
    { guiStateToDraw :: [GuiNode]
guiStateToDraw = GuiNode
gui GuiNode -> [GuiNode] -> [GuiNode]
forall a. a -> [a] -> [a]
: Guis -> [GuiNode]
guiStateToDraw Guis
st
    , guiStateInstr :: Dep ()
guiStateInstr  = Guis -> Dep ()
guiStateInstr Guis
st Dep () -> Dep () -> Dep ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Dep ()
act }

saveGuiRoot :: Panel -> GE ()
saveGuiRoot :: Panel -> GE ()
saveGuiRoot Panel
g = (Guis -> Guis) -> GE ()
modifyGuis ((Guis -> Guis) -> GE ()) -> (Guis -> Guis) -> GE ()
forall a b. (a -> b) -> a -> b
$ \Guis
st ->
    Guis
st { guiStateRoots :: [Panel]
guiStateRoots = Panel
g Panel -> [Panel] -> [Panel]
forall a. a -> [a] -> [a]
: Guis -> [Panel]
guiStateRoots Guis
st }

saveDefKeybdPanel :: GE ()
saveDefKeybdPanel :: GE ()
saveDefKeybdPanel = Panel -> GE ()
saveGuiRoot (Panel -> GE ()) -> Panel -> GE ()
forall a b. (a -> b) -> a -> b
$ Win -> Bool -> Panel
Single (Name -> Maybe Rect -> Gui -> Win
Win Name
"" Maybe Rect
forall a. Maybe a
Nothing Gui
g) Bool
isKeybd
    where
        g :: Gui
g = Name -> Gui
defText Name
"keyboard listener"
        isKeybd :: Bool
isKeybd = Bool
True

bumpGuiStateId :: Guis -> (Int, Guis)
bumpGuiStateId :: Guis -> (Int, Guis)
bumpGuiStateId Guis
s = (Guis -> Int
guiStateNewId Guis
s, Guis
s{ guiStateNewId :: Int
guiStateNewId = Int -> Int
forall a. Enum a => a -> a
succ (Int -> Int) -> Int -> Int
forall a b. (a -> b) -> a -> b
$ Guis -> Int
guiStateNewId Guis
s })

getPanels :: History -> [Panel]
getPanels :: History -> [Panel]
getPanels History
h = (Panel -> Panel) -> [Panel] -> [Panel]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Gui -> Gui) -> Panel -> Panel
mapGuiOnPanel (GuiMap -> Gui -> Gui
restoreTree GuiMap
m)) ([Panel] -> [Panel]) -> [Panel] -> [Panel]
forall a b. (a -> b) -> a -> b
$ Guis -> [Panel]
guiStateRoots (Guis -> [Panel]) -> Guis -> [Panel]
forall a b. (a -> b) -> a -> b
$ History -> Guis
guis History
h
    where m :: GuiMap
m = [GuiNode] -> GuiMap
guiMap ([GuiNode] -> GuiMap) -> [GuiNode] -> GuiMap
forall a b. (a -> b) -> a -> b
$ Guis -> [GuiNode]
guiStateToDraw (Guis -> [GuiNode]) -> Guis -> [GuiNode]
forall a b. (a -> b) -> a -> b
$ History -> Guis
guis History
h

-- have to be executed after all instruments
guiInstrExp :: GE (DepT GE ())
guiInstrExp :: GE (Dep ())
guiInstrExp = (History -> Dep ()) -> GE (Dep ())
forall a. (History -> a) -> GE a
withHistory (Guis -> Dep ()
guiStateInstr (Guis -> Dep ()) -> (History -> Guis) -> History -> Dep ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. History -> Guis
guis)


-- key codes

-- | Keyboard events.
data KeyEvt = Press Key | Release Key
    deriving (Int -> KeyEvt -> Name -> Name
[KeyEvt] -> Name -> Name
KeyEvt -> Name
(Int -> KeyEvt -> Name -> Name)
-> (KeyEvt -> Name) -> ([KeyEvt] -> Name -> Name) -> Show KeyEvt
forall a.
(Int -> a -> Name -> Name)
-> (a -> Name) -> ([a] -> Name -> Name) -> Show a
showList :: [KeyEvt] -> Name -> Name
$cshowList :: [KeyEvt] -> Name -> Name
show :: KeyEvt -> Name
$cshow :: KeyEvt -> Name
showsPrec :: Int -> KeyEvt -> Name -> Name
$cshowsPrec :: Int -> KeyEvt -> Name -> Name
Show, KeyEvt -> KeyEvt -> Bool
(KeyEvt -> KeyEvt -> Bool)
-> (KeyEvt -> KeyEvt -> Bool) -> Eq KeyEvt
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: KeyEvt -> KeyEvt -> Bool
$c/= :: KeyEvt -> KeyEvt -> Bool
== :: KeyEvt -> KeyEvt -> Bool
$c== :: KeyEvt -> KeyEvt -> Bool
Eq)

-- | Keys.
data Key
    = CharKey Char
    | F1 | F2 | F3 | F4 | F5 | F6 | F7 | F8 | F9 | F10 | F11 | F12 | Scroll
    | CapsLook | LeftShift | RightShift | LeftCtrl | RightCtrl | Enter | LeftAlt | RightAlt | LeftWinKey | RightWinKey
    | Backspace | ArrowUp | ArrowLeft | ArrowRight | ArrowDown
    | Insert | Home | PgUp | Delete | End | PgDown
    | NumLock | NumDiv | NumMul | NumSub | NumHome | NumArrowUp
    | NumPgUp | NumArrowLeft | NumSpace | NumArrowRight | NumEnd
    | NumArrowDown | NumPgDown | NumIns | NumDel | NumEnter | NumPlus
    | Num7 | Num8 | Num9 | Num4 | Num5 | Num6 | Num1 | Num2 | Num3 | Num0 | NumDot
    deriving (Int -> Key -> Name -> Name
[Key] -> Name -> Name
Key -> Name
(Int -> Key -> Name -> Name)
-> (Key -> Name) -> ([Key] -> Name -> Name) -> Show Key
forall a.
(Int -> a -> Name -> Name)
-> (a -> Name) -> ([a] -> Name -> Name) -> Show a
showList :: [Key] -> Name -> Name
$cshowList :: [Key] -> Name -> Name
show :: Key -> Name
$cshow :: Key -> Name
showsPrec :: Int -> Key -> Name -> Name
$cshowsPrec :: Int -> Key -> Name -> Name
Show, Key -> Key -> Bool
(Key -> Key -> Bool) -> (Key -> Key -> Bool) -> Eq Key
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Key -> Key -> Bool
$c/= :: Key -> Key -> Bool
== :: Key -> Key -> Bool
$c== :: Key -> Key -> Bool
Eq)

keyToCode :: Key -> Int
keyToCode :: Key -> Int
keyToCode Key
x = case Key
x of
    CharKey Char
a -> Char -> Int
forall a. Enum a => a -> Int
fromEnum Char
a
    Key
F1 -> Int
446
    Key
F2 -> Int
447
    Key
F3 -> Int
448
    Key
F4 -> Int
449
    Key
F5 -> Int
450
    Key
F6 -> Int
451
    Key
F7 -> Int
452
    Key
F8 -> Int
453
    Key
F9 -> Int
454
    Key
F10 -> Int
456
    Key
F11 -> Int
457
    Key
F12 -> Int
458
    Key
Scroll-> Int
276
    Key
CapsLook -> Int
485
    Key
LeftShift -> Int
481
    Key
RightShift -> Int
482
    Key
LeftCtrl -> Int
483
    Key
RightCtrl -> Int
484
    Key
Enter -> Int
269
    Key
LeftAlt -> Int
489
    Key
RightAlt -> Int
490
    Key
LeftWinKey -> Int
491
    Key
RightWinKey -> Int
492
    Key
Backspace -> Int
264
    Key
ArrowUp -> Int
338
    Key
ArrowLeft -> Int
337
    Key
ArrowRight -> Int
339
    Key
ArrowDown -> Int
340
    Key
Insert -> Int
355
    Key
Home -> Int
336
    Key
PgUp -> Int
341
    Key
Delete -> Int
511
    Key
End -> Int
343
    Key
PgDown -> Int
342

    Key
NumLock -> Int
383
    Key
NumDiv -> Int
431
    Key
NumMul -> Int
426
    Key
NumSub -> Int
429
    Key
NumHome -> Int
436
    Key
NumArrowUp -> Int
438
    Key
NumPgUp -> Int
341
    Key
NumArrowLeft -> Int
337
    Key
NumSpace -> Int
267
    Key
NumArrowRight -> Int
339
    Key
NumEnd -> Int
343
    Key
NumArrowDown -> Int
340
    Key
NumPgDown -> Int
342
    Key
NumIns -> Int
355
    Key
NumDel -> Int
511
    Key
NumEnter -> Int
397
    Key
NumPlus -> Int
427

    Key
Num7 -> Int
439
    Key
Num8 -> Int
440
    Key
Num9 -> Int
441
    Key
Num4 -> Int
436
    Key
Num5 -> Int
437
    Key
Num6 -> Int
438
    Key
Num1 -> Int
433
    Key
Num2 -> Int
434
    Key
Num3 -> Int
435
    Key
Num0 -> Int
432
    Key
NumDot -> Int
430

keyEvtToCode :: KeyEvt -> Int
keyEvtToCode :: KeyEvt -> Int
keyEvtToCode KeyEvt
x = case KeyEvt
x of
    Press Key
k   -> Key -> Int
keyToCode Key
k
    Release Key
k -> Int -> Int
forall a. Num a => a -> a
negate (Int -> Int) -> Int -> Int
forall a b. (a -> b) -> a -> b
$ Key -> Int
keyToCode Key
k

listenKeyEvt :: KeyEvt -> GE Var
listenKeyEvt :: KeyEvt -> GE Var
listenKeyEvt KeyEvt
evt = do
    History
hist <- GE History
getHistory
    let g :: Guis
g      = History -> Guis
guis History
hist
        keyMap :: KeyCodeMap
keyMap = Guis -> KeyCodeMap
guiKeyEvents Guis
g
        code :: Int
code   = KeyEvt -> Int
keyEvtToCode KeyEvt
evt

    case Int -> KeyCodeMap -> Maybe Var
forall a. Int -> IntMap a -> Maybe a
IM.lookup Int
code KeyCodeMap
keyMap of
        Just Var
var -> Var -> GE Var
forall (m :: * -> *) a. Monad m => a -> m a
return Var
var
        Maybe Var
Nothing  -> do
            Var
var <- UpdField Globals Var
forall a. UpdField Globals a
onGlobals UpdField Globals Var -> UpdField Globals Var
forall a b. (a -> b) -> a -> b
$ Rate -> E -> State Globals Var
newClearableGlobalVar Rate
Kr E
0
            History
hist2 <- GE History
getHistory
            let newKeyMap :: KeyCodeMap
newKeyMap = Int -> Var -> KeyCodeMap -> KeyCodeMap
forall a. Int -> a -> IntMap a -> IntMap a
IM.insert Int
code Var
var KeyCodeMap
keyMap
                newG :: Guis
newG      = Guis
g { guiKeyEvents :: KeyCodeMap
guiKeyEvents = KeyCodeMap
newKeyMap }
                hist3 :: History
hist3     = History
hist2 { guis :: Guis
guis = Guis
newG }
            History -> GE ()
putHistory History
hist3
            Var -> GE Var
forall (m :: * -> *) a. Monad m => a -> m a
return Var
var

-- assumes that first instrument id is 18 and 17 is free to use.
keyEventInstrId :: InstrId
keyEventInstrId :: InstrId
keyEventInstrId = Int -> InstrId
intInstrId Int
17

keyEventInstrBody :: KeyCodeMap -> GE InstrBody
keyEventInstrBody :: KeyCodeMap -> GE E
keyEventInstrBody KeyCodeMap
keyMap = Dep () -> GE E
forall (m :: * -> *). (Functor m, Monad m) => DepT m () -> m E
execDepT (Dep () -> GE E) -> Dep () -> GE E
forall a b. (a -> b) -> a -> b
$ do
    let keys :: E
keys     = E
flKeyIn
        isChange :: E
isChange = E -> E
changed E
keys E -> E -> E
forall a bool. (EqB a, bool ~ BooleanOf a) => a -> a -> bool
==* E
1
    Rate -> E -> Dep () -> Dep ()
forall (m :: * -> *).
Monad m =>
Rate -> E -> DepT m () -> DepT m ()
when1 Rate
Kr E
isChange (Dep () -> Dep ()) -> Dep () -> Dep ()
forall a b. (a -> b) -> a -> b
$ do
        Rate -> [(E, Dep ())] -> Dep () -> Dep ()
forall (m :: * -> *).
Monad m =>
Rate -> [(E, DepT m ())] -> DepT m () -> DepT m ()
whens Rate
Kr (((Int, Var) -> (E, Dep ())) -> [(Int, Var)] -> [(E, Dep ())]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Int -> Var -> (E, Dep ())) -> (Int, Var) -> (E, Dep ())
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry ((Int -> Var -> (E, Dep ())) -> (Int, Var) -> (E, Dep ()))
-> (Int -> Var -> (E, Dep ())) -> (Int, Var) -> (E, Dep ())
forall a b. (a -> b) -> a -> b
$ E -> Int -> Var -> (E, Dep ())
forall (m :: * -> *). Monad m => E -> Int -> Var -> (E, DepT m ())
listenEvt E
keys) [(Int, Var)]
events) Dep ()
doNothing
    where
        doNothing :: Dep ()
doNothing = () -> Dep ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

        listenEvt :: E -> Int -> Var -> (E, DepT m ())
listenEvt E
keySig Int
keyCode Var
var = (E
keySig E -> E -> E
forall a bool. (EqB a, bool ~ BooleanOf a) => a -> a -> bool
==* Int -> E
int Int
keyCode, Var -> E -> DepT m ()
forall (m :: * -> *). Monad m => Var -> E -> DepT m ()
writeVar Var
var E
1)

        events :: [(Int, Var)]
events = KeyCodeMap -> [(Int, Var)]
forall a. IntMap a -> [(Int, a)]
IM.toList KeyCodeMap
keyMap

        flKeyIn :: E
        flKeyIn :: E
flKeyIn = Name -> Spec1 -> [E] -> E
opcs Name
"FLkeyIn" [(Rate
Kr, [])] []

getKeyEventListener :: GE (Maybe Instr)
getKeyEventListener :: GE (Maybe Instr)
getKeyEventListener = do
    History
h <- GE History
getHistory
    if (KeyCodeMap -> Bool
forall a. IntMap a -> Bool
IM.null (KeyCodeMap -> Bool) -> KeyCodeMap -> Bool
forall a b. (a -> b) -> a -> b
$ Guis -> KeyCodeMap
guiKeyEvents (Guis -> KeyCodeMap) -> Guis -> KeyCodeMap
forall a b. (a -> b) -> a -> b
$ History -> Guis
guis History
h)
        then Maybe Instr -> GE (Maybe Instr)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Instr
forall a. Maybe a
Nothing
        else do
            InstrId -> GE ()
saveAlwaysOnInstr InstrId
keyEventInstrId
            E
body <- KeyCodeMap -> GE E
keyEventInstrBody (KeyCodeMap -> GE E) -> KeyCodeMap -> GE E
forall a b. (a -> b) -> a -> b
$ Guis -> KeyCodeMap
guiKeyEvents (Guis -> KeyCodeMap) -> Guis -> KeyCodeMap
forall a b. (a -> b) -> a -> b
$ History -> Guis
guis History
h
            Maybe Instr -> GE (Maybe Instr)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe Instr -> GE (Maybe Instr))
-> Maybe Instr -> GE (Maybe Instr)
forall a b. (a -> b) -> a -> b
$ Instr -> Maybe Instr
forall a. a -> Maybe a
Just (InstrId -> E -> Instr
Instr InstrId
keyEventInstrId E
body)

-----------------------------------------------
-- osc port listen

getOscPortHandle :: Int -> GE E
getOscPortHandle :: Int -> GE E
getOscPortHandle Int
port = State (OscListenPorts, Globals) E -> GE E
forall b. State (OscListenPorts, Globals) b -> GE b
onOscPorts ((Var -> E)
-> StateT (OscListenPorts, Globals) Identity Var
-> State (OscListenPorts, Globals) E
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Var -> E
inlineVar (StateT (OscListenPorts, Globals) Identity Var
 -> State (OscListenPorts, Globals) E)
-> StateT (OscListenPorts, Globals) Identity Var
-> State (OscListenPorts, Globals) E
forall a b. (a -> b) -> a -> b
$ Int -> StateT (OscListenPorts, Globals) Identity Var
getOscPortVar Int
port)
    where
        onOscPorts :: State (OscListenPorts, Globals) b -> GE b
onOscPorts = (History -> (OscListenPorts, Globals))
-> ((OscListenPorts, Globals) -> History -> History)
-> State (OscListenPorts, Globals) b
-> GE b
forall a b.
(History -> a) -> (a -> History -> History) -> State a b -> GE b
onHistory (\History
h -> (History -> OscListenPorts
oscListenPorts History
h, History -> Globals
globals History
h)) (\(OscListenPorts
ports, Globals
gs) History
h -> History
h { oscListenPorts :: OscListenPorts
oscListenPorts = OscListenPorts
ports, globals :: Globals
globals = Globals
gs })

-----------------------------------------------
-- cabbage

cabbage :: Cabbage.Cab -> GE ()
cabbage :: Cab -> GE ()
cabbage Cab
cab = (History -> History) -> GE ()
modifyHistory ((History -> History) -> GE ()) -> (History -> History) -> GE ()
forall a b. (a -> b) -> a -> b
$ \History
h -> History
h { cabbageGui :: Maybe Lang
cabbageGui = Lang -> Maybe Lang
forall a. a -> Maybe a
Just (Lang -> Maybe Lang) -> Lang -> Maybe Lang
forall a b. (a -> b) -> a -> b
$ Cab -> Lang
Cabbage.runCab Cab
cab }

-----------------------------------------------
-- head pan

simpleHrtfmove :: E -> E -> E -> E -> E ->  E -> GE (E, E)
simpleHrtfmove :: E -> E -> E -> E -> E -> E -> GE (E, E)
simpleHrtfmove E
a1 E
a2 E
a3 E
a4 E
a5 E
a6 = do
    (E
left, E
right) <- GE (E, E)
getHrtfFiles
    (E, E) -> GE (E, E)
forall (m :: * -> *) a. Monad m => a -> m a
return ((E, E) -> GE (E, E)) -> (E, E) -> GE (E, E)
forall a b. (a -> b) -> a -> b
$ E -> E -> E -> E -> E -> E -> E -> E -> (E, E)
hrtfmove E
a1 E
a2 E
a3 E
left E
right E
a4 E
a5 E
a6

simpleHrtfstat :: E -> E -> E -> E -> E -> GE (E, E)
simpleHrtfstat :: E -> E -> E -> E -> E -> GE (E, E)
simpleHrtfstat E
a1 E
a2 E
a3 E
a4 E
a5 = do
    (E
left, E
right) <- GE (E, E)
getHrtfFiles
    (E, E) -> GE (E, E)
forall (m :: * -> *) a. Monad m => a -> m a
return ((E, E) -> GE (E, E)) -> (E, E) -> GE (E, E)
forall a b. (a -> b) -> a -> b
$ E -> E -> E -> E -> E -> E -> E -> (E, E)
hrtfstat E
a1 E
a2 E
a3 E
left E
right E
a4 E
a5

getHrtfFiles :: GE (E, E)
getHrtfFiles :: GE (E, E)
getHrtfFiles = do
    Int
sr <- (Options -> Int) -> GE Options -> GE Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Options -> Int
defSampleRate GE Options
getOptions
    (Name
left, Name
right) <- IO (Name, Name) -> GE (Name, Name)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Name, Name) -> GE (Name, Name))
-> IO (Name, Name) -> GE (Name, Name)
forall a b. (a -> b) -> a -> b
$ Int -> IO (Name, Name)
hrtfFileNames Int
sr
    (E, E) -> GE (E, E)
forall (m :: * -> *) a. Monad m => a -> m a
return (Name -> E
str Name
left, Name -> E
str Name
right)

hrtfFileNames :: Int -> IO (String, String)
hrtfFileNames :: Int -> IO (Name, Name)
hrtfFileNames Int
sr = (Name -> Name -> (Name, Name))
-> IO Name -> IO Name -> IO (Name, Name)
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 (,) (Name -> IO Name
getDataFileName (Name -> Int -> Name
forall a. Show a => Name -> a -> Name
name Name
"left" Int
sr)) (Name -> IO Name
getDataFileName (Name -> Int -> Name
forall a. Show a => Name -> a -> Name
name Name
"right" Int
sr))
    where name :: Name -> a -> Name
name Name
dir a
n = [Name] -> Name
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [Name
"data/hrtf-", a -> Name
forall a. Show a => a -> Name
show a
n, Name
"-", Name
dir, Name
".dat"]

-----------------------------------------------
-- read macros

readMacrosDouble :: String -> Double -> GE E
readMacrosDouble :: Name -> Double -> GE E
readMacrosDouble = (Name -> E)
-> (Name -> Double -> MacrosInit) -> Name -> Double -> GE E
forall a.
(Name -> E) -> (Name -> a -> MacrosInit) -> Name -> a -> GE E
readMacrosBy Name -> E
D.readMacrosDouble Name -> Double -> MacrosInit
MacrosInitDouble

readMacrosString :: String -> String -> GE E
readMacrosString :: Name -> Name -> GE E
readMacrosString = (Name -> E) -> (Name -> Name -> MacrosInit) -> Name -> Name -> GE E
forall a.
(Name -> E) -> (Name -> a -> MacrosInit) -> Name -> a -> GE E
readMacrosBy Name -> E
D.readMacrosString Name -> Name -> MacrosInit
MacrosInitString

readMacrosInt :: String -> Int -> GE E
readMacrosInt :: Name -> Int -> GE E
readMacrosInt    = (Name -> E) -> (Name -> Int -> MacrosInit) -> Name -> Int -> GE E
forall a.
(Name -> E) -> (Name -> a -> MacrosInit) -> Name -> a -> GE E
readMacrosBy Name -> E
D.readMacrosInt    Name -> Int -> MacrosInit
MacrosInitInt

readMacrosBy :: (String ->  E) -> (String -> a -> MacrosInit) -> String -> a -> GE E
readMacrosBy :: (Name -> E) -> (Name -> a -> MacrosInit) -> Name -> a -> GE E
readMacrosBy Name -> E
extract Name -> a -> MacrosInit
allocator Name
name a
initValue = do
    State MacrosInits () -> GE ()
forall b. State MacrosInits b -> GE b
onMacrosInits (State MacrosInits () -> GE ()) -> State MacrosInits () -> GE ()
forall a b. (a -> b) -> a -> b
$ MacrosInit -> State MacrosInits ()
initMacros (MacrosInit -> State MacrosInits ())
-> MacrosInit -> State MacrosInits ()
forall a b. (a -> b) -> a -> b
$ Name -> a -> MacrosInit
allocator Name
name a
initValue
    E -> GE E
forall (m :: * -> *) a. Monad m => a -> m a
return (E -> GE E) -> E -> GE E
forall a b. (a -> b) -> a -> b
$ Name -> E
extract Name
name
    where onMacrosInits :: State MacrosInits b -> GE b
onMacrosInits = (History -> MacrosInits)
-> (MacrosInits -> History -> History)
-> State MacrosInits b
-> GE b
forall a b.
(History -> a) -> (a -> History -> History) -> State a b -> GE b
onHistory History -> MacrosInits
macrosInits (\MacrosInits
val History
h -> History
h { macrosInits :: MacrosInits
macrosInits = MacrosInits
val })

-----------------------------------------------
-- udo plugins

addUdoPlugin :: UdoPlugin -> GE ()
addUdoPlugin :: UdoPlugin -> GE ()
addUdoPlugin UdoPlugin
p = State [UdoPlugin] () -> GE ()
forall b. State [UdoPlugin] b -> GE b
onUdo (UdoPlugin -> State [UdoPlugin] ()
E.addUdoPlugin UdoPlugin
p)
    where onUdo :: State [UdoPlugin] b -> GE b
onUdo = (History -> [UdoPlugin])
-> ([UdoPlugin] -> History -> History)
-> State [UdoPlugin] b
-> GE b
forall a b.
(History -> a) -> (a -> History -> History) -> State a b -> GE b
onHistory History -> [UdoPlugin]
udoPlugins (\[UdoPlugin]
val History
h -> History
h{ udoPlugins :: [UdoPlugin]
udoPlugins = [UdoPlugin]
val })

renderUdoPlugins :: History -> IO String
renderUdoPlugins :: History -> IO Name
renderUdoPlugins History
h = ([Name] -> Name) -> IO [Name] -> IO Name
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [Name] -> Name
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat (IO [Name] -> IO Name) -> IO [Name] -> IO Name
forall a b. (a -> b) -> a -> b
$ (Name -> IO Name) -> [Name] -> IO [Name]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Name -> IO Name
getUdoPluginBody ([Name] -> IO [Name]) -> [Name] -> IO [Name]
forall a b. (a -> b) -> a -> b
$ [UdoPlugin] -> [Name]
getUdoPluginNames ([UdoPlugin] -> [Name]) -> [UdoPlugin] -> [Name]
forall a b. (a -> b) -> a -> b
$ History -> [UdoPlugin]
udoPlugins History
h

getUdoPluginBody :: String -> IO String
getUdoPluginBody :: Name -> IO Name
getUdoPluginBody Name
name = Name -> IO Name
readFile (Name -> IO Name) -> IO Name -> IO Name
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Name -> IO Name
getDataFileName Name
filename
    where filename :: Name
filename = [Name] -> Name
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [Name
"data/opcodes/", Name
name, Name
".udo"]