packages feed

csound-expression-typed 0.0.5.3 → 0.0.5.4

raw patch · 12 files changed

+332/−23 lines, 12 filesdep ~csound-expression-dynamic

Dependency ranges changed: csound-expression-dynamic

Files

csound-expression-typed.cabal view
@@ -1,5 +1,5 @@ Name:          csound-expression-typed-Version:       0.0.5.3+Version:       0.0.5.4 Cabal-Version: >= 1.6 License:       BSD3 License-file:  LICENSE@@ -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.3, data-default,-        wl-pprint, stable-maps >= 0.0.3.3, csound-expression-dynamic >= 0.0.6+        wl-pprint, stable-maps >= 0.0.3.3, csound-expression-dynamic >= 0.0.7   Hs-Source-Dirs:      src/   Exposed-Modules:     Csound.Typed@@ -58,7 +58,9 @@     Csound.Typed.Control.Vco     Csound.Typed.Control.Mix     Csound.Typed.Control.Midi+    Csound.Typed.Control.Sf2     Csound.Typed.Control.Osc+    Csound.Typed.Control.Channel     Csound.Typed.Control.SERef     Csound.Typed.Control.Instr
src/Csound/Typed/Control.hs view
@@ -11,6 +11,10 @@     module Csound.Typed.Control.Midi,     -- * OSC     module Csound.Typed.Control.Osc,+    -- * Channel+    module Csound.Typed.Control.Channel,+    -- * Sf2+    module Csound.Typed.Control.Sf2,     -- * Events     module Csound.Typed.Control.Evt,     -- * Band-limited oscillators@@ -25,6 +29,8 @@ import Csound.Typed.Control.Mix import Csound.Typed.Control.Midi import Csound.Typed.Control.Osc+import Csound.Typed.Control.Channel+import Csound.Typed.Control.Sf2 import Csound.Typed.Control.Vco  import Csound.Typed.Types
+ src/Csound/Typed/Control/Channel.hs view
@@ -0,0 +1,76 @@+-- | Named channels.+--+-- With named channels we can read and +-- write values to the variables with dynamic names.+-- We can specify the variable with string (Str).+--+-- Csound has an C api wich is ported to many languages.+-- With named channels we can interact with csound+-- that runns a program. We can read and write to named channels+-- from another program.+module Csound.Typed.Control.Channel(+    -- * Getters+    chnGetD, chnGetSig, chnGetCtrl, chnGetStr,++    -- * Setters+    chnSetD, chnSetSig, chnSetCtrl, chnSetStr+) where++import Control.Monad.Trans.Class++import Csound.Dynamic(Rate(..))+import Csound.Typed.Types+import Csound.Typed.GlobalState++-- getters++-- | Reads a value of type double.+chnGetD :: Str -> SE D+chnGetD = get Ir++-- | Reads a control signal. +-- The control signals are updated at +-- the lower rate. +chnGetCtrl :: Str -> SE Sig+chnGetCtrl = get Kr++-- | Reads an audio signal.+chnGetSig :: Str -> SE Sig+chnGetSig = get Ar++-- | Reads a string.+chnGetStr :: Str -> SE Str+chnGetStr = get Sr++-- setters+++-- | Writes a value of type double.+chnSetD :: D -> Str -> SE ()+chnSetD = set Ir++-- | Writes an audio signal.+chnSetSig :: Sig -> Str -> SE ()+chnSetSig = set Ar++-- | Writes a control signal. +-- The control signals are updated at +-- the lower rate. +chnSetCtrl :: Sig -> Str -> SE ()+chnSetCtrl = set Kr++-- | Writes a string.+chnSetStr :: Str -> Str -> SE ()+chnSetStr = set Sr++------------------------------------------------------++get :: Val a => Rate -> Str -> SE a+get rate chn = fmap fromGE $ fromDep $ (chnGet rate) =<< (lift $ unStr chn)++set :: Val a => Rate -> a -> Str -> SE ()+set rate val chn = fromDep_ $ do+    v <- lift $ toGE val+    c <- lift $ unStr chn+    chnSet rate v c+
src/Csound/Typed/Control/Evt.hs view
@@ -17,6 +17,8 @@ import Csound.Typed.GlobalState import Csound.Typed.Control.Instr +import Csound.Typed.Control.SERef+ ------------------------------------------------- -- triggereing the events @@ -29,7 +31,7 @@     key <- evtKey evts instr     withCache InfiniteDur getEvtKey saveEvtKey key $ do         cacheName <- liftIO $ C.makeCacheName instr-        instrId <- saveSourceInstrCached cacheName (funArity instr) (insExp instr)+        instrId <- saveSourceInstrCachedWithLivenessWatch cacheName (funArity instr) (insExp instr)         saveEvtInstr (arityOuts $ funArity instr) instrId evts  -- | A closure to trigger an instrument inside the body of another instrument.@@ -38,21 +40,26 @@     key <- evtKey evts instr     withCache InfiniteDur getEvtKey saveEvtKey key $ do                 cacheName <- liftIO $ C.makeCacheName instr-        instrId <- saveSourceInstrCached cacheName (funArity instr) (insExp instr)+        instrId <- saveSourceInstrCachedWithLivenessWatch 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 arity instrId evts = saveInstr evtMixInstr+saveEvtInstr arity instrId evts = saveInstr $ do+    aliveCountRef <- newSERef (10 :: D)+    evtMixInstr aliveCountRef     where-        evtMixInstr :: SE ()-        evtMixInstr = do+        evtMixInstr :: SERef D -> SE ()+        evtMixInstr aliveCountRef = do             chnId <- fromDep $ C.chnRefAlloc arity-            go chnId evts+            go aliveCountRef chnId evts             fromDep_ $ hideGEinDep $ fmap (\chn -> C.sendOut arity =<< C.readChn chn) chnId +            aliveCount <- readSERef aliveCountRef+            fromDep_ $ hideGEinDep $ liftA2 masterUpdateChnAlive chnId $ toGE aliveCount  -        go :: Arg a => GE C.ChnRef -> Evt [(D, D, a)] -> SE ()-        go mchnId events = +        go :: Arg a => SERef D -> GE C.ChnRef -> Evt [(D, D, a)] -> SE ()+        go aliveCountRef mchnId events =              runEvt events $ \es -> do+                writeSERef aliveCountRef $ int $ 2 * length es                 chnId <- geToSe mchnId                 fromDep_ $ mapM_ (event chnId) es     @@ -67,7 +74,7 @@     key <- evtKey evts instr     withCache InfiniteDur getEvtKey saveEvtKey key $ do         cacheName <- liftIO $ C.makeCacheName instr-        instrId <- saveSourceInstrCached cacheName (funArity instr) (insExp instr)+        instrId <- saveSourceInstrCachedWithLivenessWatch cacheName (funArity instr) (insExp instr)         saveEvtInstr (arityOuts $ funArity instr) instrId (fmap (fmap phi) evts)       where phi (a, b) = (0, a, b)      @@ -77,7 +84,7 @@     key <- evtKey evts instr     withCache InfiniteDur getEvtKey saveEvtKey key $ do         cacheName <- liftIO $ C.makeCacheName instr-        instrId <- saveSourceInstrCached cacheName (funArity instr) (insExp instr)+        instrId <- saveSourceInstrCachedWithLivenessWatch cacheName (funArity instr) (insExp instr)         saveEvtInstr (arityOuts $ funArity instr) instrId (fmap (fmap phi) $ evts toArg)       where phi (a, b) = (0, a, b) @@ -90,7 +97,7 @@     key <- evtKey evts instr     withCache InfiniteDur getEvtKey saveEvtKey key $ do         cacheName <- liftIO $ C.makeCacheName instr-        instrId <- saveSourceInstrCached cacheName (funArity instr) (insExp $ (autoOff turnOffTime =<< ) . instr)+        instrId <- saveSourceInstrCachedWithLivenessWatch cacheName (funArity instr) (insExp $ (autoOff turnOffTime =<< ) . instr)         saveEvtInstr (arityOuts $ funArity instr) instrId (fmap (fmap phi) evts)     where phi a = (0, -1, a) @@ -100,7 +107,7 @@     key <- evtKey evts instr     withCache InfiniteDur getEvtKey saveEvtKey key $ do         cacheName <- liftIO $ C.makeCacheName instr-        instrId <- saveSourceInstrCached cacheName (funArity instr) (insExp $ (autoOff turnOffTime =<< ) . instr)+        instrId <- saveSourceInstrCachedWithLivenessWatch cacheName (funArity instr) (insExp $ (autoOff turnOffTime =<< ) . instr)         saveEvtInstr (arityOuts $ funArity instr) instrId (fmap (fmap phi) $ evts toArg)     where phi a = (0, -1, a)
+ src/Csound/Typed/Control/Sf2.hs view
@@ -0,0 +1,36 @@+{-# Language TypeFamilies #-}+module Csound.Typed.Control.Sf2(+    Sf(..), unSf+) where++import Data.Boolean+import Data.Default++import qualified Csound.Dynamic as D++import Csound.Typed.Types+import Csound.Typed.GlobalState++-- | The sf2 sound font preset. It is defined with+-- file name, bank and program integers.+data Sf = Sf +    { sfName :: String+    , sfBank :: Int+    , sfProg :: Int } +    | SfId (GE E)+    +instance Val Sf where+    fromGE = SfId+    toGE   = unSf++unSf :: Sf -> GE E+unSf x = case x of+    SfId a -> a+    Sf name bank prog -> fmap D.int $ saveSf (SfSpec name bank prog)++instance Default Sf where +    def = fromE 0++type instance BooleanOf Sf  = BoolD+instance IfB Sf where ifB = on3 ifB+
src/Csound/Typed/GlobalState.hs view
@@ -8,7 +8,12 @@     BandLimited(..), readBandLimited, renderBandLimited,     Instrs(..), IdMap(..), getInstrIds,     getIn, chnUpdateUdo, renderGlobals, turnoff, turnoff2, exitnow,-    oscListen, oscInit, oscSend+    oscListen, oscInit, oscSend,+    chnSet, chnGet, +    masterUpdateChnAlive,+    servantUpdateChnAlive,+    SfFluid(..), SfSpec(..), renderSf, sfVar,+    sfSetList ) where  import Csound.Typed.GlobalState.Options
src/Csound/Typed/GlobalState/Elements.hs view
@@ -4,6 +4,8 @@     IdMap(..), saveId, newIdMapId,     -- ** Gens     GenMap, newGen, newGenId,+    -- Sf2+    SfFluid(..), SfSpec(..), SfMap, newSf, sfVar, renderSf,     -- ** Band-limited waveforms     BandLimited(..), BandLimitedMap,      saveBandLimited, renderBandLimited,@@ -16,7 +18,7 @@     -- * Instruments     Instrs(..), saveInstr, CacheName, makeCacheName, saveCachedInstr, getInstrIds,     -- * Src-    InstrBody, getIn, sendOut, sendChn, sendGlobal, +    InstrBody, getIn, sendOut, sendChn, sendGlobal, chnPargId,     Event(..),     ChnRef(..), chnRefFromParg, chnRefAlloc, readChn, writeChn, chnUpdateUdo,     subinstr, subinstr_, event_i, event, safeOut, autoOff, changed@@ -79,6 +81,46 @@ newString :: String -> State StringMap Prim newString = fmap PrimInt . saveId +-- sf++data SfFluid = SfFluid +    { sfId   :: Int+    , sfVars :: [Var] }++data SfSpec = SfSpec+    { sfName    :: String+    , sfBank    :: Int+    , sfProgram :: Int +    } deriving (Eq, Ord, Show)++type SfMap = IdMap SfSpec++newSf :: SfSpec -> State SfMap Int+newSf = saveId++sfVar :: Int -> E+sfVar n = readOnlyVar (VarVerbatim Ir $ sfEngineName n)++sfEngineName :: Int -> String+sfEngineName n = "gi_Sf_engine_" ++ show n++sfInstrName :: Int -> String+sfInstrName n = "i_Sf_instr_" ++ show n++renderSf :: Monad m => SfSpec -> Int -> DepT m ()+renderSf (SfSpec name bank prog) n = verbatim $ +    engineStr ++ "\n" +++    loadStr   ++ "\n" +++    selectProgStr ++ "\n"+    where +        engineStr = engineName ++ " fluidEngine"+        loadStr   = insName ++ " fluidLoad \"" ++ name ++ "\", " ++  engineName ++ ", 1"+        selectProgStr = "fluidProgramSelect " ++ engineName ++ ", 1, " ++ insName +            ++ ", " ++ show bank ++ ", " ++ show prog++        engineName = sfEngineName n+        insName    = sfInstrName n+ -- band-limited waveforms (used with vco2init)  data BandLimited = Saw | Pulse | Square | Triangle | IntegratedSaw | UserGen Gen@@ -267,7 +309,10 @@     return (fmap readOnlyVar vars, zipWithM_ (appendVarBy (+)) vars sigs)  sendChn :: Monad m => Int -> Int -> [E] -> DepT m ()-sendChn arityIns arityOuts sigs = writeChn (chnRefFromParg (4 + arityIns) arityOuts) sigs+sendChn arityIns arityOuts sigs = writeChn (chnRefFromParg (chnPargId arityIns) arityOuts) sigs++chnPargId :: Int -> Int+chnPargId arityIns = 4 + arityIns  -- guis
src/Csound/Typed/GlobalState/GE.hs view
@@ -15,6 +15,8 @@     addNote,     -- * GEN routines     saveGen,+    -- * Sf2+    saveSf, sfTable,     -- * Band-limited waves     saveBandLimitedWave,     -- * Strings@@ -34,6 +36,7 @@ import Data.Boolean import Data.Default import qualified Data.IntMap as IM+import qualified Data.Map    as M  import Control.Monad.IO.Class import Control.Monad.Trans.Class@@ -79,6 +82,7 @@ data History = History     { genMap            :: GenMap     , stringMap         :: StringMap+    , sfMap             :: SfMap     , globals           :: Globals     , instrs            :: Instrs     , midis             :: [MidiAssign]@@ -92,7 +96,7 @@     , guis              :: Guis }  instance Default History where-    def = History 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 (return ()) def def def  data Msg = Msg data MidiAssign = MidiAssign MidiType Channel InstrId@@ -153,6 +157,15 @@ saveGen = onGenMap . newGen     where onGenMap = onHistory genMap (\val h -> h{ genMap = val }) +onSfMap :: State SfMap a -> GE a+onSfMap = onHistory sfMap (\val h -> h{ sfMap = val })++saveSf :: SfSpec -> GE Int+saveSf = onSfMap . newSf ++sfTable :: History -> [(SfSpec, Int)]+sfTable = M.toList . idMapContent . sfMap+ saveBandLimitedWave :: BandLimited -> GE Int saveBandLimitedWave = onBandLimitedMap . saveBandLimited     where onBandLimitedMap = onHistory @@ -188,6 +201,9 @@  addNote :: InstrId -> CsdEvent Note -> GE () addNote instrId evt = modifyHistory $ \h -> h { notes = (instrId, evt) : notes h }+++  {- setMasterInstrId :: InstrId -> GE ()
src/Csound/Typed/GlobalState/Instr.hs view
@@ -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, exitnow)+import Csound.Typed.GlobalState.Opcodes(turnoff2, exitnow, servantUpdateChnAlive) import Csound.Typed.GlobalState.Elements(getInstrIds)  data Arity = Arity@@ -27,12 +27,25 @@ 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)++saveSourceInstrCachedWithLivenessWatch :: C.CacheName -> Arity -> InsExp -> GE InstrId+saveSourceInstrCachedWithLivenessWatch cacheName arity instr = saveCachedInstr cacheName $ do+    toOut =<< instr+    livenessWatch arity +    where toOut = SE . C.sendChn (arityIns arity) (arityOuts arity)+ saveSourceInstrCached :: C.CacheName -> Arity -> InsExp -> GE InstrId saveSourceInstrCached cacheName arity instr = saveCachedInstr cacheName $ toOut =<< instr     where toOut = SE . C.sendChn (arityIns arity) (arityOuts arity)  saveSourceInstrCached_ :: C.CacheName -> UnitExp -> GE InstrId saveSourceInstrCached_ cacheName instr = saveCachedInstr cacheName instr++saveSourceInstrCachedWithLivenessWatch_ :: C.CacheName -> Arity -> UnitExp -> GE InstrId+saveSourceInstrCachedWithLivenessWatch_ cacheName arity instr = saveCachedInstr cacheName $ +    instr >> livenessWatch arity  saveEffectInstr :: Arity -> EffExp -> GE InstrId saveEffectInstr arity eff = saveInstr $ setOuts =<< eff =<< getIns
src/Csound/Typed/GlobalState/Opcodes.hs view
@@ -2,7 +2,7 @@     sprintf,     -- * channel opcodes     ChnRef(..), chnRefFromParg, chnRefAlloc, readChn, writeChn, -    chnUpdateUdo,+    chnUpdateUdo, masterUpdateChnAlive, servantUpdateChnAlive,     -- * trigger an instrument     Event(..), event, event_i, appendChn, subinstr, subinstr_, changed,     -- * output@@ -11,11 +11,17 @@     oscili, oscilikt, vco2ft, vco2ift, vco2init, ftgen,     -- * OSC     oscInit, oscListen, oscSend,+    -- * channels+    chnGet, chnSet,     -- * times-    times+    times,+    -- * Fluid+    fluidEngine, fluidLoad, fluidProgramSelect,+    -- * Soundfonts+    sfSetList ) where -import Control.Monad(zipWithM_)+import Control.Monad(zipWithM_, forM_) import Data.Boolean  import Csound.Dynamic@@ -52,6 +58,21 @@ chnName name chnId = sprintf formatString [chnId]     where formatString = str $ 'p' : show name ++ "_" ++ "%d" +masterUpdateChnAlive :: Monad m => ChnRef -> E -> DepT m ()+masterUpdateChnAlive ref count = chnsetK count (chnAliveName $ chnRefId ref)    ++servantUpdateChnAlive :: Monad m => Int -> DepT m ()+servantUpdateChnAlive pargId = do+    let sName = chnAliveName (pn pargId) +    kAlive <- chngetK sName+    when1 (kAlive <* 0) $ do+        turnoff+    chnsetK (kAlive - 1) sName++chnAliveName :: E -> E+chnAliveName chnId = sprintf formatString [chnId]+    where formatString = str $ "alive" ++ "_" ++ "%d"+ sprintf :: E -> [E] -> E sprintf a as = opcs "sprintf" [(Sr, Sr:repeat Ir)] (a:as) @@ -65,6 +86,12 @@ chnget :: Monad m => E -> DepT m E chnget name = depT $ opcs "chnget" [(Ar, [Sr])] [name] +chngetK :: Monad m => E -> DepT m E+chngetK name = depT $ opcs "chnget" [(Kr, [Sr])] [name]++chnsetK :: Monad m => E -> E -> DepT m ()+chnsetK val name = depT_ $ opcsNoInlineArgs "chnset" [(Xr, [Kr, Sr])] [val, name]+ chnclear :: Monad m => E -> DepT m () chnclear name = depT_ $ opcs "chnclear" [(Xr, [Sr])] [name] @@ -213,8 +240,48 @@ oscSend args = depT_ $ opcs "OSCsend" [(Xr, Kr:Ir:Ir:Ir:Ir:repeat Xr)] args  -----------------------------------------------------------+-- Channel++chnGet :: Monad m => Rate -> E -> DepT m E+chnGet r chn = depT $ opcs "chnget" [(r, [Sr])] [chn]++chnSet :: Monad m => Rate -> E -> E -> DepT m ()+chnSet r val chn = depT_ $ opcs "chnset" [(Xr, [r, Sr])] [val, chn]++----------------------------------------------------------- -- times  times :: Monad m => DepT m E times = depT $ opcs "times" [(Ir, []), (Kr, [])] [] +-----------------------------------------------------------+-- fluid engine++fluidEngine :: Monad m => DepT m E+fluidEngine = depT $ opcs "fluidEngine" [(Ir, [])] []++fluidLoad :: Monad m => String -> E -> DepT m E+fluidLoad sfName engine = depT $ opcs "fluidLoad" [(Ir, [Sr, Ir, Ir])] [str sfName, engine, 1]++fluidProgramSelect :: Monad m => E -> E -> Int -> Int -> DepT m E+fluidProgramSelect engine sfInstr bank prog = depT $ opcs "fluidProgramSelect" +    [(Xr, replicate 5 Ir)] [engine, 1, sfInstr, int bank, int prog]++-----------------------------------------------------------+-- soundfonts++sfload :: Monad m => String -> DepT m E+sfload fileName =  depT $ opcs "sfload" [(Ir, [Sr])] [str fileName]++sfplist :: Monad m => E -> DepT m ()+sfplist sf = depT_ $ opcs "sfplist" [(Xr, [Ir])] [sf]++sfpreset :: Monad m => Int -> Int -> E -> Int -> DepT m ()+sfpreset bank prog sf index = depT_ $ opcs "iPreset sfpreset" [(Xr, [Ir, Ir, Ir, Ir])] [int prog, int bank, sf, int index]++sfSetList :: Monad m => String -> [(Int, Int, Int)] -> DepT m ()+sfSetList fileName presets = do+    sf <- sfload fileName+    sfplist sf+    forM_ presets $ \(bank, prog, index) -> sfpreset bank prog sf index+
src/Csound/Typed/Render.hs view
@@ -11,6 +11,8 @@ import Data.Default import Data.Maybe import Data.Tuple+import Data.Ord+import Data.List(sortBy, groupBy)  import Csound.Dynamic hiding (csdFlags) import Csound.Typed.Types@@ -76,7 +78,8 @@     initGlobals     renderBandLimited (genMap hist) (bandLimitedMap hist)     userInstr0 hist-    chnUpdateUdo +    chnUpdateUdo+    sf2     guiStmt $ getPanels hist     where         globalConstants = do@@ -90,6 +93,11 @@          initGlobals = fst $ renderGlobals $ globals $ hist +        sf2 = mapM_ (uncurry sfSetList) $ sfGroup $ sfTable hist+        sfGroup = fmap phi . groupBy (\a b -> getName a == getName b) . sortBy (comparing getName)+            where +                getName = sfName . fst+                phi as = (getName $ head as, fmap (\(sf, index) -> (sfBank sf, sfProgram sf, index)) as)  reactOnMidi :: History -> Flags -> Flags reactOnMidi h flags
src/Csound/Typed/Types/Prim.hs view
@@ -6,6 +6,7 @@     -- ** Tables     preTab, TabSize(..), TabArgs(..), updateTabSize,     fromPreTab, getPreTabUnsafe, skipNorm, forceNorm,+    nsamp, ftlen, ftchnls, ftsr, ftcps,      -- ** constructors     double, int, text, @@ -427,4 +428,31 @@ -- | Creates a constant boolean signal. boolSig :: BoolD -> BoolSig boolSig = fromGE . toGE+++----------------------------------------------++-- | nsamp — Returns the number of samples loaded into a stored function table number.+--+-- > nsamp(x) (init-rate args only)+--+-- csound doc: <http://www.csounds.com/manual/html/nsamp.html>+nsamp :: Tab -> D+nsamp = on1 $ opr1 "nsamp"++-- | Returns a length of the table.+ftlen :: Tab -> D+ftlen = on1 $ opr1 "ftlen"++-- | Returns the number of channels for a table that stores wav files+ftchnls :: Tab -> D+ftchnls = on1 $ opr1 "ftchnls"++-- | Returns the sample rate for a table that stores wav files+ftsr :: Tab -> D+ftsr = on1 $ opr1 "ftsr"++-- | Returns the base frequency for a table that stores wav files+ftcps :: Tab -> D+ftcps = on1 $ opr1 "ftcps"