{-# Language TupleSections #-}
module Csound.Typed.GlobalState.GE(
GE, Dep, History(..), withOptions, withHistory, getOptions, evalGE, execGE,
getHistory, putHistory,
onGlobals, bpmVar,
MidiAssign(..), Msg(..), renderMidiAssign, saveMidi, saveToMidiInstr,
MidiCtrl(..), saveMidiCtrl, renderMidiCtrl,
saveAlwaysOnInstr, onInstr, saveUserInstr0, getSysExpr,
saveNamedInstr,
TotalDur(..), pureGetTotalDurForF0, getTotalDurForTerminator,
setDurationForce, setDuration, setDurationToInfinite,
addNote,
GenId,
saveGen, saveTabs, getNextGlobalGenId,
saveWriteGen, saveWriteTab,
saveSf, sfTable,
saveBandLimitedWave,
saveStr,
GetCache, SetCache, withCache,
newGuiHandle, saveGuiRoot, saveDefKeybdPanel, appendToGui,
newGuiVar, getPanels, guiHandleToVar,
guiInstrExp,
listenKeyEvt, Key(..), KeyEvt(..), Guis(..),
getKeyEventListener,
getOscPortHandle,
MacrosInit(..), readMacrosDouble, readMacrosString, readMacrosInt,
cabbage,
simpleHrtfmove, simpleHrtfstat,
addUdoPlugin, renderUdoPlugins
) where
import Paths_csound_expression_typed
import Control.Applicative
import Control.Monad
import Data.Boolean
import Data.Default
import Data.Text (Text)
import Data.Text qualified as Text
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
newtype GE a = GE { forall a. GE a -> ReaderT Options (StateT History IO) a
unGE :: ReaderT Options (StateT History IO) a }
runGE :: GE a -> Options -> History -> IO (a, History)
runGE :: forall a. 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 :: forall a. Options -> GE a -> IO a
evalGE Options
options GE a
a = ((a, History) -> a) -> IO (a, History) -> IO a
forall a b. (a -> b) -> IO a -> IO b
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 :: forall a. Options -> GE a -> IO History
execGE Options
options GE a
a = ((a, History) -> History) -> IO (a, History) -> IO History
forall a b. (a -> b) -> IO a -> IO b
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 :: forall a b. (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 a b.
(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 :: forall a. a -> GE a
pure = 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 a. a -> ReaderT Options (StateT History IO) a
forall (m :: * -> *) a. Monad m => a -> m a
return
<*> :: forall a b. 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
GE a
ma >>= :: forall a b. 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 a b.
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 :: forall a. 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 a. 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 a. 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 a. a -> DepT GE a
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 :: forall (m :: * -> *). Monad m => 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
$ Text -> Spec1 -> [E] -> E
opcs Text
"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
$ Text -> Spec1 -> [E] -> E
opcs Text
"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 a. a -> [a]
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 :: forall (m :: * -> *). Monad m => 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 :: forall (m :: * -> *). Monad m => 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
$ Text -> Spec1 -> [E] -> E
opcs Text
"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 a b. (a -> b) -> GE a -> GE b
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 :: Text -> GE E
saveStr :: Text -> GE E
saveStr = (Prim -> E) -> GE Prim -> GE E
forall a b. (a -> b) -> GE a -> GE b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Prim -> E
prim (GE Prim -> GE E) -> (Text -> GE Prim) -> Text -> 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)
-> (Text -> State StringMap Prim) -> Text -> GE Prim
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> 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 = 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 = 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 :: forall a. 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 = 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 :: forall a. 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 = 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 a b.
(a -> b) -> StateT GenMap Identity a -> StateT GenMap Identity b
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 :: forall a. 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 = 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 = 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 = 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 = 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 = 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 = 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 a b. DepT GE a -> DepT GE b -> DepT GE b
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 = 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 a. a -> GE a
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 a b. DepT GE a -> DepT GE b -> DepT GE b
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 = 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, evt) : notes h }
withOptions :: (Options -> a) -> GE a
withOptions :: forall a. (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 (m :: * -> *) a. Monad m => m a -> ReaderT Options m a
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 (m :: * -> *) a. Monad m => m a -> ReaderT Options m a
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 :: forall a. (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 (m :: * -> *) a. Monad m => m a -> ReaderT Options m 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 a b. (a -> b) -> StateT History IO a -> StateT History IO b
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 (m :: * -> *) a. Monad m => m a -> ReaderT Options m a
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 :: forall a.
(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 :: forall a. (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 (m :: * -> *) a. Monad m => m a -> ReaderT Options m 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
onHistory :: (History -> a) -> (a -> History -> History) -> State a b -> GE b
onHistory :: forall a b.
(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 a. a -> IO a
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 :: forall a. UpdField Instrs a
onInstr = (History -> Instrs)
-> (Instrs -> History -> History) -> State Instrs a -> GE 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 = a })
onGlobals :: UpdField Globals a
onGlobals :: forall a. UpdField Globals a
onGlobals = (History -> Globals)
-> (Globals -> History -> History) -> State Globals a -> GE 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 = a })
saveNamedInstr :: Text -> InstrBody -> GE ()
saveNamedInstr :: Text -> E -> GE ()
saveNamedInstr Text
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
$ Text -> E -> State NamedInstrs ()
E.saveNamedInstr Text
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 = a })
type GetCache a b = a -> Cache GE -> Maybe b
fromCache :: GetCache a b -> a -> GE (Maybe b)
fromCache :: forall a b. 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 :: forall a b. 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 = f key val (cache h) }
withCache :: TotalDur -> GetCache key val -> SetCache key val -> key -> GE val -> GE val
withCache :: forall key val.
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 a. a -> GE a
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 a. a -> GE a
forall (m :: * -> *) a. Monad m => a -> m a
return val
r
TotalDur -> GE ()
setTotalDur TotalDur
dur
val -> GE val
forall a. a -> GE a
forall (m :: * -> *) a. Monad m => a -> m a
return val
res
data Guis = Guis
{ Guis -> Int
guiStateNewId :: Int
, Guis -> Dep ()
guiStateInstr :: DepT GE ()
, Guis -> [GuiNode]
guiStateToDraw :: [GuiNode]
, Guis -> [Panel]
guiStateRoots :: [Panel]
, Guis -> KeyCodeMap
guiKeyEvents :: KeyCodeMap }
type KeyCodeMap = IM.IntMap Var
instance Default Guis where
def :: Guis
def = Int -> Dep () -> [GuiNode] -> [Panel] -> KeyCodeMap -> Guis
Guis Int
0 (() -> Dep ()
forall a. a -> DepT GE a
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 = g' })
guiHandleToVar :: GuiHandle -> Var
guiHandleToVar :: GuiHandle -> Var
guiHandleToVar (GuiHandle Int
n) = VarType -> Rate -> Text -> Var
Var VarType
GlobalVar Rate
Ir (Char -> Text -> Text
Text.cons Char
'h' (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ String -> Text
Text.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ Int -> String
forall a. Show a => a -> String
show Int
n)
newGuiVar :: GE (Var, GuiHandle)
newGuiVar :: GE (Var, GuiHandle)
newGuiVar = (Var -> GuiHandle -> (Var, GuiHandle))
-> GE Var -> GE GuiHandle -> GE (Var, GuiHandle)
forall a b c. (a -> b -> c) -> GE a -> GE b -> GE c
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 = f $ guis 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 = gui : guiStateToDraw st
, guiStateInstr = guiStateInstr st >> 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 = g : guiStateRoots st }
saveDefKeybdPanel :: GE ()
saveDefKeybdPanel :: GE ()
saveDefKeybdPanel = Panel -> GE ()
saveGuiRoot (Panel -> GE ()) -> Panel -> GE ()
forall a b. (a -> b) -> a -> b
$ Win -> Bool -> Panel
Single (Text -> Maybe Rect -> Gui -> Win
Win Text
"" Maybe Rect
forall a. Maybe a
Nothing Gui
g) Bool
isKeybd
where
g :: Gui
g = Text -> Gui
defText Text
"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 = succ $ guiStateNewId s })
getPanels :: History -> [Panel]
getPanels :: History -> [Panel]
getPanels History
h = (Panel -> Panel) -> [Panel] -> [Panel]
forall a b. (a -> b) -> [a] -> [b]
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
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)
data KeyEvt = Press Key | Release Key
deriving (Int -> KeyEvt -> ShowS
[KeyEvt] -> ShowS
KeyEvt -> String
(Int -> KeyEvt -> ShowS)
-> (KeyEvt -> String) -> ([KeyEvt] -> ShowS) -> Show KeyEvt
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> KeyEvt -> ShowS
showsPrec :: Int -> KeyEvt -> ShowS
$cshow :: KeyEvt -> String
show :: KeyEvt -> String
$cshowList :: [KeyEvt] -> ShowS
showList :: [KeyEvt] -> ShowS
Show, KeyEvt -> KeyEvt -> Bool
(KeyEvt -> KeyEvt -> Bool)
-> (KeyEvt -> KeyEvt -> Bool) -> Eq KeyEvt
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: KeyEvt -> KeyEvt -> Bool
== :: KeyEvt -> KeyEvt -> Bool
$c/= :: KeyEvt -> KeyEvt -> Bool
/= :: KeyEvt -> KeyEvt -> Bool
Eq)
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 -> ShowS
[Key] -> ShowS
Key -> String
(Int -> Key -> ShowS)
-> (Key -> String) -> ([Key] -> ShowS) -> Show Key
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Key -> ShowS
showsPrec :: Int -> Key -> ShowS
$cshow :: Key -> String
show :: Key -> String
$cshowList :: [Key] -> ShowS
showList :: [Key] -> ShowS
Show, Key -> Key -> Bool
(Key -> Key -> Bool) -> (Key -> Key -> Bool) -> Eq Key
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Key -> Key -> Bool
== :: Key -> Key -> Bool
$c/= :: Key -> Key -> Bool
/= :: 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 a. a -> GE a
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 = newKeyMap }
hist3 :: History
hist3 = History
hist2 { guis = newG }
History -> GE ()
putHistory History
hist3
Var -> GE Var
forall a. a -> GE a
forall (m :: * -> *) a. Monad m => a -> m a
return Var
var
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 bool. (bool ~ BooleanOf E) => E -> E -> bool
forall a bool. (EqB a, bool ~ BooleanOf a) => a -> a -> bool
==* E
1
IfRate -> E -> DepT GE (CodeBlock E) -> Dep ()
forall (m :: * -> *).
Monad m =>
IfRate -> E -> DepT m (CodeBlock E) -> DepT m ()
when1 IfRate
IfKr E
isChange (DepT GE (CodeBlock E) -> Dep ())
-> DepT GE (CodeBlock E) -> Dep ()
forall a b. (a -> b) -> a -> b
$ do
Dep () -> DepT GE (CodeBlock E)
forall (m :: * -> *). Monad m => DepT m () -> DepT m (CodeBlock E)
toBlock (Dep () -> DepT GE (CodeBlock E))
-> Dep () -> DepT GE (CodeBlock E)
forall a b. (a -> b) -> a -> b
$ IfRate
-> [(E, DepT GE (CodeBlock E))] -> DepT GE (CodeBlock E) -> Dep ()
forall (m :: * -> *).
Monad m =>
IfRate
-> [(E, DepT m (CodeBlock E))] -> DepT m (CodeBlock E) -> DepT m ()
whens IfRate
IfKr (((Int, Var) -> (E, DepT GE (CodeBlock E)))
-> [(Int, Var)] -> [(E, DepT GE (CodeBlock E))]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Int -> Var -> (E, DepT GE (CodeBlock E)))
-> (Int, Var) -> (E, DepT GE (CodeBlock E))
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry ((Int -> Var -> (E, DepT GE (CodeBlock E)))
-> (Int, Var) -> (E, DepT GE (CodeBlock E)))
-> (Int -> Var -> (E, DepT GE (CodeBlock E)))
-> (Int, Var)
-> (E, DepT GE (CodeBlock E))
forall a b. (a -> b) -> a -> b
$ E -> Int -> Var -> (E, DepT GE (CodeBlock E))
forall {m :: * -> *}.
Monad m =>
E -> Int -> Var -> (E, DepT m (CodeBlock E))
listenEvt E
keys) [(Int, Var)]
events) (Dep () -> DepT GE (CodeBlock E)
forall (m :: * -> *). Monad m => DepT m () -> DepT m (CodeBlock E)
toBlock Dep ()
doNothing)
where
doNothing :: Dep ()
doNothing = () -> Dep ()
forall a. a -> DepT GE a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
listenEvt :: E -> Int -> Var -> (E, DepT m (CodeBlock E))
listenEvt E
keySig Int
keyCode Var
var = (E
keySig E -> E -> E
forall bool. (bool ~ BooleanOf E) => E -> E -> bool
forall a bool. (EqB a, bool ~ BooleanOf a) => a -> a -> bool
==* Int -> E
int Int
keyCode, DepT m () -> DepT m (CodeBlock E)
forall (m :: * -> *). Monad m => DepT m () -> DepT m (CodeBlock E)
toBlock (DepT m () -> DepT m (CodeBlock E))
-> DepT m () -> DepT m (CodeBlock E)
forall a b. (a -> b) -> a -> b
$ 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 = Text -> Spec1 -> [E] -> E
opcs Text
"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 a. a -> GE a
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 a. a -> GE a
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)
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 a b.
(a -> b)
-> StateT (OscListenPorts, Globals) Identity a
-> StateT (OscListenPorts, Globals) Identity b
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 = ports, globals = gs })
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 = Just $ Cabbage.runCab cab }
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 a. a -> GE a
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 a. a -> GE a
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 a b. (a -> b) -> GE a -> GE b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Options -> Int
defSampleRate GE Options
getOptions
(String
left, String
right) <- IO (String, String) -> GE (String, String)
forall a. IO a -> GE a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (String, String) -> GE (String, String))
-> IO (String, String) -> GE (String, String)
forall a b. (a -> b) -> a -> b
$ Int -> IO (String, String)
hrtfFileNames Int
sr
(E, E) -> GE (E, E)
forall a. a -> GE a
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> E
str String
left, String -> E
str String
right)
hrtfFileNames :: Int -> IO (String, String)
hrtfFileNames :: Int -> IO (String, String)
hrtfFileNames Int
sr = (String -> String -> (String, String))
-> IO String -> IO String -> IO (String, String)
forall a b c. (a -> b -> c) -> IO a -> IO b -> IO c
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 (,) (String -> IO String
getDataFileName (String -> Int -> String
forall {a}. Show a => String -> a -> String
name String
"left" Int
sr)) (String -> IO String
getDataFileName (String -> Int -> String
forall {a}. Show a => String -> a -> String
name String
"right" Int
sr))
where name :: String -> a -> String
name String
dir a
n = [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [String
"data/hrtf-", a -> String
forall a. Show a => a -> String
show a
n, String
"-", String
dir, String
".dat"]
readMacrosDouble :: Text -> Double -> GE E
readMacrosDouble :: Text -> Double -> GE E
readMacrosDouble = (Text -> E)
-> (Text -> Double -> MacrosInit) -> Text -> Double -> GE E
forall a.
(Text -> E) -> (Text -> a -> MacrosInit) -> Text -> a -> GE E
readMacrosBy Text -> E
D.readMacrosDouble Text -> Double -> MacrosInit
MacrosInitDouble
readMacrosString :: Text -> Text -> GE E
readMacrosString :: Text -> Text -> GE E
readMacrosString = (Text -> E) -> (Text -> Text -> MacrosInit) -> Text -> Text -> GE E
forall a.
(Text -> E) -> (Text -> a -> MacrosInit) -> Text -> a -> GE E
readMacrosBy Text -> E
D.readMacrosString Text -> Text -> MacrosInit
MacrosInitString
readMacrosInt :: Text -> Int -> GE E
readMacrosInt :: Text -> Int -> GE E
readMacrosInt = (Text -> E) -> (Text -> Int -> MacrosInit) -> Text -> Int -> GE E
forall a.
(Text -> E) -> (Text -> a -> MacrosInit) -> Text -> a -> GE E
readMacrosBy Text -> E
D.readMacrosInt Text -> Int -> MacrosInit
MacrosInitInt
readMacrosBy :: (Text -> E) -> (Text -> a -> MacrosInit) -> Text -> a -> GE E
readMacrosBy :: forall a.
(Text -> E) -> (Text -> a -> MacrosInit) -> Text -> a -> GE E
readMacrosBy Text -> E
extract Text -> a -> MacrosInit
allocator Text
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
$ Text -> a -> MacrosInit
allocator Text
name a
initValue
E -> GE E
forall a. a -> GE a
forall (m :: * -> *) a. Monad m => a -> m a
return (E -> GE E) -> E -> GE E
forall a b. (a -> b) -> a -> b
$ Text -> E
extract Text
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 = val })
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 = val })
renderUdoPlugins :: History -> IO Text
renderUdoPlugins :: History -> IO Text
renderUdoPlugins History
h = ([Text] -> Text) -> IO [Text] -> IO Text
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat (IO [Text] -> IO Text) -> IO [Text] -> IO Text
forall a b. (a -> b) -> a -> b
$ (Text -> IO Text) -> [Text] -> IO [Text]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM Text -> IO Text
getUdoPluginBody ([Text] -> IO [Text]) -> [Text] -> IO [Text]
forall a b. (a -> b) -> a -> b
$ [UdoPlugin] -> [Text]
getUdoPluginNames ([UdoPlugin] -> [Text]) -> [UdoPlugin] -> [Text]
forall a b. (a -> b) -> a -> b
$ History -> [UdoPlugin]
udoPlugins History
h
getUdoPluginBody :: Text -> IO Text
getUdoPluginBody :: Text -> IO Text
getUdoPluginBody Text
name = (String -> Text) -> IO String -> IO Text
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap String -> Text
Text.pack (IO String -> IO Text) -> IO String -> IO Text
forall a b. (a -> b) -> a -> b
$ String -> IO String
readFile (String -> IO String) -> IO String -> IO String
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< String -> IO String
getDataFileName String
filename
where filename :: String
filename = [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [String
"data/opcodes/", Text -> String
Text.unpack Text
name, String
".udo"]