packages feed

csound-expression-typed 0.0.5.4 → 0.0.6.0

raw patch · 7 files changed

+102/−23 lines, 7 filesdep +deepseqdep ~csound-expression-dynamic

Dependencies added: deepseq

Dependency ranges changed: csound-expression-dynamic

Files

csound-expression-typed.cabal view
@@ -1,5 +1,5 @@ Name:          csound-expression-typed-Version:       0.0.5.4+Version:       0.0.6.0 Cabal-Version: >= 1.6 License:       BSD3 License-file:  LICENSE@@ -24,8 +24,8 @@ Library   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.7+        base >= 4, base < 5, ghc-prim, containers, transformers >= 0.3, Boolean >= 0.1.0, colour >= 2.3, data-default, deepseq,+        wl-pprint, stable-maps >= 0.0.3.3, csound-expression-dynamic >= 0.1.0   Hs-Source-Dirs:      src/   Exposed-Modules:     Csound.Typed
src/Csound/Typed/Control/SERef.hs view
@@ -1,5 +1,7 @@ module Csound.Typed.Control.SERef where +import Control.DeepSeq(deepseq)+ import Control.Monad import Control.Monad.Trans.Class import Csound.Dynamic hiding (newLocalVars)@@ -8,18 +10,31 @@ import Csound.Typed.GlobalState  -- | It describes a reference to mutable values.-data SERef a = SERef +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 = do-    vars <- newLocalVars (tupleRates t) (fromTuple t)-    let wr a = fromDep_ $ (zipWithM_ writeVar vars) =<< lift (fromTuple a)+newSERef t = fmap SERef $ newLocalVars (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)+    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.@@ -31,11 +46,13 @@ -- | 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+newGlobalSERef t = fmap SERef $ newGlobalVars (tupleRates t) (fromTuple t)    +{-     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.
src/Csound/Typed/GlobalState/Elements.hs view
@@ -196,10 +196,10 @@     { allocVarType     :: GlobalVarType      , allocVar         :: Var     , allocVarInit     :: E -    } deriving (Show)+    }  data GlobalVarType = PersistentGlobalVar | ClearableGlobalVar-    deriving (Eq, Show)+    deriving (Eq)  instance Default Globals where     def = Globals def def
src/Csound/Typed/GlobalState/GE.hs view
@@ -117,7 +117,6 @@         initc7 a b c = depT_ $ opcs "initc7" [(Xr, [Ir, Ir, Ir])] [a, b, c]  data TotalDur = ExpDur E | NumDur Double | InfiniteDur-    deriving (Eq, Ord)  getTotalDurForTerminator :: GE E getTotalDurForTerminator = fmap (getTotalDurForTerminator' . totalDur) getHistory
src/Csound/Typed/GlobalState/SE.hs view
@@ -29,8 +29,8 @@     return = SE . return     ma >>= mf = SE $ unSE ma >>= unSE . mf -runSE :: SE a -> GE (a, LocalHistory)-runSE = runDepT . unSE+runSE :: SE a -> GE a+runSE = fmap fst . runDepT . unSE  execSE :: SE () -> GE InstrBody execSE a = execDepT $ unSE a@@ -54,7 +54,7 @@ fromDep_ = SE              evalSE :: SE a -> GE a-evalSE = fmap fst . runSE+evalSE = evalDepT . unSE  geToSe :: GE a -> SE a geToSe = SE . lift
src/Csound/Typed/Gui/Gui.hs view
@@ -5,7 +5,7 @@     guiStmt,      -- * Layout-    hor, ver, space, sca, horSca, verSca, +    hor, ver, space, sca, horSca, verSca,          padding, margin,     -- * Props     props, forceProps,
src/Csound/Typed/Gui/Widget.hs view
@@ -6,12 +6,14 @@     -- * Types     Input, Output, Inner,     noInput, noOutput, noInner,-    Widget, widget, Source, source, Sink, sink, Display, display,+    Widget, widget, Source, source, Sink, sink, Display, display, SinkSource, sinkSource,+    mapSource, mapGuiSource, mhor, mver, msca,      -- * Widgets     count, countSig, joy, knob, roller, slider, sliderBank, numeric, meter, box,     button, butBank, butBankSig, butBank1, butBankSig1, toggle, toggleSig,     setNumeric, +    setToggle, setToggleSig,     -- * Transformers     setTitle,     -- * Keyboard    @@ -23,9 +25,10 @@ import Control.Monad import Control.Monad.Trans.Class +import Data.Monoid import Data.Boolean -import Csound.Dynamic hiding (int)+import Csound.Dynamic hiding (int, when1) import qualified Csound.Typed.GlobalState.Elements as C  import Csound.Typed.Gui.Gui@@ -123,13 +126,37 @@ -- | A producer of the values. type Source a = SE (Gui, Input a) +type SinkSource a = SE (Gui, Output a, Input a)+ -- | A static element. We can only look at it. type Display  = SE Gui + -- | A handy function for transforming the value of producers. mapSource :: (a -> b) -> Source a -> Source b mapSource f = fmap $ \(gui, ins) -> (gui, f ins)  +-- | A handy function for transforming the GUIs of producers.+mapGuiSource :: (Gui -> Gui) -> Source a -> Source a+mapGuiSource f = fmap $ \(gui, ins) -> (f gui, ins) ++mGroup :: Monoid a => ([Gui] -> Gui) -> [Source a] -> Source a+mGroup guiGroup as = do+    (gs, fs) <- fmap unzip $ sequence as    +    return (guiGroup gs, mconcat fs)++-- | Horizontal grouping of widgets that can produce monoidal values.+mhor :: Monoid a => [Source a] -> Source a+mhor = mGroup hor++-- | Vertical grouping of widgets that can produce monoidal values.+mver :: Monoid a => [Source a] -> Source a+mver = mGroup ver++-- | Scaling of widgets that can produce values.+msca :: Double -> Source a -> Source a+msca d = mapGuiSource (sca d)+ -- | A widget constructor. widget :: SE (Gui, Output a, Input b, Inner) -> Widget a b widget x = go =<< x@@ -154,6 +181,12 @@         select (g, o, _, _) = (g, o)         append (g, o) = (g, o, noInput, noInner) +sinkSource :: SE (Gui, Output a, Input a) -> SinkSource a+sinkSource x = fmap select $ widget $ fmap append x+    where+        select (g, o, i, _) = (g, o, i)+        append (g, o, i) = (g, o, i, noInner)+ -- | A display constructor. display :: SE Gui -> Display  display x = fmap select $ widget $ fmap append x@@ -188,6 +221,11 @@     | null a    = id     | otherwise = fmap (first $ setLabel a) +setLabelSnkSource :: String -> SinkSource a -> SinkSource a+setLabelSnkSource a +    | null a    = id+    | otherwise = fmap (\(x, y, z) -> (setLabel a x, y, z)) + singleOut :: Maybe Double -> Elem -> Source Sig  singleOut v0 el = geToSe $ do     (var, handle) <- newGuiVar@@ -206,6 +244,15 @@     appendToGui (GuiNode gui handle) (unSE noInner)     return (fromGuiHandle handle, outs handle) +singleInOut :: (GuiHandle -> Output Sig) -> Maybe Double -> Elem -> SinkSource Sig+singleInOut outs v0 el = geToSe $ do+    (var, handle) <- newGuiVar+    let handleVar = guiHandleToVar handle+        inits = maybe [] (return . InitMe handleVar) v0+        gui = fromElem [var, handleVar] inits el+    appendToGui (GuiNode gui handle) (unSE noInner)+    return (fromGuiHandle handle, outs handle, readSig var)+ -- | A variance on the function 'Csound.Gui.Widget.count', but it produces  -- a signal of piecewise constant function.  countSig :: ValDiap -> ValStep -> Maybe ValStep -> Double -> Source Sig@@ -331,14 +378,17 @@ -- > button text --  -- doc: <http://www.csounds.com/manual/html/FLbutton.html>-toggle :: String -> Source (Evt D)-toggle name = mapSource snaps $ toggleSig name-+toggle :: String -> Bool -> Source (Evt D)+toggle name initVal = mapSource snaps $ toggleSig name initVal+     -- | A variance on the function 'Csound.Gui.Widget.toggle', but it produces  -- a signal of piecewise constant function. -toggleSig :: String -> Source Sig-toggleSig name = setLabelSource name $ singleOut Nothing Toggle+toggleSig :: String -> Bool -> Source Sig+toggleSig name initVal = setLabelSource name $ singleOut (initToggle initVal) Toggle +initToggle :: Bool -> Maybe Double+initToggle a = if a then (Just 1) else Nothing+ -- | A FLTK widget opcode that creates a bank of buttons. -- Result is (x, y) coordinate of the triggered button. -- @@ -385,6 +435,18 @@ meter name sp v = setLabelSink name $ singleIn setVal (Just v) (Slider sp)  -------------------------------------------------------------+-- writeable widgets++setToggleSig :: String -> Bool -> SinkSource Sig+setToggleSig name initVal = setLabelSnkSource name $ singleInOut setVal (initToggle initVal) Toggle++setToggle :: String -> Bool -> SinkSource (Evt D)+setToggle name initVal = sinkSource $ do+    (g, outs, ins) <- setToggleSig name initVal+    let evtOuts a = outs =<< stepper 0 (fmap sig a)+    return (g, evtOuts, snaps ins)++------------------------------------------------------------- -- keyboard  -- | The stream of keyboard press/release events.@@ -430,6 +492,7 @@ changed :: [Sig] -> Sig changed = Sig . fmap f . mapM unSig     where f = opcs "changed" [(Kr, repeat Kr)]+