csound-expression-typed 0.0.4 → 0.0.5

raw patch · 10 files changed

+98/−75 lines, 10 filesPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

API changes (from Hackage documentation)

Files

• csound-expression-typed.cabal +1/−1
• src/Csound/Typed/Control.hs +8/−1
• src/Csound/Typed/Control/Evt.hs +39/−35
• src/Csound/Typed/Control/Instr.hs +1/−1
• src/Csound/Typed/Control/Mix.hs +1/−1
• src/Csound/Typed/GlobalState.hs +1/−1
• src/Csound/Typed/GlobalState/GE.hs +37/−20
• src/Csound/Typed/GlobalState/Instr.hs +2/−10
• src/Csound/Typed/GlobalState/Opcodes.hs +4/−1
• src/Csound/Typed/Render.hs +4/−4

@@ -1,5 +1,5 @@ Name:          csound-expression-typed-Version:       0.0.4+Version:       0.0.5 Cabal-Version: >= 1.6 License:       BSD3 License-file:  LICENSE

@@ -4,7 +4,7 @@     -- ** SE reference     module Csound.Typed.Control.SERef,     -- * Global settings-    instr0, getIns,+    instr0, getIns, setDur,     -- * Score     module Csound.Typed.Control.Mix,     -- * Midi@@ -45,4 +45,11 @@         proxy :: SE a -> a         proxy = const undefined +-- | Sets total duration to the given value.+setDur :: Sigs a => D -> a -> a+setDur mdt as = toTuple $ do+    dt <- toGE mdt+    vals <- fromTuple as+    setDurationForce dt+    return vals 

@@ -1,8 +1,8 @@ {-# Language FlexibleContexts #-} module Csound.Typed.Control.Evt(-    trig, sched, schedHarp, -    trigBy, schedBy, schedHarpBy,-    trig_, sched_,+    trigs, scheds, schedHarps, +    trigsBy, schedsBy, schedHarpsBy,+    trigs_, scheds_, ) where  import System.Mem.StableName@@ -24,8 +24,8 @@ -- contains triples: -- -- > (delay_after_event_is_fired, duration_of_the_event, argument_for_the_instrument)-trig :: (Arg a, Sigs b) => (a -> SE b) -> Evt (D, D, a) -> b-trig instr evts = apInstr0 $ do+trigs :: (Arg a, Sigs b) => (a -> SE b) -> Evt [(D, D, a)] -> b+trigs instr evts = apInstr0 $ do     key <- evtKey evts instr     withCache InfiniteDur getEvtKey saveEvtKey key $ do         cacheName <- liftIO $ C.makeCacheName instr@@ -33,15 +33,15 @@         saveEvtInstr (arityOuts $ funArity instr) instrId evts  -- | A closure to trigger an instrument inside the body of another instrument.-trigBy :: (Arg a, Sigs b, Arg c) => (a -> SE b) -> (c -> Evt (D, D, a)) -> (c -> b)-trigBy instr evts args = flip apInstr args $ do+trigsBy :: (Arg a, Sigs b, Arg c) => (a -> SE b) -> (c -> Evt [(D, D, a)]) -> (c -> b)+trigsBy instr evts args = flip apInstr args $ do     key <- evtKey evts instr     withCache InfiniteDur getEvtKey saveEvtKey key $ do                 cacheName <- liftIO $ C.makeCacheName instr         instrId <- saveSourceInstrCached cacheName (funArity instr) (insExp instr)         saveEvtInstr (arityOuts $ funArity instr) instrId (evts toArg)   -saveEvtInstr :: Arg a => Int -> C.InstrId -> Evt (D, D, a) -> GE C.InstrId+saveEvtInstr :: Arg a => Int -> C.InstrId -> Evt [(D, D, a)] -> GE C.InstrId saveEvtInstr arity instrId evts = saveInstr evtMixInstr     where         evtMixInstr :: SE ()@@ -50,54 +50,58 @@             go chnId evts             fromDep_ $ hideGEinDep $ fmap (\chn -> C.sendOut arity =<< C.readChn chn) chnId  -        go :: Arg a => GE C.ChnRef -> Evt (D, D, a) -> SE ()-        go mchnId es = -            runEvt es $ \(start, dur, args) -> fromDep_ $ hideGEinDep $ do-                chnId <- mchnId-                e <- C.Event instrId <$> toGE start <*> toGE dur <*> (fmap (++ [C.chnRefId chnId]) $ toNote args) -                return $ C.event e +        go :: Arg a => GE C.ChnRef -> Evt [(D, D, a)] -> SE ()+        go mchnId events = +            runEvt events $ \es -> do+                chnId <- geToSe mchnId+                fromDep_ $ mapM_ (event chnId) es+    +        event :: Arg a => C.ChnRef -> (D, D, a) -> Dep ()+        event chnId (start, dur, args) = hideGEinDep $ fmap C.event $ +            C.Event instrId <$> toGE start <*> toGE dur <*> (fmap (++ [C.chnRefId chnId]) $ toNote args) +             --- | It's like the function @trig@, but delay is set to zero.-sched :: (Arg a, Sigs b) => (a -> SE b) -> Evt (D, a) -> b-sched instr evts = apInstr0 $ do+-- | It's like the function @trigs@, but delay is set to zero.+scheds :: (Arg a, Sigs b) => (a -> SE b) -> Evt [(D, a)] -> b+scheds instr evts = apInstr0 $ do     key <- evtKey evts instr     withCache InfiniteDur getEvtKey saveEvtKey key $ do         cacheName <- liftIO $ C.makeCacheName instr         instrId <- saveSourceInstrCached cacheName (funArity instr) (insExp instr)-        saveEvtInstr (arityOuts $ funArity instr) instrId (fmap phi evts)  +        saveEvtInstr (arityOuts $ funArity instr) instrId (fmap (fmap phi) evts)       where phi (a, b) = (0, a, b)       -- | A closure to trigger an instrument inside the body of another instrument.-schedBy :: (Arg a, Sigs b, Arg c) => (a -> SE b) -> (c -> Evt (D, a)) -> (c -> b)-schedBy instr evts args = flip apInstr args $ do+schedsBy :: (Arg a, Sigs b, Arg c) => (a -> SE b) -> (c -> Evt [(D, a)]) -> (c -> b)+schedsBy instr evts args = flip apInstr args $ do     key <- evtKey evts instr     withCache InfiniteDur getEvtKey saveEvtKey key $ do         cacheName <- liftIO $ C.makeCacheName instr         instrId <- saveSourceInstrCached cacheName (funArity instr) (insExp instr)-        saveEvtInstr (arityOuts $ funArity instr) instrId (fmap phi $ evts toArg)  +        saveEvtInstr (arityOuts $ funArity instr) instrId (fmap (fmap phi) $ evts toArg)       where phi (a, b) = (0, a, b)  -- | An instrument is triggered with event stream and delay time is set to zero  -- (event fires immediately) and duration is set to inifinite time. The note is  -- held while the instrument is producing something. If the instrument is silent -- 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+schedHarps :: (Arg a, Sigs b) => D -> (a -> SE b) -> Evt [a] -> b+schedHarps turnOffTime instr evts = apInstr0 $ do     key <- evtKey evts instr     withCache InfiniteDur getEvtKey saveEvtKey key $ do         cacheName <- liftIO $ C.makeCacheName instr         instrId <- saveSourceInstrCached cacheName (funArity instr) (insExp $ (autoOff turnOffTime =<< ) . instr)-        saveEvtInstr (arityOuts $ funArity instr) instrId (fmap phi evts)+        saveEvtInstr (arityOuts $ funArity instr) instrId (fmap (fmap phi) evts)     where phi a = (0, -1, 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+schedHarpsBy :: (Arg a, Sigs b, Arg c) => D -> (a -> SE b) -> (c -> Evt [a]) -> (c -> b)+schedHarpsBy turnOffTime instr evts args = flip apInstr args $ do     key <- evtKey evts instr     withCache InfiniteDur getEvtKey saveEvtKey key $ do         cacheName <- liftIO $ C.makeCacheName instr         instrId <- saveSourceInstrCached cacheName (funArity instr) (insExp $ (autoOff turnOffTime =<< ) . instr)-        saveEvtInstr (arityOuts $ funArity instr) instrId (fmap phi $ evts toArg)+        saveEvtInstr (arityOuts $ funArity instr) instrId (fmap (fmap phi) $ evts toArg)     where phi a = (0, -1, a)  autoOff :: Sigs a => D -> a -> SE a@@ -110,8 +114,8 @@ -----------------------------------------------------------------------  -- | Triggers a procedure on the event stream.-trig_ :: (Arg a) => (a -> SE ()) -> Evt (D, D, a) -> SE ()-trig_ instr evts = fromDep_ $ hideGEinDep $ do+trigs_ :: (Arg a) => (a -> SE ()) -> Evt [(D, D, a)] -> SE ()+trigs_ instr evts = fromDep_ $ hideGEinDep $ do     key <- evtKey evts instr     withCache InfiniteDur getEvtProcKey saveEvtProcKey key $ do         cacheName <- liftIO $ C.makeCacheName instr@@ -119,18 +123,18 @@         return $ saveEvtInstr_ instrId evts  -- | Triggers a procedure on the event stream. A delay time is set to zero.-sched_ :: (Arg a) => (a -> SE ()) -> Evt (D, a) -> SE ()-sched_ instr evts = fromDep_ $ hideGEinDep $ do+scheds_ :: (Arg a) => (a -> SE ()) -> Evt [(D, a)] -> SE ()+scheds_ 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 $ fmap phi evts+        return $ saveEvtInstr_ instrId $ fmap (fmap phi) evts     where phi (a, b) = (0, a, b) -saveEvtInstr_ :: Arg a => C.InstrId -> Evt (D, D, a) -> Dep ()-saveEvtInstr_ instrId evts = unSE $ runEvt evts $ \(start, dur, args) -> fromDep_ $ hideGEinDep$ -    fmap C.event $ C.Event instrId <$> toGE start <*> toGE dur <*> toNote args+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  ------------------------------------------------------------------- 

@@ -1,6 +1,6 @@ -- | Converts to low-level instruments module Csound.Typed.Control.Instr(-    Arity(..), InsExp, EffExp,+    Arity(..), InsExp, EffExp,      funArity, constArity,      insExp, effExp, masterExp, midiExp, unitExp,      apInstr, apInstr0

@@ -15,7 +15,7 @@  import Csound.Typed.Types import Csound.Typed.Types.MixSco-import Csound.Typed.GlobalState+import Csound.Typed.GlobalState hiding (notes) import Csound.Typed.Control.Instr  -- | Special type that represents a scores of sound signals.

@@ -7,7 +7,7 @@     -- * Reexports dynamic     BandLimited(..), readBandLimited, renderBandLimited,     Instrs(..), IdMap(..), getInstrIds,-    getIn, chnUpdateUdo, renderGlobals, turnoff, turnoff2+    getIn, chnUpdateUdo, renderGlobals, turnoff, turnoff2, exitnow ) where  import Csound.Typed.GlobalState.Options

@@ -8,7 +8,8 @@     -- * Instruments     saveAlwaysOnInstr, onInstr, saveUserInstr0, getSysExpr,     -- * Total duration-    TotalDur(..), getTotalDurGE, getTotalDur, setDuration, setDurationToInfinite,+    TotalDur(..), pureGetTotalDurForF0, getTotalDurForTerminator, +    setDurationForce, setDuration, setDurationToInfinite,     -- * Notes     addNote,     -- * GEN routines@@ -102,23 +103,42 @@         massign n instr = depT_ $ opcs "massign" [(Xr, [Ir,Ir])] [int n, prim $ PrimInstrId instr]         pgmassign pgm instr mchn = depT_ $ opcs "pgmassign" [(Xr, [Ir,Ir,Ir])] ([int pgm, prim $ PrimInstrId instr] ++ maybe [] (return . int) mchn) -data TotalDur = NumDur Double | InfiniteDur+data TotalDur = ExpDur E | NumDur Double | InfiniteDur     deriving (Eq, Ord) -getTotalDurGE :: GE Double-getTotalDurGE = do-    opt <- getOptions-    dt  <- fmap totalDur getHistory-    return $ getTotalDur opt dt+getTotalDurForF0 :: GE Double+getTotalDurForF0 = fmap (pureGetTotalDurForF0 . totalDur) getHistory -getTotalDur :: Options -> (Maybe TotalDur) -> Double-getTotalDur _ = toDouble . maybe InfiniteDur id  -    where +getTotalDurForTerminator :: GE E+getTotalDurForTerminator = fmap (getTotalDurForTerminator' . totalDur) getHistory++pureGetTotalDurForF0 :: Maybe TotalDur -> Double+pureGetTotalDurForF0 = toDouble . maybe InfiniteDur id  +    where         toDouble x = case x of             NumDur d    -> d+            _           -> infiniteDur+ +getTotalDurForTerminator' :: Maybe TotalDur -> E+getTotalDurForTerminator' = toExpr . maybe InfiniteDur id+    where+        toExpr x = case x of+            NumDur d    -> double d             InfiniteDur -> infiniteDur-        infiniteDur = 7 * 24 * 60 * 60 -- a week+            ExpDur e    -> e             +infiniteDur :: Num a => a+infiniteDur = 7 * 24 * 60 * 60 -- a week        ++setDurationToInfinite :: GE ()+setDurationToInfinite = setTotalDur InfiniteDur++setDuration :: Double -> GE ()+setDuration = setTotalDur . NumDur++setDurationForce :: E -> GE ()+setDurationForce = setTotalDur . ExpDur + saveStr :: String -> GE E saveStr = fmap prim . onStringMap . newString     where onStringMap = onHistory stringMap (\val h -> h{ stringMap = val })@@ -132,13 +152,6 @@     where onBandLimitedMap = onHistory                  (\a -> (genMap a, bandLimitedMap a))                  (\(gm, blm) h -> h { genMap = gm, bandLimitedMap = blm})--setDurationToInfinite :: GE ()-setDurationToInfinite = setTotalDur InfiniteDur--setDuration :: Double -> GE ()-setDuration = setTotalDur . NumDur- setTotalDur :: TotalDur -> GE () setTotalDur = onTotalDur . modify . const . Just     where onTotalDur = onHistory totalDur (\a h -> h { totalDur = a })@@ -151,8 +164,12 @@ saveUserInstr0 expr = onUserInstr0 $ modify ( >> expr)     where onUserInstr0 = onHistory userInstr0 (\a h -> h { userInstr0 = a }) -getSysExpr :: GE (Dep ())-getSysExpr = withHistory $ clearGlobals . globals+getSysExpr :: InstrId -> GE (Dep ())+getSysExpr terminatorInstrId = do+    e1 <- withHistory $ clearGlobals . globals+    dt <- getTotalDurForTerminator+    let e2 = event_i $ Event terminatorInstrId dt 0.01 [] +    return $ e1 >> e2     where clearGlobals = snd . renderGlobals  saveAlwaysOnInstr :: InstrId -> GE ()

@@ -10,7 +10,7 @@ import Csound.Typed.GlobalState.SE import Csound.Typed.GlobalState.Options import Csound.Typed.GlobalState.Cache-import Csound.Typed.GlobalState.Opcodes(turnoff2)+import Csound.Typed.GlobalState.Opcodes(turnoff2, exitnow) import Csound.Typed.GlobalState.Elements(getInstrIds)  data Arity = Arity@@ -76,16 +76,8 @@     saveUserInstr0 $ unSE $ (SE . zipWithM_ writeVar vars) =<< as      return $ fmap readOnlyVar vars -saveTerminatorInstr :: GE () -saveTerminatorInstr = do-    instrId <- saveInstr =<< terminatorInstr-    dt <- getTotalDurGE-    addNote instrId (dt, 0.01, [])- terminatorInstr :: GE (SE ()) terminatorInstr = do     ids <- fmap (getInstrIds . instrs) getHistory-    return $ fromDep_ $ mapM_ turnoff2 $ fmap instrIdE ids-    -    +    return $ fromDep_ $ (mapM_ turnoff2 $ fmap instrIdE ids) >> exitnow 

@@ -6,7 +6,7 @@     -- * trigger an instrument     Event(..), event, event_i, appendChn, subinstr, subinstr_, changed,     -- * output-    out, outs, safeOut, autoOff, turnoff, turnoff2,+    out, outs, safeOut, autoOff, turnoff, turnoff2, exitnow,     -- * vco2     oscili, oscilikt, vco2ft, vco2ift, vco2init, ftgen,     -- * times@@ -154,6 +154,9 @@  turnoff2 :: Monad m => E -> DepT m () turnoff2 instrId = depT_ $ opcs "turnoff2" [(Xr, [Ir, Ir, Ir])] [instrId, 0, 0]++exitnow :: Monad m => DepT m ()+exitnow = depT_ $ opcs "exitnow" [(Xr, [])] []  ihold :: Monad m => DepT m () ihold = depT_ $ opcs "ihold" [(Xr, [])] []

@@ -25,7 +25,6 @@ toCsd :: Tuple a => Options -> SE a -> GE Csd toCsd options sigs = do        saveMasterInstr (constArity sigs) (masterExp sigs)-    saveTerminatorInstr     renderHistory (outArity sigs) options  renderOut_ :: SE () -> IO String@@ -50,8 +49,9 @@ renderHistory nchnls opt = do     keyEventListener <- getKeyEventListener     hist1 <- getHistory-    instr0 <- execDepT $ getInstr0 nchnls opt hist1-    expr2 <- getSysExpr +    instr0 <- execDepT $ getInstr0 nchnls opt hist1    +    terminatorInstrId <- saveInstr =<< terminatorInstr+    expr2 <- getSysExpr terminatorInstrId      saveAlwaysOnInstr =<< saveInstr (SE expr2)     expr3 <- guiInstrExp      saveAlwaysOnInstr =<< saveInstr (SE expr3)@@ -59,7 +59,7 @@     let orc = Orc instr0 (maybeAppend keyEventListener $ fmap (uncurry Instr) $ instrsContent $ instrs hist2)        hist3 <- getHistory      let flags   = reactOnMidi hist3 $ csdFlags opt-        sco     = Sco (Just $ getTotalDur opt $ totalDur hist3) +        sco     = Sco (Just $ pureGetTotalDurForF0 $ totalDur hist3)                        (renderGens $ genMap hist3) $                       ((fmap alwaysOn $ alwaysOnInstrs hist3) ++ (getNoteEvents $ notes hist3))     return $ Csd flags orc sco