csound-expression-typed 0.0.7.7 → 0.0.7.8

raw patch · 20 files changed

+310/−425 lines, 20 filesdep −stable-mapsdep ~temporal-mediaPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependencies removed: stable-maps

Dependency ranges changed: temporal-media

API changes (from Hackage documentation)

Files

• csound-expression-typed.cabal +5/−6
• src/Csound/Typed/Control.hs +2/−2
• src/Csound/Typed/Control/Evt.hs +49/−77
• src/Csound/Typed/Control/Midi.hs +38/−13
• src/Csound/Typed/Control/Mix.hs +13/−26
• src/Csound/Typed/Control/Osc.hs +10/−10
• src/Csound/Typed/Control/Ref.hs +59/−0
• src/Csound/Typed/Control/SERef.hs +0/−63
• src/Csound/Typed/GlobalState.hs +1/−3
• src/Csound/Typed/GlobalState/Cache.hs +0/−99
• src/Csound/Typed/GlobalState/Elements.hs +21/−29
• src/Csound/Typed/GlobalState/GE.hs +4/−35
• src/Csound/Typed/GlobalState/Instr.hs +18/−20
• src/Csound/Typed/GlobalState/Opcodes.hs +26/−1
• src/Csound/Typed/GlobalState/Options.hs +1/−2
• src/Csound/Typed/Gui/BoxModel.hs +5/−1
• src/Csound/Typed/Types/Evt.hs +24/−30
• src/Csound/Typed/Types/MixSco.hs +6/−6
• src/Csound/Typed/Types/Prim.hs +24/−1
• src/Csound/Typed/Types/Tuple.hs +4/−1

@@ -1,12 +1,12 @@ Name:          csound-expression-typed-Version:       0.0.7.7+Version:       0.0.7.8 Cabal-Version: >= 1.6 License:       BSD3 License-file:  LICENSE Author:	       Anton Kholomiov Synopsis:      typed core for the library csound-expression Stability:     Experimental-Tested-With:   GHC==7.6+Tested-With:   GHC==7.10 Build-Type:    Simple Category:      Music, Sound Maintainer:    <anton.kholomiov@gmail.com>@@ -25,7 +25,7 @@   Ghc-Options:    -Wall   Build-Depends:         base >= 4, base < 5, ghc-prim, containers, transformers >= 0.3, Boolean >= 0.1.0, colour >= 2.0, data-default, deepseq,-        wl-pprint, stable-maps >= 0.0.3.3, csound-expression-dynamic >= 0.1.4.3, temporal-media >= 0.6.0+        wl-pprint, csound-expression-dynamic >= 0.1.4.3, temporal-media >= 0.6.1   Hs-Source-Dirs:      src/   Exposed-Modules:     Csound.Typed@@ -46,8 +46,7 @@     Csound.Typed.GlobalState.Options     Csound.Typed.GlobalState.GE     Csound.Typed.GlobalState.SE-    Csound.Typed.GlobalState.Instr-    Csound.Typed.GlobalState.Cache+    Csound.Typed.GlobalState.Instr         Csound.Typed.GlobalState.Elements     Csound.Typed.GlobalState.Opcodes @@ -61,7 +60,7 @@     Csound.Typed.Control.Sf2     Csound.Typed.Control.Osc     Csound.Typed.Control.Channel-    Csound.Typed.Control.SERef+    Csound.Typed.Control.Ref     Csound.Typed.Control.Instr      Csound.Typed.Gui.Gui

@@ -2,7 +2,7 @@     -- * SE     module Csound.Typed.GlobalState.SE,     -- ** SE reference-    module Csound.Typed.Control.SERef,+    module Csound.Typed.Control.Ref,     -- * Global settings     instr0, getIns, setDur,     -- * Misc@@ -24,7 +24,7 @@ ) where  import Csound.Typed.GlobalState.SE-import Csound.Typed.Control.SERef+import Csound.Typed.Control.Ref  import Csound.Typed.Control.Evt import Csound.Typed.Control.Mix

@@ -4,8 +4,6 @@     retrigs, evtLoop, evtLoopOnce     ) where -import System.Mem.StableName- import Data.Boolean  import Control.Applicative@@ -22,7 +20,7 @@ import Csound.Typed.Control.Instr import Csound.Typed.Control.Mix(Sco) -import Csound.Typed.Control.SERef+import Csound.Typed.Control.Ref import Csound.Typed.Constants(infiniteDur)  renderEvts :: Evt (Sco a) -> Evt [(D, D, a)]@@ -30,52 +28,43 @@     where unEvt e = (T.eventStart e, T.eventDur e, T.eventContent e)  sched :: (Arg a, Sigs b) => (a -> SE b) -> Evt (Sco a) -> b-sched instr evts = apInstr0 $ do-    key <- evtKey evts instr-    withCache InfiniteDur getEvtKey saveEvtKey key $ do-        cacheName <- liftIO $ C.makeCacheName instr-        instrId <- saveSourceInstrCachedWithLivenessWatch cacheName (funArity instr) (insExp instr)-        saveEvtInstr (arityOuts $ funArity instr) instrId (renderEvts evts)+sched instr evts = apInstr0 $ do        +    instrId <- saveSourceInstrWithLivenessWatch (funArity instr) (insExp instr)+    saveEvtInstr (arityOuts $ funArity instr) instrId (renderEvts evts)     where unEvt e = (T.eventStart e, T.eventDur e, T.eventContent e)  -- | Triggers a procedure on the event stream. sched_ :: (Arg a) => (a -> SE ()) -> Evt (Sco a) -> SE () sched_ instr evts = fromDep_ $ hideGEinDep $ do-    key <- evtKey evts instr-    withCache InfiniteDur getEvtProcKey saveEvtProcKey key $ do-        cacheName <- liftIO $ C.makeCacheName instr-        instrId <- saveSourceInstrCached_ cacheName (unitExp $ fmap (const unit) $ instr toArg)-        return $ saveEvtInstr_ instrId (renderEvts evts)+    instrId <- saveSourceInstr_  (unitExp $ fmap (const unit) $ instr toArg)+    return $ saveEvtInstr_ instrId (renderEvts evts)  -- | A closure to trigger an instrument inside the body of another instrument. schedBy :: (Arg a, Sigs b, Arg c) => (a -> SE b) -> (c -> Evt (Sco a)) -> (c -> b) schedBy instr evts args = flip apInstr args $ do-    key <- evtKey evts instr-    withCache InfiniteDur getEvtKey saveEvtKey key $ do        -        cacheName <- liftIO $ C.makeCacheName instr-        instrId <- saveSourceInstrCachedWithLivenessWatch cacheName (funArity instr) (insExp instr)-        saveEvtInstr (arityOuts $ funArity instr) instrId (renderEvts $ evts toArg)  +    instrId <- saveSourceInstrWithLivenessWatch (funArity instr) (insExp instr)+    saveEvtInstr (arityOuts $ funArity instr) instrId (renderEvts $ evts toArg)    ------------------------------------------------- -- triggereing the events  saveEvtInstr :: Arg a => Int -> C.InstrId -> Evt [(D, D, a)] -> GE C.InstrId saveEvtInstr arity instrId evts = saveInstr $ do-    aliveCountRef <- newSERef (10 :: D)+    aliveCountRef <- newRef (10 :: D)     evtMixInstr aliveCountRef     where-        evtMixInstr :: SERef D -> SE ()+        evtMixInstr :: Ref D -> SE ()         evtMixInstr aliveCountRef = do             chnId <- fromDep $ C.chnRefAlloc arity             go aliveCountRef chnId evts             fromDep_ $ hideGEinDep $ fmap (\chn -> C.sendOut arity =<< C.readChn chn) chnId -            aliveCount <- readSERef aliveCountRef+            aliveCount <- readRef aliveCountRef             fromDep_ $ hideGEinDep $ liftA2 masterUpdateChnAlive chnId $ toGE aliveCount  -        go :: Arg a => SERef D -> GE C.ChnRef -> Evt [(D, D, a)] -> SE ()+        go :: Arg a => Ref D -> GE C.ChnRef -> Evt [(D, D, a)] -> SE ()         go aliveCountRef mchnId events =              runEvt events $ \es -> do-                writeSERef aliveCountRef $ int $ 2 * length es+                writeRef aliveCountRef $ int $ 2 * length es                 chnId <- geToSe mchnId                 fromDep_ $ mapM_ (event chnId) es     @@ -86,34 +75,31 @@ -- | Retriggers an instrument every time an event happens. The note -- is held until the next event happens. retrigs :: (Arg a, Sigs b) => (a -> SE b) -> Evt [a] -> b-retrigs instr evts = apInstr0 $ do-    key <- evtKey evts instr-    withCache InfiniteDur getEvtKey saveEvtKey key $ do-        cacheName <- liftIO $ C.makeCacheName instr-        instrId <- saveSourceInstrCachedWithLivenessWatchAndRetrig cacheName (funArity instr) (insExp instr)-        saveRetrigEvtInstr (arityOuts $ funArity instr) instrId evts+retrigs instr evts = apInstr0 $ do       +    instrId <- saveSourceInstrWithLivenessWatchAndRetrig (funArity instr) (insExp instr)+    saveRetrigEvtInstr (arityOuts $ funArity instr) instrId evts     saveRetrigEvtInstr :: Arg a => Int -> C.InstrId -> Evt [a] -> GE C.InstrId saveRetrigEvtInstr arity instrId evts = saveInstr $ do-    aliveCountRef  <- newSERef (10 :: D)-    retrigWatchRef <- newSERef (0  :: D)+    aliveCountRef  <- newRef (10 :: D)+    retrigWatchRef <- newRef (0  :: D)     evtMixInstr aliveCountRef retrigWatchRef     where-        evtMixInstr :: SERef D -> SERef D -> SE ()+        evtMixInstr :: Ref D -> Ref D -> SE ()         evtMixInstr aliveCountRef retrigWatchRef = do             chnId <- fromDep $ C.chnRefAlloc arity             go aliveCountRef retrigWatchRef chnId evts             fromDep_ $ hideGEinDep $ fmap (\chn -> C.sendOut arity =<< C.readChn chn) chnId -            aliveCount <- readSERef aliveCountRef+            aliveCount <- readRef aliveCountRef             fromDep_ $ hideGEinDep $ liftA2 masterUpdateChnAlive chnId $ toGE aliveCount                          -        go :: Arg a => SERef D -> SERef D -> GE C.ChnRef -> Evt [a] -> SE ()+        go :: Arg a => Ref D -> Ref D -> GE C.ChnRef -> Evt [a] -> SE ()         go aliveCountRef retrigWatchRef mchnId events =              runEvt events $ \es -> do-                writeSERef aliveCountRef $ int $ 2 * length es                -                modifySERef retrigWatchRef (+ 1)+                writeRef aliveCountRef $ int $ 2 * length es                +                modifyRef retrigWatchRef (+ 1)                 chnId <- geToSe mchnId-                currentRetrig <- readSERef retrigWatchRef+                currentRetrig <- readRef retrigWatchRef                 fromDep_ $ hideGEinDep $ liftA2 masterUpdateChnRetrig mchnId $ toGE currentRetrig                                                 fromDep_ $ mapM_ (event chnId currentRetrig) es     @@ -130,11 +116,8 @@  evtLoopGen :: (Num a, Tuple a, Sigs a) => Bool -> Maybe (Evt Unit) -> [SE a] -> [Evt Unit] -> a evtLoopGen mustLoop maybeOffEvt instrs evts = apInstr0 $ do-    key <- evtKey evts instr-    withCache InfiniteDur getEvtKey saveEvtKey key $ do-        cacheName <- liftIO $ C.makeCacheName instr        -        (instrId, evtInstrId) <- saveSourceInstrCachedWithLivenessWatchAndRetrigAndEvtLoop cacheName (constArity instr) (insExp $ toInstrExp instr) (toSingleEvt evts)-        saveEvtLoopInstr mustLoop loopLength maybeOffEvt (arityOuts $ constArity instr) instrId evtInstrId+    (instrId, evtInstrId) <- saveSourceInstrWithLivenessWatchAndRetrigAndEvtLoop (constArity instr) (insExp $ toInstrExp instr) (toSingleEvt evts)+    saveEvtLoopInstr mustLoop loopLength maybeOffEvt (arityOuts $ constArity instr) instrId evtInstrId     where                  loopLength = int $ lcm (length instrs) (length evts)         instr = toSingleInstr instrs@@ -142,20 +125,22 @@         toInstrExp :: a -> (Unit -> a)         toInstrExp = const -        toSingleInstr :: (Num a, Tuple a) => [SE a] -> SE a+        toSingleInstr :: (Sigs a, Num a, Tuple a) => [SE a] -> SE a         toSingleInstr as = do             let n = mod' (fromE $ getRetrigVal 4) (sig $ int $ length as)-            ref <- newSERef 0+            ref <- newRef 0             zipWithM_ (f ref n) (fmap (sig . int) [0 .. ]) as-            readSERef ref+            readRef ref             where -                f ref n ix a = when1 (n ==* ix) $ writeSERef ref =<< a+                f :: Tuple a => Ref a -> Sig -> Sig -> SE a -> SE ()+                f ref n ix a = when1 (n ==* ix) $ writeRef ref =<< a          toSingleEvt :: [Evt Unit] -> SE ()         toSingleEvt evts = do             let n = mod' (fromE $ getRetrigVal 4) (sig $ int $ length evts)-            zipWithM_ (f n) (fmap (sig . int) [0 .. ]) evts+            zipWithM_ (f n) (fmap (sig . int) [0 .. ]) evts                         where +                f :: Sig -> Sig -> Evt Unit -> SE ()                 f n ix evt = when1 (n ==* ix) $ evtLoopInstr evt  evtLoopInstr :: Evt Unit -> SE ()@@ -164,39 +149,39 @@  saveEvtLoopInstr :: Bool -> D -> Maybe (Evt Unit) -> Int -> C.InstrId -> C.InstrId -> GE C.InstrId saveEvtLoopInstr mustLoop loopLength maybeOffEvt arity instrId evtInstrId = saveInstr $ do-    aliveCountRef  <- newSERef (10 :: D)-    retrigWatchRef <- newSERef (0  :: D)        +    aliveCountRef  <- newRef (10 :: D)+    retrigWatchRef <- newRef (0  :: D)             evtMixInstr aliveCountRef retrigWatchRef     where-        evtMixInstr :: SERef D -> SERef D -> SE ()+        evtMixInstr :: Ref D -> Ref D -> SE ()         evtMixInstr aliveCountRef retrigWatchRef = do             chnId <- fromDep $ C.chnRefAlloc arity             initStartInstrs chnId             isOn <- fmap sig $ case maybeOffEvt of                 Nothing     -> return 1                 Just offEvt -> do-                    isOn <- newSERef (1 :: D)                    +                    isOn <- newRef (1 :: D)                                         runEvt offEvt $ const $ do-                        writeSERef isOn 0-                        modifySERef retrigWatchRef (+ 1)-                        currentRetrig <- readSERef retrigWatchRef+                        writeRef isOn 0+                        modifyRef retrigWatchRef (+ 1)+                        currentRetrig <- readRef retrigWatchRef                         fromDep_ $ hideGEinDep $ liftA2 masterUpdateChnRetrig chnId $ toGE currentRetrig                        -                    readSERef isOn         +                    readRef isOn                       masterEvt <- fmap (sigToEvt . (* isOn) . fromGE . fmap C.changed . toGE) $ readServantEvt chnId             go aliveCountRef retrigWatchRef chnId masterEvt             fromDep_ $ hideGEinDep $ fmap (\chn -> C.sendOut arity =<< C.readChn chn) chnId -            aliveCount <- readSERef aliveCountRef+            aliveCount <- readRef aliveCountRef             fromDep_ $ hideGEinDep $ liftA2 masterUpdateChnAlive chnId $ toGE aliveCount              go = goBy (+ 1)    -        goBy :: (D -> D) -> SERef D -> SERef D -> GE C.ChnRef -> Evt Unit -> SE ()+        goBy :: (D -> D) -> Ref D -> Ref D -> GE C.ChnRef -> Evt Unit -> SE ()         goBy updateRetrig aliveCountRef retrigWatchRef mchnId events =              runEvt events $ \es -> do                -                modifySERef retrigWatchRef updateRetrig+                modifyRef retrigWatchRef updateRetrig                 chnId <- geToSe mchnId-                currentRetrig <- readSERef retrigWatchRef+                currentRetrig <- readRef retrigWatchRef                 if not mustLoop                      then do                         when1 (sig currentRetrig >=* (sig loopLength)) $ do@@ -241,21 +226,15 @@ -- for some seconds (specified in the first argument) then it's turned off. schedHarp :: (Arg a, Sigs b) => D -> (a -> SE b) -> Evt [a] -> b schedHarp turnOffTime instr evts = apInstr0 $ do-    key <- evtKey evts instr-    withCache InfiniteDur getEvtKey saveEvtKey key $ do-        cacheName <- liftIO $ C.makeCacheName instr-        instrId <- saveSourceInstrCachedWithLivenessWatch cacheName (funArity instr) (insExp $ (autoOff turnOffTime =<< ) . instr)-        saveEvtInstr (arityOuts $ funArity instr) instrId (fmap (fmap phi) evts)+    instrId <- saveSourceInstrWithLivenessWatch (funArity instr) (insExp $ (autoOff turnOffTime =<< ) . instr)+    saveEvtInstr (arityOuts $ funArity instr) instrId (fmap (fmap phi) evts)     where phi a = (0, infiniteDur, a)  -- | A closure to trigger an instrument inside the body of another instrument. schedHarpBy :: (Arg a, Sigs b, Arg c) => D -> (a -> SE b) -> (c -> Evt [a]) -> (c -> b) schedHarpBy turnOffTime instr evts args = flip apInstr args $ do-    key <- evtKey evts instr-    withCache InfiniteDur getEvtKey saveEvtKey key $ do-        cacheName <- liftIO $ C.makeCacheName instr-        instrId <- saveSourceInstrCachedWithLivenessWatch cacheName (funArity instr) (insExp $ (autoOff turnOffTime =<< ) . instr)-        saveEvtInstr (arityOuts $ funArity instr) instrId (fmap (fmap phi) $ evts toArg)+    instrId <- saveSourceInstrWithLivenessWatch (funArity instr) (insExp $ (autoOff turnOffTime =<< ) . instr)+    saveEvtInstr (arityOuts $ funArity instr) instrId (fmap (fmap phi) $ evts toArg)     where phi a = (0, infiniteDur, a)  autoOff :: Sigs a => D -> a -> SE a@@ -269,13 +248,6 @@ saveEvtInstr_ :: Arg a => C.InstrId -> Evt [(D, D, a)] -> Dep () saveEvtInstr_ instrId evts = unSE $ runEvt evts $ \es -> fromDep_ $ mapM_ event es     where event (start, dur, args) = hideGEinDep $ fmap C.event $ C.Event instrId <$> toGE start <*> toGE dur <*> toNote args-----------------------------------------------------------------------evtKey :: a -> b -> GE EvtKey-evtKey a b = liftIO $ EvtKey <$> hash a <*> hash b-    where hash x = hashStableName <$> makeStableName x-  ------------------------------------------------------------------- -- sample level triggering

@@ -11,48 +11,67 @@ import Control.Applicative import Control.Monad import Control.Monad.IO.Class++import Csound.Dynamic+ import Csound.Typed.Types import Csound.Typed.GlobalState import Csound.Typed.Control.Instr-import Csound.Typed.Control.SERef+import Csound.Typed.Control.Ref +import qualified Csound.Typed.GlobalState.Opcodes as C(midiVolumeFactor)+ -- | Triggers a midi-instrument (aka Csound's massign) for all channels.  -- It's useful to test a single instrument. midi :: (Num a, Sigs a) => (Msg -> SE a) -> SE a-midi = fromProcMidi midi_+midi = fromProcMidi midiWithInstrId_  -- | Triggers a midi-instrument (aka Csound's massign) on the specified channel.  midin :: (Num a, Sigs a) => Channel -> (Msg -> SE a) -> SE a-midin n = fromProcMidi (midin_ n)+midin n = fromProcMidi (midinWithInstrId_ n)  -- | Triggers a midi-instrument (aka Csound's pgmassign) on the specified programm bank.  pgmidi :: (Num a, Sigs a) => Maybe Int -> Channel -> (Msg -> SE a) -> SE a-pgmidi mchn n = fromProcMidi (pgmidi_ mchn n)+pgmidi mchn n = fromProcMidi (pgmidiWithInstrId_ mchn n) -fromProcMidi :: (Num a, Sigs a) => ((Msg -> SE ()) -> SE ()) -> (Msg -> SE a) -> SE a+fromProcMidi :: (Num a, Sigs a) => ((InstrId -> Msg -> SE ()) -> SE ()) -> (Msg -> SE a) -> SE a fromProcMidi procMidi f = do-    ref <- newGlobalSERef 0-    procMidi (mixSERef ref <=< f)-    res <- readSERef ref-    writeSERef ref 0+    ref <- newGlobalRef 0+    procMidi (\instrId -> mixRef ref . scaleMidiVolumeFactor instrId <=< f)+    res <- readRef ref+    writeRef ref 0     return res  -----------------------------------------------------------------  -- | Triggers a midi-procedure (aka Csound's massign) for all channels. +midiWithInstrId_ :: (InstrId -> Msg -> SE ()) -> SE ()+midiWithInstrId_ = midinWithInstrId_ 0++-- | Triggers a midi-procedure (aka Csound's pgmassign) on the given channel. +midinWithInstrId_ :: Channel -> (InstrId -> Msg -> SE ()) -> SE ()+midinWithInstrId_ chn instr = genMidi_ Massign chn instr++-- | Triggers a midi-procedure (aka Csound's pgmassign) on the given programm bank. +pgmidiWithInstrId_ :: Maybe Int -> Channel -> (InstrId -> Msg -> SE ()) -> SE ()+pgmidiWithInstrId_ mchn chn instr = genMidi_ (Pgmassign mchn) chn instr++-----------------------------------------------------------------++-- | Triggers a midi-procedure (aka Csound's massign) for all channels.  midi_ :: (Msg -> SE ()) -> SE () midi_ = midin_ 0  -- | Triggers a midi-procedure (aka Csound's pgmassign) on the given channel.  midin_ :: Channel -> (Msg -> SE ()) -> SE ()-midin_ = genMidi_ Massign+midin_ chn instr = genMidi_ Massign chn (const instr)  -- | Triggers a midi-procedure (aka Csound's pgmassign) on the given programm bank.  pgmidi_ :: Maybe Int -> Channel -> (Msg -> SE ()) -> SE ()-pgmidi_ mchn = genMidi_ (Pgmassign mchn)+pgmidi_ mchn chn instr = genMidi_ (Pgmassign mchn) chn (const instr) -genMidi_ :: MidiType -> Channel -> (Msg -> SE ()) -> SE ()-genMidi_ midiType chn instr = geToSe $ saveToMidiInstr midiType chn (unSE $ instr Msg)+genMidi_ :: MidiType -> Channel -> (InstrId -> Msg -> SE ()) -> SE ()+genMidi_ midiType chn instr = geToSe $ saveToMidiInstr midiType chn (\instrId -> unSE $ instr instrId Msg)  ----------------------------------------------------------------- -- midi ctrls@@ -61,3 +80,9 @@ initMidiCtrl chno ctrlno val = geToSe $      saveMidiCtrl =<< (MidiCtrl <$> toGE chno <*> toGE ctrlno <*> toGE val) ++-----------------------------------------------------------------+-- midi volume factor++scaleMidiVolumeFactor :: Sigs a => InstrId -> a -> a+scaleMidiVolumeFactor instrId = mapTuple (C.midiVolumeFactor instrId * )

@@ -9,8 +9,6 @@ import Control.Applicative import Control.Monad.IO.Class import Data.Traversable-import System.Mem.StableName- import Temporal.Media  import Csound.Dynamic hiding (Instr, Sco, str)@@ -43,17 +41,15 @@ -- > res = sco instrument scores  sco :: (Arg a, Sigs b) => (a -> SE b) -> Sco a -> Sco (Mix b) sco instr notes = wrapSco notes $ \events -> do-    events' <- traverse toNote events-    cacheName <- liftIO $ C.makeCacheName instr-    instrId <- saveSourceInstrCachedWithLivenessWatch cacheName (funArity instr) (insExp instr)+    events' <- traverse toNote events    +    instrId <- saveSourceInstrWithLivenessWatch (funArity instr) (insExp instr)     return $ Snd instrId events'  -- | Invokes a procedure for the given bunch of events. sco_ :: (Arg a) => (a -> SE ()) -> Sco a -> Sco (Mix Unit) sco_ instr notes = wrapSco notes $ \events -> do-    events' <- traverse toNote events-    cacheName <- liftIO $ C.makeCacheName instr-    instrId <- saveSourceInstrCached_ cacheName (unitExp $ fmap (const unit) $ instr toArg)+    events' <- traverse toNote events    +    instrId <- saveSourceInstr_ (unitExp $ fmap (const unit) $ instr toArg)     return $ Snd instrId events'  -- | Applies an effect to the sound. Effect is applied to the sound on the give track. @@ -79,29 +75,23 @@  -- | Renders a scores to the sound signals. we can use it inside the other instruments. mix :: (Sigs a) => Sco (Mix a) -> a-mix a = flip apInstr unit $ do-    key <- mixKey a-    durE <- toGE $ dur a-    withCache (ExpDur durE) getMixKey saveMixKey key $ -        saveMixInstr (mixArity a) =<< toEventList a'+mix a = flip apInstr unit $ do    +    setDuration =<< (toGE $ dur a)+    saveMixInstr (mixArity a) =<< toEventList a'     where a' = toCsdEventList a  -- | Imitates a closure for a bunch of notes to be played within another instrument.  mixBy :: (Arg a, Sigs b) => (a -> Sco (Mix b)) -> (a -> b)-mixBy evts args = flip apInstr args $ do-    key <- mixKey evts-    durE <- toGE $ dur evts'-    withCache (ExpDur durE) getMixKey saveMixKey key $ -        saveMixInstr (mixArityFun evts) =<< (toEventList evts')+mixBy evts args = flip apInstr args $ do    +    setDuration =<< (toGE $ dur evts')+    saveMixInstr (mixArityFun evts) =<< (toEventList evts')     where evts' = toCsdEventList $ evts toArg  -- | Converts a bunch of procedures scheduled with scores to a single procedure. mix_ :: Sco (Mix Unit) -> SE ()-mix_ a = fromDep_ $ hideGEinDep $ do-    key <- mixKey a-    durE <- toGE $ dur a-    withCache (ExpDur durE) getMixProcKey saveMixProcKey key $-        saveMixInstr_ =<< toEventList a'+mix_ a = fromDep_ $ hideGEinDep $ do    +    setDuration =<< (toGE $ dur a)+    saveMixInstr_ =<< toEventList a'     where a' = toCsdEventList a  -- | Imitates a closure for a bunch of procedures to be played within another instrument. @@ -109,9 +99,6 @@ mixBy_ evts args = mix_ $ evts args  ------------------------------------------------------------mixKey :: a -> GE MixKey-mixKey = liftIO . fmap (MixKey . hashStableName) . makeStableName  toEventList :: Sco (Mix a) -> GE (CsdEventList M) toEventList evts = fmap delayAndRescaleCsdEventListM $ traverse unMix $ evts    

@@ -11,7 +11,7 @@ import Csound.Typed.GlobalState hiding (oscInit, oscListen, oscSend) import qualified Csound.Typed.GlobalState as C(oscInit, oscListen, oscSend) -import Csound.Typed.Control.SERef+import Csound.Typed.Control.Ref   newtype OscRef = OscRef { unOscRef :: D }@@ -36,9 +36,9 @@ initOsc :: OscPort -> SE OscRef initOsc port = do     oscRef <- fmap fromGE $ fromDep $ C.oscInit (fromIntegral port)-    varRef <- newGlobalSERef (0 :: D)-    writeSERef varRef oscRef-    ihandle <- readSERef varRef+    varRef <- newGlobalRef (0 :: D)+    writeRef varRef oscRef+    ihandle <- readRef varRef     return $ OscRef ihandle  -- | Listens for the OSC-messages. The first argument is OSC-reference.@@ -59,25 +59,25 @@ listenOsc :: forall a . Tuple a => OscRef -> OscAddress -> OscType -> Evt a listenOsc oscRef oscAddr oscType = Evt $ \bam -> do     (readCond, writeCond) <- sensorsSE (0 :: Sig)-    resRef <- newSERef (defTuple :: a)+    resRef <- newRef (defTuple :: a)     writeCond =<< listen resRef     readCond >>= (\cond -> whileDo (cond ==* 1) $ do-        bam =<< readSERef resRef+        bam =<< readRef resRef         writeCond =<< listen resRef)     where-        listen :: Tuple a => SERef a -> SE Sig+        listen :: Tuple a => Ref a -> SE Sig         listen ref = csdOscListen ref oscRef oscAddr oscType -        csdOscListen :: Tuple a => SERef a -> OscRef -> OscAddress -> OscType -> SE Sig+        csdOscListen :: Tuple a => Ref a -> OscRef -> OscAddress -> OscType -> SE Sig         csdOscListen resRef oscHandle addr ty = do-            args <- readSERef resRef+            args <- readRef resRef             res  <- fmap fromGE $ fromDep $ hideGEinDep $ do                  expArgs <- fromTuple args                 expOscHandle <- toGE $ unOscRef oscHandle                 expAddr <- toGE $ text addr                 expOscType <- toGE $ text ty                 return $ C.oscListen $ expOscHandle : expAddr : expOscType : expArgs-            writeSERef resRef args+            writeRef resRef args             return res  -- | Sends OSC-messages. It takes in a name of the host computer 

@@ -0,0 +1,59 @@+module Csound.Typed.Control.Ref where++import Control.DeepSeq(deepseq)++import Control.Monad+import Csound.Dynamic hiding (newLocalVars)++import Csound.Typed.Types.Tuple+import Csound.Typed.GlobalState.SE++-- | It describes a reference to mutable values.+newtype Ref a = Ref [Var]++writeRef :: Tuple a => Ref a -> a -> SE ()+writeRef (Ref vars) a = fromDep_ $ hideGEinDep $ do+    vals <- fromTuple a+    return $ zipWithM_ writeVar vars vals++--    (zipWithM_ writeVar vars) =<< lift (fromTuple a)+--writeVar :: Var -> E -> Dep ()+--[Var] (GE [E])++readRef  :: Tuple a => Ref a -> SE a+readRef (Ref vars) = SE $ fmap (toTuple . return) $ mapM readVar vars++-- | Allocates a new local (it is visible within the instrument) mutable value and initializes it with value. +-- A reference can contain a tuple of variables.+newRef :: Tuple a => a -> SE (Ref a)+newRef t = fmap Ref $ newLocalVars (tupleRates t) (fromTuple t)    +   +-- | Adds the given signal to the value that is contained in the+-- reference.+mixRef :: (Num a, Tuple a) => Ref a -> a -> SE ()+mixRef ref asig = modifyRef ref (+ asig)++-- | Modifies the Ref value with given function.+modifyRef :: Tuple a => Ref a -> (a -> a) -> SE ()+modifyRef ref f = do+    v <- readRef ref      +    writeRef ref (f v)++-- | An alias for the function @newRef@. It returns not the reference+-- to mutable value but a pair of reader and writer functions.+sensorsSE :: Tuple a => a -> SE (SE a, a -> SE ())+sensorsSE a = do+    ref <- newRef a+    return $ (readRef ref, writeRef ref)++-- | Allocates a new global mutable value and initializes it with value. +-- A reference can contain a tuple of variables.+newGlobalRef :: Tuple a => a -> SE (Ref a)+newGlobalRef t = fmap Ref $ newGlobalVars (tupleRates t) (fromTuple t)    ++-- | An alias for the function @newRef@. It returns not the reference+-- to mutable value but a pair of reader and writer functions.+globalSensorsSE :: Tuple a => a -> SE (SE a, a -> SE ())+globalSensorsSE a = do+    ref <- newRef a+    return $ (readRef ref, writeRef ref)

@@ -1,63 +0,0 @@-module Csound.Typed.Control.SERef where--import Control.DeepSeq(deepseq)--import Control.Monad-import Csound.Dynamic hiding (newLocalVars)--import Csound.Typed.Types.Tuple-import Csound.Typed.GlobalState.SE---- | It describes a reference to mutable values.-newtype SERef a = SERef [Var]-{--    { writeSERef :: a -> SE ()-    , readSERef  :: SE a }--}--writeSERef :: Tuple a => SERef a -> a -> SE ()-writeSERef (SERef vars) a = fromDep_ $ hideGEinDep $ do-    vals <- fromTuple a-    return $ zipWithM_ writeVar vars vals----    (zipWithM_ writeVar vars) =<< lift (fromTuple a)---writeVar :: Var -> E -> Dep ()---[Var] (GE [E])--readSERef  :: Tuple a => SERef a -> SE a-readSERef (SERef vars) = SE $ fmap (toTuple . return) $ mapM readVar vars---- | Allocates a new local (it is visible within the instrument) mutable value and initializes it with value. --- A reference can contain a tuple of variables.-newSERef :: Tuple a => a -> SE (SERef a)-newSERef t = fmap SERef $ newLocalVars (tupleRates t) (fromTuple t)    -   --- | Adds the given signal to the value that is contained in the--- reference.-mixSERef :: (Num a, Tuple a) => SERef a -> a -> SE ()-mixSERef ref asig = modifySERef ref (+ asig)---- | Modifies the SERef value with given function.-modifySERef :: Tuple a => SERef a -> (a -> a) -> SE ()-modifySERef ref f = do-    v <- readSERef ref      -    writeSERef ref (f v)---- | An alias for the function @newSERef@. It returns not the reference--- to mutable value but a pair of reader and writer functions.-sensorsSE :: Tuple a => a -> SE (SE a, a -> SE ())-sensorsSE a = do-    ref <- newSERef a-    return $ (readSERef ref, writeSERef ref)---- | Allocates a new global mutable value and initializes it with value. --- A reference can contain a tuple of variables.-newGlobalSERef :: Tuple a => a -> SE (SERef a)-newGlobalSERef t = fmap SERef $ newGlobalVars (tupleRates t) (fromTuple t)    ---- | An alias for the function @newSERef@. It returns not the reference--- to mutable value but a pair of reader and writer functions.-globalSensorsSE :: Tuple a => a -> SE (SE a, a -> SE ())-globalSensorsSE a = do-    ref <- newSERef a-    return $ (readSERef ref, writeSERef ref)

@@ -2,8 +2,7 @@     module Csound.Typed.GlobalState.Options,     module Csound.Typed.GlobalState.GE,     module Csound.Typed.GlobalState.SE,-    module Csound.Typed.GlobalState.Instr,-    module Csound.Typed.GlobalState.Cache,    +    module Csound.Typed.GlobalState.Instr,         -- * Reexports dynamic         BandLimited(..), readBandLimited, renderBandLimited,     Instrs(..), IdMap(..), getInstrIds,@@ -27,6 +26,5 @@ import Csound.Typed.GlobalState.GE import Csound.Typed.GlobalState.SE import Csound.Typed.GlobalState.Instr-import Csound.Typed.GlobalState.Cache import Csound.Typed.GlobalState.Elements import Csound.Typed.GlobalState.Opcodes

@@ -1,99 +0,0 @@-module Csound.Typed.GlobalState.Cache(-    Cache(..), HashKey,    -    -- * Mix-    -- ** Functions-    CacheMix, MixKey(..),-    saveMixKey, getMixKey,-    -- ** Procedures-    CacheMixProc, -    saveMixProcKey, getMixProcKey,-    -- * Evt-    -- ** Functions-    CacheEvt, EvtKey(..),-    saveEvtKey, getEvtKey,-    -- ** Procedures-    CacheEvtProc, -    saveEvtProcKey, getEvtProcKey-) where--import qualified Data.Map as M-import Data.Default--import Csound.Dynamic--data Cache m = Cache -    { cacheMix      :: CacheMix-    , cacheMixProc  :: CacheMixProc m-    , cacheEvt      :: CacheEvt-    , cacheEvtProc  :: CacheEvtProc m }--instance Default (Cache m) where-    def = Cache def def def def--type HashKey = Int--type GetKey  m a b = a -> Cache m -> Maybe b-type SaveKey m a b = a -> b -> Cache m -> Cache m--getKeyMap :: (Ord key) => (Cache m -> M.Map key val) -> GetKey m key val-getKeyMap f key x = M.lookup key $ f x--saveKeyMap :: (Ord key) => (Cache m -> M.Map key val) -> (M.Map key val -> Cache m -> Cache m) -> SaveKey m key val-saveKeyMap getter setter key val cache = setter (M.insert key val $ getter cache) cache--------------------------------------------------------------- Mix---- Mix functions--newtype MixKey = MixKey HashKey-    deriving (Eq, Ord)--type    MixVal = InstrId--type CacheMix = M.Map MixKey MixVal--getMixKey :: GetKey m MixKey MixVal-getMixKey = getKeyMap cacheMix--saveMixKey :: SaveKey m MixKey MixVal-saveMixKey = saveKeyMap cacheMix (\a x -> x { cacheMix = a })---- Mix procedures--type CacheMixProc m = M.Map MixKey (DepT m ())--getMixProcKey :: GetKey m MixKey (DepT m ())-getMixProcKey = getKeyMap cacheMixProc--saveMixProcKey :: SaveKey m MixKey (DepT m ())-saveMixProcKey = saveKeyMap cacheMixProc (\a x -> x { cacheMixProc = a })--------------------------------------------------------------- Evt---- Evt functions--data EvtKey = EvtKey HashKey HashKey-    deriving (Eq, Ord)--type    EvtVal = InstrId--type CacheEvt = M.Map EvtKey EvtVal--getEvtKey :: GetKey m EvtKey EvtVal-getEvtKey = getKeyMap cacheEvt--saveEvtKey :: SaveKey m EvtKey EvtVal-saveEvtKey = saveKeyMap cacheEvt (\a x -> x { cacheEvt = a })---- Evt procedures--type CacheEvtProc m = M.Map EvtKey (DepT m ())--getEvtProcKey :: GetKey m EvtKey (DepT m ())-getEvtProcKey = getKeyMap cacheEvtProc--saveEvtProcKey :: SaveKey m EvtKey (DepT m ())-saveEvtProcKey = saveKeyMap cacheEvtProc (\a x -> x { cacheEvtProc = a })-

@@ -18,7 +18,7 @@     Globals(..), newPersistentGlobalVar, newClearableGlobalVar,      renderGlobals,     -- * Instruments-    Instrs(..), saveInstr, CacheName, makeCacheName, saveCachedInstr, getInstrIds,+    Instrs(..), newInstrId, saveInstrById, saveInstr, getInstrIds,     -- * Src     InstrBody, getIn, sendOut, sendChn, sendGlobal, chnPargId,     Event(..),@@ -29,12 +29,10 @@  import Control.Monad.Trans.State.Strict import Control.Monad(zipWithM_)+import Control.Applicative(liftA2) import Data.Default import qualified Data.Map as M -import qualified System.Mem.StableName.Dynamic as DM-import qualified System.Mem.StableName.Dynamic.Map as DM- import Csound.Dynamic.Types import Csound.Dynamic.Build import Csound.Dynamic.Build.Numeric()@@ -201,10 +199,10 @@ data MidiKey = MidiKey MidiType Channel     deriving (Show, Eq, Ord) -type MidiMap m = M.Map MidiKey (DepT m ())+type MidiMap m = M.Map MidiKey (InstrId -> DepT m ()) -saveMidiInstr :: Monad m => MidiType -> Channel -> DepT m () -> MidiMap m -> MidiMap m-saveMidiInstr ty chn body = M.insertWith (flip (>>)) (MidiKey ty chn) body+saveMidiInstr :: Monad m => MidiType -> Channel -> (InstrId -> DepT m ()) -> MidiMap m -> MidiMap m+saveMidiInstr ty chn body = M.insertWith (liftA2 $ flip (>>)) (MidiKey ty chn) body  -- global variables @@ -250,41 +248,35 @@ -- instrs  data Instrs = Instrs-    { instrsCache   :: DM.Map InstrId-    , instrsNewId   :: Int+    { instrsNewId   :: Int     , instrsContent :: [(InstrId, InstrBody)]     }  instance Default Instrs where-    def = Instrs DM.empty 18 []--type CacheName = DM.DynamicStableName--makeCacheName :: a -> IO CacheName-makeCacheName = DM.makeDynamicStableName +    def = Instrs 18 []  getInstrIds :: Instrs -> [InstrId] getInstrIds = fmap fst . instrsContent  ----------------------------------------------------------------- ---saveCachedInstr :: CacheName -> InstrBody -> State Instrs InstrId -saveCachedInstr name body = state $ \s -> -    case DM.lookup name $ instrsCache s of-        Just n  -> (n, s)-        Nothing -> -            let newId   = instrsNewId s-                s1      = s { instrsCache   = DM.insert name (intInstrId newId) $ instrsCache s-                            , instrsNewId   = succ newId-                            , instrsContent = (intInstrId newId, body) : instrsContent s }-            in  (intInstrId newId, s1) -saveInstr :: InstrBody -> State Instrs InstrId-saveInstr body = state $ \s ->+newInstrId :: State Instrs InstrId+newInstrId = state $ \s ->     let newId   = instrsNewId s-        s1      = s { instrsNewId   = succ newId-                    , instrsContent = (intInstrId newId, body) : instrsContent s }+        s1      = s { instrsNewId = succ newId }         in  (intInstrId newId, s1)++saveInstrById :: InstrId -> InstrBody -> State Instrs ()+saveInstrById instrId body = state $ \s -> +    let s1 = s { instrsContent = (instrId, body) : instrsContent s }+    in  ((), s1)++saveInstr :: InstrBody -> State Instrs InstrId+saveInstr body = do+    newId <- newInstrId+    saveInstrById newId body+    return newId  ----------------------------------------------------------------- -- sound sources

@@ -10,7 +10,7 @@     saveAlwaysOnInstr, onInstr, saveUserInstr0, getSysExpr,     -- * Total duration     TotalDur(..), pureGetTotalDurForF0, getTotalDurForTerminator, -    setDurationForce, setDuration, setDurationToInfinite,    +    setDurationForce, setDuration, setDurationToInfinite,     -- * Notes     addNote,     -- * GEN routines@@ -21,8 +21,6 @@     saveBandLimitedWave,     -- * Strings     saveStr,-    -- * Cache-    GetCache, SetCache, withCache,     -- * Guis     newGuiHandle, saveGuiRoot, saveDefKeybdPanel, appendToGui,      newGuiVar, getPanels, guiHandleToVar,@@ -46,7 +44,6 @@ import Csound.Dynamic   import Csound.Typed.GlobalState.Options-import Csound.Typed.GlobalState.Cache import Csound.Typed.GlobalState.Elements import Csound.Typed.Constants(infiniteDur) @@ -94,12 +91,11 @@     , alwaysOnInstrs    :: [InstrId]     , notes             :: [(InstrId, CsdEvent)]     , userInstr0        :: Dep ()-    , bandLimitedMap    :: BandLimitedMap-    , cache             :: Cache GE+    , bandLimitedMap    :: BandLimitedMap         , guis              :: Guis }  instance Default History where-    def = History def def def def def def def def def def def def (return ()) def def def+    def = History def def def def def def def def def def def def (return ()) def def  data Msg = Msg data MidiAssign = MidiAssign MidiType Channel InstrId@@ -179,7 +175,7 @@ saveMidi ma = onMidis $ modify (ma: )     where onMidis = onHistory midis (\a h -> h { midis = a }) -saveToMidiInstr :: MidiType -> Channel -> Dep () -> GE ()+saveToMidiInstr :: MidiType -> Channel -> (InstrId -> Dep ()) -> GE () saveToMidiInstr ty chn expr = onMidiMap (saveMidiInstr ty chn expr)     where onMidiMap = modifyHistoryField midiMap (\a h -> h { midiMap = a }) @@ -255,33 +251,6 @@  onGlobals :: UpdField Globals a onGlobals = onHistory globals (\a h -> h { globals = a })--------------------------------------------------------------------------- cache---- midi functions--type GetCache a b = a -> Cache GE -> Maybe b--fromCache :: GetCache a b -> a -> GE (Maybe b)-fromCache f key = withHistory $ f key . cache--type SetCache a b = a -> b -> Cache GE -> Cache GE--toCache :: SetCache a b -> a -> b -> GE () -toCache f key val = modifyHistory $ \h -> h { cache = f key val (cache h) }--withCache :: TotalDur -> GetCache key val -> SetCache key val -> key -> GE val -> GE val-withCache dur lookupResult saveResult key getResult = do    -    ma <- fromCache lookupResult key-    res <- case ma of-        Just a      -> return a-        Nothing     -> do-            r <- getResult-            toCache saveResult key r-            return r-    setTotalDur dur-    return res  -------------------------------------------------------- -- guis

@@ -11,7 +11,6 @@ import Csound.Typed.GlobalState.GE import Csound.Typed.GlobalState.SE import Csound.Typed.GlobalState.Options-import Csound.Typed.GlobalState.Cache import Csound.Typed.GlobalState.Opcodes(turnoff2, exitnow, servantUpdateChnAlive, servantUpdateChnRetrig) import Csound.Typed.GlobalState.Elements(getInstrIds) @@ -26,45 +25,42 @@ saveInstr :: SE () -> GE InstrId saveInstr a = onInstr . C.saveInstr =<< execSE a -saveCachedInstr :: C.CacheName -> SE () -> GE InstrId-saveCachedInstr cacheName a = onInstr . C.saveCachedInstr cacheName =<< execSE a- livenessWatch :: Arity -> SE () livenessWatch arity = fromDep_ $ servantUpdateChnAlive (C.chnPargId $ arityIns arity)  retrigWatch :: Arity -> SE () retrigWatch arity = fromDep_ $ servantUpdateChnRetrig (C.chnPargId $ arityIns arity) -saveSourceInstrCachedWithLivenessWatch :: C.CacheName -> Arity -> InsExp -> GE InstrId-saveSourceInstrCachedWithLivenessWatch cacheName arity instr = saveCachedInstr cacheName $ do+saveSourceInstrWithLivenessWatch :: Arity -> InsExp -> GE InstrId+saveSourceInstrWithLivenessWatch arity instr = saveInstr $ do     toOut =<< instr     livenessWatch arity      where toOut = SE . C.sendChn (arityIns arity) (arityOuts arity) -saveSourceInstrCachedWithLivenessWatchAndRetrig :: C.CacheName -> Arity -> InsExp -> GE InstrId-saveSourceInstrCachedWithLivenessWatchAndRetrig cacheName arity instr = saveCachedInstr cacheName $ do+saveSourceInstrWithLivenessWatchAndRetrig :: Arity -> InsExp -> GE InstrId+saveSourceInstrWithLivenessWatchAndRetrig arity instr = saveInstr $ do     toOut =<< instr     retrigWatch arity     livenessWatch arity         where toOut = SE . C.sendChn (arityIns arity) (arityOuts arity) -saveSourceInstrCachedWithLivenessWatchAndRetrigAndEvtLoop :: C.CacheName -> Arity -> InsExp -> UnitExp -> GE (InstrId, InstrId)-saveSourceInstrCachedWithLivenessWatchAndRetrigAndEvtLoop cacheName arity instr evtInstr = do -    instrId <- saveSourceInstrCachedWithLivenessWatchAndRetrig cacheName arity instr+saveSourceInstrWithLivenessWatchAndRetrigAndEvtLoop :: Arity -> InsExp -> UnitExp -> GE (InstrId, InstrId)+saveSourceInstrWithLivenessWatchAndRetrigAndEvtLoop arity instr evtInstr = do +    instrId <- saveSourceInstrWithLivenessWatchAndRetrig  arity instr     evtInstrId <- saveInstr (evtInstr >> retrigWatch evtInstrArity >> livenessWatch evtInstrArity)     return (instrId, evtInstrId)     where          evtInstrArity = Arity 0 0         -saveSourceInstrCached :: C.CacheName -> Arity -> InsExp -> GE InstrId-saveSourceInstrCached cacheName arity instr = saveCachedInstr cacheName $ toOut =<< instr+saveSourceInstr :: Arity -> InsExp -> GE InstrId+saveSourceInstr arity instr = saveInstr $ toOut =<< instr     where toOut = SE . C.sendChn (arityIns arity) (arityOuts arity) -saveSourceInstrCached_ :: C.CacheName -> UnitExp -> GE InstrId-saveSourceInstrCached_ cacheName instr = saveCachedInstr cacheName instr+saveSourceInstr_ :: UnitExp -> GE InstrId+saveSourceInstr_ instr = saveInstr instr -saveSourceInstrCachedWithLivenessWatch_ :: C.CacheName -> Arity -> UnitExp -> GE InstrId-saveSourceInstrCachedWithLivenessWatch_ cacheName arity instr = saveCachedInstr cacheName $ +saveSourceInstrWithLivenessWatch_ :: Arity -> UnitExp -> GE InstrId+saveSourceInstrWithLivenessWatch_ arity instr = saveInstr $      instr >> livenessWatch arity  saveEffectInstr :: Arity -> EffExp -> GE InstrId@@ -100,11 +96,13 @@ saveMidiMap :: GE () saveMidiMap = do     m <- fmap midiMap getHistory-    mapM_ (\(C.MidiKey midiType channel, instrExpr) -> saveMidiInstr_ midiType channel (SE instrExpr)) $ toList m+    mapM_ (\(C.MidiKey midiType channel, instrExpr) -> saveMidiInstr_ midiType channel (SE . instrExpr)) $ toList m -saveMidiInstr_ :: C.MidiType -> C.Channel -> UnitExp -> GE ()+saveMidiInstr_ :: C.MidiType -> C.Channel -> (InstrId -> UnitExp) -> GE () saveMidiInstr_ midiType channel instr = do-    instrId <- onInstr . C.saveInstr =<< execSE instr+    instrId <- onInstr C.newInstrId+    onInstr . C.saveInstrById instrId =<< execSE (instr instrId)+    -- instrId <- onInstr . C.saveInstr =<< execSE instr     saveMidi $ MidiAssign midiType channel instrId     saveIns0 :: Int -> [Rate] -> SE [E] -> GE [E]

@@ -16,14 +16,21 @@     oscInit, oscListen, oscSend,     -- * channels     chnGet, chnSet,+    -- * metro+    metro,     -- * times     times,     -- * Fluid     fluidEngine, fluidLoad, fluidProgramSelect,     -- * Soundfonts-    sfSetList+    sfSetList,+    -- * Midi+    midiVolumeFactor ) where ++import Prelude hiding ((<*))+ import Control.Monad(zipWithM_, forM_) import Data.Boolean @@ -297,6 +304,12 @@ chnSet r val chn = depT_ $ opcs "chnset" [(Xr, [r, Sr])] [val, chn]  -----------------------------------------------------------+-- metro++metro :: E -> E+metro a = opcs "metro" [(Kr, [Kr])] [a]++----------------------------------------------------------- -- times  times :: Monad m => DepT m E@@ -333,3 +346,15 @@     sfplist sf     forM_ presets $ \(bank, prog, index) -> sfpreset bank prog sf index     +-----------------------------------------------------------+-- midi volume factor (normalize by number of notes)++midiVolumeFactor :: InstrId -> E+midiVolumeFactor idx = flip port 0.0015 $ ifB (n ==* 0) 1 (recip n)+    where n = sqrt (active idx)++active :: InstrId -> E    +active instrId = opcs "active" [(Kr, [Ir])] [instrIdE instrId]++port :: E -> E -> E+port a b = opcs "port" [(Kr, [Kr, Ir])] [a, b]

@@ -11,7 +11,6 @@ ) where  import Control.Applicative-import Data.Monoid import Data.Default import qualified Data.IntMap as IM @@ -46,7 +45,7 @@         , csdTabFi          = csdTabFi a <|> csdTabFi b }  defGain :: Options -> Double-defGain = maybe 0.5 id . csdGain+defGain = maybe 0.8 id . csdGain  defSampleRate :: Options -> Int defSampleRate = maybe 44100 id . csdSampleRate

@@ -6,9 +6,9 @@     appendContext, cascade, boundingRect, zeroRect ) where +import Control.Monad import Control.Monad.Trans.State.Strict import Data.Default-import Data.Monoid  data Interval = Interval      { start :: Int@@ -54,6 +54,10 @@     | Ver Offset [Scene ctx a]     | Context ctx (Scene ctx a)     deriving (Show, Functor)++instance Applicative (Scene ctx) where+    pure = return+    (<*>) = ap  instance Monad (Scene ctx) where     return = Prim

@@ -13,7 +13,7 @@ import Csound.Typed.Types.Prim import Csound.Typed.Types.Tuple import Csound.Typed.GlobalState-import Csound.Typed.Control.SERef+import Csound.Typed.Control.Ref  import qualified Csound.Typed.GlobalState.Opcodes as C @@ -134,18 +134,18 @@ -- an event happens and zero otherwise. evtToBool :: Evt a -> SE BoolSig evtToBool evt = do-    var <- newSERef (double 0)-    writeSERef var (double 0)-    runEvt evt $ const $ writeSERef var (double 1)-    asig <- readSERef var+    var <- newRef (double 0)+    writeRef var (double 0)+    runEvt evt $ const $ writeRef var (double 1)+    asig <- readRef var     return $ boolSig $ asig ==* (double 1)  -- | Converts events to signals. stepper :: Tuple a => a -> Evt a -> SE a stepper v0 evt = do-    (readSt, writeSt) <- sensorsSE v0-    runEvt evt $ \a -> writeSt a-    readSt +    ref <- newGlobalRef v0+    runEvt evt $ \a -> writeRef ref a+    readRef ref  ------------------------------------------------------------- -- synchronization@@ -153,29 +153,23 @@ -- | Executes actions synchronized with global tempo (in Hz). --  -- > runEvtSync tempoCps evt proc-sync :: (Default a, Tuple a) => D -> Evt a -> Evt a-sync dt evt = Evt $ \bam -> do-    initGlobalTime <- times-    refCounter <- newSERef $ frac' $ initGlobalTime * dt-    refVal     <- newSERef def-    refFire    <- newSERef (0 :: D)+sync :: (Default a, Tuple a) => Sig -> Evt a -> Evt a+sync dt evt = Evt $ \bam -> do    +    refVal     <- newRef def+    refFire    <- newRef (0 :: D)      runEvt evt $ \a -> do-        writeSERef refVal  a-        writeSERef refFire 1--    updCounter <- readSERef refCounter-    writeSERef refCounter (updCounter - 1 / getControlRate)--    counter <- readSERef refCounter-    fire    <- readSERef refFire-    when1 (sig counter <=* 0 &&* sig fire ==* 1) $ do-        val <- readSERef refVal+        writeRef refVal  a+        writeRef refFire 1     +    +    fire    <- readRef refFire+    when1 (metro dt  ==* 1 &&* sig fire ==* 1) $ do+        val <- readRef refVal         bam val-        writeSERef refFire 0-        -    when1 (sig counter <=* 0) $ do-        writeSERef refCounter (1 / dt)-    where        -        times = fmap D $ fromDep C.times+        writeRef refFire 0   +    where+        metro :: Sig -> Sig+        metro asig = fromGE $ fmap C.metro $ toGE asig++        

@@ -11,7 +11,7 @@ import Csound.Typed.GlobalState.Opcodes import Csound.Typed.GlobalState.GE import Csound.Typed.GlobalState.SE-import Csound.Typed.Control.SERef+import Csound.Typed.Control.Ref import Csound.Typed.Types.Prim  import qualified Temporal.Media as T@@ -61,21 +61,21 @@ renderMixSco :: Int -> CsdEventList M -> Dep [E] renderMixSco arity evts = do     chnId <- chnRefAlloc arity  -    aliveCountRef <- unSE $ newSERef (10 :: D)  +    aliveCountRef <- unSE $ newRef (10 :: D)       go aliveCountRef chnId evts         readChn chnId     where -        go :: SERef D -> ChnRef -> CsdEventList M -> Dep ()+        go :: Ref D -> ChnRef -> CsdEventList M -> Dep ()         go aliveCountRef outId xs = do             mapM_ (onEvent aliveCountRef outId) notes-            unSE $ writeSERef aliveCountRef $ int $ 2 * length notes-            aliveCount <- unSE $ readSERef aliveCountRef+            unSE $ writeRef aliveCountRef $ int $ 2 * length notes+            aliveCount <- unSE $ readRef aliveCountRef             hideGEinDep $ liftA2 masterUpdateChnAlive (return chnId) $ toGE aliveCount              where                  notes = csdEventListNotes xs                 chnId = outId -        onEvent :: SERef D -> ChnRef -> (D, D, M) -> Dep ()+        onEvent :: Ref D -> ChnRef -> (D, D, M) -> Dep ()         onEvent aliveCountRef outId (start, dur, x) = case x of             Snd instrId es          -> onSnd aliveCountRef instrId outId es             Eff instrId es arityIn  -> onEff aliveCountRef instrId start dur outId es arityIn

@@ -24,9 +24,12 @@     quot', rem', div', mod', ceil', floor', round', int', frac',         -- ** logic funs-    when1, whens, untilDo, whileDo, boolSig+    when1, whens, untilDo, whileDo, boolSig,+    equalsTo, notEqualsTo, lessThan, greaterThan, lessThanEquals, greaterThanEquals ) where +import Prelude hiding ((<*))+ import Control.Applicative hiding ((<*)) import Control.Monad import Control.Monad.Trans.Class@@ -591,6 +594,26 @@ boolSig x = case x of     PrimBoolD b -> PrimBoolSig b     BoolD a     -> BoolSig a++infix  4  `equalsTo`, `notEqualsTo`, `lessThan`, `lessThanEquals`, `greaterThanEquals`, `greaterThan`++equalsTo :: EqB a => a -> a -> BooleanOf a+equalsTo = (==*)++notEqualsTo :: EqB a => a -> a -> BooleanOf a+notEqualsTo = (/=*)++lessThan :: OrdB a => a -> a -> BooleanOf a+lessThan = (<*) ++greaterThan :: OrdB a => a -> a -> BooleanOf a+greaterThan = (>*)++lessThanEquals :: OrdB a => a -> a -> BooleanOf a+lessThanEquals = (<=*)++greaterThanEquals :: OrdB a => a -> a -> BooleanOf a+greaterThanEquals = (>=*)  ---------------------------------------------- 

@@ -6,7 +6,7 @@ module Csound.Typed.Types.Tuple(     -- ** Tuple     Tuple(..), TupleMethods, makeTupleMethods, -    fromTuple, toTuple, tupleArity, tupleRates, defTuple,+    fromTuple, toTuple, tupleArity, tupleRates, defTuple, mapTuple,      Sig2, Sig3, Sig4, Sig5, Sig6, Sig8, @@ -67,6 +67,9 @@  defTuple :: Tuple a => a defTuple = defTuple_ tupleMethods++mapTuple :: Tuple a => (E -> E) -> a -> a+mapTuple f a = toTuple (fmap (fmap f) $ fromTuple a)  -- | Defines instance of type class 'Tuple' for a new type in terms of an already defined one. makeTupleMethods :: (Tuple a) => (a -> b) -> (b -> a) -> TupleMethods b