csound-expression-typed 0.0.5.2 → 0.0.5.3

raw patch · 12 files changed

+204/−28 lines, 12 filesdep ~csound-expression-dynamicPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependency ranges changed: csound-expression-dynamic

API changes (from Hackage documentation)

Files

• csound-expression-typed.cabal +3/−2
• src/Csound/Typed/Control.hs +3/−0
• src/Csound/Typed/Control/Midi.hs +9/−1
• src/Csound/Typed/Control/Osc.hs +98/−0
• src/Csound/Typed/Control/SERef.hs +16/−1
• src/Csound/Typed/GlobalState.hs +2/−1
• src/Csound/Typed/GlobalState/GE.hs +17/−6
• src/Csound/Typed/GlobalState/Opcodes.hs +15/−1
• src/Csound/Typed/GlobalState/SE.hs +14/−2
• src/Csound/Typed/Gui/Widget.hs +6/−10
• src/Csound/Typed/Render.hs +3/−1
• src/Csound/Typed/Types/Prim.hs +18/−3

@@ -1,5 +1,5 @@ Name:          csound-expression-typed-Version:       0.0.5.2+Version:       0.0.5.3 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.5+        wl-pprint, stable-maps >= 0.0.3.3, csound-expression-dynamic >= 0.0.6   Hs-Source-Dirs:      src/   Exposed-Modules:     Csound.Typed@@ -58,6 +58,7 @@     Csound.Typed.Control.Vco     Csound.Typed.Control.Mix     Csound.Typed.Control.Midi+    Csound.Typed.Control.Osc     Csound.Typed.Control.SERef     Csound.Typed.Control.Instr 

@@ -9,6 +9,8 @@     module Csound.Typed.Control.Mix,     -- * Midi     module Csound.Typed.Control.Midi,+    -- * OSC+    module Csound.Typed.Control.Osc,     -- * Events     module Csound.Typed.Control.Evt,     -- * Band-limited oscillators@@ -22,6 +24,7 @@ import Csound.Typed.Control.Evt import Csound.Typed.Control.Mix import Csound.Typed.Control.Midi+import Csound.Typed.Control.Osc import Csound.Typed.Control.Vco  import Csound.Typed.Types

@@ -2,7 +2,8 @@ module Csound.Typed.Control.Midi(     Msg, Channel,     midi, midin, pgmidi, -    midi_, midin_, pgmidi_+    midi_, midin_, pgmidi_,+    initMidiCtrl ) where  import System.Mem.StableName@@ -57,4 +58,11 @@  midiKey :: MidiType -> Channel -> a -> GE MidiKey midiKey ty chn a = liftIO $ MidiKey ty chn . hashStableName <$> makeStableName a  ++-----------------------------------------------------------------+-- midi ctrls++initMidiCtrl :: D -> D -> D -> SE ()+initMidiCtrl chno ctrlno val = geToSe $ +    saveMidiCtrl =<< (MidiCtrl <$> toGE chno <*> toGE ctrlno <*> toGE val) 

@@ -0,0 +1,98 @@+-- | Open sound control +{-# Language ScopedTypeVariables #-}+module Csound.Typed.Control.Osc(+    OscRef, OscHost, OscPort, OscAddress, OscType, +    initOsc, listenOsc, sendOsc+) where++import Data.Boolean ((==*))++import Csound.Typed.Types+import Csound.Typed.GlobalState hiding (oscInit, oscListen, oscSend)+import qualified Csound.Typed.GlobalState as C(oscInit, oscListen, oscSend)++import Csound.Typed.Control.SERef+++newtype OscRef = OscRef { unOscRef :: D }++-- | Port to listen OSC-messages.+type OscPort = Int++-- | Path-like string ("/foo/bar/baz")+type OscAddress = String++ +-- | The string specifies the type of expected arguments. +-- The string can contain the characters "bcdfilmst" which stand for +-- Boolean, character, double, float, 32-bit integer, 64-bit integer, MIDI, +-- string and timestamp.+type OscType = String++-- | The hostname of the computer. An empty string is for local machine.+type OscHost = String++-- | Initializes host client. The process starts to run in the background.+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+    return $ OscRef ihandle++-- | Listens for the OSC-messages. The first argument is OSC-reference.+-- We can create it with the function @oscInit@. The next two arguments are strings.+-- The former specifies the path-like address to listen the messages. It can be:+--+-- > /foo/bar/baz+--+-- The latter specifies the type of expected arguments. +-- The string can contain the characters "bcdfilmst" which stand for +-- Boolean, character, double, float, 32-bit integer, 64-bit integer, MIDI, +-- string and timestamp.+--+-- The result is an event of messages. We can run a callback on it+-- with standard function @runEvt@:+--+-- > runEvt :: Evt a -> (a -> SE ()) -> SE ()+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)+    writeCond =<< listen resRef+    readCond >>= (\cond -> whileDo (cond ==* 1) $ do+        bam =<< readSERef resRef+        writeCond =<< listen resRef)+    where+        listen :: Tuple a => SERef a -> SE Sig+        listen ref = csdOscListen ref oscRef oscAddr oscType++        csdOscListen :: Tuple a => SERef a -> OscRef -> OscAddress -> OscType -> SE Sig+        csdOscListen resRef oscHandle addr ty = do+            args <- readSERef 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+            return res++-- | Sends OSC-messages. It takes in a name of the host computer +-- (empty string is alocal machine), port on which the target +-- machine is listening, OSC-addres and type. The last argument+-- produces the values for OSC-messages.+sendOsc :: forall a . Tuple a => OscHost -> OscPort -> OscAddress -> OscType -> Evt a -> SE ()+sendOsc host port addr ty evts = runEvt evts send+    where +        send :: Tuple a => a -> SE ()+        send as = SE $ hideGEinDep $ do+            args <- fromTuple as+            expHost <- toGE $ text $ host+            expPort <- toGE $ int  $ port+            expAddr <- toGE $ text $ addr+            expTy   <- toGE $ text $ ty+            return $ C.oscSend $ 1 : expHost : expPort : expAddr : expTy : args+

@@ -12,7 +12,7 @@     { writeSERef :: a -> SE ()     , readSERef  :: SE a } --- | Allocates a new mutable value and initializes it with value. +-- | 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 = do@@ -28,3 +28,18 @@     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 = do+    vars <- newGlobalVars (tupleRates t) (fromTuple t)+    let wr a = fromDep_ $ (zipWithM_ writeVar vars) =<< lift (fromTuple a)+        re   = fmap toTuple $ fromDep $ mapM readVar vars+    return (SERef wr re)++-- | 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)

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

@@ -2,9 +2,10 @@     GE, Dep, History(..), withOptions, withHistory, getOptions, evalGE, execGE,     getHistory, putHistory,     -- * Globals-    onGlobals, +    onGlobals,     -- * Midi     MidiAssign(..), Msg(..), renderMidiAssign, saveMidi,  +    MidiCtrl(..), saveMidiCtrl, renderMidiCtrl,     -- * Instruments     saveAlwaysOnInstr, onInstr, saveUserInstr0, getSysExpr,     -- * Total duration@@ -81,6 +82,7 @@     , globals           :: Globals     , instrs            :: Instrs     , midis             :: [MidiAssign]+    , midiCtrls         :: [MidiCtrl]     , totalDur          :: Maybe TotalDur     , alwaysOnInstrs    :: [InstrId]     , notes             :: [(InstrId, CsdEvent Note)]@@ -90,11 +92,12 @@     , guis              :: Guis }  instance Default History where-    def = History def def def def def def def def (return ()) def def def+    def = History def def def def def def def def def (return ()) def def def  data Msg = Msg data MidiAssign = MidiAssign MidiType Channel InstrId-            +data MidiCtrl   = MidiCtrl E E E+ renderMidiAssign :: Monad m => MidiAssign -> DepT m () renderMidiAssign (MidiAssign ty chn instrId) = case ty of     Massign         -> massign chn instrId@@ -103,12 +106,15 @@         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) +renderMidiCtrl :: Monad m => MidiCtrl -> DepT m ()+renderMidiCtrl (MidiCtrl chno ctrlno val) = initc7 chno ctrlno val+    where +        initc7 :: Monad m => E -> E -> E -> DepT m ()+        initc7 a b c = depT_ $ opcs "initc7" [(Xr, [Ir, Ir, Ir])] [a, b, c]+ data TotalDur = ExpDur E | NumDur Double | InfiniteDur     deriving (Eq, Ord) -getTotalDurForF0 :: GE Double-getTotalDurForF0 = fmap (pureGetTotalDurForF0 . totalDur) getHistory- getTotalDurForTerminator :: GE E getTotalDurForTerminator = fmap (getTotalDurForTerminator' . totalDur) getHistory @@ -160,6 +166,10 @@ saveMidi ma = onMidis $ modify (ma: )     where onMidis = onHistory midis (\a h -> h { midis = a }) +saveMidiCtrl :: MidiCtrl -> GE ()+saveMidiCtrl ma = onMidis $ modify (ma: )+    where onMidis = onHistory midiCtrls (\a h -> h { midiCtrls = a })+ saveUserInstr0 :: Dep () -> GE () saveUserInstr0 expr = onUserInstr0 $ modify ( >> expr)     where onUserInstr0 = onHistory userInstr0 (\a h -> h { userInstr0 = a })@@ -441,4 +451,5 @@             saveAlwaysOnInstr keyEventInstrId             body <- keyEventInstrBody $ guiKeyEvents $ guis h             return $ Just (Instr keyEventInstrId body)+ 

@@ -9,6 +9,8 @@     out, outs, safeOut, autoOff, turnoff, turnoff2, exitnow,     -- * vco2     oscili, oscilikt, vco2ft, vco2ift, vco2init, ftgen,+    -- * OSC+    oscInit, oscListen, oscSend,     -- * times     times ) where@@ -198,7 +200,19 @@ vco2init :: [E] -> E vco2init = opcs "vco2init" [(Ir, repeat Ir)] -----------------------+-----------------------------------------------------------+-- OSC++oscInit :: Monad m => E -> DepT m E+oscInit port = depT $ opcs "OSCinit" [(Ir, [Ir])] [port]++oscListen :: Monad m => [E] -> DepT m E+oscListen args = depT $ opcs "OSClisten" [(Kr, Ir:Ir:Ir:repeat Xr)] args++oscSend :: Monad m => [E] -> DepT m ()+oscSend args = depT_ $ opcs "OSCsend" [(Xr, Kr:Ir:Ir:Ir:Ir:repeat Xr)] args++----------------------------------------------------------- -- times  times :: Monad m => DepT m E

@@ -2,7 +2,7 @@     SE(..), LocalHistory(..),      runSE, execSE, evalSE, execGEinSE, hideGEinDep,      fromDep, fromDep_, geToSe,-    newLocalVar, newLocalVars        +    newLocalVar, newLocalVars, newGlobalVars ) where  import Control.Applicative@@ -12,6 +12,7 @@ import Csound.Dynamic hiding (newLocalVar, newLocalVars) import qualified Csound.Dynamic as D(newLocalVar, newLocalVars) import Csound.Typed.GlobalState.GE+import Csound.Typed.GlobalState.Elements(newPersistentGlobalVar)  -- | The Csound's @IO@-monad. All values that produce side effects are wrapped -- in the @SE@-monad.@@ -35,10 +36,13 @@ execSE a = execDepT $ unSE a  execGEinSE :: SE (GE a) -> SE a-execGEinSE (SE sa) = SE $ do+execGEinSE a = geToSe =<< a+{-+(SE sa) = SE $ do     ga <- sa     a  <- lift ga     return a+-}  hideGEinDep :: GE (Dep a) -> Dep a hideGEinDep = join . lift@@ -63,4 +67,12 @@  newLocalVar :: Rate -> GE E -> SE Var newLocalVar rate val = SE $ D.newLocalVar rate val++----------------------------------------------------------------------+-- allocation of the global vars++newGlobalVars :: [Rate] -> GE [E] -> SE [Var]+newGlobalVars rs vs = geToSe $ zipWithM f rs =<< vs+    where f r v = onGlobals $ newPersistentGlobalVar r v+ 

@@ -11,7 +11,7 @@     -- * Widgets     count, countSig, joy, knob, roller, slider, sliderBank, numeric, meter, box,     button, butBank, butBankSig, butBank1, butBankSig1, toggle, toggleSig,-    value, +    setNumeric,      -- * Transformers     setTitle,     -- * Keyboard    @@ -199,10 +199,10 @@  singleIn :: (GuiHandle -> Output Sig) -> Maybe Double -> Elem -> Sink Sig  singleIn outs v0 el = geToSe $ do-    (_, handle) <- newGuiVar+    (var, handle) <- newGuiVar     let handleVar = guiHandleToVar handle                 inits = maybe [] (return . InitMe handleVar) v0-        gui = fromElem [handleVar] inits el+        gui = fromElem [var, handleVar] inits el     appendToGui (GuiNode gui handle) (unSE noInner)     return (fromGuiHandle handle, outs handle) @@ -374,13 +374,9 @@ butBankSig1 name xn yn (x0, y0) = setSourceTitle name $ singleOut (Just n) $ ButBank xn yn     where n = fromIntegral $ y0 + x0 * yn --- | FLvalue shows current the value of a valuator in a text field.------ > value initVal------ doc: <http://www.csounds.com/manual/html/FLvalue.html>-value :: String -> Double -> Sink Sig -value name v = setLabelSink name $ singleIn printk2 (Just v) Value+-- |  FLtext that is sink shows current the value of a valuator in a text field.+setNumeric :: String -> ValDiap -> ValStep -> Double -> Sink Sig+setNumeric name diap step v0 = setLabelSource name $ singleIn printk2 (Just v0) $ Text diap step   -- | A slider that serves as indicator. It consumes values instead of producing. --

@@ -72,6 +72,7 @@ getInstr0 nchnls opt hist = do     globalConstants     midiAssigns+    midiInitCtrls     initGlobals     renderBandLimited (genMap hist) (bandLimitedMap hist)     userInstr0 hist@@ -84,7 +85,8 @@             setNchnls   (max 1 nchnls)             setZeroDbfs 1 -        midiAssigns = mapM_ renderMidiAssign $ midis hist+        midiAssigns   = mapM_ renderMidiAssign $ midis hist+        midiInitCtrls = mapM_ renderMidiCtrl   $ midiCtrls hist          initGlobals = fst $ renderGlobals $ globals $ hist 

@@ -23,7 +23,7 @@     quot', rem', div', mod', ceil', floor', round', int', frac',         -- ** logic funs-    when1, whens, boolSig+    when1, whens, untilDo, whileDo, boolSig ) where  import Control.Applicative hiding ((<*))@@ -35,8 +35,8 @@ import Data.Default import Data.Boolean -import Csound.Dynamic hiding (double, int, str, when1, whens, ifBegin, ifEnd, elseBegin, elseIfBegin)-import qualified Csound.Dynamic as D(double, int, str, ifBegin, ifEnd, elseBegin, elseIfBegin)+import Csound.Dynamic hiding (double, int, str, when1, whens, ifBegin, ifEnd, elseBegin, elseIfBegin, untilBegin, untilEnd, untilDo)+import qualified Csound.Dynamic as D(double, int, str, ifBegin, ifEnd, elseBegin, elseIfBegin, untilBegin, untilEnd) import Csound.Typed.GlobalState  -- | Signals@@ -408,6 +408,21 @@  elseIfBegin :: BoolSig -> SE () elseIfBegin a = fromDep_ $ D.elseIfBegin =<< lift (toGE a)++untilDo :: BoolSig -> SE () -> SE ()+untilDo p body = do+    untilBegin p+    body+    untilEnd++whileDo :: BoolSig -> SE () -> SE ()+whileDo p = untilDo (notB p) ++untilBegin :: BoolSig -> SE ()+untilBegin a = fromDep_ $ D.untilBegin =<< lift (toGE a)++untilEnd :: SE ()+untilEnd = fromDep_ D.untilEnd  -- | Creates a constant boolean signal. boolSig :: BoolD -> BoolSig