csound-expression-typed 0.2.3.1 → 0.2.4

raw patch · 47 files changed

+514/−701 lines, 47 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 +5/−3
• src/Csound/Typed/Constants.hs +2/−2
• src/Csound/Typed/Control/Api.hs +2/−50
• src/Csound/Typed/Control/ArrayTraverse.hs +20/−20
• src/Csound/Typed/Control/Evt.hs +16/−36
• src/Csound/Typed/Control/Instr.hs +0/−2
• src/Csound/Typed/Control/InstrRef.hs +18/−19
• src/Csound/Typed/Control/MacrosArgs.hs +2/−4
• src/Csound/Typed/Control/Midi.hs +11/−16
• src/Csound/Typed/Control/Mix.hs +1/−1
• src/Csound/Typed/Control/Osc.hs +2/−2
• src/Csound/Typed/Control/Ref.hs +5/−52
• src/Csound/Typed/Control/Vco.hs +44/−46
• src/Csound/Typed/GlobalState/Elements.hs +28/−47
• src/Csound/Typed/GlobalState/GE.hs +4/−2
• src/Csound/Typed/GlobalState/Instr.hs +12/−13
• src/Csound/Typed/GlobalState/InstrApi.hs +12/−11
• src/Csound/Typed/GlobalState/Opcodes.hs +30/−29
• src/Csound/Typed/GlobalState/Options.hs +15/−7
• src/Csound/Typed/GlobalState/SE.hs +4/−5
• src/Csound/Typed/Gui/BoxModel.hs +0/−2
• src/Csound/Typed/Gui/Cabbage/Cabbage.hs +42/−41
• src/Csound/Typed/Gui/Cabbage/CabbageLang.hs +13/−13
• src/Csound/Typed/Gui/Gui.hs +1/−8
• src/Csound/Typed/Gui/Widget.hs +1/−4
• src/Csound/Typed/Plugins/Adsr140.hs +5/−9
• src/Csound/Typed/Plugins/AmbiRow.hs +2/−5
• src/Csound/Typed/Plugins/Audaciouseq.hs +7/−11
• src/Csound/Typed/Plugins/Diode.hs +15/−19
• src/Csound/Typed/Plugins/Iain.hs +15/−19
• src/Csound/Typed/Plugins/Korg35.hs +20/−24
• src/Csound/Typed/Plugins/LiveRow.hs +2/−5
• src/Csound/Typed/Plugins/SolinaChorus.hs +9/−13
• src/Csound/Typed/Plugins/TabQueue.hs +7/−8
• src/Csound/Typed/Plugins/TapeEcho.hs +3/−5
• src/Csound/Typed/Plugins/Utilities.hs +3/−7
• src/Csound/Typed/Plugins/Zdf.hs +12/−14
• src/Csound/Typed/Plugins/ZeroDelayConvolution.hs +2/−5
• src/Csound/Typed/Render.hs +2/−3
• src/Csound/Typed/Types/Array.hs +81/−74
• src/Csound/Typed/Types/Evt.hs +1/−1
• src/Csound/Typed/Types/Lift.hs +15/−17
• src/Csound/Typed/Types/MixSco.hs +2/−5
• src/Csound/Typed/Types/MonoArg.hs +4/−4
• src/Csound/Typed/Types/Prim.hs +14/−15
• src/Csound/Typed/Types/SigSpace.hs +3/−1
• src/Csound/Typed/Types/Tuple.hs +0/−2

@@ -1,5 +1,5 @@ Name:          csound-expression-typed-Version:       0.2.3.1+Version:       0.2.4 Cabal-Version: >= 1.22 License:       BSD3 License-file:  LICENSE@@ -11,7 +11,7 @@ Category:      Music, Sound Maintainer:    <anton.kholomiov@gmail.com> -Description:+Description: typed core for library csound-expression. Provides typed core lang for csound  Data-Files :     data/hrtf-44100-left.dat@@ -80,7 +80,7 @@         filepath,         directory,         wl-pprint >= 1.2.1,-        csound-expression-dynamic >= 0.3.5,+        csound-expression-dynamic >= 0.3.6,         temporal-media >= 0.6.3,         hashable   Hs-Source-Dirs:      src/@@ -162,3 +162,5 @@     Paths_csound_expression_typed    Default-Language: Haskell2010+  Default-extensions:+    LambdaCase

@@ -1,6 +1,6 @@ module Csound.Typed.Constants(-	infiniteDur+  infiniteDur ) where  infiniteDur :: Num a => a-infiniteDur = 7 * 24 * 60 * 60 -- a week +infiniteDur = 7 * 24 * 60 * 60 -- a week

@@ -6,17 +6,13 @@ ) where  import Data.Boolean-import Control.Monad.Trans.Class-import Control.Applicative  import qualified Csound.Dynamic as D-import Csound.Dynamic(Rate(..), opcs, depT_)-import Data.Boolean((==*), (>*), ifB)  import Csound.Typed.Types import Csound.Typed.Control.Ref import Csound.Typed.GlobalState-import Csound.Typed.GlobalState.Opcodes(eventi, Event(..), turnoff, port, downsamp)+import Csound.Typed.GlobalState.Opcodes(eventi, Event(..), downsamp) import Csound.Typed.InnerOpcodes  import Csound.Typed.Plugins.TabQueue@@ -120,7 +116,7 @@     return $ MonoArg kamp kcps kgate trig     where         onNote = tabQueue2_append-        offNote tab (pch, vol) = tabQueue2_delete tab pch+        offNote tab (pch, _vol) = tabQueue2_delete tab pch  trigByNameMidiCbk :: String -> ((D, D) -> SE ())  -> ((D, D) -> SE ()) -> SE () trigByNameMidiCbk name noteOn noteOff =@@ -132,52 +128,8 @@             whenD1 (noteFlag ==* 0) $ noteOff (pch, vol)             SE turnoff -port' :: Sig -> D -> Sig-port' a b = fromGE $ do-    a' <- toGE a-    b' <- toGE b-    return $ port a' b'- downsamp' :: Sig -> Sig downsamp' a = fromGE $ do     a' <- toGE a     return $ downsamp a' --- |--- Fast table opcodes.------ Fast table opcodes. Faster than---     table and---     tablew because don't---     allow wrap-around and limit and don't check index validity. Have---     been implemented in order to provide fast access to---     arrays. Support non-power of two tables (can be generated by any---     GEN function by giving a negative length value).------ >  tabw  ksig, kndx, ifn [,ixmode]--- >  tabw  asig, andx, ifn [,ixmode]------ csound doc: <http://www.csounds.com/manual/html/tab.html>-tabw ::  Sig -> Sig -> Tab -> SE ()-tabw b1 b2 b3 = SE $ (depT_ =<<) $ lift $ f <$> unSig b1 <*> unSig b2 <*> unTab b3-    where f a1 a2 a3 = opcs "tabw" [(Xr,[Kr,Kr,Ir,Ir])] [a1,a2,a3]----- |--- Fast table opcodes.------ Fast table opcodes. Faster than---     table and---     tablew because don't---     allow wrap-around and limit and don't check index validity. Have---     been implemented in order to provide fast access to---     arrays. Support non-power of two tables (can be generated by any---     GEN function by giving a negative length value).------ > kr  tab  kndx, ifn[, ixmode]--- > ar  tab  xndx, ifn[, ixmode]------ csound doc: <http://www.csounds.com/manual/html/tab.html>-tab ::  Sig -> Tab -> Sig-tab b1 b2 = Sig $ f <$> unSig b1 <*> unTab b2-    where f a1 a2 = opcs "tab" [(Kr,[Kr,Ir,Ir]),(Ar,[Xr,Ir,Ir])] [a1,a2]

@@ -1,6 +1,6 @@ {-# Language ScopedTypeVariables #-} -- | Array traversals and folds-module Csound.Typed.Control.ArrayTraverse(        +module Csound.Typed.Control.ArrayTraverse(     foreachArr, foreachArrD, forRowArr, forColumnArr, forRowArrD, forColumnArrD,     foldArr, foldRowArr, foldColumnArr, foldRowsArrD, foldColumnsArrD ) where@@ -9,7 +9,7 @@ import Csound.Typed.Control.Ref import Csound.Typed.GlobalState import Data.Boolean-import qualified Csound.Dynamic as D  +import qualified Csound.Dynamic as D  ------------------------------------------------------------------------- -- Functional style traversals@@ -42,16 +42,16 @@         recWhile :: [Ref b] -> [(Int, Ref b, Ref b)] -> SE ()         recWhile vars xs = case xs of             [] -> do-                ix <- readRef $ concatRef vars+                ix <- readRef $ concatRefs vars                 val <- readArr array ix                 body (ix, val)             (n, var, condVar) : rest -> do-                whileRefBegin condVar +                whileRefBegin condVar                  recWhile vars rest                  modifyRef var (+ 1)-                ix <- readRef var                +                ix <- readRef var                 writeRef condVar (ifB (ix `lessThan` getArrayLength n array) 1 0)                  fromDep_ D.whileEnd@@ -61,14 +61,14 @@         proxy :: Arr ix a -> ix         proxy = const undefined -        concatRef :: [Ref b] -> Ref ix-        concatRef vs = Ref $ vs >>= \(Ref xs) -> xs+        concatRefs :: [Ref b] -> Ref ix+        concatRefs vs = Ref $ vs >>= \(Ref xs) -> xs  -- | Traverses all elements in the given row of 2D array at the signal rate and applies a procedure to all elements. forRowArr :: (Tuple a) => Sig -> Arr Sig2 a -> ((Sig, a) -> SE ()) -> SE ()-forRowArr rowId array phi = whileRef 0 cond body+forRowArr rowId array phi = whileRef 0 condition body     where-        cond ix = return $ ix `lessThan` lenarray array `withD` 2+        condition ix = return $ ix `lessThan` lenarray array `withD` 2          body ix = do             val <- readArr array (rowId, ix)@@ -78,9 +78,9 @@  -- | Traverses all elements in the given column of 2D array at the signal rate and applies a procedure to all elements. forColumnArr :: (Tuple a) => Sig -> Arr Sig2 a -> ((Sig, a) -> SE ()) -> SE ()-forColumnArr colId array phi = whileRef 0 cond body+forColumnArr colId array phi = whileRef 0 condition body     where-        cond ix = return $ ix `lessThan` lenarray array `withD` 1+        condition ix = return $ ix `lessThan` lenarray array `withD` 1          body ix = do             val <- readArr array (ix, colId)@@ -88,10 +88,10 @@             return $ ix + 1  -- | Traverses all elements in the given row of 2D array at the init rate and applies a procedure to all elements.-forRowArrD :: Tuple a => D -> Arr D2 a -> ((D, a) -> SE ()) -> SE () -forRowArrD rowId array phi = whileRefD 0 cond body+forRowArrD :: Tuple a => D -> Arr D2 a -> ((D, a) -> SE ()) -> SE ()+forRowArrD rowId array phi = whileRefD 0 condition body     where-        cond ix = return $ ix `lessThan` lenarray array `withD` 2+        condition ix = return $ ix `lessThan` lenarray array `withD` 2          body ix = do             val <- readArr array (rowId, ix)@@ -100,9 +100,9 @@  -- | Traverses all elements in the given column of 2D array at the init rate and applies a procedure to all elements. forColumnArrD :: Tuple a => D -> Arr D2 a -> ((D, a) -> SE ()) -> SE ()-forColumnArrD colId array phi = whileRefD 0 cond body+forColumnArrD colId array phi = whileRefD 0 condition body     where-        cond ix = return $ ix `lessThan` lenarray array `withD` 1+        condition ix = return $ ix `lessThan` lenarray array `withD` 1          body ix = do             val <- readArr array (ix, colId)@@ -119,7 +119,7 @@ toFoldFun :: Tuple b => (a -> b -> SE b) -> Ref b -> a -> SE () toFoldFun phi ref a = writeRef ref =<< phi a =<< readRef ref --- | Traverses a row in the array and accumulates a value. We invoke the function +-- | Traverses a row in the array and accumulates a value. We invoke the function -- with accumulator function, initial value and the array with signal of the row number. -- -- > foldRowArr accum initValue rowId array@@ -129,7 +129,7 @@     forRowArr rowId array $ toFoldFun phi res     readRef res --- | Traverses a column in the array and accumulates a value. We invoke the function +-- | Traverses a column in the array and accumulates a value. We invoke the function -- with accumulator function, initial value and the array with signal of the row number. -- -- > foldColumnArr accum initValue columnId array@@ -139,7 +139,7 @@     forColumnArr rowId array $ toFoldFun phi res     readRef res --- | Traverses a row at the **init rate** in the array and accumulates a value. We invoke the function +-- | Traverses a row at the **init rate** in the array and accumulates a value. We invoke the function -- with accumulator function, initial value and the array with signal of the row number. -- -- > foldRowArr accum initValue rowId array@@ -149,7 +149,7 @@     forRowArrD rowId array $ toFoldFun phi res     readRef res --- | Traverses a column at the **init rate** in the array and accumulates a value. We invoke the function +-- | Traverses a column at the **init rate** in the array and accumulates a value. We invoke the function -- with accumulator function, initial value and the array with signal of the row number. -- -- > foldColumnArr accum initValue columnId array

@@ -5,14 +5,10 @@     retrigs, evtLoop, evtLoopOnce ) where -import System.Mem.StableName--import Data.Monoid import Data.Boolean  import Control.Applicative import Control.Monad-import Control.Monad.IO.Class  import qualified Temporal.Media as T(render, Event(..)) @@ -122,12 +118,12 @@ evtLoopOnce = evtLoopGen False  evtLoopGen :: (Num a, Tuple a, Sigs a) => Bool -> Maybe (Evt Unit) -> [SE a] -> [Evt Unit] -> a-evtLoopGen mustLoop maybeOffEvt instrs evts = apInstr0 $ do+evtLoopGen mustLoop maybeOffEvt instruments evts = apInstr0 $ do     (instrId, evtInstrId) <- saveSourceInstrCachedWithLivenessWatchAndRetrigAndEvtLoop (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+        loopLength = int $ lcm (length instruments) (length evts)+        instr = toSingleInstr instruments          toInstrExp :: a -> (Unit -> a)         toInstrExp = const@@ -143,9 +139,9 @@                 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+        toSingleEvt es = do+            let n = mod' (fromE $ getRetrigVal 4) (sig $ int $ length es)+            zipWithM_ (f n) (fmap (sig . int) [0 .. ]) es             where                 f :: Sig -> Sig -> Evt Unit -> SE ()                 f n ix evt = when1 (n ==* ix) $ evtLoopInstr evt@@ -184,8 +180,8 @@         go = goBy (+ 1)          goBy :: (D -> D) -> Ref D -> Ref D -> GE C.ChnRef -> Evt Unit -> SE ()-        goBy updateRetrig aliveCountRef retrigWatchRef mchnId events =-            runEvt events $ \es -> do+        goBy updateRetrig _aliveCountRef retrigWatchRef mchnId events =+            runEvt events $ \_es -> do                 modifyRef retrigWatchRef updateRetrig                 chnId <- geToSe mchnId                 currentRetrig <- readRef retrigWatchRef@@ -208,7 +204,7 @@         audioEvent = fireEventFor eventForAudioInstr         evtEvent   = fireEventFor eventForEvtInstr -        startEvtInstr chnId currentRetrig = C.event $ eventForEvtInstr chnId currentRetrig+        -- startEvtInstr chnId currentRetrig = C.event $ eventForEvtInstr chnId currentRetrig          initStartInstrs mchnId = fromDep_ $ hideGEinDep $ do             chnId <- mchnId@@ -256,35 +252,19 @@ saveEvtInstr_ instrId evts = unSE $ runEvt evts $ \es -> fromDep_ $ mapM_ event es     where event (start, dur, args) = hideGEinDep $ fmap C.event $ C.Event (primInstrId 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--samNext :: (Sigs a) => Evt Unit -> a -> a -> a-samNext = undefined--samLoop :: (Sigs a) => Evt Unit -> a -> a-samLoop = undefined- ------------------------------------------------------------- -- monophonic scheduling  -- | Turns monoSched :: Evt (Sco (D, D)) -> SE MonoArg-monoSched evts = evtPort instr evts read+monoSched evts = evtPort instr evts readP     where         instr ((amp, cps), p) = do             (_, _, gate) <- I.readPort p             I.writePort p (sig amp, sig cps, gate + 1) -        read :: I.Port (Sig, Sig, Sig) -> SE MonoArg-        read p = do+        readP :: I.Port (Sig, Sig, Sig) -> SE MonoArg+        readP p = do             (amp, cps, gate) <- I.readPort p             I.writePort p (amp, cps, 0)             return $ MonoArg amp cps (ifB (gate `equalsTo` 0) 0 1) (changed [amp, cps, gate])@@ -305,9 +285,9 @@         ons ref (amp, cps) =             writeRef ref $ MonoArg { monoAmp = sig amp, monoCps = sig cps, monoGate = 1, monoTrig = 1 } -        offs ref = modifyRef ref $ \arg -> arg { monoGate = 0 }+        offs ref = modifyRef ref $ \a -> a { monoGate = 0 } -        clearTrig ref = modifyRef ref $ \arg -> arg { monoTrig = 0 }+        clearTrig ref = modifyRef ref $ \a -> a { monoTrig = 0 }  -- | Plays the note until next note comes monoSchedHarp :: Evt (D, D) -> SE MonoArg@@ -315,11 +295,11 @@   evtPort :: (Arg a, Sigs p) => ((a, I.Port p) -> SE ()) -> Evt (Sco a) -> (I.Port p -> SE b) -> SE b-evtPort instr evts read = do+evtPort instr evts readP = do     port <- I.freePort     idx <- I.newInstrLinked instr     runSco evts $ go idx port-    read port+    readP port     where         go idx port (start,dur,a) = I.event idx (start, dur, (a, port)) 

@@ -6,13 +6,11 @@     apInstr, apInstr0 ) where -import Data.Default import Csound.Dynamic(InstrId(..)) import qualified Csound.Typed.GlobalState.Elements as C  import Csound.Typed.Types import Csound.Typed.GlobalState-import Csound.Typed.GlobalState.Opcodes(primInstrId)  funProxy :: (a -> f b) -> (a, b) funProxy = const (msg, msg)

@@ -2,28 +2,27 @@ module Csound.Typed.Control.InstrRef(     InstrRef, newInstr, scheduleEvent, turnoff2, negateInstrRef, addFracInstrRef,     newOutInstr, noteOn, noteOff-) where    +) where  import Control.Monad import Control.Monad.Trans.Class -import Control.Applicative import Data.Default import Csound.Dynamic(InstrId(..), Rate(..), DepT, depT_, opcs) import qualified Csound.Typed.GlobalState.Elements as C  import Csound.Typed.Types-import Csound.Typed.GlobalState hiding (turnoff2) +import Csound.Typed.GlobalState hiding (turnoff2) import Csound.Typed.Control.Ref  -- | Fractional part of the instrument dentifier.-data InstrFrac = InstrFrac -    { instrFracValue :: D-    , instrFracSize  :: D    +data InstrFrac = InstrFrac+    { _instrFracValue :: D+    , _instrFracSize  :: D     }  -- | Instrument reference. we can invoke or stop the instrument by the identifier.-data InstrRef a = InstrRef +data InstrRef a = InstrRef     { instrRefMain :: D     , instrRefFrac :: Maybe InstrFrac } @@ -31,7 +30,7 @@ newInstr ::  (Arg a) => (a -> SE ()) -> SE (InstrRef a) newInstr instr = geToSe $ fmap fromInstrId $ saveInstr $ instr toArg --- | Schedules an event for the instrument. +-- | Schedules an event for the instrument. -- -- > scheduleEvent instrRef delay duration args --@@ -42,10 +41,10 @@ getInstrId :: InstrRef a -> D getInstrId (InstrRef value frac) = value + maybe 0 fromFrac frac     where-        fromFrac (InstrFrac value size) = (value * 10 + 1) / (size * 10)+        fromFrac (InstrFrac val size) = (val * 10 + 1) / (size * 10)  -- | Negates the instrument identifier. This trick is used in Csound to update the instrument arguments while instrument is working.-negateInstrRef :: InstrRef a -> InstrRef a +negateInstrRef :: InstrRef a -> InstrRef a negateInstrRef ref = ref { instrRefMain = negate $ instrRefMain ref }  -- | Adds fractional part to the instrument reference. This trick is used in Csound to identify the notes (or specific instrument invokation).@@ -54,8 +53,8 @@  fromInstrId :: InstrId -> InstrRef a fromInstrId x = case x of-    InstrId frac ceil -> InstrRef (int ceil) Nothing-    InstrLabel _    -> error "No reference for string instrument id. (Csound.Typed.Control.Instr.hs: fromInstrId)"+    InstrId _frac ceil -> InstrRef (int ceil) Nothing+    InstrLabel _       -> error "No reference for string instrument id. (Csound.Typed.Control.Instr.hs: fromInstrId)"  -- | Creates an insturment that produces a value. newOutInstr :: (Arg a, Sigs b) => (a -> SE b) -> SE (InstrRef a, b)@@ -70,7 +69,7 @@ noteOn maxSize noteId instrId args = scheduleEvent (addFracInstrRef maxSize noteId instrId) 0 (-1) args  -- | Stops a note with fractional instrument reference.-noteOff :: (Default a, Arg a) => D -> D -> InstrRef a -> SE () +noteOff :: (Default a, Arg a) => D -> D -> InstrRef a -> SE () noteOff maxSize noteId instrId = scheduleEvent (negateInstrRef $ addFracInstrRef maxSize noteId instrId) 0 0.01 def  -- | Turns off the note played on the given instrument.@@ -78,13 +77,13 @@ -- -- > turnoff2 instrRef mode releaseTime ----- The mode is sum of the following values: --- --- * 0, 1, or 2: turn off all instances (0), oldest only (1), or newest only (2) --- --- * 4: only turn off notes with exactly matching (fractional) instrument number, rather than ignoring fractional part +-- The mode is sum of the following values: ----- * 8: only turn off notes with indefinite duration (idur < 0 or MIDI) +-- * 0, 1, or 2: turn off all instances (0), oldest only (1), or newest only (2)+--+-- * 4: only turn off notes with exactly matching (fractional) instrument number, rather than ignoring fractional part+--+-- * 8: only turn off notes with indefinite duration (idur < 0 or MIDI) -- -- @releaseTime@  if non-zero, the turned off instances are allowed to release, otherwise are deactivated immediately (possibly resulting in clicks). turnoff2 :: InstrRef a -> Sig -> Sig -> SE ()

@@ -3,16 +3,14 @@     readMacrosString, readMacrosDouble, readMacrosInt ) where -import qualified Csound.Dynamic as D- import Csound.Typed.Types import qualified Csound.Typed.GlobalState as G(readMacrosString, readMacrosDouble, readMacrosInt)  readMacrosString :: String -> String -> Str-readMacrosString name value = fromGE $ G.readMacrosString name value +readMacrosString name value = fromGE $ G.readMacrosString name value  readMacrosDouble :: String -> Double -> D-readMacrosDouble name value = fromGE $ G.readMacrosDouble name value +readMacrosDouble name value = fromGE $ G.readMacrosDouble name value  readMacrosInt :: String -> Int -> D readMacrosInt name value = fromGE $ G.readMacrosInt  name value

@@ -1,36 +1,31 @@ {-# Language FlexibleContexts #-} module Csound.Typed.Control.Midi(     Msg, Channel,-    midi, midin, pgmidi, +    midi, midin, pgmidi,     midi_, midin_, pgmidi_,     initMidiCtrl ) where -import System.Mem.StableName--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.Ref  import qualified Csound.Typed.GlobalState.Opcodes as C(midiVolumeFactor) --- | Triggers a midi-instrument (aka Csound's massign) for all channels. +-- | 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 midiWithInstrId_ --- | Triggers a midi-instrument (aka Csound's massign) on the specified channel. +-- | 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 (midinWithInstrId_ n) --- | Triggers a midi-instrument (aka Csound's pgmassign) on the specified programm bank. +-- | 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 (pgmidiWithInstrId_ mchn n) @@ -44,29 +39,29 @@  ----------------------------------------------------------------- --- | Triggers a midi-procedure (aka Csound's massign) for all channels. +-- | Triggers a midi-procedure (aka Csound's massign) for all channels. midiWithInstrId_ :: (Msg -> SE ()) -> SE () midiWithInstrId_ = midinWithInstrId_ 0 --- | Triggers a midi-procedure (aka Csound's pgmassign) on the given channel. +-- | Triggers a midi-procedure (aka Csound's pgmassign) on the given channel. midinWithInstrId_ :: Channel -> (Msg -> SE ()) -> SE () midinWithInstrId_ chn instr = genMidi_ Massign chn instr --- | Triggers a midi-procedure (aka Csound's pgmassign) on the given programm bank. +-- | Triggers a midi-procedure (aka Csound's pgmassign) on the given programm bank. pgmidiWithInstrId_ :: Maybe Int -> Channel -> (Msg -> SE ()) -> SE () pgmidiWithInstrId_ mchn chn instr = genMidi_ (Pgmassign mchn) chn instr  ----------------------------------------------------------------- --- | Triggers a midi-procedure (aka Csound's massign) for all channels. +-- | 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. +-- | Triggers a midi-procedure (aka Csound's pgmassign) on the given channel. midin_ :: Channel -> (Msg -> SE ()) -> SE () midin_ chn instr = genMidi_ Massign chn instr --- | Triggers a midi-procedure (aka Csound's pgmassign) on the given programm bank. +-- | Triggers a midi-procedure (aka Csound's pgmassign) on the given programm bank. pgmidi_ :: Maybe Int -> Channel -> (Msg -> SE ()) -> SE () pgmidi_ mchn chn instr = genMidi_ (Pgmassign mchn) chn instr @@ -77,7 +72,7 @@ -- midi ctrls  initMidiCtrl :: D -> D -> D -> SE ()-initMidiCtrl chno ctrlno val = geToSe $ +initMidiCtrl chno ctrlno val = geToSe $     saveMidiCtrl =<< (MidiCtrl <$> toGE chno <*> toGE ctrlno <*> toGE val)  

@@ -3,7 +3,7 @@     Mix,     sco, eff, mix, mixBy, monoSco,     sco_, mix_, mixBy_,-    Sco, CsdEventList(..), CsdEvent+    Sco, CsdEventList, CsdEvent ) where  import Data.Boolean

@@ -6,12 +6,12 @@     OscVal, listenOscVal ) where -import Data.Boolean (ifB, (==*))+import Data.Boolean ((==*)) import Csound.Dynamic(Rate(..))  import Csound.Typed.Types import Csound.Typed.GlobalState hiding (oscInit, oscListen, oscSend)-import qualified Csound.Typed.GlobalState as C(oscInit, oscListen, oscSend)+import qualified Csound.Typed.GlobalState as C(oscListen, oscSend)  import Csound.Typed.Control.Ref 

@@ -9,10 +9,8 @@ ) where  import Data.Boolean-import Control.DeepSeq(deepseq)  import Control.Monad-import Control.Applicative import Control.Monad.Trans.Class import Csound.Dynamic hiding (when1, newLocalVars, writeArr, readArr, whileRef) @@ -53,6 +51,7 @@ newCtrlRef :: Tuple a => a -> SE (Ref a) newCtrlRef t = fmap Ref $ newLocalVars (fmap toCtrlRate $ tupleRates t) (fromTuple t) +toCtrlRate :: Rate -> Rate toCtrlRate x = case x of     Ar -> Kr     Kr -> Ir@@ -133,32 +132,10 @@     ref <- newGlobalCtrlRef ((fromGE $ saveWriteTab size) :: D)     fmap (fromGE . toGE) $ readRef ref -{--    identifier <- geToSe $ getNextGlobalGenId-    ref <- newGlobalRef (0 :: D)-    tabId <- ftgenonce 0 (Csound.Typed.Types.Prim.int identifier) size 7 0 [size, 0]-    writeRef ref (fromGE $ toGE tabId)-    fmap (fromGE . toGE) $ readRef ref--}- ----------------------------------------------------------------------- -- some opcodes that I have to define upfront - -- |--- Generate a function table from within an instrument definition, without duplication of data.------ Enables the creation of function tables entirely inside---       instrument definitions, without any duplication of data.------ > ifno  ftgenonce  ip1, ip2dummy, isize, igen, iarga, iargb, ...------ csound doc: <http://www.csounds.com/manual/html/ftgenonce.html>-ftgenonce ::  D -> D -> D -> D -> D -> [D] -> SE Tab-ftgenonce b1 b2 b3 b4 b5 b6 = fmap ( Tab . return) $ SE $ (depT =<<) $ lift $ f <$> unD b1 <*> unD b2 <*> unD b3 <*> unD b4 <*> unD b5 <*> mapM unD b6-    where f a1 a2 a3 a4 a5 a6 = opcs "ftgenonce" [(Ir,(repeat Ir))] ([a1,a2,a3,a4,a5] ++ a6)---- | -- Generate a score function table from within the orchestra, which is deleted at the end of the note. -- -- Generate a score function table from within the orchestra,@@ -171,34 +148,10 @@ ftgentmp b1 b2 b3 b4 b5 b6 = fmap ( Tab . return) $ SE $ (depT =<<) $ lift $ f <$> unD b1 <*> unD b2 <*> unD b3 <*> unD b4 <*> unD b5 <*> mapM unD b6     where f a1 a2 a3 a4 a5 a6 = opcs "ftgentmp" [(Ir,(repeat Ir))] ([a1,a2,a3,a4,a5] ++ a6) ---------------------------------------------------{--whileSE :: SE BoolSig -> SE () -> SE ()-whileSE mcond body = do-    ref <- newCtrlRef $ (0 :: Sig)-    writeCond ref-    whileRefBegin ref-    body-    writeCond ref-    whileRefEnd-    where-        writeCond :: Ref Sig -> SE ()-        writeCond ref = writeRef ref =<< fmap (\x -> ifB x 1 0) mcond---- ifBegin :: BoolSig -> SE ()--- ifBegin a = fromDep_ $ D.ifBegin Kr =<< lift (toGE a)--whileRefBegin :: Ref Sig -> SE ()-whileRefBegin (Ref [var]) = fromDep_ $ D.whileBegin ((D.prim $ D.PrimVar D.Kr var) ==* 1)--whileRefEnd :: SE ()-whileRefEnd = fromDep_ D.whileEnd--} --------------------------------------------------------------------  whileRef :: forall st . Tuple st => st -> (st -> SE BoolSig) -> (st -> SE st) -> SE ()-whileRef initVal cond body = do+whileRef initVal c body = do     refSt   <- newCtrlRef initVal     refCond <- newRef =<< condSig =<< readRef refSt     whileRefBegin refCond@@ -207,11 +160,11 @@     fromDep_ whileEnd     where         condSig :: st -> SE Sig-        condSig   = fmap (\b -> ifB b 1 0) . cond+        condSig   = fmap (\b -> ifB b 1 0) . c   whileRefD :: forall st . Tuple st => st -> (st -> SE BoolD) -> (st -> SE st) -> SE ()-whileRefD initVal cond body = do+whileRefD initVal c body = do     refSt   <- newCtrlRef initVal     refCond <- newRef =<< condSig =<< readRef refSt     whileRefBegin refCond@@ -220,7 +173,7 @@     fromDep_ whileEnd     where         condSig :: st -> SE D-        condSig   = fmap (\b -> ifB b 1 0) . cond+        condSig   = fmap (\b -> ifB b 1 0) . c  whileRefBegin :: SigOrD a => Ref a -> SE () whileRefBegin (Ref vars) = fromDep_ $ D.whileRef $ head vars

@@ -3,7 +3,7 @@     saw, isaw, pulse, tri, sqr, blosc,     saw', isaw', pulse', tri', sqr', blosc', -    -- * Hard sync +    -- * Hard sync     SyncSmooth(..),      sawSync, isawSync, pulseSync, triSync, sqrSync, bloscSync,@@ -30,8 +30,6 @@ import Csound.Typed.GlobalState import Csound.Typed.Types -import Csound.Typed.GlobalState- -------------------------------------------------------------- -- no phase @@ -48,7 +46,7 @@ tri = noPhaseWave Triangle  -- | Pulse (not normalized).-pulse :: Sig -> Sig +pulse :: Sig -> Sig pulse = noPhaseWave Pulse  -- | A square wave.@@ -77,7 +75,7 @@ tri' = withPhaseWave Triangle  -- | Pulse (not normalized).-pulse' :: D -> Sig -> Sig +pulse' :: D -> Sig -> Sig pulse' = withPhaseWave Pulse  -- | A square wave.@@ -113,14 +111,14 @@  -- | Sawtooth oscillator with hard-sync. -- The first argument is a ration between slave and master oscillators.--- +-- -- > sawSync ratio cps sawSync :: Sig -> Sig -> Sig sawSync = relativeSync sawSyncAbs  -- | Integrated sawtooth oscillator with hard-sync. -- The first argument is a ration between slave and master oscillators.--- +-- -- > isawSync ratio cps isawSync :: Sig -> Sig -> Sig isawSync = relativeSync isawSyncAbs@@ -128,28 +126,28 @@  -- | Triangle oscillator with hard-sync. -- The first argument is a ration between slave and master oscillators.--- +-- -- > triSync ratio cps triSync :: Sig -> Sig -> Sig triSync = relativeSync triSyncAbs  -- | Pulse oscillator with hard-sync. -- The first argument is a ration between slave and master oscillators.--- +-- -- > pulseSync ratio cps pulseSync :: Sig -> Sig -> Sig pulseSync = relativeSync pulseSyncAbs  -- | Square oscillator with hard-sync. -- The first argument is a ration between slave and master oscillators.--- +-- -- > sqrSync ratio cps sqrSync :: Sig -> Sig -> Sig sqrSync = relativeSync sqrSyncAbs  -- | Band-limited oscillator with hard-sync. -- The first argument is a ration between slave and master oscillators.--- +-- -- > bloscSync tab ratio cps bloscSync :: Tab -> Sig -> Sig -> Sig bloscSync t = relativeSync (bloscSyncAbs t)@@ -162,42 +160,42 @@  -- | Sawtooth oscillator with hard-sync with phase. -- The second argument is a ration between slave and master oscillators.--- +-- -- > sawSync' phase ratio cps sawSync' :: D -> Sig -> Sig -> Sig sawSync' = relativeSync' sawSyncAbs'  -- | Integrated sawtooth oscillator with hard-sync with phase. -- The second argument is a ration between slave and master oscillators.--- +-- -- > isawSync' phase ratio cps isawSync' :: D -> Sig -> Sig -> Sig isawSync' = relativeSync' isawSyncAbs'  -- | Triangle oscillator with hard-sync with phase. -- The second argument is a ration between slave and master oscillators.--- +-- -- > triSync' phase ratio cps triSync' :: D -> Sig -> Sig -> Sig triSync' = relativeSync' triSyncAbs'  -- | Pulse oscillator with hard-sync with phase. -- The second argument is a ration between slave and master oscillators.--- +-- -- > pulseSync' phase ratio cps pulseSync' :: D -> Sig -> Sig -> Sig pulseSync' = relativeSync' pulseSyncAbs'  -- | Square oscillator with hard-sync with phase. -- The second argument is a ration between slave and master oscillators.--- +-- -- > sqrSync' phase ratio cps sqrSync' :: D -> Sig -> Sig -> Sig sqrSync' = relativeSync' sqrSyncAbs'  -- | Band-limited oscillator with hard-sync with phase. -- The second argument is a ration between slave and master oscillators.--- +-- -- > bloscSync' phase tab ratio cps bloscSync' :: Tab -> D -> Sig -> Sig -> Sig bloscSync' t = relativeSync' (bloscSyncAbs' t)@@ -210,45 +208,45 @@  -- | Sawtooth oscillator with hard-sync. We can specify the smoothness type. -- The @ratio@ argument is a ration between slave and master oscillators.--- +-- -- > sawSyncBy spec ratio cps sawSyncBy :: SyncSmooth -> Sig -> Sig -> Sig sawSyncBy = relativeSyncBy sawSyncAbsBy  -- | Integrated sawtooth oscillator with hard-sync. We can specify the smoothness type. -- The first argument is a ration between slave and master oscillators.--- +-- -- > isawSyncB specy ratio cps isawSyncBy :: SyncSmooth -> Sig -> Sig -> Sig isawSyncBy = relativeSyncBy isawSyncAbsBy  -- | Triangle oscillator with hard-sync. We can specify the smoothness type. -- The @ratio@ argument is a ration between slave and master oscillators.--- +-- -- > triSyncBy spec ratio cps triSyncBy :: SyncSmooth -> Sig -> Sig -> Sig triSyncBy = relativeSyncBy triSyncAbsBy  -- | Pulse oscillator with hard-sync. We can specify the smoothness type. -- The @ratio@ argument is a ration between slave and master oscillators.--- +-- -- > pulseSyncBy spec ratio cps pulseSyncBy :: SyncSmooth -> Sig -> Sig -> Sig pulseSyncBy = relativeSyncBy pulseSyncAbsBy  -- | Square oscillator with hard-sync. We can specify the smoothness type. -- The @ratio@ argument is a ration between slave and master oscillators.--- +-- -- > sawSyncBy spec ratio cps sqrSyncBy :: SyncSmooth -> Sig -> Sig -> Sig sqrSyncBy = relativeSyncBy sqrSyncAbsBy  -- | Bandlimited table oscillator with hard-sync. We can specify the smoothness type. -- The @ratio@ argument is a ration between slave and master oscillators.--- +-- -- > bloscSyncBy spec tab ratio cps bloscSyncBy :: SyncSmooth -> Tab -> Sig -> Sig -> Sig-bloscSyncBy smoothType t = relativeSyncBy (\smoothType -> bloscSyncAbsBy smoothType t) smoothType+bloscSyncBy smoothType t = relativeSyncBy (\smoothTy -> bloscSyncAbsBy smoothTy t) smoothType  ------------------------------------------------------------ -- phase@@ -258,86 +256,86 @@  -- | Sawtooth oscillator with hard-sync with phase. We can specify the smoothness type. -- The @ratio@ argument is a ration between slave and master oscillators.--- +-- -- > sawSyncBy' spec phase ratio cps sawSyncBy' :: SyncSmooth -> D -> Sig -> Sig -> Sig sawSyncBy' = relativeSyncBy' sawSyncAbsBy'  -- | Integrated sawtooth oscillator with hard-sync with phase. We can specify the smoothness type. -- The @ratio@ argument is a ration between slave and master oscillators.--- +-- -- > isawSyncBy' spec phase ratio cps isawSyncBy' :: SyncSmooth -> D -> Sig -> Sig -> Sig isawSyncBy' = relativeSyncBy' isawSyncAbsBy'  -- | Triangle oscillator with hard-sync with phase. We can specify the smoothness type. -- The @ratio@ argument is a ration between slave and master oscillators.--- +-- -- > triSyncBy' spec phase ratio cps triSyncBy' :: SyncSmooth -> D -> Sig -> Sig -> Sig triSyncBy' = relativeSyncBy' triSyncAbsBy'  -- | Pulse oscillator with hard-sync with phase. We can specify the smoothness type. -- The @ratio@ argument is a ration between slave and master oscillators.--- +-- -- > pulseSyncBy' spec phase ratio cps pulseSyncBy' :: SyncSmooth -> D -> Sig -> Sig -> Sig pulseSyncBy' = relativeSyncBy' pulseSyncAbsBy'  -- | Square oscillator with hard-sync with phase. We can specify the smoothness type. -- The @ratio@ argument is a ration between slave and master oscillators.--- +-- -- > sawSyncBy' spec phase ratio cps sqrSyncBy' :: SyncSmooth -> D -> Sig -> Sig -> Sig sqrSyncBy' = relativeSyncBy' sqrSyncAbsBy'  -- | Bandlimited table oscillator with hard-sync with phase. We can specify the smoothness type. -- The @ratio@ argument is a ration between slave and master oscillators.--- +-- -- > bloscSyncBy' spec phase tab ratio cps bloscSyncBy' :: SyncSmooth -> Tab -> D -> Sig -> Sig -> Sig-bloscSyncBy' smoothType t = relativeSyncBy' (\smoothType -> bloscSyncAbsBy' smoothType t) smoothType+bloscSyncBy' smoothType t = relativeSyncBy' (\smoothTy -> bloscSyncAbsBy' smoothTy t) smoothType  ------------------------------------------------------------  -- | Sawtooth oscillator with hard-sync. -- The @freq@ argument is an absolute frequency of a slave oscillator.--- +-- -- > sawSyncAbs freq slaveCps masterCps sawSyncAbs :: Sig -> Sig -> Sig sawSyncAbs = sawSyncAbsBy def  -- | Integrated sawtooth oscillator with hard-sync. -- The @freq@ argument is an absolute frequency of a slave oscillator.--- +-- -- > isawSyncAbs freq slaveCps masterCps isawSyncAbs :: Sig -> Sig -> Sig isawSyncAbs = isawSyncAbsBy def  -- | Triangle oscillator with hard-sync. -- The @freq@ argument is an absolute frequency of a slave oscillator.--- +-- -- > triSyncAbs freq slaveCps masterCps triSyncAbs :: Sig -> Sig -> Sig triSyncAbs = triSyncAbsBy def  -- | Pulse oscillator with hard-sync. -- The @freq@ argument is an absolute frequency of a slave oscillator.--- +-- -- > pulseSyncAbs freq slaveCps masterCps pulseSyncAbs :: Sig -> Sig -> Sig pulseSyncAbs = pulseSyncAbsBy def  -- | Square oscillator with hard-sync. -- The @freq@ argument is an absolute frequency of a slave oscillator.--- +-- -- > sqrSyncAbs freq slaveCps masterCps sqrSyncAbs :: Sig -> Sig -> Sig sqrSyncAbs = sqrSyncAbsBy def  -- | Bandlimited table oscillator with hard-sync. -- The @freq@ argument is an absolute frequency of a slave oscillator.--- +-- -- > bloscSyncAbs tab freq slaveCps masterCps bloscSyncAbs :: Tab -> Sig -> Sig -> Sig bloscSyncAbs = bloscSyncAbsBy def@@ -346,42 +344,42 @@  -- | Sawtooth oscillator with hard-sync with phase. -- The @freq@ argument is an absolute frequency of a slave oscillator.--- +-- -- > sawSyncAbs' phase freq slaveCps masterCps sawSyncAbs' :: D -> Sig -> Sig -> Sig sawSyncAbs' = sawSyncAbsBy' def  -- | Integrated sawtooth oscillator with hard-sync with phase. -- The @freq@ argument is an absolute frequency of a slave oscillator.--- +-- -- > isawSyncAbs' phase freq slaveCps masterCps isawSyncAbs' :: D -> Sig -> Sig -> Sig isawSyncAbs' = isawSyncAbsBy' def  -- | Triangle oscillator with hard-sync with phase. -- The @freq@ argument is an absolute frequency of a slave oscillator.--- +-- -- > triSyncAbs' phase freq slaveCps masterCps triSyncAbs' :: D -> Sig -> Sig -> Sig triSyncAbs' = triSyncAbsBy' def  -- | Pulse oscillator with hard-sync with phase. -- The @freq@ argument is an absolute frequency of a slave oscillator.--- +-- -- > pulseSyncAbs' phase freq slaveCps masterCps pulseSyncAbs' :: D -> Sig -> Sig -> Sig pulseSyncAbs' = pulseSyncAbsBy' def  -- | Square oscillator with hard-sync with phase. -- The @freq@ argument is an absolute frequency of a slave oscillator.--- +-- -- > sqrSyncAbs' phase freq slaveCps masterCps sqrSyncAbs' :: D -> Sig -> Sig -> Sig sqrSyncAbs' = sqrSyncAbsBy' def  -- | Bandlimited table oscillator with hard-sync with phase. -- The @freq@ argument is an absolute frequency of a slave oscillator.--- +-- -- > bloscSyncAbs' phase tab freq slaveCps masterCps bloscSyncAbs' :: Tab -> D -> Sig -> Sig -> Sig bloscSyncAbs' = bloscSyncAbsBy' def@@ -410,7 +408,7 @@ -- | A hard sync for pulse wave with absolute slave frequency. -- -- > pulseSyncAbs syncType salveCps masterCps-pulseSyncAbsBy :: SyncSmooth -> Sig -> Sig -> Sig +pulseSyncAbsBy :: SyncSmooth -> Sig -> Sig -> Sig pulseSyncAbsBy = noPhaseWaveHardSync Pulse  -- | A hard sync for square wave with absolute slave frequency.@@ -443,7 +441,7 @@ triSyncAbsBy' = withPhaseWaveHardSync Triangle  -- | Pulse (not normalized).-pulseSyncAbsBy' :: SyncSmooth -> D -> Sig -> Sig -> Sig +pulseSyncAbsBy' :: SyncSmooth -> D -> Sig -> Sig -> Sig pulseSyncAbsBy' = withPhaseWaveHardSync Pulse  -- | A square wave.@@ -459,7 +457,7 @@ -----------------------------------------------  -- | Type of smooth shape to make smooth transitions on retrigger.--- Available types are: +-- Available types are: -- -- * No smooth: @RawSync@ --

@@ -57,7 +57,7 @@ import qualified Data.Map as M import qualified Data.IntMap as IM -import Csound.Dynamic.Types+import Csound.Dynamic.Types hiding (genId) import Csound.Dynamic.Build import Csound.Dynamic.Build.Numeric() @@ -103,9 +103,9 @@ nextPowOfTwo :: Int -> Int nextPowOfTwo n     | frac == 0 = n-    | otherwise = 2 ^ (integ + 1)+    | otherwise = 2 ^ ((integ :: Int) + 1)     where-        (integ, frac) = properFraction $ logBase 2 (fromIntegral n)+        (integ, frac) = (properFraction $ logBase 2 (fromIntegral n)) :: (Int, Double)  saveGenId :: Ord a => a -> State (IdMap a) Int saveGenId a = state $ \s ->@@ -219,6 +219,7 @@     SimpleBandLimitedWave simpleId -> int simpleId     UserBandLimitedWave   userId   -> noRate $ ReadVar $ bandLimitedVar userId +bandLimitedVar :: Show a => a -> Var bandLimitedVar userId = Var GlobalVar Ir ("BandLim" ++ show userId)  data BandLimitedMap = BandLimitedMap@@ -282,39 +283,12 @@         renderVcoVarAssignment n = writeVar (bandLimitedVar n) =<< (fmap negate $ readVar (ftVar n))          renderVco :: Monad m => (BandLimited, BandLimitedId) -> DepT m ()-        renderVco (bandLimited, blId) = case blId of+        renderVco (_bandLimited, blId) = case blId of             SimpleBandLimitedWave waveId -> do                 free <- readVar freeVcoVar                 writeVar freeVcoVar $ vco2init [int waveId, free]             UserBandLimitedWave   _      -> return () --{--            renderFirstVco n (head vcos)-            mapM_ renderTailVco (tail vcos)--        getUserGens as = phi =<< as-            where phi (x, gId) = case x of-                        UserGen g   -> [(g, gId)]-                        _           -> []--        renderGen (g, n) = toDummy $ ftgen (int n) g--        renderFirstVco n x = renderVco (int n) x-        renderTailVco x = renderVco (readOnlyVar vcoVar) x--        renderVco ftId (wave, waveId) = toVcoVar $ vco2init $ case wave of-            UserGen _   -> [ int waveId, ftId, 1.05, -1, -1, int $ negate waveId ]-            _           -> [ int waveId, ftId ]--        vcoVar = dummyVar-        toVcoVar = toDummy--        dummyVar = Var LocalVar Ir "ft"--        toDummy = writeVar dummyVar--}- readBandLimited :: Maybe E -> BandLimitedId -> E -> E readBandLimited mphase n cps = oscilikt 1 cps (vco2ft cps (bandLimitedIdToExpr n)) mphase @@ -322,7 +296,7 @@ readHardSyncBandLimited msmoothShape mphase n slaveCps masterCps = smoothWave * readShape n phasorSlave slaveCps     where         (phasorMaster, syncMaster) = syncphasor masterCps 0 Nothing-        (phasorSlave,  syncSlave)  = syncphasor slaveCps syncMaster mphase+        (phasorSlave,  _syncSlave) = syncphasor slaveCps syncMaster mphase          smoothWave = case msmoothShape of             Nothing    -> 1@@ -353,12 +327,12 @@     , globalsVars   :: [AllocVar] }  data AllocVar = AllocVar-        { allocVarType     :: GlobalVarType-        , allocVar         :: Var-        , allocVarInit     :: E }+        { _allocVarType     :: GlobalVarType+        , _allocVar         :: Var+        , _allocVarInit     :: E }     | AllocArrVar-        { allocArrVar :: Var-        , allocArrVarSizes :: [E] }+        { _allocArrVar :: Var+        , _allocArrVarSizes :: [E] }  data GlobalVarType = PersistentGlobalVar | ClearableGlobalVar     deriving (Eq)@@ -403,12 +377,12 @@         gs = globalsVars a          initAlloc x = case x of-            AllocVar _  var init  -> initVar var init-            AllocArrVar var sizes -> initArr var sizes+            AllocVar _  var initProc -> initVar var initProc+            AllocArrVar var sizes    -> initArr var sizes          clearAlloc x = case x of-            AllocVar _  var init  ->  writeVar var init-            AllocArrVar _ _       -> return ()+            AllocVar _  var initProc -> writeVar var initProc+            AllocArrVar _ _          -> return ()          isClearable x = case x of             AllocVar ty _ _ -> ty == ClearableGlobalVar@@ -532,20 +506,20 @@ -------------------------------------------------------- -- Osc listeners -newtype OscListenPorts = OscListenPorts { unOscListenPorts :: IM.IntMap Var }+newtype OscListenPorts = OscListenPorts (IM.IntMap Var)  instance Default OscListenPorts where     def = OscListenPorts IM.empty  getOscPortVar :: Int -> State (OscListenPorts, Globals) Var-getOscPortVar port = state $ \st@(OscListenPorts m, globals) -> case IM.lookup port m of+getOscPortVar portId = state $ \st@(OscListenPorts m, globals) -> case IM.lookup portId m of         Just a  -> (a, st)-        Nothing -> onNothing port m globals+        Nothing -> onNothing m globals     where-        onNothing port m globals = (var, (OscListenPorts m1, newGlobals))+        onNothing m globals = (var, (OscListenPorts m1, newGlobals))             where-                (var, newGlobals) = runState (allocOscPortVar port) globals-                m1 = IM.insert port var m+                (var, newGlobals) = runState (allocOscPortVar portId) globals+                m1 = IM.insert portId var m   allocOscPortVar :: Int -> State Globals Var@@ -583,6 +557,13 @@  ---------------------------------------------------------- -- Steven Yi wonderful UDOs++zdfPlugin, solinaChorusPlugin, audaciouseqPlugin, adsr140Plugin, diodePlugin, korg35Plugin,+  zeroDelayConvolutionPlugin, analogDelayPlugin, distortionPlugin, envelopeFolollowerPlugin,+  flangerPlugin, freqShifterPlugin, loFiPlugin, panTremPlugin, monoTremPlugin, phaserPlugin,+  pitchShifterPlugin, pitchShifterDelayPlugin, reversePlugin, ringModulatorPlugin, stChorusPlugin,+  stereoPingPongDelayPlugin, tapeEchoPlugin, delay1kPlugin,+  ambiRowPlugin, ambiRowMp3Plugin, liveRowPlugin, liveRowsPlugin, tabQueuePlugin, tabQueue2Plugin :: UdoPlugin  zdfPlugin           = UdoPlugin "zdf"               -- Zero delay filters solinaChorusPlugin  = UdoPlugin "solina_chorus"     -- solina chorus

@@ -185,6 +185,7 @@ saveGen :: Gen -> GE Int saveGen = onGenMap . newGen +onGenMap :: State GenMap a -> GE a onGenMap = onHistory genMap (\val h -> h{ genMap = val })  saveWriteGen :: Gen -> GE E@@ -193,6 +194,7 @@ saveWriteTab :: Int -> GE E saveWriteTab = onWriteGenMap . newWriteTab +onWriteGenMap :: State WriteGenMap a -> GE a onWriteGenMap = onHistory writeGenMap (\val h -> h{ writeGenMap = val })  saveTabs :: [Gen] -> GE E@@ -577,9 +579,9 @@ readMacrosInt    = readMacrosBy D.readMacrosInt    MacrosInitInt  readMacrosBy :: (String ->  E) -> (String -> a -> MacrosInit) -> String -> a -> GE E-readMacrosBy reader allocator name initValue = do+readMacrosBy extract allocator name initValue = do     onMacrosInits $ initMacros $ allocator name initValue-    return $ reader name+    return $ extract name     where onMacrosInits = onHistory macrosInits (\val h -> h { macrosInits = val })  -----------------------------------------------

@@ -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) @@ -35,24 +34,24 @@ saveSourceInstrCachedWithLivenessWatch :: Arity -> InsExp -> GE InstrId saveSourceInstrCachedWithLivenessWatch arity instr = saveInstr $ do     toOut =<< instr-    livenessWatch arity +    livenessWatch arity     where toOut = SE . C.sendChn (arityIns arity) (arityOuts arity)  saveSourceInstrCachedWithLivenessWatchAndRetrig :: Arity -> InsExp -> GE InstrId saveSourceInstrCachedWithLivenessWatchAndRetrig arity instr = saveInstr $ do     toOut =<< instr     retrigWatch arity-    livenessWatch arity    +    livenessWatch arity     where toOut = SE . C.sendChn (arityIns arity) (arityOuts arity)  saveSourceInstrCachedWithLivenessWatchAndRetrigAndEvtLoop :: Arity -> InsExp -> UnitExp -> GE (InstrId, InstrId)-saveSourceInstrCachedWithLivenessWatchAndRetrigAndEvtLoop arity instr evtInstr = do +saveSourceInstrCachedWithLivenessWatchAndRetrigAndEvtLoop arity instr evtInstr = do     instrId <- saveSourceInstrCachedWithLivenessWatchAndRetrig arity instr     evtInstrId <- saveInstr (evtInstr >> retrigWatch evtInstrArity >> livenessWatch evtInstrArity)     return (instrId, evtInstrId)-    where +    where         evtInstrArity = Arity 0 0-        + saveSourceInstrCached :: Arity -> InsExp -> GE InstrId saveSourceInstrCached arity instr = saveInstr $ toOut =<< instr     where toOut = SE . C.sendChn (arityIns arity) (arityOuts arity)@@ -61,12 +60,12 @@ saveSourceInstrCached_ instr = saveInstr instr  saveSourceInstrCachedWithLivenessWatch_ :: Arity -> UnitExp -> GE InstrId-saveSourceInstrCachedWithLivenessWatch_ arity instr = saveInstr $ +saveSourceInstrCachedWithLivenessWatch_ arity instr = saveInstr $     instr >> livenessWatch arity  saveEffectInstr :: Arity -> EffExp -> GE InstrId saveEffectInstr arity eff = saveInstr $ setOuts =<< eff =<< getIns-    where +    where         setOuts = SE . C.writeChn (C.chnRefFromParg 5 (arityOuts arity))         getIns  = SE $ C.readChn  $ C.chnRefFromParg 4 (arityIns  arity) @@ -82,7 +81,7 @@  saveMasterInstr :: Arity -> InsExp -> GE () saveMasterInstr arity sigs = do-    gainLevel <- fmap defGain getOptions +    gainLevel <- fmap defGain getOptions     saveAlwaysOnInstr =<< (saveInstr $ (SE . C.sendOut (arityOuts arity) . C.safeOut gainLevel) =<< sigs)  saveMidiInstr :: C.MidiType -> C.Channel -> Arity -> InsExp -> GE [E]@@ -92,7 +91,7 @@     let expr = (SE . zipWithM_ (appendVarBy (+)) vars) =<< instr     instrId <- saveInstr expr     saveMidi $ MidiAssign midiType channel instrId-    return $ fmap readOnlyVar vars +    return $ fmap readOnlyVar vars  saveMidiMap :: GE () saveMidiMap = do@@ -100,14 +99,14 @@     mapM_ (\(C.MidiKey midiType channel, instrExpr) -> saveMidiInstr_ midiType channel (SE instrExpr)) $ toList m  saveMidiInstr_ :: C.MidiType -> C.Channel -> UnitExp -> GE ()-saveMidiInstr_ midiType channel instr = do    +saveMidiInstr_ midiType channel instr = do     instrId <- saveInstr instr-    saveMidi $ MidiAssign midiType channel instrId   +    saveMidi $ MidiAssign midiType channel instrId  saveIns0 :: Int -> [Rate] -> SE [E] -> GE [E] saveIns0 arity rates as = do     vars <- onGlobals $ zipWithM C.newPersistentGlobalVar rates (replicate arity 0)-    saveUserInstr0 $ unSE $ (SE . zipWithM_ writeVar vars) =<< as +    saveUserInstr0 $ unSE $ (SE . zipWithM_ writeVar vars) =<< as     return $ fmap readOnlyVar vars  terminatorInstr :: GE (SE ())

@@ -5,7 +5,6 @@     turnoff, turnoff2 ) where -import Control.Monad import Control.Monad.Trans.Class  import Csound.Dynamic hiding (InstrId, when1)@@ -18,11 +17,11 @@ import Csound.Typed.GlobalState.Port  -import qualified Csound.Typed.GlobalState.Opcodes as Opcodes(Event(..), event, eventi, turnoff2, turnoff, initSig, activeKr)+import qualified Csound.Typed.GlobalState.Opcodes as Opcodes(Event(..), event, eventi, turnoff2, turnoff, activeKr)  data InstrId a-    = InstrId { unInstrId :: GE E }-    | InstrLinkedId { instrLivenessPort :: PortCtrl Sig, unInstrId :: GE E }+    = InstrId { _unInstrId :: GE E }+    | InstrLinkedId { _instrLivenessPort :: PortCtrl Sig, _unInstrId :: GE E }  newInstr :: Arg a => (a -> SE ()) -> InstrId a newInstr instr = InstrId $ fmap instrIdE $ saveInstr (instr toArg)@@ -44,8 +43,8 @@             d <- toGE dur             as <- fromTuple args             return $ Opcodes.Event i s d as-getEvent (InstrLinkedId port idx) (start, dur, arg) = do-    getEvent (InstrId idx) (start, dur, (arg, port))+getEvent (InstrLinkedId port idx) (start, dur, argument) = do+    getEvent (InstrId idx) (start, dur, (argument, port))   getEventi :: Tuple a => InstrId a -> (D, D, a) -> SE Opcodes.Event@@ -55,12 +54,14 @@             d <- toGE dur             as <- fromTuple args             return $ Opcodes.Event i s d as-getEventi (InstrLinkedId port idx) (start, dur, arg) = do-    getEventi (InstrId idx) (start, dur, (arg, port))+getEventi (InstrLinkedId port idx) (start, dur, argument) = do+    getEventi (InstrId idx) (start, dur, (argument, port))   turnoff2 :: InstrId a -> SE ()-turnoff2 (InstrId expr) = SE $ Opcodes.turnoff2 =<< lift expr+turnoff2 = \case+  InstrId expr -> SE $ Opcodes.turnoff2 =<< lift expr+  InstrLinkedId _ _ -> error "turnoff2 is undefined for InstrLinkedId"  turnoff :: SE () turnoff = SE $ Opcodes.turnoff@@ -75,8 +76,8 @@     return resInstrId     where         instr' :: (a, PortCtrl Sig) -> SE ()-        instr' (arg, port) = do-            instr arg+        instr' (argument, port) = do+            instr argument             testLiveness port  testLiveness :: PortCtrl Sig -> SE ()

@@ -1,6 +1,6 @@ module Csound.Typed.GlobalState.Opcodes(     sprintf,-    -- * channel opcodes    +    -- * channel opcodes     ChnRef(..), chnRefFromParg, chnRefAlloc, readChn, writeChn, overWriteChn, freeChn, chnName, chnget, chnset, chngetK, chnsetK, initSig, active, activeKr,     readChnEvtLoop,     chnUpdateUdo, masterUpdateChnAlive, servantUpdateChnAlive,@@ -45,7 +45,7 @@  -- channels -data ChnRef = ChnRef +data ChnRef = ChnRef     { chnRefId      :: E     , chnRefNames   :: [E] } @@ -56,7 +56,7 @@ chnRefAlloc arity = do     chnId <- freeChn     return $ ChnRef chnId $ fmap (flip chnName chnId) [1 .. arity]-    + readChn :: Monad m => ChnRef -> DepT m [E] readChn ref = do     res <- mapM chnget $ chnRefNames ref@@ -68,11 +68,11 @@  overWriteChn :: Monad m => ChnRef -> [E] -> DepT m () overWriteChn ref sigs = zipWithM_ chnset (chnRefNames ref) sigs-    + clearChn :: Monad m => ChnRef -> DepT m () clearChn = mapM_ chnclear . chnRefNames --- | +-- | -- > chnName outputPortNumber freeChnId chnName :: Int -> E -> E chnName name chnId = sprintf formatString [chnId]@@ -86,7 +86,7 @@  servantUpdateChnAlive :: Monad m => Int -> DepT m () servantUpdateChnAlive pargId = do-    let sName = chnAliveName (pn pargId) +    let sName = chnAliveName (pn pargId)     kAlive <- chngetK sName     when1 Kr (kAlive <* -10) $ do         turnoff@@ -97,15 +97,15 @@  servantUpdateChnRetrig :: Monad m => Int -> DepT m () servantUpdateChnRetrig pargId = do-    let sName = chnRetrigName (pn pargId) +    let sName = chnRetrigName (pn pargId)     let retrigVal = pn $ pargId + 1     kRetrig <- chngetK sName     when1 Kr (kRetrig /=* retrigVal) $ do-        turnoff    +        turnoff  servantUpdateChnEvtLoop :: Monad m => Int -> DepT m () servantUpdateChnEvtLoop pargId = do-    let sName = chnEvtLoopName (pn pargId) +    let sName = chnEvtLoopName (pn pargId)     kEvtLoop <- chngetK sName     chnsetK sName (ifB (kEvtLoop ==* 0) 1 0)     turnoff@@ -186,19 +186,19 @@ event_i = eventBy "event_i" Ir  eventBy :: Monad m => String -> Rate -> Event -> DepT m ()-eventBy name rate a = depT_ $ opcs name [(Xr, Sr : repeat rate)] +eventBy name rate a = depT_ $ opcs name [(Xr, Sr : repeat rate)]     (str "i" : (eventInstrId a) : (eventStart a) : (eventDur a) : (eventArgs a))  appendChn :: E -> Event -> Event appendChn chn a = a { eventArgs = eventArgs a ++ [chn] }  subinstr :: Int -> InstrId -> [E] -> [E]-subinstr outArity instrId args = ( $ outArity) $ mopcs "subinstr" -    (repeat Ar, Ir : repeat Kr) +subinstr outArity instrId args = ( $ outArity) $ mopcs "subinstr"+    (repeat Ar, Ir : repeat Kr)     (prim (PrimInstrId instrId) : args)  subinstr_ :: Monad m => InstrId -> [E] -> DepT m ()-subinstr_ instrId args = depT_ $ head $ ($ 1) $  mopcs "subinstr" +subinstr_ instrId args = depT_ $ head $ ($ 1) $  mopcs "subinstr"     (repeat Ar, Ir : repeat Kr)     (prim (PrimInstrId instrId) : args) @@ -222,7 +222,7 @@ -- safe out  -- clipps values by 0dbfs-safeOut :: Double -> [E] -> [E] +safeOut :: Double -> [E] -> [E] safeOut gainLevel = fmap (( * double gainLevel) . limiter)  limiter :: E -> E@@ -230,17 +230,17 @@  autoOff :: Monad m => E -> [E] -> DepT m [E] autoOff dt a = do-    ihold    +    ihold     when1 Kr (trig a)         turnoff     return a     where-        trig = (<* eps) . (env + ) . setRate Kr . flip follow dt . l2 +        trig = (<* eps) . (env + ) . setRate Kr . flip follow dt . l2          eps = 1e-5          l2 :: [E] -> E-        l2 xs = sqrt $ sum $ zipWith (*) xs xs +        l2 xs = sqrt $ sum $ zipWith (*) xs xs          env = linseg [1, dt/2, 1, dt/2, 0, 1, 0] @@ -270,9 +270,9 @@ -- ares oscilikt xamp, xcps, kfn [, iphs] [, istor] -- kres oscilikt kamp, kcps, kfn [, iphs] [, istor] oscilikt :: E -> E -> E -> Maybe E -> E-oscilikt amp cps fn mphase = opcs "oscilikt" +oscilikt amp cps fn mphase = opcs "oscilikt"     [ (Ar, [Xr, Xr, Kr, Ir, Ir])-    , (Kr, [Kr, Kr, Kr, Ir, Ir])]     +    , (Kr, [Kr, Kr, Kr, Ir, Ir])]     (case mphase of         Nothing  -> [amp, cps, fn]         Just phs -> [amp, cps, fn, phs]@@ -283,13 +283,13 @@ oscili :: E -> E -> E -> Maybe E -> E oscili amp cps fn mphase = opcs "oscili"     [ (Ar, [Xr, Xr, Ir, Ir, Ir])-    , (Kr, [Kr, Kr, Ir, Ir, Ir])]     +    , (Kr, [Kr, Kr, Ir, Ir, Ir])]     (case mphase of         Nothing  -> [amp, cps, fn]         Just phs -> [amp, cps, fn, phs]     )-     + -- kfn vco2ft kcps, iwave [, inyx] vco2ft :: E -> E -> E vco2ft cps iwave = opcs "vco2ft" [(Kr, [Kr, Ir, Ir])] [cps, iwave]@@ -304,7 +304,7 @@     ++ (fmap double $ genArgs g)  genIdE :: GenId -> E-genIdE genId = case genId of+genIdE = \case     IntGenId n -> int n     StringGenId a -> str a @@ -316,14 +316,14 @@     Nothing     -> [xcps, asyncin]     Just phase  -> [xcps, asyncin, phase] -tableikt :: E -> E -> E +tableikt :: E -> E -> E tableikt xndx kfn  = opcs "tableikt" [(Ar, [Xr, Kr, Ir, Ir, Ir])] [xndx, kfn, 1]  ----------------------------------------------------------- -- OSC  oscInit :: E -> E-oscInit port = opcs "OSCinit" [(Ir, [Ir])] [port]+oscInit portExpr = opcs "OSCinit" [(Ir, [Ir])] [portExpr]  oscListen :: Monad m => E -> E -> E -> [Var] -> DepT m E oscListen oscHandle addr oscType vars = depT $ opcs "OSClisten" [(Kr, Ir:Ir:Ir:repeat Xr)] (oscHandle : addr : oscType : fmap inlineVar vars)@@ -362,7 +362,7 @@ 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" +fluidProgramSelect engine sfInstr bank prog = depT $ opcs "fluidProgramSelect"     [(Xr, replicate 5 Ir)] [engine, 1, sfInstr, int bank, int prog]  -----------------------------------------------------------@@ -382,7 +382,7 @@     sf <- sfload fileName     sfplist sf     forM_ presets $ \(bank, prog, index) -> sfpreset bank prog sf index-    + ----------------------------------------------------------- -- midi volume factor (normalize by number of notes) @@ -393,13 +393,13 @@     where sqrtN = sqrt n           n     = activeIr idx -active :: E -> E    +active :: E -> E active instrId = opcs "active" [(Kr, [Ir]), (Ir, [Ir])] [instrId] -activeIr :: E -> E    +activeIr :: E -> E activeIr instrId = opcs "active" [(Ir, [Ir])] [instrId] -activeKr :: E -> E    +activeKr :: E -> E activeKr instrId = opcs "active" [(Kr, [Ir])] [instrId]  port :: E -> E -> E@@ -410,6 +410,7 @@  ----------------------------------------------------------- +getPair :: (Int -> [a]) -> (a, a) getPair mout = (a, b)     where [a, b] = mout 2 

@@ -17,12 +17,14 @@     -- *** String identifiers     idPadsynth, idTanh, idExp, idSone, idFarey, idWave,     -- * Jacko-    Jacko(..), JackoConnect, renderJacko+    Jacko(..), JackoConnect, renderJacko,+    -- * Debug trace+    csdNeedTrace ) where -import Data.Monoid import Control.Applicative import Data.Default+import Data.Maybe  import qualified Data.IntMap as IM import qualified Data.Map    as M@@ -46,10 +48,12 @@     , csdTabFi          :: Maybe TabFi              -- ^ Default fidelity of the arrays     , csdScaleUI        :: Maybe (Double, Double)   -- ^ Scale factors for UI-window     , csdJacko          :: Maybe Jacko+    , csdJackConnect    :: Maybe [(String, String)] -- ^ list of jack connections to make after csound app is launched (Linux only)+    , csdTrace          :: Maybe Bool               -- ^ Do we need debug-trace, default is False     } deriving (Eq, Show, Read)  instance Default Options where-    def = Options def def def def def def def+    def = Options def def def def def def def def def  #if MIN_VERSION_base(4,11,0) instance Semigroup Options where@@ -74,7 +78,9 @@     , csdGain           = csdGain a <|> csdGain b     , csdTabFi          = csdTabFi a <|> csdTabFi b     , csdScaleUI        = csdScaleUI a <|> csdScaleUI b-    , csdJacko          = csdJacko a <|> csdJacko b }+    , csdJacko          = csdJacko a <|> csdJacko b+    , csdJackConnect    = csdJackConnect a <> csdJackConnect b+    , csdTrace          = csdTrace a <|> csdTrace b }  defScaleUI :: Options -> (Double, Double) defScaleUI = maybe (1, 1) id . csdScaleUI@@ -231,7 +237,7 @@  renderJacko :: Jacko -> String renderJacko spec = unlines $ filter ( /= "")-    [ "JackoInit " ++ (str $ jackoServer spec) ++ ", " ++ (str $ jackoClient spec)+    [ "JackoInit " ++ (show $ jackoServer spec) ++ ", " ++ (show $ jackoClient spec)     , if (jackoFreewheel spec) then "JackoFreewheel 1" else ""     , if (jackoInfo spec) then "JackoInfo" else ""     , renderConnections "JackoAudioInConnect" $ jackoAudioIns spec@@ -242,6 +248,8 @@     where         renderConnections name links = unlines $ fmap (renderLink name) links -        renderLink name (a, b) = name ++ " " ++ (str a) ++ ", " ++  (str b)+        renderLink name (a, b) = name ++ " " ++ (show a) ++ ", " ++  (show b) -        str x = "\"" ++ x ++ "\""++csdNeedTrace :: Options -> Bool+csdNeedTrace opt = fromMaybe False $ csdTrace opt

@@ -1,13 +1,12 @@ module Csound.Typed.GlobalState.SE(-    SE(..), LocalHistory(..), -    runSE, execSE, evalSE, execGEinSE, hideGEinDep, +    SE(..), LocalHistory(..),+    runSE, execSE, evalSE, execGEinSE, hideGEinDep,     fromDep, fromDep_, geToSe,     newLocalVar, newLocalVars, newGlobalVars, newClearableGlobalVars,     -- array variables     newLocalArrVar, newGlobalArrVar, newTmpArrVar ) where -import Control.Applicative import Control.Monad import Control.Monad.Trans.Class @@ -50,11 +49,11 @@ hideGEinDep = join . lift  fromDep :: Dep a -> SE (GE a)-fromDep = fmap return . SE +fromDep = fmap return . SE  fromDep_ :: Dep () -> SE () fromDep_ = SE-            + evalSE :: SE a -> GE a evalSE = evalDepT . unSE 

@@ -7,10 +7,8 @@ ) where  import Control.Monad-import Control.Applicative import Control.Monad.Trans.State.Strict import Data.Default-import Data.Monoid  data Interval = Interval     { start :: Int

@@ -1,15 +1,15 @@ {-# Language GeneralizedNewtypeDeriving  #-}-module Csound.Typed.Gui.Cabbage.Cabbage(    -    Cab, CabProp, Col(..), runCab, -    +module Csound.Typed.Gui.Cabbage.Cabbage(+    Cab, CabProp, Col(..), runCab,+     -- * Widgets-    button, filebutton, infobutton, checkbox, combobox, csoundoutput, encoder, gentable, +    button, filebutton, infobutton, checkbox, combobox, csoundoutput, encoder, gentable,     hrange, vrange, form, groupbox, image, keyboard, label, hslider, vslider,     rslider, soundfiler, signaldisplay, textbox, texteditor, xypad,      -- * Properties-    bounds, channel, text1, text2, value, colour, colour0, colour1, backgroundcolour, textcolour, trackercolour, outlinecolour, -    fontcolour, fontcolour0, fontcolour1, latched, identchannel, rotate, alpha, visible, caption, widgetarray, popuptext, +    bounds, channel, text1, text2, value, colour, colour0, colour1, backgroundcolour, textcolour, trackercolour, outlinecolour,+    fontcolour, fontcolour0, fontcolour1, latched, identchannel, rotate, alpha, visible, caption, widgetarray, popuptext,     active, svgfile, populate, mode, file, shape, corners, channeltype, align, sliderincr, max, min, textbox', trackerthickness,     linethickness, range, range2, size, pluginid, guirefresh, plant, child, show, middlec, keywidth, scrollbars, fontstyle,     scrubberpos, zoom, displaytype, updaterate, wrap@@ -20,17 +20,16 @@  import Data.Maybe import Control.Monad.Trans.Writer.Strict-import Control.Applicative -import Csound.Typed.Gui.Cabbage.CabbageLang	+import Csound.Typed.Gui.Cabbage.CabbageLang  type Cab = Cab' () type CabProp = CabProp' () --- | The Cab is a monad for Cabbage markup language. +-- | The Cab is a monad for Cabbage markup language. -- The markup description can be constructed in the same way as blaze-html markup. newtype Cab' a = Cab' { unCab' :: Writer [Line] a }-	deriving (Functor, Applicative, Monad)+  deriving (Functor, Applicative, Monad)  runCab :: Cab -> [Line] runCab = snd . runWriter . unCab'@@ -49,34 +48,34 @@  --------------------------------------- -button, filebutton, infobutton, checkbox, combobox, csoundoutput, encoder, gentable, +button, filebutton, infobutton, checkbox, combobox, csoundoutput, encoder, gentable,     hrange, vrange, form, groupbox, image, keyboard, label, hslider, vslider,     rslider, soundfiler, signaldisplay, textbox, texteditor, xypad :: CabProp -> Cab -button 			= widget "button"-filebutton 		= widget "filebutton"-infobutton 		= widget "infobutton"-checkbox 		= widget "checkbox"-combobox 		= widget "combobox"-csoundoutput	= widget "csoundoutput"-encoder 		= widget "encoder"-gentable 		= widget "gentable"-hrange 			= widget "hrange"-vrange 			= widget "vrange"-form 			= widget "form"-groupbox 		= widget "groupbox"-image 			= widget "image"-keyboard 		= widget "keyboard"-label 			= widget "label"-hslider 		= widget "hslider"-vslider 		= widget "vslider"-rslider 		= widget "rslider"-soundfiler 		= widget "soundfiler"-signaldisplay	= widget "signaldisplay"-textbox 		= widget "textbox"-texteditor 		= widget "texteditor"-xypad 			= widget "xypad"-	+button      = widget "button"+filebutton    = widget "filebutton"+infobutton    = widget "infobutton"+checkbox    = widget "checkbox"+combobox    = widget "combobox"+csoundoutput  = widget "csoundoutput"+encoder     = widget "encoder"+gentable    = widget "gentable"+hrange      = widget "hrange"+vrange      = widget "vrange"+form      = widget "form"+groupbox    = widget "groupbox"+image       = widget "image"+keyboard    = widget "keyboard"+label       = widget "label"+hslider     = widget "hslider"+vslider     = widget "vslider"+rslider     = widget "rslider"+soundfiler    = widget "soundfiler"+signaldisplay = widget "signaldisplay"+textbox     = widget "textbox"+texteditor    = widget "texteditor"+xypad       = widget "xypad"+ --------------------------------------- -- properties @@ -85,11 +84,13 @@  data Col = Hash String | Rgb Int Int Int +colProp :: Col -> [Arg] colProp x = case x of-	Hash a -> [StringArg a]-	Rgb r g b -> fmap IntArg [r, g, b]+  Hash a -> [StringArg a]+  Rgb r g b -> fmap IntArg [r, g, b] -boolProp x = IntArg $ if x then 1 else 0	+boolProp :: Bool -> Arg+boolProp x = IntArg $ if x then 1 else 0  bounds :: Int -> Int -> Int -> Int -> CabProp bounds x y w h = mkProperty "bounds" (fmap IntArg [x, y, w, h])@@ -164,7 +165,7 @@ active a = mkProperty "active" [boolProp a]  svgfile :: String -> String -> CabProp-svgfile ty file = mkProperty "svgfile" (fmap StringArg [ty, file])+svgfile ty fileName = mkProperty "svgfile" (fmap StringArg [ty, fileName])  populate :: String -> String -> CabProp populate filetype dir = mkProperty "populate" (fmap StringArg [filetype, dir])@@ -206,10 +207,10 @@ linethickness a = mkProperty "linethickness" [FloatArg a]  range :: Float -> Float -> (Float, Float) -> CabProp-range min max value = range2 min max value Nothing Nothing+range minVal maxVal val = range2 minVal maxVal val Nothing Nothing  range2 :: Float -> Float -> (Float, Float) -> Maybe Float -> Maybe Float -> CabProp-range2 min max value mskew mincr = mkProperty "range" $ catMaybes [Just $ FloatArg min, Just $ FloatArg max, Just $ (uncurry ColonArg) value, fmap FloatArg mskew, fmap FloatArg mincr]+range2 minVal maxVal val mskew mincr = mkProperty "range" $ catMaybes [Just $ FloatArg minVal, Just $ FloatArg maxVal, Just $ (uncurry ColonArg) val, fmap FloatArg mskew, fmap FloatArg mincr]  size :: Int -> Int -> CabProp size w h = mkProperty "size" (fmap IntArg [w, h])

@@ -1,20 +1,20 @@ module Csound.Typed.Gui.Cabbage.CabbageLang(-	Lang, Line(..), Property(..), Arg(..), ppCabbage+  Lang, Line(..), Property(..), Arg(..), ppCabbage ) where  import Text.PrettyPrint.Leijen  type Lang = [Line] -data Line = Line -	{ lineDef :: String-	, lineProperties :: [Property]-	}+data Line = Line+  { lineDef :: String+  , lineProperties :: [Property]+  } -data Property = Property -	{ propertyName :: String-	, propertyArgs :: [Arg] -	}+data Property = Property+  { propertyName :: String+  , propertyArgs :: [Arg]+  }  data Arg = StringArg String | FloatArg Float | IntArg Int | ColonArg Float Float @@ -32,7 +32,7 @@  ppArg :: Arg -> Doc ppArg x = case x of-	StringArg s -> dquotes (text s)-	FloatArg a  -> float a-	IntArg a    -> int a-	ColonArg a b -> float a <> colon <> float b+  StringArg s -> dquotes (text s)+  FloatArg a  -> float a+  IntArg a    -> int a+  ColonArg a b -> float a <> colon <> float b

@@ -31,24 +31,17 @@  import Prelude hiding(elem, span) -import Control.Applicative(Alternative(..)) import Data.Default-import Data.Char(toLower) import Data.Maybe(isNothing) import Data.Monoid -import Data.Colour-import Data.Colour.Names(white, gray)-import Data.Colour.SRGB- import qualified Data.IntMap as IM import Text.PrettyPrint.Leijen(Doc)  import Csound.Dynamic(DepT, depT_, Var(..), VarType(..), Rate(..), noRate, MainExp(..), InstrId(..)) -import qualified Text.PrettyPrint.Leijen as P(int, double, vcat, hcat, hsep, punctuate, comma, empty, text, char, (<+>))+import qualified Text.PrettyPrint.Leijen as P(int, double, vcat, empty, text) import qualified Csound.Typed.Gui.BoxModel as Box-import Csound.Typed.Gui.BoxModel(Rect(..)) import Csound.Typed.Constants(infiniteDur)  import Csound.Typed.Gui.Types

@@ -5,7 +5,7 @@     keyPanels, panelBy, keyPanelBy, tabsBy, keyTabsBy,      -- * Types-    Input(..), Output(..), Inner(..),+    Input, Output, Inner,     noInput, noOutput, noInner,     Widget, widget, Source, source, Sink, sink, Display, display, SinkSource, sinkSource, sourceSlice, sinkSlice,     mapSource, mapGuiSource, mhor, mver, msca,@@ -21,17 +21,14 @@     KeyEvt(..), Key(..), keyIn ) where -import Control.Applicative import Control.Arrow import Control.Monad import Control.Monad.Trans.Class -import Data.Monoid import Data.Boolean  import Csound.Dynamic hiding (int, when1) import qualified Csound.Typed.GlobalState.Elements as C-import qualified Csound.Typed.GlobalState.Opcodes as C  import Csound.Typed.Gui.Gui import Csound.Typed.GlobalState

@@ -1,11 +1,7 @@-module Csound.Typed.Plugins.Adsr140(  -	adsr140 +module Csound.Typed.Plugins.Adsr140(+  adsr140 ) where -import Data.Boolean-import Control.Monad.Trans.Class-import Control.Applicative- import Csound.Dynamic  import Csound.Typed.Types.Prim@@ -15,12 +11,12 @@  ------------------------------------------------------------------------------- --- | Gated, Re-triggerable ADSR modeled after the Doepfer A-140 +-- | Gated, Re-triggerable ADSR modeled after the Doepfer A-140 -- opcode adsr140, a, aakkkk ----- inputs: agate, aretrig, kattack, kdecay, ksustain, krelease +-- inputs: agate, aretrig, kattack, kdecay, ksustain, krelease adsr140 :: Sig -> Sig -> Sig -> Sig -> Sig -> Sig -> Sig adsr140 agate aretrig kattack kdecay ksustain krelease = fromGE $ do     addUdoPlugin E.adsr140Plugin     f <$> toGE agate <*> toGE aretrig <*> toGE kattack <*> toGE kdecay <*> toGE ksustain <*> toGE krelease-    where f agate aretrig kattack kdecay ksustain krelease = opcs "adsr140" [(Ar, [Ar, Ar, Kr, Kr, Kr, Kr])] [agate, aretrig, kattack, kdecay, ksustain, krelease]+    where f agate' aretrig' kattack' kdecay' ksustain' krelease' = opcs "adsr140" [(Ar, [Ar, Ar, Kr, Kr, Kr, Kr])] [agate', aretrig', kattack', kdecay', ksustain', krelease']

@@ -2,9 +2,6 @@   ambiRow, ambiRowMp3 ) where -import Control.Monad.Trans.Class-import Control.Applicative- import Csound.Dynamic  import Csound.Typed.Types@@ -15,11 +12,11 @@ ambiRow (Arr sFiles) kSpeed kIndex iFadeTime = toTuple $ fmap ($ 2) $ do   addUdoPlugin E.ambiRowPlugin   f sFiles <$> toGE kSpeed <*> toGE kIndex <*> toGE iFadeTime-  where f sFiles kSpeed kIndex iFadeTime = mopcs "AmbiRow" ([Ar, Ar], [Sr, Kr, Kr, Ir]) [inlineVar $ head sFiles, kSpeed, kIndex, iFadeTime]+  where f sFiles' kSpeed' kIndex' iFadeTime' = mopcs "AmbiRow" ([Ar, Ar], [Sr, Kr, Kr, Ir]) [inlineVar $ head sFiles', kSpeed', kIndex', iFadeTime']  ambiRowMp3 :: Arr1 Str -> Sig -> Sig -> D -> Sig2 ambiRowMp3 (Arr sFiles) kSpeed kIndex iFadeTime = toTuple $ fmap ($ 2) $ do   addUdoPlugin E.ambiRowMp3Plugin   f sFiles <$> toGE kSpeed <*> toGE kIndex <*> toGE iFadeTime-  where f sFiles kSpeed kIndex iFadeTime = mopcs "AmbiRowMp3" ([Ar, Ar], [Sr, Kr, Kr, Ir]) [inlineVar $ head sFiles, kSpeed, kIndex, iFadeTime]+  where f sFiles' kSpeed' kIndex' iFadeTime' = mopcs "AmbiRowMp3" ([Ar, Ar], [Sr, Kr, Kr, Ir]) [inlineVar $ head sFiles', kSpeed', kIndex', iFadeTime'] 

@@ -1,11 +1,7 @@-module Csound.Typed.Plugins.Audaciouseq( -    audaciousEq   +module Csound.Typed.Plugins.Audaciouseq(+    audaciousEq ) where -import Data.Boolean-import Control.Monad.Trans.Class-import Control.Applicative- import Csound.Dynamic  import Csound.Typed.Types@@ -16,19 +12,19 @@  -- | opcode audaciouseq, a, kkkkkkkkkka ----- inputs: kgain1, kgain2, kgain3, kgain4, kgain5, +-- inputs: kgain1, kgain2, kgain3, kgain4, kgain5, --     kgain6, kgain7, kgain8, kgain9, kgain10 ain ----- 10-band EQ +-- 10-band EQ --   Input: kgain1, kgain2, ... kgain10, asig --   Output: aout -- --   10 kgain arguments maps to each band---   Bands are: 31.25, 52.6, 125, 500, 1000, ---              2000, 4000, 8000, 16000 +--   Bands are: 31.25, 52.6, 125, 500, 1000,+--              2000, 4000, 8000, 16000 -- audaciousEq :: Sig -> Sig -> Sig -> Sig -> Sig -> Sig -> Sig -> Sig -> Sig -> Sig -> Sig -> Sig audaciousEq kgain1 kgain2 kgain3 kgain4 kgain5 kgain6 kgain7 kgain8 kgain9 kgain10 ain = fromGE $ do     addUdoPlugin E.audaciouseqPlugin     f <$> toGE ain <*> toGE kgain1 <*> toGE kgain2 <*> toGE kgain3 <*> toGE kgain4 <*> toGE kgain5 <*> toGE kgain6 <*> toGE kgain7 <*> toGE kgain8 <*> toGE kgain9 <*> toGE kgain10-    where f ain kgain1 kgain2 kgain3 kgain4 kgain5 kgain6 kgain7 kgain8 kgain9 kgain10 = opcs "audaciouseq" [(Ar, [Ar, Kr, Kr, Kr, Kr, Kr, Kr, Kr, Kr, Kr, Kr])] [ain, kgain1, kgain2, kgain3, kgain4, kgain5, kgain6, kgain7, kgain8, kgain9, kgain10]+    where f ain' kgain1' kgain2' kgain3' kgain4' kgain5' kgain6' kgain7' kgain8' kgain9' kgain10' = opcs "audaciouseq" [(Ar, [Ar, Kr, Kr, Kr, Kr, Kr, Kr, Kr, Kr, Kr, Kr])] [ain', kgain1', kgain2', kgain3', kgain4', kgain5', kgain6', kgain7', kgain8', kgain9', kgain10']

@@ -1,42 +1,38 @@-module Csound.Typed.Plugins.Diode(  +module Csound.Typed.Plugins.Diode(     diode, linDiode, noNormDiode ) where -import Data.Boolean-import Control.Monad.Trans.Class-import Control.Applicative- import Csound.Dynamic  import Csound.Typed.Types import Csound.Typed.GlobalState import qualified Csound.Typed.GlobalState.Elements as E(diodePlugin) --- | Linear diode ladder filter. +-- | Linear diode ladder filter. -- -- > linDiode centerFrequency resonance asig ----- resonance ranges in the interval [0, 1] and higher. +-- resonance ranges in the interval [0, 1] and higher. -- self-resonance occurs at 1. linDiode :: Sig -> Sig -> Sig -> Sig linDiode cfq res ain = diodeLadder ain cfq (normReson res) 0 1 --- | Non-Linear normalized diode ladder filter. +-- | Non-Linear normalized diode ladder filter. -- -- > diode saturation centerFrequency resonance asig ----- resonance ranges in the interval [0, 1] and higher. +-- resonance ranges in the interval [0, 1] and higher. -- self-resonance occurs at 1. -- -- saturation ranges from 1 and higher (typical value: 4) diode :: Sig -> Sig -> Sig -> Sig -> Sig diode ksaturation cfq res ain = diodeLadder ain cfq (normReson res) 1 ksaturation --- | Non-Linear not normalized diode ladder filter. +-- | Non-Linear not normalized diode ladder filter. -- -- > noNormDiode saturation centerFrequency resonance asig ----- resonance ranges in the interval [0, 1] and higher. +-- resonance ranges in the interval [0, 1] and higher. -- self-resonance occurs at 1. -- -- saturation ranges from 1 and higher (typical value: 4)@@ -49,28 +45,28 @@ -------------------------------------------------------------------------------  -- | Diode Ladder Filter--- +-- -- Based on code by Will Pirkle, presented in: -- -- http://www.willpirkle.com/Downloads/AN-6DiodeLadderFilter.pdf--- --- and in his book "Designing software synthesizer plug-ins in C++ : for +--+-- and in his book "Designing software synthesizer plug-ins in C++ : for -- RackAFX, VST3, and Audio Units" -- -- UDO version by Steven Yi (2016.xx.xx) -- -- ARGS -- ain - signal to filter--- acf/kcf - cutoff frequency +-- acf/kcf - cutoff frequency -- ak/kk  - k-value that controls resonance, self-resonance occurs at k=17;--- knlp - use non-linear processing: ---        0 - none +-- knlp - use non-linear processing:+--        0 - none --        1 - normalized (outputs to range +-1.0) --        2 - non-normalized (less expensive than normalized, range +-0.8)--- ksaturation - saturation amount for non-linear processing +-- ksaturation - saturation amount for non-linear processing --        (default: 1.0, greater values lead to higher saturation) diodeLadder :: Sig -> Sig -> Sig -> Sig -> Sig -> Sig diodeLadder ain xcf xk knlp ksaturation = fromGE $ do     addUdoPlugin E.diodePlugin     f <$> toGE ain <*> toGE xcf <*> toGE xk <*> toGE knlp <*> toGE ksaturation-    where f ain xcf xk knlp ksaturation = opcs "diode_ladder" [(Ar, [Ar, Xr, Xr, Kr, Kr])] [ain, xcf, xk, knlp, ksaturation]+    where f ain' xcf' xk' knlp' ksaturation' = opcs "diode_ladder" [(Ar, [Ar, Xr, Xr, Kr, Kr])] [ain', xcf', xk', knlp', ksaturation']

@@ -4,10 +4,6 @@     fxPanTrem, fxMonoTrem, fxPhaser, fxPitchShifter, fxReverse, fxRingModulator, fxChorus2, fxPingPong ) where -import Data.Boolean-import Control.Monad.Trans.Class-import Control.Applicative- import Csound.Dynamic  import Csound.Typed.Types@@ -42,7 +38,7 @@ csdPitchShifterDelay ain ktrans kdlt kFB1 kFB2 imaxdlt = fromGE $ do     addUdoPlugin E.pitchShifterDelayPlugin     f <$> toGE ain <*> toGE ktrans <*> toGE kdlt <*> toGE kFB1 <*> toGE kFB2 <*> toGE imaxdlt-    where f ain ktrans kdlt kFB1 kFB2 imaxdlt = opcs "PitchShifterDelay" [(Ar, [Ar, Kr, Kr, Kr, Kr, Ir])] [ain, ktrans, kdlt, kFB1, kFB2, imaxdlt]+    where f ain' ktrans' kdlt' kFB1' kFB2' imaxdlt' = opcs "PitchShifterDelay" [(Ar, [Ar, Kr, Kr, Kr, Kr, Ir])] [ain', ktrans', kdlt', kFB1', kFB2', imaxdlt']  -------------------------------------------------------- -- multi fx@@ -67,7 +63,7 @@ csdAnalogDelay ain kmix ktime kfback ktone = fromGE $ do     addUdoPlugin E.analogDelayPlugin     f <$> toGE ain <*> toGE kmix <*> toGE ktime <*> toGE kfback <*> toGE ktone-    where f ain kmix ktime kfback ktone = opcs "AnalogDelay" [(Ar,[Ar,Kr,Kr,Kr,Kr])] [ain, kmix, ktime, kfback, ktone]+    where f ain' kmix' ktime' kfback' ktone' = opcs "AnalogDelay" [(Ar,[Ar,Kr,Kr,Kr,Kr])] [ain', kmix', ktime', kfback', ktone']  fxDistortion :: Sig -> Sig -> Sig -> Sig -> Sig fxDistortion klevel kdrive ktone ain = csdDistortion ain klevel kdrive ktone@@ -88,7 +84,7 @@ csdDistortion ain klevel kdrive ktone = fromGE $ do     addUdoPlugin E.distortionPlugin     f <$> toGE ain <*> toGE klevel <*> toGE kdrive <*> toGE ktone-    where f ain klevel kdrive ktone = opcs "Distortion" [(Ar,[Ar,Kr,Kr,Kr])] [ain, klevel, kdrive, ktone]+    where f ain' klevel' kdrive' ktone' = opcs "Distortion" [(Ar,[Ar,Kr,Kr,Kr])] [ain', klevel', kdrive', ktone']   fxEnvelopeFollower :: Sig -> Sig -> Sig -> Sig -> Sig@@ -110,7 +106,7 @@ csdEnvelopeFollower ain ksens kfreq kres = fromGE $ do     addUdoPlugin E.envelopeFolollowerPlugin     f <$> toGE ain <*> toGE ksens <*> toGE kfreq <*> toGE kres-    where f ain ksens kfreq kres = opcs "EnvelopeFollower" [(Ar,[Ar,Kr,Kr,Kr])] [ain, ksens, kfreq, kres]+    where f ain' ksens' kfreq' kres' = opcs "EnvelopeFollower" [(Ar,[Ar,Kr,Kr,Kr])] [ain', ksens', kfreq', kres']  -- ; Flanger -- ; ----------------@@ -129,7 +125,7 @@ fxFlanger krate kdepth kdelay kfback ain = fromGE $ do     addUdoPlugin E.flangerPlugin     f <$> toGE ain <*> toGE krate <*> toGE kdepth <*> toGE kdelay <*> toGE kfback-    where f ain krate kdepth kdelay kfback = opcs "Flanger" [(Ar,[Ar,Kr,Kr,Kr,Kr])] [ain, krate, kdepth, kdelay, kfback]+    where f ain' krate' kdepth' kdelay' kfback' = opcs "Flanger" [(Ar,[Ar,Kr,Kr,Kr,Kr])] [ain', krate', kdepth', kdelay', kfback']   -- ; FreqShifter@@ -149,7 +145,7 @@ fxFreqShifter kmix kfreq kmult kfback adry = fromGE $ do     addUdoPlugin E.freqShifterPlugin     f <$> toGE adry <*> toGE kmix <*> toGE kfreq <*> toGE kmult <*> toGE kfback-    where f adry kmix kfreq kmult kfback = opcs "FreqShifter" [(Ar,[Ar,Kr,Kr,Kr,Kr])] [adry, kmix, kfreq, kmult, kfback]+    where f adry' kmix' kfreq' kmult' kfback' = opcs "FreqShifter" [(Ar,[Ar,Kr,Kr,Kr,Kr])] [adry', kmix', kfreq', kmult', kfback']   -- ; LoFi@@ -167,7 +163,7 @@ fxLoFi kbits kfold ain = fromGE $ do     addUdoPlugin E.loFiPlugin     f <$> toGE ain <*> toGE kbits <*> toGE kfold-    where f ain kbits kfold = opcs "LoFi" [(Ar,[Ar,Kr,Kr])] [ain, kbits, kfold]+    where f ain' kbits' kfold' = opcs "LoFi" [(Ar,[Ar,Kr,Kr])] [ain', kbits', kfold']  -- ; PanTrem -- ; ----------------@@ -187,7 +183,7 @@ fxPanTrem krate kdepth kmode kwave (ainL, ainR) = toTuple $ do     addUdoPlugin E.panTremPlugin     f <$> toGE ainL <*> toGE ainR <*> toGE krate <*> toGE kdepth <*> toGE kmode <*> toGE kwave-    where f ainL ainR krate kdepth kmode kwave = ($ 2) $ mopcs "PanTrem" ([Ar,Ar], [Ar,Ar, Kr,Kr,Kr,Kr]) [ainL, ainR, krate, kdepth, kmode, kwave]+    where f ainL' ainR' krate' kdepth' kmode' kwave' = ($ 2) $ mopcs "PanTrem" ([Ar,Ar], [Ar,Ar, Kr,Kr,Kr,Kr]) [ainL', ainR', krate', kdepth', kmode', kwave']  -- ; Tremolo -- ; ----------------@@ -205,7 +201,7 @@ fxMonoTrem krate kdepth kwave ain = fromGE $ do     addUdoPlugin E.monoTremPlugin     f <$> toGE ain <*> toGE krate <*> toGE kdepth <*> toGE kwave-    where f ain krate kdepth kwave = opcs "MonoTrem" [(Ar, [Ar,Kr,Kr,Kr])] [ain, krate, kdepth, kwave]+    where f ain' krate' kdepth' kwave' = opcs "MonoTrem" [(Ar, [Ar,Kr,Kr,Kr])] [ain', krate', kdepth', kwave']  -- ; Phaser -- ; ----------------@@ -224,7 +220,7 @@ fxPhaser krate kdepth kfreq kfback ain = fromGE $ do     addUdoPlugin E.phaserPlugin     f <$> toGE ain <*> toGE krate <*> toGE kdepth <*> toGE kfreq <*> toGE kfback-    where f ain krate kdepth kfreq kfback = opcs "Phaser" [(Ar,[Ar,Kr,Kr,Kr,Kr])] [ain, krate, kdepth, kfreq, kfback]+    where f ain' krate' kdepth' kfreq' kfback' = opcs "Phaser" [(Ar,[Ar,Kr,Kr,Kr,Kr])] [ain', krate', kdepth', kfreq', kfback']  -- ; PitchShifter -- ; ------------@@ -244,7 +240,7 @@ fxPitchShifter ifftsize kmix kscal kfback ain = fromGE $ do     addUdoPlugin E.pitchShifterPlugin     f <$> toGE ain <*> toGE kmix <*> toGE kscal <*> toGE kfback <*> toGE ifftsize-    where f ain kmix kscal kfback ifftsize = opcs "PitchShifter" [(Ar,[Ar,Kr,Kr,Kr,Ir])] [ain, kmix, kscal, kfback, ifftsize]+    where f ain' kmix' kscal' kfback' ifftsize' = opcs "PitchShifter" [(Ar,[Ar,Kr,Kr,Kr,Ir])] [ain', kmix', kscal', kfback', ifftsize']   -- ; Reverse@@ -261,7 +257,7 @@ fxReverse ktime ain = fromGE $ do     addUdoPlugin E.reversePlugin     f <$> toGE ain <*> toGE ktime-    where f ain ktime = opcs "Reverse" [(Ar,[Ar,Kr])] [ain, ktime]+    where f ain' ktime' = opcs "Reverse" [(Ar,[Ar,Kr])] [ain', ktime']  -- ; RingModulator -- ; ----------------@@ -279,7 +275,7 @@ fxRingModulator kmix kfreq kenv ain = fromGE $ do     addUdoPlugin E.ringModulatorPlugin     f <$> toGE ain <*> toGE kmix <*> toGE kfreq <*> toGE kenv-    where f ain kmix kfreq kenv = opcs "RingModulator" [(Ar,[Ar,Kr,Kr,Kr])] [ain, kmix, kfreq, kenv]+    where f ain' kmix' kfreq' kenv' = opcs "RingModulator" [(Ar,[Ar,Kr,Kr,Kr])] [ain', kmix', kfreq', kenv']  -- ; StChorus -- ; ----------------@@ -298,7 +294,7 @@ fxChorus2 krate kdepth kwidth (ainL, ainR) = toTuple $ do     addUdoPlugin E.stChorusPlugin     f <$> toGE ainL <*> toGE ainR <*> toGE krate <*> toGE kdepth <*> toGE kwidth-    where f ainL ainR krate kdepth kwidth = ($ 2) $ mopcs "StChorus" ([Ar,Ar], [Ar,Ar,Kr,Kr,Kr]) [ainL, ainR, krate, kdepth, kwidth]+    where f ainL' ainR' krate' kdepth' kwidth' = ($ 2) $ mopcs "StChorus" ([Ar,Ar], [Ar,Ar,Kr,Kr,Kr]) [ainL', ainR', krate', kdepth', kwidth']  -- aInL, aInR, kdelayTime, kFeedback, kMix, iMaxDelayTime xin @@ -309,5 +305,5 @@ fxPingPong iMaxDelTime kmix kwidth ktone ktime kfeedback (ainL, ainR) = toTuple $ do     addUdoPlugin E.stereoPingPongDelayPlugin     f <$> toGE ainL <*> toGE ainR <*> toGE ktime <*> toGE kfeedback <*> toGE kmix <*> toGE kwidth <*> toGE ktone <*> toGE iMaxDelTime-    where f ainL ainR ktime kfeedback kmix kwidth ktone iMaxDelTime = ($ 2) $ mopcs "StereoPingPongDelay" ([Ar,Ar], [Ar,Ar,Kr,Kr,Kr,Kr,Kr,Ir]) [ainL, ainR, ktime, kfeedback, kmix, kwidth, ktone, iMaxDelTime]+    where f ainL' ainR' ktime' kfeedback' kmix' kwidth' ktone' iMaxDelTime' = ($ 2) $ mopcs "StereoPingPongDelay" ([Ar,Ar], [Ar,Ar,Kr,Kr,Kr,Kr,Kr,Ir]) [ainL', ainR', ktime', kfeedback', kmix', kwidth', ktone', iMaxDelTime'] 

@@ -1,52 +1,48 @@-module Csound.Typed.Plugins.Korg35(  +module Csound.Typed.Plugins.Korg35(     linKorg_lp, linKorg_hp, korg_lp, korg_hp ) where -import Data.Boolean-import Control.Monad.Trans.Class-import Control.Applicative- import Csound.Dynamic  import Csound.Typed.Types import Csound.Typed.GlobalState import qualified Csound.Typed.GlobalState.Elements as E(korg35Plugin) --- | Linear korg 35 low pass filter (12 dB). +-- | Linear korg 35 low pass filter (12 dB). -- -- > linDiode centerFrequency resonance asig ----- resonance ranges in the interval [0, 1] and higher. +-- resonance ranges in the interval [0, 1] and higher. -- self-resonance occurs at 1. linKorg_lp :: Sig -> Sig -> Sig -> Sig linKorg_lp cfq res ain = k35_lpf ain cfq (normReson res) 0 1 --- | Linear korg 35 high pass filter (6 dB). +-- | Linear korg 35 high pass filter (6 dB). -- -- > linDiode centerFrequency resonance asig ----- resonance ranges in the interval [0, 1] and higher. +-- resonance ranges in the interval [0, 1] and higher. -- self-resonance occurs at 1. linKorg_hp :: Sig -> Sig -> Sig -> Sig linKorg_hp cfq res ain = k35_hpf ain cfq (normReson res) 0 1  --- | Korg 35 low pass filter (12 dB). +-- | Korg 35 low pass filter (12 dB). -- -- > diode saturation centerFrequency resonance asig ----- resonance ranges in the interval [0, 1] and higher. +-- resonance ranges in the interval [0, 1] and higher. -- self-resonance occurs at 1. -- -- saturation ranges from 1 and higher (typical value: 4) korg_lp :: Sig -> Sig -> Sig -> Sig -> Sig korg_lp ksaturation cfq res ain = k35_lpf ain cfq (normReson res) 1 ksaturation --- | Korg 35 high pass filter (6 dB). +-- | Korg 35 high pass filter (6 dB). -- -- > diode saturation centerFrequency resonance asig ----- resonance ranges in the interval [0, 1] and higher. +-- resonance ranges in the interval [0, 1] and higher. -- self-resonance occurs at 1. -- -- saturation ranges from 1 and higher (typical value: 4)@@ -60,13 +56,13 @@  -- 12db/oct low-pass filter based on Korg 35 module -- (found in MS-10 and MS-20).--- +-- -- Based on code by Will Pirkle, presented in:--- +-- -- http://www.willpirkle.com/Downloads/AN-5Korg35_V3.pdf--- +-- -- [ARGS]--- +-- -- ain - audio input -- acutoff - frequency of cutoff -- kQ - filter Q [1, 10.0] (k35-lpf will clamp to boundaries)@@ -76,18 +72,18 @@ k35_lpf ain acutoff kQ knonlinear ksaturation = fromGE $ do     addUdoPlugin E.korg35Plugin     f <$> toGE ain <*> toGE acutoff <*> toGE kQ <*> toGE knonlinear <*> toGE ksaturation-    where f ain acutoff kQ knonlinear ksaturation = opcs "k35_lpf" [(Ar, [Ar, Xr, Kr, Kr, Kr])] [ain, acutoff, kQ, knonlinear, ksaturation]+    where f ain' acutoff' kQ' knonlinear' ksaturation' = opcs "k35_lpf" [(Ar, [Ar, Xr, Kr, Kr, Kr])] [ain', acutoff', kQ', knonlinear', ksaturation']   -- 6db/oct high-pass filter based on Korg 35 module -- (found in MS-10 and MS-20).--- +-- -- Based on code by Will Pirkle, presented in:--- --- http://www.willpirkle.com/Downloads/AN-7Korg35HPF_V2.pdf --- +--+-- http://www.willpirkle.com/Downloads/AN-7Korg35HPF_V2.pdf+-- -- [ARGS]--- +-- -- ain - audio input -- acutoff - frequency of cutoff -- kQ - filter Q [1, 10.0] (k35_hpf will clamp to boundaries)@@ -97,4 +93,4 @@ k35_hpf ain acutoff kQ knonlinear ksaturation = fromGE $ do     addUdoPlugin E.korg35Plugin     f <$> toGE ain <*> toGE acutoff <*> toGE kQ <*> toGE knonlinear <*> toGE ksaturation-    where f ain acutoff kQ knonlinear ksaturation = opcs "k35_hpf" [(Ar, [Ar, Xr, Kr, Kr, Kr])] [ain, acutoff, kQ, knonlinear, ksaturation]+    where f ain' acutoff' kQ' knonlinear' ksaturation' = opcs "k35_hpf" [(Ar, [Ar, Xr, Kr, Kr, Kr])] [ain', acutoff', kQ', knonlinear', ksaturation']

@@ -3,9 +3,6 @@   liveRows ) where -import Control.Monad.Trans.Class-import Control.Applicative- import Csound.Dynamic  import Csound.Typed.Types@@ -16,10 +13,10 @@ liveRow iTabSize iTabs iBpm iBeatDur kUserIndex iAuxParams = fromGE $ do   addUdoPlugin E.liveRowPlugin   f <$> toGE iTabSize <*> toGE iTabs <*> toGE iBpm <*> toGE iBeatDur <*> toGE kUserIndex <*> toGE iAuxParams-  where f iTabSize iTabs iBpm iBeatDur kUserIndex iAuxParams = opcs "liveRow" [(Ar, [Ir, Ir, Ir, Ir, Kr, Ir])] [iTabSize, iTabs, iBpm, iBeatDur, kUserIndex, iAuxParams]+  where f iTabSize' iTabs' iBpm' iBeatDur' kUserIndex' iAuxParams' = opcs "liveRow" [(Ar, [Ir, Ir, Ir, Ir, Kr, Ir])] [iTabSize', iTabs', iBpm', iBeatDur', kUserIndex', iAuxParams']  liveRows :: D -> TabList -> TabList -> D -> D -> Sig -> Tab -> Sig2 liveRows iTabSize iLeftTabs iRightTabs iBpm iBeatDur kUserIndex iAuxParams = toTuple $ fmap ($ 2) $ do   addUdoPlugin E.liveRowsPlugin   f <$> toGE iTabSize <*> toGE iLeftTabs <*> toGE iRightTabs <*> toGE iBpm <*> toGE iBeatDur <*> toGE kUserIndex <*> toGE iAuxParams-  where f iTabSize iLeftTabs iRightTabs iBpm iBeatDur kUserIndex iAuxParams = mopcs "liveRows" ([Ar, Ar], [Ir, Ir, Ir, Ir, Ir, Kr, Ir]) [iTabSize, iLeftTabs, iRightTabs, iBpm, iBeatDur, kUserIndex, iAuxParams]+  where f iTabSize' iLeftTabs' iRightTabs' iBpm' iBeatDur' kUserIndex' iAuxParams' = mopcs "liveRows" ([Ar, Ar], [Ir, Ir, Ir, Ir, Ir, Kr, Ir]) [iTabSize', iLeftTabs', iRightTabs', iBpm', iBeatDur', kUserIndex', iAuxParams']

@@ -1,11 +1,7 @@-module Csound.Typed.Plugins.SolinaChorus(  -    solinaChorus, testSolinaChorus    +module Csound.Typed.Plugins.SolinaChorus(+    solinaChorus, testSolinaChorus ) where -import Data.Boolean-import Control.Monad.Trans.Class-import Control.Applicative- import Csound.Dynamic  import Csound.Typed.Types@@ -13,16 +9,16 @@ import qualified Csound.Typed.GlobalState.Elements as E(solinaChorusPlugin)  -- Solina Chorus, based on Solina String Ensemble Chorus Module---  +-- --   based on: -- --   J. Haible: Triple Chorus --   http://jhaible.com/legacy/triple_chorus/triple_chorus.html--- +-- -- > solinaChorus (lfo_amp1, lfo_freq1) (lfo_amp2, lfo_freq2) -- --   Author: Steven Yi---   Date: 2016.05.22  +--   Date: 2016.05.22 -- -- Example --@@ -36,20 +32,20 @@ -------------------------------------------------------------------------------  --   Solina Chorus, based on Solina String Ensemble Chorus Module---  +-- --   based on: -- --   J. Haible: Triple Chorus --   http://jhaible.com/legacy/triple_chorus/triple_chorus.html -- --   Hugo Portillo: Solina-V String Ensemble---   http://www.native-instruments.com/en/reaktor-community/reaktor-user-library/entry/show/4525/ +--   http://www.native-instruments.com/en/reaktor-community/reaktor-user-library/entry/show/4525/ -- --   Parabola tabled shape borrowed from Iain McCurdy delayStereoChorus.csd: --   http://iainmccurdy.org/CsoundRealtimeExamples/Delays/delayStereoChorus.csd -- --   Author: Steven Yi---   Date: 2016.05.22  +--   Date: 2016.05.22 -- --  opcode solina_chorus, a, aKKKK --@@ -58,4 +54,4 @@ solina_chorus aLeft klfo_freq1 klfo_amp1 klfo_freq2 klfo_amp2 = fromGE $ do     addUdoPlugin E.solinaChorusPlugin     f <$> toGE aLeft <*> toGE klfo_freq1 <*> toGE klfo_amp1 <*> toGE klfo_freq2 <*> toGE klfo_amp2-    where f aLeft klfo_freq1 klfo_amp1 klfo_freq2 klfo_amp2 = opcs "solina_chorus" [(Ar, [Ar, Kr, Kr, Kr, Kr])] [aLeft, klfo_freq1, klfo_amp1, klfo_freq2, klfo_amp2]+    where f aLeft' klfo_freq1' klfo_amp1' klfo_freq2' klfo_amp2' = opcs "solina_chorus" [(Ar, [Ar, Kr, Kr, Kr, Kr])] [aLeft', klfo_freq1', klfo_amp1', klfo_freq2', klfo_amp2']

@@ -4,7 +4,6 @@  import Data.Boolean import Control.Monad.Trans.Class-import Control.Applicative  import Csound.Dynamic @@ -18,19 +17,19 @@ -- | -- > tabQueue2_append table (pch, vol) tabQueue2_append :: Tab -> (D, D) -> SE ()-tabQueue2_append tab (pch, vol) = SE $ (depT_ =<<) $ lift $ do    +tabQueue2_append tab (pch, vol) = SE $ (depT_ =<<) $ lift $ do     addUdoPlugin E.tabQueue2Plugin     f <$> toGE tab <*> toGE pch <*> toGE vol-    where f tab pch vol = opcs "TabQueue2_Append" [(Xr, [Ir, Ir, Ir])] [tab, pch, vol]+    where f tab' pch' vol' = opcs "TabQueue2_Append" [(Xr, [Ir, Ir, Ir])] [tab', pch', vol']  -- | Delete by pitch -- -- > tabQueue2_delete table pch tabQueue2_delete :: Tab -> D -> SE ()-tabQueue2_delete tab pch = SE $ (depT_ =<<) $ lift $ do    +tabQueue2_delete tab pch = SE $ (depT_ =<<) $ lift $ do     addUdoPlugin E.tabQueue2Plugin     f <$> toGE tab <*> toGE pch-    where f tab pch = opcs "TabQueue2_Delete" [(Xr, [Ir, Ir])] [tab, pch]+    where f tab' pch' = opcs "TabQueue2_Delete" [(Xr, [Ir, Ir])] [tab', pch']  -- | Queue is not empty tabQueue2_hasElements :: Tab -> BoolSig@@ -40,10 +39,10 @@ tabQueue2_hasElements' tab = fromGE $ do     addUdoPlugin E.tabQueue2Plugin     f <$> toGE tab-    where f tab = opcs "TabQueue2_HasElements" [(Kr, [Ir])] [tab]+    where f tab' = opcs "TabQueue2_HasElements" [(Kr, [Ir])] [tab']  tabQueue2_readLastElement :: Tab -> (Sig, Sig) tabQueue2_readLastElement tab = toTuple $ fmap ($ 2) $ do-    addUdoPlugin E.tabQueue2Plugin    +    addUdoPlugin E.tabQueue2Plugin     f <$> toGE tab-    where f tab = mopcs "TabQueue2_ReadLastElement" ([Kr, Kr], [Ir]) [tab]+    where f tab' = mopcs "TabQueue2_ReadLastElement" ([Kr, Kr], [Ir]) [tab']

@@ -5,8 +5,6 @@ ) where  import Control.Monad.Trans.Class-import Control.Applicative- import Csound.Dynamic  import Csound.Typed.Types@@ -29,7 +27,7 @@ tapeRead ain kdel kRandomSpread = fmap (Sig . return) $ SE $ (depT =<<) $ lift $ do   addUdoPlugin E.tapeEchoPlugin   f <$> toGE ain <*> toGE kdel <*> toGE kRandomSpread-  where f ain kdel krand = opcs "tapeRead" [(Ar, [Ar, Kr, Kr])] [ain, kdel, krand]+  where f ain' kdel' krand' = opcs "tapeRead" [(Ar, [Ar, Kr, Kr])] [ain', kdel', krand']   -- | Function to write to tape@@ -44,7 +42,7 @@ tapeWrite :: Sig -> Sig -> Sig -> SE () tapeWrite ain aout kFeedback = SE $ (depT_ =<<) $ lift $ do   f <$> toGE ain <*> toGE aout <*> toGE kFeedback-  where f ain aout kfb = opcs "tapeWrite" [(Xr, [Ar, Ar, Kr])] [ain, aout, kfb]+  where f ain' aout' kfb' = opcs "tapeWrite" [(Xr, [Ar, Ar, Kr])] [ain', aout', kfb']  -- | Generic multi-tap echo opcode. --@@ -61,4 +59,4 @@ tapeEcho iSize kDelay kEchoGain kFbGain kTone kRandomSpread aIn = fromGE $ do   addUdoPlugin E.tapeEchoPlugin   f <$> toGE aIn <*> toGE kDelay <*> toGE kEchoGain <*> toGE kFbGain <*> toGE kTone <*> toGE kRandomSpread <*> toGE iSize-  where f aIn kDelay kEchoGain kFbGain kTone kRandomSpread iSize = opcs "TapeEchoN" [(Ar, [Ar, Kr, Kr, Kr, Kr, Kr, Ir])] [aIn, kDelay, kEchoGain, kFbGain, kTone, kRandomSpread, iSize]+  where f aIn' kDelay' kEchoGain' kFbGain' kTone' kRandomSpread' iSize' = opcs "TapeEchoN" [(Ar, [Ar, Kr, Kr, Kr, Kr, Kr, Ir])] [aIn', kDelay', kEchoGain', kFbGain', kTone', kRandomSpread', iSize']

@@ -1,11 +1,7 @@-module Csound.Typed.Plugins.Utilities(  -	delay1k +module Csound.Typed.Plugins.Utilities(+  delay1k ) where -import Data.Boolean-import Control.Monad.Trans.Class-import Control.Applicative- import Csound.Dynamic  import Csound.Typed.Types.Prim@@ -20,4 +16,4 @@ delay1k ain = fromGE $ do     addUdoPlugin E.delay1kPlugin     f <$> toGE ain-    where f ain = opcs "Delay1k" [(Kr, [Kr])] [ain]+    where f x = opcs "Delay1k" [(Kr, [Kr])] [x]

@@ -11,15 +11,12 @@      -- Four poles filters     zdf4, zlp4, zbp4, zhp4,+    zdf_4pole_hp,      -- Eq-filters     peakEq, highShelf, lowShelf ) where -import Data.Boolean-import Control.Monad.Trans.Class-import Control.Applicative- import Csound.Dynamic  import Csound.Typed.Types@@ -68,6 +65,7 @@ zdf2_notch :: Sig -> Sig -> Sig -> (Sig, Sig, Sig, Sig) zdf2_notch cfq q asig = zdf_2pole_notch asig cfq q +zbr :: Sig -> Sig -> Sig -> Sig zbr cfq q asig = notch     where (_, _, _, notch) = zdf2_notch cfq q asig @@ -116,7 +114,7 @@ zdf_1pole asig cfq = toTuple $ fmap ($ 2) $ do     addUdoPlugin E.zdfPlugin     f <$> toGE asig <*> toGE cfq-    where f asig cfq = mopcs "zdf_1pole" ([Ar, Ar], [Ar, Ar]) [asig, cfq]+    where f asig' cfq' = mopcs "zdf_1pole" ([Ar, Ar], [Ar, Ar]) [asig', cfq']  -- 1-pole allpass filter -- takes in an a-rate signal and corner frequency where input@@ -125,7 +123,7 @@ zdf_allpass_1pole asig cfq = fromGE $ do     addUdoPlugin E.zdfPlugin     f <$> toGE asig <*> toGE cfq-    where f asig cfq = opcs "zdf_allpass_1pole" [(Ar, [Ar, Ar])] [asig, cfq]+    where f asig' cfq' = opcs "zdf_allpass_1pole" [(Ar, [Ar, Ar])] [asig', cfq']  -- 2-pole (12dB) lowpass/highpass/bandpass filter -- takes in a a-rate signal, cutoff value in frequency, and@@ -136,7 +134,7 @@ zdf_2pole asig cfq q = toTuple $ fmap ($ 3) $ do     addUdoPlugin E.zdfPlugin     f <$> toGE asig <*> toGE cfq <*> toGE q-    where f asig cfq q = mopcs "zdf_2pole" ([Ar, Ar, Ar], [Ar, Ar, Ar]) [asig, cfq, q]+    where f asig' cfq' q' = mopcs "zdf_2pole" ([Ar, Ar, Ar], [Ar, Ar, Ar]) [asig', cfq', q']  -- 2-pole (12dB) lowpass/highpass/bandpass/notch filter -- takes in a a-rate signal, cutoff value in frequency, and@@ -147,7 +145,7 @@ zdf_2pole_notch asig cfq q = toTuple $ fmap ($ 4) $ do     addUdoPlugin E.zdfPlugin     f <$> toGE asig <*> toGE cfq <*> toGE q-    where f asig cfq q = mopcs "zdf_2pole_notch" ([Ar, Ar, Ar, Ar], [Ar, Ar, Ar]) [asig, cfq, q]+    where f asig' cfq' q' = mopcs "zdf_2pole_notch" ([Ar, Ar, Ar, Ar], [Ar, Ar, Ar]) [asig', cfq', q']  -- moog ladder --@@ -158,7 +156,7 @@ zdf_ladder asig cfq res = fromGE $ do     addUdoPlugin E.zdfPlugin     f <$> toGE asig <*> toGE cfq <*> toGE res-    where f asig cfq res = opcs "zdf_ladder" [(Ar, [Ar, Ar, Ar])] [asig, cfq, res]+    where f asig' cfq' res' = opcs "zdf_ladder" [(Ar, [Ar, Ar, Ar])] [asig', cfq', res']  -- 4-pole --@@ -170,7 +168,7 @@ zdf_4pole asig cfq res = toTuple $ fmap ($ 6) $ do     addUdoPlugin E.zdfPlugin     f <$> toGE asig <*> toGE cfq <*> toGE res-    where f asig cfq res = mopcs "zdf_4pole" ([Ar, Ar, Ar, Ar, Ar, Ar], [Ar, Ar, Ar]) [asig, cfq, res]+    where f asig' cfq' res' = mopcs "zdf_4pole" ([Ar, Ar, Ar, Ar, Ar, Ar], [Ar, Ar, Ar]) [asig', cfq', res']  -- 4-pole --@@ -182,7 +180,7 @@ zdf_4pole_hp asig cfq res = toTuple $ fmap ($ 6) $ do     addUdoPlugin E.zdfPlugin     f <$> toGE asig <*> toGE cfq <*> toGE res-    where f asig cfq res = mopcs "zdf_4pole_hp" ([Ar, Ar, Ar, Ar, Ar, Ar], [Ar, Ar, Ar]) [asig, cfq, res]+    where f asig' cfq' res' = mopcs "zdf_4pole_hp" ([Ar, Ar, Ar, Ar, Ar, Ar], [Ar, Ar, Ar]) [asig', cfq', res']  -- ;; TODO - implement -- opcode zdf_peak_eq, a, akkk@@ -191,7 +189,7 @@ zdf_peak_eq ain kcf kres kdB = fromGE $ do     addUdoPlugin E.zdfPlugin     f <$> toGE ain <*> toGE kcf <*> toGE kres <*> toGE kdB-    where f ain kcf kres kdB = opcs "zdf_peak_eq" [(Ar, [Ar, Kr, Kr, Kr])] [ain, kcf, kres, kdB]+    where f ain' kcf' kres' kdB' = opcs "zdf_peak_eq" [(Ar, [Ar, Kr, Kr, Kr])] [ain', kcf', kres', kdB']  -- opcode zdf_high_shelf_eq, a, akk --  ain, kcf, kdB xin@@ -199,7 +197,7 @@ zdf_high_shelf_eq asig cfq res = fromGE $ do     addUdoPlugin E.zdfPlugin     f <$> toGE asig <*> toGE cfq <*> toGE res-    where f asig cfq res = opcs "zdf_high_shelf_eq" [(Ar, [Ar, Kr, Kr])] [asig, cfq, res]+    where f asig' cfq' res' = opcs "zdf_high_shelf_eq" [(Ar, [Ar, Kr, Kr])] [asig', cfq', res']  -- opcode zdf_low_shelf_eq, a, akk --  ain, kcf, kdB xin@@ -207,4 +205,4 @@ zdf_low_shelf_eq asig cfq res = fromGE $ do     addUdoPlugin E.zdfPlugin     f <$> toGE asig <*> toGE cfq <*> toGE res-    where f asig cfq res = opcs "zdf_low_shelf_eq" [(Ar, [Ar, Kr, Kr])] [asig, cfq, res]+    where f asig' cfq' res' = opcs "zdf_low_shelf_eq" [(Ar, [Ar, Kr, Kr])] [asig', cfq', res']

@@ -1,11 +1,8 @@ module Csound.Typed.Plugins.ZeroDelayConvolution(-	 ZConvSpec(..), zconv, zconv'+   ZConvSpec(..), zconv, zconv' ) where -import Data.Boolean import Data.Default-import Control.Monad.Trans.Class-import Control.Applicative  import Csound.Dynamic @@ -50,4 +47,4 @@ zconv' (ZConvSpec ipart irat inp) ifn ain = fromGE $ do     addUdoPlugin E.zeroDelayConvolutionPlugin     f <$> toGE ain <*> toGE ipart <*> toGE irat <*> toGE inp <*> toGE ifn-    where f ain ipart irat inp ifn = opcs "ZConv" [(Ar, [Ar, Ir, Ir, Ir, Ir])] [ain, ipart, irat, inp, ifn]+    where f ain' ipart' irat' inp' ifn' = opcs "ZConv" [(Ar, [Ar, Ir, Ir, Ir, Ir])] [ain', ipart', irat', inp', ifn']

@@ -12,7 +12,6 @@ import Data.Default import Data.Maybe import Data.Tuple-import Data.Monoid import Data.Ord import Data.List(sortBy, groupBy) import qualified Data.IntMap as IM@@ -98,14 +97,14 @@         sco     = Sco (Just $ pureGetTotalDurForF0 $ totalDur hist3)                       (renderGens (genMap hist3) (writeGenMap hist3)) $                       ((fmap alwaysOn $ alwaysOnInstrs hist3) ++ (getNoteEvents $ notes hist3))-    let plugins = getPlugins opt hist3+    let plugins = getPlugins hist3     return $ Csd flags orc sco plugins     where         renderGens gens writeGens = (fmap swap $ M.toList $ idMapContent  gens) ++ writeGens         maybeAppend ma = maybe id (:) ma         getNoteEvents = fmap $ \(instrId, evt) -> (instrId, [evt]) -        getPlugins opt hist = case cabbageGui hist of+        getPlugins hist = case cabbageGui hist of                 Nothing -> []                 Just x  -> [(Plugin "Cabbage" (displayS (renderPretty 1 10000 $ ppCabbage x) ""))] 

@@ -1,6 +1,6 @@ {-# Language FlexibleInstances, ScopedTypeVariables #-} module Csound.Typed.Types.Array(-    Arr(..), +    Arr(..),     newLocalArr, newGlobalArr, newLocalCtrlArr, newGlobalCtrlArr,     fillLocalArr, fillGlobalArr, fillLocalCtrlArr, fillGlobalCtrlArr,     readArr, writeArr, writeInitArr, modifyArr, mixArr,@@ -8,27 +8,29 @@     Arr1, DArr1, Arr2, DArr2, Arr3, DArr3,     arr1, darr1, arr2, darr2, arr3, darr3, -    -- * Array opcodes    -    maparrayNew, lenarray, copyf2array, copya2ftab, minarray, maxarray, sumarray, +    -- * Array opcodes+    maparrayNew, lenarray, copyf2array, copya2ftab, minarray, maxarray, sumarray,     scalearray, slicearrayNew,      maparrayCopy, slicearrayCopy,+    divArrayCopy, subArrayCopy,+    addArrayCopy, mulArrayCopy,+    addArrayNew, mulArrayNew, divArrayNew, subArrayNew,      -- * Spectral opcodes-    SpecArr, +    SpecArr, -    fftNew, fftinvNew, rfftNew, rifftNew, pvs2tab, tab2pvs, cmplxprodNew, -    rect2polNew, pol2rectNew, pol2rect2New, windowArrayNew, +    fftNew, fftinvNew, rfftNew, rifftNew, pvs2tab, tab2pvs, cmplxprodNew,+    rect2polNew, pol2rectNew, pol2rect2New, windowArrayNew,     r2cNew, c2rNew, magsArrayNew, phsArrayNew, -    fftCopy, fftinvCopy, rfftCopy, rifftCopy, cmplxprodCopy, -    rect2polCopy, pol2rectCopy, pol2rect2Copy, windowArrayCopy, +    fftCopy, fftinvCopy, rfftCopy, rifftCopy, cmplxprodCopy,+    rect2polCopy, pol2rectCopy, pol2rect2Copy, windowArrayCopy,     r2cCopy, c2rCopy, magsArrayCopy, phsArrayCopy ) where   import Control.Monad-import Control.Monad.Trans.Class  import Csound.Dynamic hiding (writeArr, writeInitArr, readArr, newLocalArrVar, newTmpArrVar, int) import qualified Csound.Dynamic as D@@ -86,14 +88,14 @@ newtype Arr ix a = Arr { unArr :: [Var] }  newArrBy :: forall ix a . (Tuple a, Tuple ix) => (Rate -> GE [E] -> SE Var) -> [D] -> SE (Arr ix a)-newArrBy mkVar sizes = +newArrBy mkVar sizes =     fmap Arr $ mapM (\x -> mkVar x (mapM toGE sizes)) (tupleRates $ (undefined :: a))-    + getIndices :: Tuple ix => [Int] -> [ix] getIndices xs = fmap (toTuple . return . fmap D.int) $ getIntIndices xs  getIntIndices :: [Int] -> [[Int]]-getIntIndices xs = fmap reverse $ foldl go [] xs+getIntIndices = fmap reverse . foldl go []     where         go :: [[Int]] -> Int -> [[Int]]         go res n = case res of@@ -131,7 +133,7 @@ -- -- > newGlobalCtrlArr sizes newGlobalCtrlArr :: (Tuple a, Tuple ix) => [D] -> SE (Arr ix a)-newGlobalCtrlArr = newArrBy newGlobalCtrlArrVar +newGlobalCtrlArr = newArrBy newGlobalCtrlArrVar  -- | Creates an array that is local to the body of Csound instrument where it's defined. -- The array contains audio signals. It fills the array from the list of values (the last argument).@@ -159,10 +161,13 @@ fillGlobalCtrlArr :: (Tuple a, Tuple ix) => [Int] -> [a] -> SE (Arr ix a) fillGlobalCtrlArr = fillArrBy newGlobalCtrlArrVar +newLocalCtrlArrVar, newGlobalCtrlArrVar :: Rate -> GE [E] -> SE Var+ newLocalCtrlArrVar  = newLocalArrVar  . toCtrlRate newGlobalCtrlArrVar = newGlobalArrVar . toCtrlRate -toCtrlRate x = case x of +toCtrlRate :: Rate -> Rate+toCtrlRate x = case x of     Ar -> Kr     Kr -> Ir     _  -> x@@ -171,10 +176,10 @@ readArr :: (Tuple a, Tuple ix) => Arr ix a -> ix -> SE a readArr (Arr vars) ixs = fmap (toTuple . return) $ SE $ hideGEinDep $ do     ixsExp <- fromTuple ixs-    return $ mapM (\v -> read v ixsExp) vars+    return $ mapM (\v -> read' v ixsExp) vars     where-        read ::  Var -> [E] -> Dep E-        read = D.readArr+        read' ::  Var -> [E] -> Dep E+        read' = D.readArr  -- | Writes data to the array. writeArr :: (Tuple ix, Tuple a) => Arr ix a -> ix -> a -> SE ()@@ -199,7 +204,7 @@ -- | Updates the value of the array with pure function. modifyArr :: (Tuple a, Tuple ix) => Arr ix a -> ix -> (a -> a) -> SE () modifyArr ref ixs f = do-    value <- readArr ref ixs +    value <- readArr ref ixs     writeArr ref ixs (f value)  mixArr :: (Tuple ix, Tuple a, Num a) => Arr ix a -> ix -> a -> SE ()@@ -244,9 +249,9 @@ -- -- Csound docs: <http://csound.github.io/docs/manual/maparray.html> maparrayNew :: Arr a b -> Str -> SE (Arr a b)-maparrayNew (Arr vs) str = SE $ fmap Arr $ hideGEinDep $ do-    strExp <- toGE str    -    return $ mapM (\var -> go var strExp) vs    +maparrayNew (Arr vs) s = SE $ fmap Arr $ hideGEinDep $ do+    strExp <- toGE s+    return $ mapM (\var -> go var strExp) vs     where         go var strExp = do             outVar <- unSE $ newTmpArrVar (varRate var)@@ -273,20 +278,20 @@     aExps <- fromTuple a     bExps <- fromTuple b     return $ zipWithM_ (\var (aExp, bExp) -> go var (aExp, bExp)) vs (zip aExps bExps)-    where -        go v (aExp, bExp) = -            depT_ $ opcs "copyf2array" [(Xr, [varRate $ head vs, Ir])] [inlineVar $ head vs, aExp, bExp]+    where+        go v (aExp, bExp) =+            depT_ $ opcs "copyf2array" [(Xr, [varRate $ head vs, Ir])] [inlineVar v, aExp, bExp]  -- | Creates a copy of some part of the given array slicearrayNew :: Arr D a -> (D, D) -> SE (Arr D a) slicearrayNew (Arr vs) (from, to) = SE $ fmap Arr $ hideGEinDep $ do-    fromExp <- toGE from-    toExp   <- toGE to-    return $ mapM (\var -> go var (fromExp, toExp)) vs    +    fromExpr <- toGE from+    toExpr   <- toGE to+    return $ mapM (\var -> go var (fromExpr, toExpr)) vs     where-        go var (from, to) = do+        go var (fromExpr, toExpr) = do             outVar <- unSE $ newTmpArrVar (varRate var)-            opcsArr isArrayInit outVar "slicearray" idRate [inlineVar var, from, to]+            opcsArr isArrayInit outVar "slicearray" idRate [inlineVar var, fromExpr, toExpr]             return $ outVar          idRate = fmap (\rate -> (rate, [rate, Ir, Ir])) [Ir, Kr, Ar]@@ -296,63 +301,63 @@ -- | Spectral array. type SpecArr = Arr Sig Sig --- |  Complex-to-complex Fast Fourier Transform. +-- |  Complex-to-complex Fast Fourier Transform. -- -- csound docs: <http://csound.github.io/docs/manual/fft.html> fftNew :: SpecArr -> SE SpecArr fftNew = convert "fft" --- | Complex-to-complex Inverse Fast Fourier Transform. +-- | Complex-to-complex Inverse Fast Fourier Transform. -- -- csound docs: <http://csound.github.io/docs/manual/fftinv.html> fftinvNew :: SpecArr -> SE SpecArr fftinvNew = convert "fftinvi" --- | Fast Fourier Transform of a real-value array. +-- | Fast Fourier Transform of a real-value array. -- -- csound docs: <http://csound.github.io/docs/manual/rfft.html> rfftNew :: SpecArr -> SE SpecArr rfftNew = convert "rfft" --- | Complex-to-real Inverse Fast Fourier Transform. +-- | Complex-to-real Inverse Fast Fourier Transform. -- -- csound docs: <http://csound.github.io/docs/manual/rifft.html> rifftNew :: SpecArr -> SE SpecArr rifftNew = convert "rifft" --- | Copies spectral data to k-rate arrays (or t-variables). Also known as pvs2array. +-- | Copies spectral data to k-rate arrays (or t-variables). Also known as pvs2array. -- -- csound docs: <http://csound.github.io/docs/manual/pvs2tab.html> pvs2tab :: SpecArr -> Spec -> SE Sig-pvs2tab = extractWith "pvs2tab" (Kr, [Xr, Fr]) +pvs2tab = extractWith "pvs2tab" (Kr, [Xr, Fr]) --- | Copies spectral data from k-rate arrays (or t-variables.). Also known as pvsfromarray. +-- | Copies spectral data from k-rate arrays (or t-variables.). Also known as pvsfromarray. -- -- csound docs: <http://csound.github.io/docs/manual/tab2pvs.html> tab2pvs :: SpecArr -> SE Spec tab2pvs = extract1 Fr "tab2pvs" --- | Complex product of two arrays. +-- | Complex product of two arrays. -- -- > kout[] cmplxprod kin1[], kin2[] ----- csound docs: <http://csound.github.io/docs/manual/cmplxprod.html> +-- csound docs: <http://csound.github.io/docs/manual/cmplxprod.html> cmplxprodNew :: SpecArr -> SpecArr -> SE SpecArr cmplxprodNew = convert2 "cmplxprod" --- |  Rectangular to polar format conversion. +-- |  Rectangular to polar format conversion. -- -- > kout[] rect2pol kin[] ----- csound docs: <http://csound.github.io/docs/manual/rect2pol.html> +-- csound docs: <http://csound.github.io/docs/manual/rect2pol.html> rect2polNew :: SpecArr -> SE SpecArr rect2polNew = convert "rect2pol"  -- | Polar to rectangular format conversion. -- -- > kout[] pol2rect kin[]--- --- csound docs: <http://csound.github.io/docs/manual/pol2rect.html> +--+-- csound docs: <http://csound.github.io/docs/manual/pol2rect.html> pol2rectNew :: SpecArr -> SE SpecArr pol2rectNew = convert "pol2rect" @@ -360,32 +365,32 @@ -- | Polar to rectangular format conversion. -- -- > kout[] pol2rect kmags[], kphs[]--- --- csound docs: <http://csound.github.io/docs/manual/pol2rect.html> +--+-- csound docs: <http://csound.github.io/docs/manual/pol2rect.html> pol2rect2New :: SpecArr -> SpecArr -> SE SpecArr pol2rect2New = convert2 "pol2rect" --- | Applies a window to an array. +-- | Applies a window to an array. -- -- > kout[] window kin[][, koff, itype] ----- csound docs: <http://csound.github.io/docs/manual/window.html> +-- csound docs: <http://csound.github.io/docs/manual/window.html> windowArrayNew :: SpecArr -> SE SpecArr windowArrayNew = convert "window" --- | Real to complex format conversion. +-- | Real to complex format conversion. -- -- > kout[] r2c kin[] ----- csound docs: <http://csound.github.io/docs/manual/r2c.html> +-- csound docs: <http://csound.github.io/docs/manual/r2c.html> r2cNew :: SpecArr -> SE SpecArr r2cNew = convert "r2c" --- | Complex to real format conversion. +-- | Complex to real format conversion. -- -- > kout[] c2r kin[] ----- csound docs: <http://csound.github.io/docs/manual/c2r.html> +-- csound docs: <http://csound.github.io/docs/manual/c2r.html> c2rNew :: SpecArr -> SE SpecArr c2rNew = convert "c2r" @@ -393,7 +398,7 @@ -- -- > kout[] mags kin[] ----- csound docs: <http://csound.github.io/docs/manual/mags.html> +-- csound docs: <http://csound.github.io/docs/manual/mags.html> magsArrayNew :: SpecArr -> SE SpecArr magsArrayNew = convert "mags" @@ -407,6 +412,8 @@  ----------------------------- +isArrayInit, noArrayInit :: Bool+ isArrayInit = True noArrayInit = False @@ -447,8 +454,8 @@     where f a = depT $ opcs name [(rate, [Xr])] [a]  extractWith :: (Tuple b, Tuple c, Tuple d) => String -> (Rate, [Rate]) -> Arr a b -> c -> SE d-extractWith name rates (Arr vs) arg = SE $ fmap (toTuple . return) $ hideGEinDep $ do-        argExps <- fromTuple arg        +extractWith name rates (Arr vs) argument = SE $ fmap (toTuple . return) $ hideGEinDep $ do+        argExps <- fromTuple argument         return $ zipWithM (\var x -> f (inlineVar var) x) vs argExps     where f a b = depT $ opcs name [rates] [a, b] @@ -457,9 +464,9 @@  -- | Transforms the dta of the array and copies it to the second array. maparrayCopy :: Arr a b -> Str -> Arr a b -> SE ()-maparrayCopy (Arr vs) str (Arr outs) = SE $ hideGEinDep $ do-    strExp <- toGE str    -    return $ zipWithM_ (\var outVar -> go var strExp outVar) vs outs   +maparrayCopy (Arr vs) s (Arr outs) = SE $ hideGEinDep $ do+    strExp <- toGE s+    return $ zipWithM_ (\var outVar -> go var strExp outVar) vs outs     where         go var strExp outVar = opcsArr noArrayInit outVar "slicearray" idRate [inlineVar var, strExp]         idRate = fmap (\rate -> (rate, [rate, Ir, Ir])) [Ir, Kr, Ar]@@ -467,11 +474,11 @@ -- | Copies a part of array to another array. slicearrayCopy :: Arr D a -> (D, D) -> Arr D a -> SE () slicearrayCopy (Arr vs) (from, to) (Arr outs) = SE $ hideGEinDep $ do-    fromExp <- toGE from-    toExp   <- toGE to-    return $ zipWithM_ (\var outVar -> go var (fromExp, toExp) outVar) vs outs   +    fromExpr <- toGE from+    toExpr   <- toGE to+    return $ zipWithM_ (\var outVar -> go var (fromExpr, toExpr) outVar) vs outs     where-        go var (from, to) outVar = opcsArr noArrayInit outVar "slicearray" idRate [inlineVar var, from, to]         +        go var (fromExpr, toExpr) outVar = opcsArr noArrayInit outVar "slicearray" idRate [inlineVar var, fromExpr, toExpr]         idRate = fmap (\rate -> (rate, [rate, Ir, Ir])) [Ir, Kr, Ar]  -- | Multiplies two arrays and copies the result into third array.@@ -493,32 +500,32 @@ -- spectral opcodes  --- |  Complex-to-complex Fast Fourier Transform. +-- |  Complex-to-complex Fast Fourier Transform. -- -- csound docs: <http://csound.github.io/docs/manual/fft.html> fftCopy :: SpecArr -> SpecArr -> SE () fftCopy = convertCopy "fft" --- | Complex-to-complex Inverse Fast Fourier Transform. +-- | Complex-to-complex Inverse Fast Fourier Transform. -- -- csound docs: <http://csound.github.io/docs/manual/fftinv.html> fftinvCopy :: SpecArr -> SpecArr -> SE () fftinvCopy = convertCopy "fftinvi" --- | Fast Fourier Transform of a real-value array. +-- | Fast Fourier Transform of a real-value array. -- -- csound docs: <http://csound.github.io/docs/manual/rfft.html> rfftCopy :: SpecArr -> SpecArr -> SE () rfftCopy = convertCopy "rfft" --- | Complex-to-real Inverse Fast Fourier Transform. +-- | Complex-to-real Inverse Fast Fourier Transform. -- -- csound docs: <http://csound.github.io/docs/manual/rifft.html> rifftCopy :: SpecArr -> SpecArr -> SE () rifftCopy = convertCopy "rifft"  --- | Complex product of two arrays. +-- | Complex product of two arrays. -- -- > kout[] cmplxprod kin1[], kin2[] --@@ -526,7 +533,7 @@ cmplxprodCopy :: SpecArr -> SpecArr -> SpecArr -> SE () cmplxprodCopy = convert2Copy "cmplxprod" --- |  Rectangular to polar format conversion. +-- |  Rectangular to polar format conversion. -- -- > kout[] rect2pol kin[] --@@ -537,7 +544,7 @@ -- | Polar to rectangular format conversion. -- -- > kout[] pol2rect kin[]--- +-- -- csound docs: <http://csound.github.io/docs/manual/pol2rect.html> pol2rectCopy :: SpecArr -> SpecArr -> SE () pol2rectCopy = convertCopy "pol2rect"@@ -545,12 +552,12 @@ -- | Polar to rectangular format conversion. -- -- > kout[] pol2rect kmags[], kphs[]--- +-- -- csound docs: <http://csound.github.io/docs/manual/pol2rect.html> pol2rect2Copy :: SpecArr -> SpecArr -> SpecArr -> SE () pol2rect2Copy = convert2Copy "pol2rect2" --- | Applies a window to an array. +-- | Applies a window to an array. -- -- > kout[] window kin[][, koff, itype] --@@ -558,15 +565,15 @@ windowArrayCopy :: SpecArr -> SpecArr -> SE () windowArrayCopy = convertCopy "window" --- | Real to complex format conversion. +-- | Real to complex format conversion. -- -- > kout[] r2c kin[] ----- csound docs: <http://csound.github.io/docs/manual/r2c.html> +-- csound docs: <http://csound.github.io/docs/manual/r2c.html> r2cCopy :: SpecArr -> SpecArr -> SE () r2cCopy = convertCopy "r2c" --- | Complex to real format conversion. +-- | Complex to real format conversion. -- -- > kout[] c2r kin[] --@@ -579,7 +586,7 @@ -- -- > kout[] mags kin[] ----- csound docs: <http://csound.github.io/docs/manual/mags.html> +-- csound docs: <http://csound.github.io/docs/manual/mags.html> magsArrayCopy :: SpecArr -> SpecArr -> SE () magsArrayCopy = convertCopy "mags" @@ -601,7 +608,7 @@ convertCopy :: String -> Arr a b -> Arr a b -> SE () convertCopy name (Arr vars) (Arr outs) = zipWithM_ go vars outs     where-        go v outVar = SE $ opcsArr noArrayInit outVar name idRate1 [inlineVar v]          +        go v outVar = SE $ opcsArr noArrayInit outVar name idRate1 [inlineVar v]         idRate1 = fmap (\r -> (r, [r])) [Kr, Ar, Ir, Sr, Fr]  convert2Copy :: String -> Arr a b -> Arr a b -> Arr a b -> SE ()

@@ -6,7 +6,6 @@     Snap, snapshot, snaps, readSnap ) where -import Data.Monoid import Data.Default import Data.Boolean @@ -46,6 +45,7 @@  #endif +mappendEvt :: Evt a -> Evt a -> Evt a mappendEvt a b = Evt $ \bam -> runEvt a bam >> runEvt b bam  -- | Converts booleans to events.

@@ -11,27 +11,25 @@     -- ** Procedure     Procedure, procedure, -    -- ** Pure multi +    -- ** Pure multi     PureMulti, Pm, fromPm, pureMulti,      -- ** Dirty multi     DirtyMulti, Dm, fromDm, dirtyMulti-        -) where -import Control.Applicative+) where  import Csound.Dynamic import Csound.Typed.Types.Prim import Csound.Typed.Types.Tuple import Csound.Typed.GlobalState-    + pureSingle :: PureSingle a => ([E] -> E) -> a pureSingle = pureSingleGE . return-    + dirtySingle :: DirtySingle a => ([E] -> Dep E) -> a dirtySingle = dirtySingleGE . return-    + procedure :: Procedure a => ([E] -> Dep ()) -> a procedure = procedureGE . return @@ -53,10 +51,10 @@  class Procedure a where     procedureGE :: GE ([E] -> Dep ()) -> a-    + class PureMulti a where     pureMultiGE :: GE ([E] -> MultiOut [E]) -> a-    + class DirtyMulti a where     dirtyMultiGE :: GE ([E] -> MultiOut (Dep [E])) -> a @@ -68,7 +66,7 @@  fromDm :: Tuple a => Dm -> SE a fromDm (Dm a) = res-    where +    where         res = fmap toTuple $ fromDep $ hideGEinDep $ fmap ( $ (tupleArity $ proxy res)) a          proxy :: SE a -> a@@ -84,7 +82,7 @@  instance PureSingle b => PureSingle (GE [E] -> b) where     pureSingleGE mf = \mas -> pureSingleGE $ (\f as bs -> f (as ++ bs)) <$> mf <*> mas-    + ps0 :: (Val a) => GE ([E] -> E) -> a ps0 = fromGE . pureSingleGE @@ -117,10 +115,10 @@  instance DirtySingle (SE (GE E)) where     dirtySingleGE = fromDep . hideGEinDep . fmap ($ [])-    + instance DirtySingle b => DirtySingle (GE E -> b) where     dirtySingleGE mf = \ma -> dirtySingleGE $ (\f a as -> f (a:as)) <$> mf <*> ma-    + instance DirtySingle b => DirtySingle (GE [E] -> b) where     dirtySingleGE mf = \mas -> dirtySingleGE $ (\f as bs -> f (as ++ bs)) <$> mf <*> mas @@ -159,10 +157,10 @@  instance Procedure b => Procedure (GE E -> b) where     procedureGE mf = \ma -> procedureGE $ (\f a as -> f (a:as)) <$> mf <*> ma-    + instance Procedure b => Procedure (GE [E] -> b) where     procedureGE mf = \mas -> procedureGE $ (\f as bs -> f (as ++ bs)) <$> mf <*> mas-    + pr1 :: (Val a, Procedure b) => GE ([E] -> Dep ()) -> a -> b pr1 f = procedureGE f . toGE @@ -188,7 +186,7 @@  instance PureMulti b => PureMulti (GE E -> b) where     pureMultiGE mf = \ma -> pureMultiGE $ (\f a as -> f (a:as)) <$> mf <*> ma-    + instance PureMulti b => PureMulti (GE [E] -> b) where     pureMultiGE mf = \mas -> pureMultiGE $ (\f as bs -> f (as ++ bs)) <$> mf <*> mas @@ -196,7 +194,7 @@ pm1 f = pureMultiGE f . toGE  pms :: (Val a, PureMulti b) => GE ([E] -> MultiOut [E]) -> ([a] -> b)-pms f = pureMultiGE f . mapM toGE +pms f = pureMultiGE f . mapM toGE  instance (PureMulti b) => PureMulti (Sig -> b)    where   pureMultiGE = pm1 instance (PureMulti b) => PureMulti (D -> b)      where   pureMultiGE = pm1

@@ -9,7 +9,7 @@ import Csound.Dynamic hiding (int) import Csound.Typed.GlobalState.Elements import Csound.Typed.GlobalState.Opcodes-import Csound.Typed.GlobalState.GE+import Csound.Typed.GlobalState.GE hiding (notes) import Csound.Typed.GlobalState.SE import Csound.Typed.Control.Ref import Csound.Typed.Types.Prim@@ -31,9 +31,6 @@ delayCsdEventList = T.del  -type TupleMonoArg = (E,E,E,E)-type RawMonoInstr = TupleMonoArg -> Dep [E]- data M     = Snd InstrId (CsdEventList [E])     | MonoSnd { monoSndInstr :: InstrId, monoSndArgs :: InstrId, monoSndNotes :: (CsdEventList [E]) }@@ -123,7 +120,7 @@             mkEvent instrId start dur []             renderMixSco_ es -        onMonoSnd instr arg es = undefined+        onMonoSnd = undefined   mkEvent :: InstrId -> Sig -> Sig -> [E] -> Dep ()

@@ -9,7 +9,7 @@ -- | Input argument for monophonic synthesizer. -- It includes signals for amplitude, frequency (Cycles Per second), gate, trigger. -- The gate equals to 1 when any note is pressed or zero when nothing is pressed.--- The trigger equals to 1 at the moment when new note is pressed otherwise it's 0. +-- The trigger equals to 1 at the moment when new note is pressed otherwise it's 0. data MonoArg = MonoArg     { monoAmp  :: Sig     , monoCps  :: Sig@@ -31,8 +31,8 @@ -- | Turns the function that expects ADSR-function and amplitude and frequency to the -- function on monophonic argument. adsrMonoSynt :: (MonoAdsr -> (Sig, Sig) -> a) -> (MonoArg -> a)-adsrMonoSynt f arg = f env (monoAmp arg, monoCps arg) -    where env = monoAdsr arg+adsrMonoSynt f argument = f env (monoAmp argument, monoCps argument)+    where env = monoAdsr argument  monoAdsr :: MonoArg -> MonoAdsr-monoAdsr arg = adsr140 (monoGate arg) (monoTrig arg) +monoAdsr argument = adsr140 (monoGate argument) (monoTrig argument)

@@ -1,3 +1,4 @@+{-# OPTIONS_GHC -Wno-orphans #-} {-# Language TypeFamilies, FlexibleInstances, FlexibleContexts, ScopedTypeVariables, Rank2Types, CPP #-} module Csound.Typed.Types.Prim(     Sig(..), unSig, D(..), unD, Tab(..), unTab, Str(..), Spec(..), Wspec(..), renderTab,@@ -32,8 +33,6 @@     when1, whens, untilDo, whileDo, boolSig,     equalsTo, notEqualsTo, lessThan, greaterThan, lessThanEquals, greaterThanEquals,     whenD1, whenDs, untilDoD, whileDoD, untilBeginD,--    module Data.NumInstances.Tuple ) where  import Prelude hiding ((<*))@@ -41,11 +40,9 @@ import Control.Applicative hiding ((<*)) import Control.Monad import Control.Monad.Trans.Class-import Data.Monoid import qualified Data.IntMap    as IM import qualified Data.Map       as M -import Data.NumInstances.Tuple  import Control.Monad.Trans.Reader @@ -53,7 +50,7 @@ import Data.Boolean import Data.String -import Csound.Dynamic hiding (double, int, str, when1, whens, ifBegin, ifEnd, elseBegin, untilBegin, untilEnd, untilDo, whileBegin, whileEnd, whileDo)+import Csound.Dynamic hiding (genId, double, int, str, when1, whens, ifBegin, ifEnd, elseBegin, untilBegin, untilEnd, untilDo, whileBegin, whileEnd, whileDo) import qualified Csound.Dynamic as D(double, int, str, ifBegin, ifEnd, elseBegin, untilBegin, untilEnd, whileBegin, whileEnd) import Csound.Typed.GlobalState.GE import Csound.Typed.GlobalState.SE@@ -249,6 +246,7 @@     Tab _ -> error "you can skip normalization only for primitive tables (made with gen-routines)"     TabPre a -> TabPre $ a{ preTabGen = skipNormGenId $ preTabGen a } +skipNormGenId :: GenId -> GenId skipNormGenId = mapIntGenId (negate . abs)  -- | Force normalization (sets table size to positive value).@@ -258,6 +256,7 @@     Tab _ -> error "you can force normalization only for primitive tables (made with gen-routines)"     TabPre a -> TabPre $ a{ preTabGen = normGenId $ preTabGen a } +normGenId :: GenId -> GenId normGenId = mapIntGenId abs  mapIntGenId :: (Int -> Int) -> GenId -> GenId@@ -282,7 +281,7 @@ tabList :: [Tab] -> TabList tabList xs = TabList $ saveTabs =<< mapM fromPreTab (getPreTabs xs)     where-        getPreTabs xs = case xs of+        getPreTabs = \case             []            -> []             Tab    _ : as -> getPreTabs as             TabPre a : as -> a : getPreTabs as@@ -351,13 +350,13 @@ ar :: Sig -> Sig ar x = case x of     PrimSig a -> PrimSig a-    Sig exp   -> Sig $ fmap (setRate Ar) exp+    Sig expr  -> Sig $ fmap (setRate Ar) expr  -- | Sets a rate of the signal to control rate. kr :: Sig -> Sig kr x = case x of     PrimSig a -> PrimSig a-    Sig exp   -> Sig $ fmap (setRate Kr) exp+    Sig expr  -> Sig $ fmap (setRate Kr) expr  -- | Converts a signal to the number (initial value of the signal). ir :: Sig -> D@@ -369,7 +368,7 @@ sig :: D -> Sig sig x = case x of     PrimD a -> PrimSig a-    D exp   -> Sig $ fmap (setRate Kr) exp+    D expr  -> Sig $ fmap (setRate Kr) expr  ------------------------------------------------------------------------------- -- single wrapper@@ -628,28 +627,28 @@  instance IfB Sig  where     ifB x a b = case x of-        PrimBoolSig cond -> if cond then a else b+        PrimBoolSig c -> if c then a else b         _                -> on3 ifB x a b  instance IfB D    where     ifB x a b = case x of-        PrimBoolD cond -> if cond then a else b+        PrimBoolD c -> if c then a else b         _              -> on3 ifB x a b  instance IfB Tab  where     ifB x a b = case x of-        PrimBoolD cond -> if cond then a else b+        PrimBoolD c -> if c then a else b         _              -> on3 ifB x a b  instance IfB Str  where     ifB x a b = case x of-        PrimBoolD cond -> if cond then a else b+        PrimBoolD c -> if c then a else b         _              -> on3 ifB x a b  instance IfB Spec where     ifB x a b = case x of-        PrimBoolD cond -> if cond then a else b-        _              -> on3 ifB x a b+        PrimBoolD c -> if c then a else b+        _           -> on3 ifB x a b  instance EqB Sig  where { (==*) = op2 (==) (==*);    (/=*) = op2 (/=) (/=*) } instance EqB D    where { (==*) = op2 (==) (==*);    (/=*) = op2 (/=) (/=*) }

@@ -17,6 +17,7 @@ import Control.Applicative import Csound.Typed.Types.Prim import Csound.Typed.GlobalState.SE+import Data.NumInstances.Tuple()  -- | A class for easy way to process the outputs of the instruments. class SigSpace a where@@ -58,7 +59,7 @@ -- > on a b biSig on :: SigSpace a => Sig -> Sig -> a -> a on a b x = uon a b $ mapSig unipolar x-    where unipolar a = 0.5 + 0.5 * a+    where unipolar v = 0.5 + 0.5 * v  -- | Rescaling of the unipolar signal (0, 1) -> (a, b) --@@ -541,6 +542,7 @@ --------------------------------------------------------- -- Sig2 -> Sig2 +fromMono :: Sig -> Sig2 fromMono a = (a, a)  instance At Sig2 Sig2 Sig where

@@ -35,8 +35,6 @@ import Data.Default import Data.Boolean -import Data.NumInstances.Tuple- import Csound.Dynamic import Csound.Typed.Types.Prim import Csound.Typed.Types.SigSpace