csound-expression-typed 0.2.0.0 → 0.2.0.1

raw patch · 9 files changed

+376/−558 lines, 9 filesdep +NumInstancesPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependencies added: NumInstances

API changes (from Hackage documentation)

Files

• csound-expression-typed.cabal +11/−11
• src/Csound/Typed/Control/Evt.hs +43/−43
• src/Csound/Typed/Control/Mix.hs +26/−26
• src/Csound/Typed/Control/Osc.hs +33/−23
• src/Csound/Typed/GlobalState/Elements.hs +65/−75
• src/Csound/Typed/Types/Evt.hs +16/−16
• src/Csound/Typed/Types/Prim.hs +67/−223
• src/Csound/Typed/Types/SigSpace.hs +78/−102
• src/Csound/Typed/Types/Tuple.hs +37/−39

@@ -1,5 +1,5 @@ Name:          csound-expression-typed-Version:       0.2.0.0+Version:       0.2.0.1 Cabal-Version: >= 1.22 License:       BSD3 License-file:  LICENSE@@ -11,7 +11,7 @@ Category:      Music, Sound Maintainer:    <anton.kholomiov@gmail.com> -Description:   +Description:  Data-Files :     data/hrtf-44100-left.dat@@ -47,9 +47,9 @@     data/opcodes/MultiFX/PitchShifter.udo     data/opcodes/MultiFX/Reverse.udo     data/opcodes/MultiFX/RingModulator.udo-    data/opcodes/MultiFX/StChorus.udo -    data/opcodes/MultiFX/StereoPingPongDelay.udo -    data/opcodes/Utility/Delay1k.udo +    data/opcodes/MultiFX/StChorus.udo+    data/opcodes/MultiFX/StereoPingPongDelay.udo+    data/opcodes/Utility/Delay1k.udo   Homepage:        https://github.com/anton-k/csound-expression-typed@@ -63,7 +63,7 @@ Library   Ghc-Options:    -Wall   Build-Depends:-        base >= 4, base < 5, ghc-prim, containers, transformers >= 0.3, Boolean >= 0.1.0, colour >= 2.0, data-default, deepseq,+        base >= 4, base < 5, ghc-prim, containers, transformers >= 0.3, Boolean >= 0.1.0, colour >= 2.0, data-default, deepseq, NumInstances,         wl-pprint, csound-expression-dynamic >= 0.3.0, temporal-media >= 0.6.0, hashable   Hs-Source-Dirs:      src/   Exposed-Modules:@@ -76,7 +76,7 @@     Csound.Typed.Gui     Csound.Typed.Gui.Cab -    Csound.Typed.Types.Prim    +    Csound.Typed.Types.Prim     Csound.Typed.Types.Evt     Csound.Typed.Types.Tuple     Csound.Typed.Types.Lift@@ -84,7 +84,7 @@     Csound.Typed.Types.MonoArg     Csound.Typed.Types.SigSpace -    Csound.Typed.Plugins    +    Csound.Typed.Plugins    Other-Modules:     Csound.Typed.GlobalState@@ -95,8 +95,8 @@     Csound.Typed.GlobalState.InstrApi     Csound.Typed.GlobalState.Cache     Csound.Typed.GlobalState.Elements-    Csound.Typed.GlobalState.Opcodes  -    Csound.Typed.GlobalState.Port  +    Csound.Typed.GlobalState.Opcodes+    Csound.Typed.GlobalState.Port     Csound.Typed.InnerOpcodes      Csound.Typed.Types.TupleHelpers@@ -110,7 +110,7 @@     Csound.Typed.Control.Sf2     Csound.Typed.Control.Osc     Csound.Typed.Control.Channel-    Csound.Typed.Control.Ref    +    Csound.Typed.Control.Ref     Csound.Typed.Control.Instr     Csound.Typed.Control.InstrRef     Csound.Typed.Control.ArrayTraverse

@@ -36,9 +36,9 @@     where unEvt e = (T.eventStart e, T.eventDur e, T.eventContent e)  sched :: (Arg a, Sigs b) => (a -> SE b) -> Evt (Sco a) -> b-sched instr evts = apInstr0 $ do    +sched instr evts = apInstr0 $ do     instrId <- saveSourceInstrCachedWithLivenessWatch (funArity instr) (insExp instr)-    saveEvtInstr (arityOuts $ funArity instr) instrId (renderEvts evts)    +    saveEvtInstr (arityOuts $ funArity instr) instrId (renderEvts evts)  -- | Triggers a procedure on the event stream. sched_ :: (Arg a) => (a -> SE ()) -> Evt (Sco a) -> SE ()@@ -50,7 +50,7 @@ schedBy :: (Arg a, Sigs b, Arg c) => (a -> SE b) -> (c -> Evt (Sco a)) -> (c -> b) schedBy instr evts args = flip apInstr args $ do     instrId <- saveSourceInstrCachedWithLivenessWatch (funArity instr) (insExp instr)-    saveEvtInstr (arityOuts $ funArity instr) instrId (renderEvts $ evts toArg)  +    saveEvtInstr (arityOuts $ funArity instr) instrId (renderEvts $ evts toArg)  ------------------------------------------------- -- triggereing the events@@ -64,28 +64,28 @@         evtMixInstr aliveCountRef = do             chnId <- fromDep $ C.chnRefAlloc arity             go aliveCountRef chnId evts-            fromDep_ $ hideGEinDep $ fmap (\chn -> C.sendOut arity =<< C.readChn chn) chnId +            fromDep_ $ hideGEinDep $ fmap (\chn -> C.sendOut arity =<< C.readChn chn) chnId             aliveCount <- readRef aliveCountRef-            fromDep_ $ hideGEinDep $ liftA2 masterUpdateChnAlive chnId $ toGE aliveCount +            fromDep_ $ hideGEinDep $ liftA2 masterUpdateChnAlive chnId $ toGE aliveCount          go :: Arg a => Ref D -> GE C.ChnRef -> Evt [(D, D, a)] -> SE ()-        go aliveCountRef mchnId events = +        go aliveCountRef mchnId events =             runEvt events $ \es -> do                 writeRef aliveCountRef $ int $ 2 * length es                 chnId <- geToSe mchnId                 fromDep_ $ mapM_ (event chnId) es-    +         event :: Arg a => C.ChnRef -> (D, D, a) -> Dep ()-        event chnId (start, dur, args) = hideGEinDep $ fmap C.event $ -            C.Event (primInstrId instrId) <$> toGE start <*> toGE dur <*> (fmap (++ [C.chnRefId chnId]) $ toNote args) -            +        event chnId (start, dur, args) = hideGEinDep $ fmap C.event $+            C.Event (primInstrId instrId) <$> toGE start <*> toGE dur <*> (fmap (++ [C.chnRefId chnId]) $ toNote args)+ -- | Retriggers an instrument every time an event happens. The note -- is held until the next event happens. retrigs :: (Arg a, Sigs b) => (a -> SE b) -> Evt [a] -> b retrigs instr evts = apInstr0 $ do     instrId <- saveSourceInstrCachedWithLivenessWatchAndRetrig (funArity instr) (insExp instr)     saveRetrigEvtInstr (arityOuts $ funArity instr) instrId evts-   + saveRetrigEvtInstr :: Arg a => Int -> C.InstrId -> Evt [a] -> GE C.InstrId saveRetrigEvtInstr arity instrId evts = saveInstr $ do     aliveCountRef  <- newRef (10 :: D)@@ -96,24 +96,24 @@         evtMixInstr aliveCountRef retrigWatchRef = do             chnId <- fromDep $ C.chnRefAlloc arity             go aliveCountRef retrigWatchRef chnId evts-            fromDep_ $ hideGEinDep $ fmap (\chn -> C.sendOut arity =<< C.readChn chn) chnId +            fromDep_ $ hideGEinDep $ fmap (\chn -> C.sendOut arity =<< C.readChn chn) chnId             aliveCount <- readRef aliveCountRef-            fromDep_ $ hideGEinDep $ liftA2 masterUpdateChnAlive chnId $ toGE aliveCount                         +            fromDep_ $ hideGEinDep $ liftA2 masterUpdateChnAlive chnId $ toGE aliveCount          go :: Arg a => Ref D -> Ref D -> GE C.ChnRef -> Evt [a] -> SE ()-        go aliveCountRef retrigWatchRef mchnId events = +        go aliveCountRef retrigWatchRef mchnId events =             runEvt events $ \es -> do-                writeRef aliveCountRef $ int $ 2 * length es                +                writeRef aliveCountRef $ int $ 2 * length es                 modifyRef retrigWatchRef (+ 1)                 chnId <- geToSe mchnId                 currentRetrig <- readRef retrigWatchRef-                fromDep_ $ hideGEinDep $ liftA2 masterUpdateChnRetrig mchnId $ toGE currentRetrig                                +                fromDep_ $ hideGEinDep $ liftA2 masterUpdateChnRetrig mchnId $ toGE currentRetrig                 fromDep_ $ mapM_ (event chnId currentRetrig) es-    +         event :: Arg a => C.ChnRef -> D -> a -> Dep ()         event chnId currentRetrig args = hideGEinDep $ fmap C.event $ do             currentRetrigExp <- toGE currentRetrig-            C.Event (primInstrId instrId) 0 infiniteDur <$> (fmap (++ [C.chnRefId chnId, currentRetrigExp]) $ toNote args) +            C.Event (primInstrId instrId) 0 infiniteDur <$> (fmap (++ [C.chnRefId chnId, currentRetrigExp]) $ toNote args)  evtLoop :: (Num a, Tuple a, Sigs a) => Maybe (Evt Unit) -> [SE a] -> [Evt Unit] -> a evtLoop = evtLoopGen True@@ -125,7 +125,7 @@ evtLoopGen mustLoop maybeOffEvt instrs evts = apInstr0 $ do     (instrId, evtInstrId) <- saveSourceInstrCachedWithLivenessWatchAndRetrigAndEvtLoop (constArity instr) (insExp $ toInstrExp instr) (toSingleEvt evts)     saveEvtLoopInstr mustLoop loopLength maybeOffEvt (arityOuts $ constArity instr) instrId evtInstrId-    where         +    where         loopLength = int $ lcm (length instrs) (length evts)         instr = toSingleInstr instrs @@ -138,7 +138,7 @@             ref <- newRef 0             zipWithM_ (f ref n) (fmap (sig . int) [0 .. ]) as             readRef ref-            where +            where                 f :: Tuple a => Ref a -> Sig -> Sig -> SE a -> SE ()                 f ref n ix a = when1 (n ==* ix) $ writeRef ref =<< a @@ -146,7 +146,7 @@         toSingleEvt evts = do             let n = mod' (fromE $ getRetrigVal 4) (sig $ int $ length evts)             zipWithM_ (f n) (fmap (sig . int) [0 .. ]) evts-            where +            where                 f :: Sig -> Sig -> Evt Unit -> SE ()                 f n ix evt = when1 (n ==* ix) $ evtLoopInstr evt @@ -157,7 +157,7 @@ saveEvtLoopInstr :: Bool -> D -> Maybe (Evt Unit) -> Int -> C.InstrId -> C.InstrId -> GE C.InstrId saveEvtLoopInstr mustLoop loopLength maybeOffEvt arity instrId evtInstrId = saveInstr $ do     aliveCountRef  <- newRef (10 :: D)-    retrigWatchRef <- newRef (0  :: D)        +    retrigWatchRef <- newRef (0  :: D)     evtMixInstr aliveCountRef retrigWatchRef     where         evtMixInstr :: Ref D -> Ref D -> SE ()@@ -167,43 +167,43 @@             isOn <- fmap sig $ case maybeOffEvt of                 Nothing     -> return 1                 Just offEvt -> do-                    isOn <- newRef (1 :: D)                    +                    isOn <- newRef (1 :: D)                     runEvt offEvt $ const $ do                         writeRef isOn 0                         modifyRef retrigWatchRef (+ 1)                         currentRetrig <- readRef retrigWatchRef-                        fromDep_ $ hideGEinDep $ liftA2 masterUpdateChnRetrig chnId $ toGE currentRetrig                        -                    readRef isOn         +                        fromDep_ $ hideGEinDep $ liftA2 masterUpdateChnRetrig chnId $ toGE currentRetrig+                    readRef isOn              masterEvt <- fmap (sigToEvt . (* isOn) . fromGE . fmap C.changed . toGE) $ readServantEvt chnId             go aliveCountRef retrigWatchRef chnId masterEvt-            fromDep_ $ hideGEinDep $ fmap (\chn -> C.sendOut arity =<< C.readChn chn) chnId +            fromDep_ $ hideGEinDep $ fmap (\chn -> C.sendOut arity =<< C.readChn chn) chnId             aliveCount <- readRef aliveCountRef-            fromDep_ $ hideGEinDep $ liftA2 masterUpdateChnAlive chnId $ toGE aliveCount    +            fromDep_ $ hideGEinDep $ liftA2 masterUpdateChnAlive chnId $ toGE aliveCount -        go = goBy (+ 1)   +        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-                if not mustLoop +                if not mustLoop                     then do                         when1 (sig currentRetrig >=* (sig loopLength)) $ do                             fromDep_ turnoff                     else return ()-                fromDep_ $ hideGEinDep $ liftA2 masterUpdateChnRetrig mchnId $ toGE currentRetrig                                +                fromDep_ $ hideGEinDep $ liftA2 masterUpdateChnRetrig mchnId $ toGE currentRetrig                 audioEvent chnId currentRetrig-                evtEvent chnId currentRetrig  +                evtEvent chnId currentRetrig            fireEventFor :: (C.ChnRef -> E -> C.Event) -> C.ChnRef -> D -> SE ()         fireEventFor f chnId currentRetrig = fromDep_ $ hideGEinDep $ fmap C.event $ do             currentRetrigExp <- toGE currentRetrig-            return $ f chnId currentRetrigExp           +            return $ f chnId currentRetrigExp          audioEvent = fireEventFor eventForAudioInstr         evtEvent   = fireEventFor eventForEvtInstr@@ -214,21 +214,21 @@             chnId <- mchnId             return $ initStartEvtInstr   chnId >> initStartAudioInstr chnId -        initStartEvtInstr   chnId = C.event_i $ eventForEvtInstr chnId 0 +        initStartEvtInstr   chnId = C.event_i $ eventForEvtInstr chnId 0         initStartAudioInstr chnId = C.event_i $ eventForAudioInstr chnId 0          eventForEvtInstr   = eventFor evtInstrId         eventForAudioInstr = eventFor instrId -        eventFor idx chnId currentRetrig = -            C.Event (primInstrId idx) 0 infiniteDur [C.chnRefId chnId, currentRetrig] +        eventFor idx chnId currentRetrig =+            C.Event (primInstrId idx) 0 infiniteDur [C.chnRefId chnId, currentRetrig]          readServantEvt :: GE C.ChnRef -> SE Sig         readServantEvt chnId = SE $ fmap fromE $ hideGEinDep $ fmap readChnEvtLoop chnId  --- | An instrument is triggered with event stream and delay time is set to zero --- (event fires immediately) and duration is set to inifinite time. The note is +-- | An instrument is triggered with event stream and delay time is set to zero+-- (event fires immediately) and duration is set to inifinite time. The note is -- held while the instrument is producing something. If the instrument is silent -- for some seconds (specified in the first argument) then it's turned off. schedHarp :: (Arg a, Sigs b) => D -> (a -> SE b) -> Evt [a] -> b@@ -246,7 +246,7 @@  autoOff :: Sigs a => D -> a -> SE a autoOff dt sigs = fmap toTuple $ fromDep $ hideGEinDep $ phi =<< fromTuple sigs-    where +    where         phi x = do             dtE <- toGE dt             return $ C.autoOff dtE x@@ -275,7 +275,7 @@ ------------------------------------------------------------- -- monophonic scheduling --- | Turns +-- | Turns monoSched :: Evt (Sco (D, D)) -> SE MonoArg monoSched evts = evtPort instr evts read     where@@ -290,7 +290,7 @@             return $ MonoArg amp cps (ifB (gate `equalsTo` 0) 0 1) (changed [amp, cps, gate])  runSco :: Arg a => Evt (Sco a) -> ((D,D,a) -> SE ()) -> SE ()-runSco evts f = runEvt (renderEvts evts) $ mapM_ f +runSco evts f = runEvt (renderEvts evts) $ mapM_ f  -- | Plays the note until next note comes or something happens on the second event stream. monoSchedUntil :: Evt (D, D) -> Evt a -> SE MonoArg@@ -302,7 +302,7 @@     where         go ref = either (ons ref) (const $ offs ref) -        ons ref (amp, cps) = +        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 }

@@ -1,6 +1,6 @@ {-# Language FlexibleContexts, ScopedTypeVariables #-} module Csound.Typed.Control.Mix(-    Mix, +    Mix,     sco, eff, mix, mixBy, monoSco,     sco_, mix_, mixBy_,     Sco, CsdEventList(..), CsdEvent@@ -30,12 +30,12 @@ toCsdEventList = id  singleCsdEvent :: (D, D, a) -> Sco a-singleCsdEvent (start, duration, content) = del start $ str duration $ temp content +singleCsdEvent (start, duration, content) = del start $ str duration $ temp content  -- | Special type that represents a scores of sound signals. -- If an instrument is triggered with the scores the result is wrapped--- in the value of this type. -newtype Mix a = Mix { unMix :: GE M } +-- in the value of this type.+newtype Mix a = Mix { unMix :: GE M }  type Sco a = Track D a @@ -45,34 +45,34 @@  -- | Plays a bunch of notes with the given instrument. ----- > res = sco instrument scores +-- > res = sco instrument scores sco :: (Arg a, Sigs b) => (a -> SE b) -> Sco a -> Sco (Mix b) sco instr notes = wrapSco notes $ \events -> do-    events' <- traverse toNote events    +    events' <- traverse toNote events     instrId <- saveSourceInstrCachedWithLivenessWatch (funArity instr) (insExp instr)     return $ Snd instrId events'  -- | Invokes a procedure for the given bunch of events. sco_ :: (Arg a) => (a -> SE ()) -> Sco a -> Sco (Mix Unit) sco_ instr notes = wrapSco notes $ \events -> do-    events' <- traverse toNote events    +    events' <- traverse toNote events     instrId <- saveSourceInstrCached_ (unitExp $ fmap (const unit) $ instr toArg)     return $ Snd instrId events' --- | Applies an effect to the sound. Effect is applied to the sound on the give track. +-- | Applies an effect to the sound. Effect is applied to the sound on the give track. ----- > res = eff effect sco +-- > res = eff effect sco ----- * @effect@ - a function that takes a tuple of signals and produces +-- * @effect@ - a function that takes a tuple of signals and produces --   a tuple of signals. ----- * @sco@ - something that is constructed with 'Csound.Base.sco' or ---   'Csound.Base.eff'. +-- * @sco@ - something that is constructed with 'Csound.Base.sco' or+--   'Csound.Base.eff'. ----- With the function 'Csound.Base.eff' you can apply a reverb or adjust the --- level of the signal. It functions like a mixing board but unlike mixing +-- With the function 'Csound.Base.eff' you can apply a reverb or adjust the+-- level of the signal. It functions like a mixing board but unlike mixing -- board it produces the value that you can arrange with functions from your--- favorite Score-generation library. You can delay it or mix with some other track and +-- favorite Score-generation library. You can delay it or mix with some other track and -- apply some another effect on top of it! eff :: (Sigs a, Sigs b) => (a -> SE b) -> Sco (Mix a) -> Sco (Mix b) eff ef sigs = wrapSco sigs $ \events -> do@@ -83,37 +83,37 @@ -- | Plays a bunch of notes with the given monophonic instrument. See details on type @MonoArg@. -- The scores contain the pairs of amplitude (0 to 1) and frequency (in Hz). ----- > res = monoSco instrument scores +-- > res = monoSco instrument scores monoSco :: forall a . Sigs a => (MonoArg -> SE a) -> Sco (D, D) -> Sco (Mix a) monoSco instr notes = wrapSco notes $ \events -> do-    events' <- traverse toNote events        +    events' <- traverse toNote events     argId <- saveSourceInstrCached_ (unitExp $ fmap (const unit) $ instrMonoArg toArg)     instrId <- saveEffectInstr ((funArity instr) { arityIns = 3 }) (effExp effInstr)-    return $ MonoSnd instrId argId events'    -    where +    return $ MonoSnd instrId argId events'+    where         instrMonoArg :: ((D, D), Port Sig3) -> SE ()         instrMonoArg ((amp, cps), port) =-            modifyPort port $ \(_, _, notnum) -> (sig amp, sig cps, notnum + 1)            +            modifyPort port $ \(_, _, notnum) -> (sig amp, sig cps, notnum + 1)          effInstr :: Sigs a => (Sig, Sig, Sig) -> SE a         effInstr (amp, cps, notnum) = instr (MonoArg amp cps gate (changed [amp, cps, gate]))             where gate = ifB (notnum ==* 0) 0 1-        + -- | Renders a scores to the sound signals. we can use it inside the other instruments. mix :: (Sigs a) => Sco (Mix a) -> a mix a = flip apInstr unit $ do     key <- mixKey a     durE <- toGE $ dur a-    withCache (ExpDur durE) getMixKey saveMixKey key $ +    withCache (ExpDur durE) getMixKey saveMixKey key $         saveMixInstr (mixArity a) =<< toEventList a'     where a' = toCsdEventList a --- | Imitates a closure for a bunch of notes to be played within another instrument. +-- | Imitates a closure for a bunch of notes to be played within another instrument. mixBy :: (Arg a, Sigs b) => (a -> Sco (Mix b)) -> (a -> b) mixBy evts args = flip apInstr args $ do     key <- mixKey evts     durE <- toGE $ dur evts'-    withCache (ExpDur durE) getMixKey saveMixKey key $ +    withCache (ExpDur durE) getMixKey saveMixKey key $         saveMixInstr (mixArityFun evts) =<< (toEventList evts')     where evts' = toCsdEventList $ evts toArg @@ -126,7 +126,7 @@         saveMixInstr_ =<< toEventList a'     where a' = toCsdEventList a --- | Imitates a closure for a bunch of procedures to be played within another instrument. +-- | Imitates a closure for a bunch of procedures to be played within another instrument. mixBy_ :: (Arg a) => (a -> Sco (Mix Unit)) -> (a -> SE ()) mixBy_ evts args = mix_ $ evts args @@ -136,7 +136,7 @@ mixKey = liftIO . fmap (MixKey . hashStableName) . makeStableName  toEventList :: Sco (Mix a) -> GE (CsdEventList M)-toEventList evts = fmap delayAndRescaleCsdEventListM $ traverse unMix $ evts    +toEventList evts = fmap delayAndRescaleCsdEventListM $ traverse unMix $ evts  mixArity :: Sigs b => f (Mix b) -> Int mixArity = tupleArity . proxy

@@ -1,12 +1,12 @@--- | Open sound control +-- | Open sound control {-# Language ScopedTypeVariables #-} module Csound.Typed.Control.Osc(-    OscRef, OscHost, OscPort, OscAddress, OscType, +    OscRef, OscHost, OscPort, OscAddress, OscType,     initOsc, listenOsc, sendOsc,     OscVal, listenOscVal ) where -import Data.Boolean ((==*))+import Data.Boolean (ifB, (==*)) import Csound.Dynamic(Rate(..))  import Csound.Typed.Types@@ -24,10 +24,10 @@ -- | Path-like string ("/foo/bar/baz") type OscAddress = String - --- | The string specifies the type of expected arguments. --- The string can contain the characters "bcdfilmst" which stand for --- Boolean, character, double, float, 32-bit integer, 64-bit integer, MIDI, ++-- | The string specifies the type of expected arguments.+-- The string can contain the characters "bcdfilmst" which stand for+-- Boolean, character, double, float, 32-bit integer, 64-bit integer, MIDI, -- string and timestamp. type OscType = String @@ -44,9 +44,9 @@ -- -- > /foo/bar/baz ----- The latter specifies the type of expected arguments. --- The string can contain the characters "bcdfilmst" which stand for --- Boolean, character, double, float, 32-bit integer, 64-bit integer, MIDI, +-- The latter specifies the type of expected arguments.+-- The string can contain the characters "bcdfilmst" which stand for+-- Boolean, character, double, float, 32-bit integer, 64-bit integer, MIDI, -- string and timestamp. -- -- The result is an event of messages. We can run a callback on it@@ -54,7 +54,7 @@ -- -- > runEvt :: Evt a -> (a -> SE ()) -> SE () listenOsc :: forall a . Tuple a => OscRef -> OscAddress -> OscType -> Evt a-listenOsc oscRef oscAddr oscType = Evt $ \bam -> do    +listenOsc oscRef oscAddr oscType = Evt $ \bam -> do     resRef <- initOscRef oscType     cond <- listen resRef     when1 cond $ bam =<< readRef resRef@@ -63,12 +63,12 @@         listen ref = fmap (==* 1) $ csdOscListen ref oscRef oscAddr oscType          csdOscListen :: Tuple a => Ref a -> OscRef -> OscAddress -> OscType -> SE Sig-        csdOscListen (Ref refVars) oscHandle addr ty =             -            fmap fromGE $ fromDep $ hideGEinDep $ do                 +        csdOscListen (Ref refVars) oscHandle addr ty =+            fmap fromGE $ fromDep $ hideGEinDep $ do                 expOscHandle <- toGE $ unOscRef oscHandle                 expAddr <- toGE $ text addr                 expOscType <- toGE $ text ty-                return $ C.oscListen expOscHandle expAddr expOscType refVars            +                return $ C.oscListen expOscHandle expAddr expOscType refVars          initOscRef :: OscType -> SE (Ref a)         initOscRef typeStr = fmap Ref $ newLocalVars (fmap getOscRate typeStr) (fromTuple $ (defTuple :: a))@@ -81,22 +81,32 @@             'f' -> Kr             _   -> Kr --- | Sends OSC-messages. It takes in a name of the host computer --- (empty string is alocal machine), port on which the target +-- | Sends OSC-messages. It takes in a name of the host computer+-- (empty string is alocal machine), port on which the target -- machine is listening, OSC-addres and type. The last argument -- produces the values for OSC-messages. sendOsc :: forall a . Tuple a => OscHost -> OscPort -> OscAddress -> OscType -> Evt a -> SE ()-sendOsc host port addr ty evts = runEvt evts send-    where -        send :: Tuple a => a -> SE ()-        send as = SE $ hideGEinDep $ do+sendOsc host port addr ty evts = do+    flagRef <- newRef (0 :: Sig)+    valRef  <- newRef defTuple+    runEvt evts $ \a -> do+        flag <- readRef flagRef+        writeRef flagRef (flag + 1)+        writeRef valRef  a++    flag <- readRef flagRef+    value <- readRef valRef+    send flag value+    where+        send :: Tuple a => Sig -> a -> SE ()+        send trig as = SE $ hideGEinDep $ do             args <- fromTuple as+            expTrig <- toGE trig             expHost <- toGE $ text $ host             expPort <- toGE $ int  $ port             expAddr <- toGE $ text $ addr             expTy   <- toGE $ text $ ty-            return $ C.oscSend $ 1 : expHost : expPort : expAddr : expTy : args-+            return $ C.oscSend $ expTrig : expHost : expPort : expAddr : expTy : args  class Tuple a => OscVal a where     getOscTypes :: a -> String@@ -146,7 +156,7 @@  -- | Listens for tuples of continuous signals read from OSC-channel. ----- > listenOscVal ref address initValue +-- > listenOscVal ref address initValue listenOscVal :: (Tuple a, OscVal a) => OscRef -> String -> a -> SE a listenOscVal port path initVal = do     ref <- getOscRef initVal

@@ -17,8 +17,8 @@     -- * Midi     MidiType(..), Channel, MidiMap, MidiKey(..), saveMidiInstr,     -- * Global variables-    Globals(..), newPersistentGlobalVar, newClearableGlobalVar,  -    newPersistentGloabalArrVar,   +    Globals(..), newPersistentGlobalVar, newClearableGlobalVar,+    newPersistentGloabalArrVar,     renderGlobals,     -- * Instruments     Instrs(..), saveInstr, getInstrIds, -- newInstrId, saveInstrById, saveInstr, CacheName, makeCacheName, saveCachedInstr, getInstrIds,@@ -36,12 +36,12 @@     -- * Udo plugins     UdoPlugin, addUdoPlugin, getUdoPluginNames,     tabQueuePlugin, tabQueue2Plugin,-    zdfPlugin, solinaChorusPlugin, audaciouseqPlugin, adsr140Plugin, +    zdfPlugin, solinaChorusPlugin, audaciouseqPlugin, adsr140Plugin,     diodePlugin, korg35Plugin, zeroDelayConvolutionPlugin,     pitchShifterDelayPlugin,     analogDelayPlugin, distortionPlugin, envelopeFolollowerPlugin, flangerPlugin, freqShifterPlugin,-    loFiPlugin, panTremPlugin, monoTremPlugin, phaserPlugin, pitchShifterPlugin, reversePlugin, -    ringModulatorPlugin, stChorusPlugin, stereoPingPongDelayPlugin,    +    loFiPlugin, panTremPlugin, monoTremPlugin, phaserPlugin, pitchShifterPlugin, reversePlugin,+    ringModulatorPlugin, stChorusPlugin, stereoPingPongDelayPlugin,     delay1kPlugin, ) where @@ -64,26 +64,26 @@  data IdMap a = IdMap     { idMapContent :: M.Map a Int-    , idMapNewId   :: Int +    , idMapNewId   :: Int     } deriving (Eq, Ord) -instance Default (IdMap a) where   +instance Default (IdMap a) where     def = IdMap def 1  saveId :: Ord a => a -> State (IdMap a) Int-saveId a = state $ \s -> +saveId a = state $ \s ->     case M.lookup a (idMapContent s) of-        Nothing -> +        Nothing ->             let newId = idMapNewId s                 s1    = s{ idMapContent = M.insert a newId (idMapContent s)-                         , idMapNewId = succ newId }    +                         , idMapNewId = succ newId }             in  (newId, s1)         Just n  -> (n, s)  newIdMapId :: State (IdMap a) Int-newIdMapId = state $ \s -> +newIdMapId = state $ \s ->     let newId = idMapNewId s-        s1 = s { idMapNewId = succ newId } +        s1 = s { idMapNewId = succ newId }     in  (newId, s1)  -- gens@@ -98,19 +98,19 @@     where intTab ns = Gen (length ns) (IntGenId (-2)) (fmap fromIntegral ns) Nothing  saveGenId :: Ord a => a -> State (IdMap a) Int-saveGenId a = state $ \s -> +saveGenId a = state $ \s ->     case M.lookup a (idMapContent s) of-        Nothing -> +        Nothing ->             let newId = nextReadOnlyTableId $ idMapNewId s                 s1    = s{ idMapContent = M.insert a newId (idMapContent s)-                         , idMapNewId = nextReadOnlyTableId newId }    +                         , idMapNewId = nextReadOnlyTableId newId }             in  (newId, s1)         Just n  -> (n, s)  newGenId :: State GenMap Int-newGenId = state $ \s -> +newGenId = state $ \s ->     let newId = idMapNewId s-        s1 = s { idMapNewId = nextReadOnlyTableId newId } +        s1 = s { idMapNewId = nextReadOnlyTableId newId }     in  (newId, s1)  -- writeable gens@@ -121,24 +121,24 @@ newWriteGen = fmap int . saveWriteGenId  newWriteTab :: Int -> State WriteGenMap E-newWriteTab = newWriteGen . fromSize +newWriteTab = newWriteGen . fromSize     where fromSize n = Gen n (IntGenId 2) (replicate n 0) Nothing  saveWriteGenId :: Gen -> State WriteGenMap Int saveWriteGenId a = state $ \s -> case s of     []         -> (initId, [(initId, a)])-    (i,_):_    ->   let newId = nextWriteTableId i +    (i,_):_    ->   let newId = nextWriteTableId i                     in (newId, (newId, a) : s)-    where +    where         initId = tableWriteStep  tableWriteStep :: Int tableWriteStep = 10  nextReadOnlyTableId :: Int -> Int-nextReadOnlyTableId x +nextReadOnlyTableId x     | y `mod` tableWriteStep == 0 = y + 1-    | otherwise                   = y  +    | otherwise                   = y     where y = x + 1  nextWriteTableId :: Int -> Int@@ -158,14 +158,14 @@  -- sf -data SfFluid = SfFluid +data SfFluid = SfFluid     { sfId   :: Int     , sfVars :: [Var] }  data SfSpec = SfSpec     { sfName    :: String     , sfBank    :: Int-    , sfProgram :: Int +    , sfProgram :: Int     } deriving (Eq, Ord, Show)  type SfMap = IdMap SfSpec@@ -183,14 +183,14 @@ sfInstrName n = "i_Sf_instr_" ++ show n  renderSf :: Monad m => SfSpec -> Int -> DepT m ()-renderSf (SfSpec name bank prog) n = verbatim $ +renderSf (SfSpec name bank prog) n = verbatim $     engineStr ++ "\n" ++     loadStr   ++ "\n" ++     selectProgStr ++ "\n"-    where +    where         engineStr = engineName ++ " fluidEngine"         loadStr   = insName ++ " fluidLoad \"" ++ name ++ "\", " ++  engineName ++ ", 1"-        selectProgStr = "fluidProgramSelect " ++ engineName ++ ", 1, " ++ insName +        selectProgStr = "fluidProgramSelect " ++ engineName ++ ", 1, " ++ insName             ++ ", " ++ show bank ++ ", " ++ show prog          engineName = sfEngineName n@@ -211,7 +211,7 @@  bandLimitedVar userId = Var GlobalVar Ir ("BandLim" ++ show userId) -data BandLimitedMap = BandLimitedMap +data BandLimitedMap = BandLimitedMap     { simpleBandLimitedMap :: M.Map BandLimited BandLimitedId     , vcoInitMap     :: GenMap     } deriving (Eq, Ord)@@ -229,27 +229,27 @@     UserGen gen     -> userGen gen     where         simpleWave writeId readId = state $ \blMap ->-            if (M.member x (simpleBandLimitedMap blMap)) +            if (M.member x (simpleBandLimitedMap blMap))                 then (SimpleBandLimitedWave readId, blMap)                 else (SimpleBandLimitedWave readId, blMap { simpleBandLimitedMap = M.insert x (SimpleBandLimitedWave writeId) (simpleBandLimitedMap blMap) }) -        userGen gen = state $ \blMap -> +        userGen gen = state $ \blMap ->             let genMap = vcoInitMap blMap                 (newId, genMap1) = runState (saveId gen) genMap-                blMap1 = blMap { vcoInitMap = genMap1 }                    +                blMap1 = blMap { vcoInitMap = genMap1 }             in  (UserBandLimitedWave newId, blMap1)   renderBandLimited :: Monad m => GenMap -> BandLimitedMap -> DepT m ()-renderBandLimited genMap blMap = -    if isEmptyBlMap blMap +renderBandLimited genMap blMap =+    if isEmptyBlMap blMap         then return ()         else render (idMapNewId genMap) (M.toList $ idMapContent $ vcoInitMap blMap) (M.toList $ simpleBandLimitedMap blMap)-    where +    where         isEmptyBlMap m = (M.null $ simpleBandLimitedMap m) && (M.null $ idMapContent $ vcoInitMap m)          render lastGenId gens vcos = do-            writeVar freeVcoVar $ int (lastGenId + length gens + 100)            +            writeVar freeVcoVar $ int (lastGenId + length gens + 100)             mapM_ (renderGen lastGenId) gens             mapM_ renderVco vcos @@ -257,12 +257,12 @@         renderGen lastGenId (gen, genId) = do             renderFtgen lastGenId (gen, genId)             renderVcoGen genId-            renderVcoVarAssignment genId            +            renderVcoVarAssignment genId          freeVcoVar = Var GlobalVar Ir "free_vco"-        ftVar n = Var GlobalVar Ir $ "vco_table_" ++ show n     +        ftVar n = Var GlobalVar Ir $ "vco_table_" ++ show n -        renderFtgen lastGenId (g, n) = writeVar (ftVar n) $ ftgen (int $ lastGenId + n) g       +        renderFtgen lastGenId (g, n) = writeVar (ftVar n) $ ftgen (int $ lastGenId + n) g          renderVcoGen ftId  = do             ft   <- readVar (ftVar ftId)@@ -278,16 +278,16 @@                 writeVar freeVcoVar $ vco2init [int waveId, free]             UserBandLimitedWave   _      -> return () -       + {-             renderFirstVco n (head vcos)-            mapM_ renderTailVco (tail 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@@ -300,7 +300,7 @@         vcoVar = dummyVar         toVcoVar = toDummy -        dummyVar = Var LocalVar Ir "ft" +        dummyVar = Var LocalVar Ir "ft"          toDummy = writeVar dummyVar -}@@ -318,7 +318,7 @@             Nothing    -> 1             Just shape -> readShape shape phasorMaster masterCps -        readShape shapeId phasor freq = tableikt phasor (vco2ft freq (bandLimitedIdToExpr shapeId))            +        readShape shapeId phasor freq = tableikt phasor (vco2ft freq (bandLimitedIdToExpr shapeId))  ---------------------------------------------------------- -- Midi@@ -342,11 +342,11 @@     { globalsNewId  :: Int     , globalsVars   :: [AllocVar] } -data AllocVar = AllocVar -        { allocVarType     :: GlobalVarType +data AllocVar = AllocVar+        { allocVarType     :: GlobalVarType         , allocVar         :: Var         , allocVarInit     :: E }-    | AllocArrVar +    | AllocArrVar         { allocArrVar :: Var         , allocArrVarSizes :: [E] } @@ -359,8 +359,8 @@  newGlobalVar :: GlobalVarType -> Rate -> E -> State Globals Var newGlobalVar ty rate initVal = state $ \s ->-    let newId = globalsNewId s        -        var   = Var GlobalVar rate ('g' : show newId) +    let newId = globalsNewId s+        var   = Var GlobalVar rate ('g' : show newId)         s1    = s { globalsNewId = succ newId                   , globalsVars  = AllocVar ty var initVal : globalsVars s }     in  (var, s1)@@ -374,8 +374,8 @@ newPersistentGloabalArrVar :: Rate -> [E] -> State Globals Var newPersistentGloabalArrVar rate sizes = state $ \s ->     let newId = globalsNewId s-        var   = Var GlobalVar rate ('g' : show newId) -        s1    = s { globalsNewId = succ newId +        var   = Var GlobalVar rate ('g' : show newId)+        s1    = s { globalsNewId = succ newId                   , globalsVars  = AllocArrVar var sizes : globalsVars s }     in (var, s1) @@ -388,7 +388,7 @@         gs = globalsVars a          initAlloc x = case x of-            AllocVar _  var init  -> initVar var init +            AllocVar _  var init  -> initVar var init             AllocArrVar var sizes -> initArr var sizes          clearAlloc x = case x of@@ -419,11 +419,11 @@   saveInstr :: InstrBody -> State Instrs InstrId-saveInstr body = state $ \s -> +saveInstr body = state $ \s ->     let h = hash body     in  case IM.lookup h $ instrsCache s of             Just  n -> (n, s)-            Nothing -> +            Nothing ->                 let newId = instrsNewId s                     s1    = s { instrsCache   = IM.insert h (intInstrId newId) $ instrsCache s                               , instrsNewId   = succ newId@@ -431,11 +431,11 @@                 in  (intInstrId newId, s1)  {--saveCachedInstr :: InstrBody -> State Instrs InstrId -saveCachedInstr name body = state $ \s -> +saveCachedInstr :: InstrBody -> State Instrs InstrId+saveCachedInstr name body = state $ \s ->     case IM.lookup name $ instrsCache s of         Just n  -> (n, s)-        Nothing -> +        Nothing ->             let newId   = instrsNewId s                 s1      = s { instrsCache   = IM.insert name (intInstrId newId) $ instrsCache s                             , instrsNewId   = succ newId@@ -445,11 +445,11 @@ newInstrId :: State Instrs InstrId newInstrId = state $ \s ->     let newId   = instrsNewId s-        s1      = s { instrsNewId = succ newId }    +        s1      = s { instrsNewId = succ newId }     in  (intInstrId newId, s1)  saveInstrById :: InstrId -> InstrBody -> State Instrs ()-saveInstrById instrId body = state $ \s -> +saveInstrById instrId body = state $ \s ->     let s1 = s { instrsContent = (instrId, body) : instrsContent s }     in  ((), s1) @@ -477,20 +477,10 @@ getIn :: Monad m => Int -> DepT m [E] getIn arity     | arity == 0    = return []-    | otherwise     = ($ arity ) $ mdepT $ mopcs name (replicate arity Ar, []) []-    where-        name-            | arity == 1 = "in"-            | arity == 2 = "ins"-            | arity == 4 = "inq"-            | arity == 6 = "inh"-            | arity == 8 = "ino"-            | arity == 16 = "inx"-            | arity == 32 = "in32"-            | otherwise = "ins"+    | otherwise     = ($ arity ) $ mdepT $ mopcs "inch" (replicate arity Ar, replicate arity Kr) (fmap int [1 .. arity])  sendOut :: Monad m => Int -> [E] -> DepT m ()-sendOut arity sigs +sendOut arity sigs     | arity == 0    = return ()     | otherwise     = do         vars <- newLocalVars (replicate arity Ar) (return $ replicate arity 0)@@ -498,7 +488,7 @@         vals <- mapM readVar vars         depT_ $ opcsNoInlineArgs name [(Xr, replicate arity Ar)] vals     where-        name            +        name             | arity == 1 = "out"             | arity == 2 = "outs"             | arity == 4 = "outq"@@ -537,7 +527,7 @@         Just a  -> (a, st)         Nothing -> onNothing port m globals     where-        onNothing port m globals = (var, (OscListenPorts m1, newGlobals)) +        onNothing port m globals = (var, (OscListenPorts m1, newGlobals))             where                 (var, newGlobals) = runState (allocOscPortVar port) globals                 m1 = IM.insert port var m@@ -551,17 +541,17 @@  type MacrosInits = M.Map String MacrosInit -data MacrosInit +data MacrosInit     = MacrosInitDouble { macrosInitName :: String, macrosInitValueDouble :: Double }     | MacrosInitString { macrosInitName :: String, macrosInitValueString :: String }     | MacrosInitInt    { macrosInitName :: String, macrosInitValueInt    :: Int  }     deriving (Show, Eq, Ord)  initMacros :: MacrosInit -> State MacrosInits ()-initMacros macrosInit = modify $ \xs -> M.insert (macrosInitName macrosInit)  macrosInit xs +initMacros macrosInit = modify $ \xs -> M.insert (macrosInitName macrosInit)  macrosInit xs  ----------------------------------------------------------- Udo plugins +-- Udo plugins  newtype UdoPlugin  = UdoPlugin { unUdoPlugin :: String } 

@@ -1,6 +1,6 @@ {-# Language TypeFamilies, FlexibleContexts #-} module Csound.Typed.Types.Evt(-    Evt(..), Bam, sync, +    Evt(..), Bam, sync,     boolToEvt, evtToBool, sigToEvt, stepper,     filterE, filterSE, accumSE, accumE, filterAccumE, filterAccumSE,     Snap, snapshot, snaps, readSnap@@ -26,12 +26,12 @@ type Bam a = a -> SE ()  instance Functor Evt where-    fmap f a = Evt $ \bam -> runEvt a (bam . f) +    fmap f a = Evt $ \bam -> runEvt a (bam . f)  instance Monoid (Evt a) where     mempty = Evt $ const $ return ()     mappend a b = Evt $ \bam -> runEvt a bam >> runEvt b bam-    + -- | Converts booleans to events. boolToEvt :: BoolSig -> Evt Unit boolToEvt b = Evt $ \bam -> when1 b $ bam unit@@ -49,7 +49,7 @@ filterSE :: (a -> SE BoolD) -> Evt a -> Evt a filterSE mpr evt = Evt $ \bam -> runEvt evt $ \a -> do     pr <- mpr a-    when1 (boolSig pr) $ bam a    +    when1 (boolSig pr) $ bam a  -- | Accumulator for events with side effects. accumSE :: (Tuple s) => s -> (a -> s -> SE (b, s)) -> Evt a -> Evt b@@ -84,7 +84,7 @@  -- | Get values of some signal at the given events. snapshot :: (Tuple a, Tuple (Snap a)) => (Snap a -> b -> c) -> a -> Evt b -> Evt c-snapshot f asig evt = Evt $ \bam -> runEvt evt $ \a -> +snapshot f asig evt = Evt $ \bam -> runEvt evt $ \a ->     bam (f (readSnap asig) a)  readSnap :: (Tuple (Snap a), Tuple a) => a -> Snap a@@ -94,13 +94,13 @@ -- given signal. Events happens only when the signal changes. snaps :: Sig -> Evt D snaps asig = snapshot const asig trigger-    where +    where         trigger = sigToEvt $ fromGE $ fmap C.changed $ toGE asig  ---------------------------------------------------------------------- snap +-- snap --- | A snapshot of the signal. It converts a type of the signal to the +-- | A snapshot of the signal. It converts a type of the signal to the -- type of the value in the given moment. Instances: -- --@@ -109,7 +109,7 @@ -- > type instance Snap Tab = Tab -- > -- > type instance Snap Sig = D--- > +-- > -- > type instance Snap (a, b) = (Snap a, Snap b) -- > type instance Snap (a, b, c) = (Snap a, Snap b, Snap c) -- > type instance Snap (a, b, c, d) = (Snap a, Snap b, Snap c, Snap d)@@ -130,7 +130,7 @@ type instance Snap (a, b, c, d, e, f) = (Snap a, Snap b, Snap c, Snap d, Snap e, Snap f)  -- | Converts an event to boolean signal. It forgets--- everything about the event values. Signal equals to one when +-- everything about the event values. Signal equals to one when -- an event happens and zero otherwise. evtToBool :: Evt a -> SE BoolSig evtToBool evt = do@@ -151,25 +151,25 @@ -- synchronization  -- | Executes actions synchronized with global tempo (in Hz).--- +-- -- > runEvtSync tempoCps evt proc sync :: (Default a, Tuple a) => Sig -> Evt a -> Evt a-sync dt evt = Evt $ \bam -> do    +sync dt evt = Evt $ \bam -> do     refVal     <- newRef def     refFire    <- newRef (0 :: D)      runEvt evt $ \a -> do         writeRef refVal  a-        writeRef refFire 1     -    +        writeRef refFire 1+     fire    <- readRef refFire     when1 (metro dt  ==* 1 &&* sig fire ==* 1) $ do         val <- readRef refVal         bam val-        writeRef refFire 0   +        writeRef refFire 0     where         metro :: Sig -> Sig         metro asig = fromGE $ fmap C.metro $ toGE asig -       + 

@@ -3,17 +3,18 @@     Sig(..), unSig, D(..), unD, Tab(..), unTab, Str(..), Spec(..), Wspec(..), renderTab,     BoolSig(..), unBoolSig, BoolD(..), unBoolD, Unit(..), unit, Val(..), hideGE, SigOrD,     Sig2, Sig3, Sig4, Sig5, Sig6, Sig7, Sig8,+    Sig2_2, Sig2_3, Sig2_4, Sig2_5, Sig2_6, Sig2_7, Sig2_8,     D2, D3, D4, D5, D6,      -- ** Tables     preTab, preStringTab, TabSize(..), TabArgs(..), updateTabSize,     fromPreTab, getPreTabUnsafe, skipNorm, forceNorm,     nsamp, ftlen, ftchnls, ftsr, ftcps,-    TabList, tabList, fromTabList, fromTabListD,   +    TabList, tabList, fromTabList, fromTabListD,      -- ** constructors-    double, int, text, -    +    double, int, text,+     -- ** constants     idur, getSampleRate, getControlRate, getBlockSize, getZeroDbfs, @@ -25,11 +26,13 @@      -- ** numeric funs     quot', rem', div', mod', ceil', floor', round', int', frac',-   +     -- ** logic funs     when1, whens, untilDo, whileDo, boolSig,     equalsTo, notEqualsTo, lessThan, greaterThan, lessThanEquals, greaterThanEquals,-    whenD1, whenDs, untilDoD, whileDoD, untilBeginD+    whenD1, whenDs, untilDoD, whileDoD, untilBeginD,++    module Data.NumInstances.Tuple ) where  import Prelude hiding ((<*))@@ -41,6 +44,8 @@ import qualified Data.IntMap    as IM import qualified Data.Map       as M +import Data.NumInstances.Tuple+ import Control.Monad.Trans.Reader  import Data.Default@@ -54,7 +59,7 @@ import Csound.Typed.GlobalState.Opcodes(tableK, tableI)  -- | Signals-data Sig  +data Sig     = Sig  (GE E)     | PrimSig Double @@ -62,7 +67,7 @@ unSig = toGE  -- | Constant numbers-data D    +data D     = D  (GE E)     | PrimD Double @@ -92,10 +97,18 @@ type Sig7 = (Sig, Sig, Sig, Sig, Sig, Sig, Sig) type Sig8 = (Sig, Sig, Sig, Sig, Sig, Sig, Sig, Sig) +type Sig2_2 = (Sig2, Sig2)+type Sig2_3 = (Sig2, Sig2, Sig2)+type Sig2_4 = (Sig2, Sig2, Sig2, Sig2)+type Sig2_5 = (Sig2, Sig2, Sig2, Sig2, Sig2)+type Sig2_6 = (Sig2, Sig2, Sig2, Sig2, Sig2, Sig2)+type Sig2_7 = (Sig2, Sig2, Sig2, Sig2, Sig2, Sig2, Sig2)+type Sig2_8 = (Sig2, Sig2, Sig2, Sig2, Sig2, Sig2, Sig2, Sig2)+ -- Booleans  -- | A signal of booleans.-data BoolSig +data BoolSig     = BoolSig (GE E)     | PrimBoolSig Bool @@ -103,7 +116,7 @@ unBoolSig = toGE  -- | A constant boolean value.-data BoolD   +data BoolD     = BoolD (GE E)     | PrimBoolD Bool @@ -120,7 +133,7 @@ -- Procedures  -- | Csound's empty tuple.-newtype Unit = Unit { unUnit :: GE () } +newtype Unit = Unit { unUnit :: GE () }  -- | Constructs Csound's empty tuple. unit :: Unit@@ -136,7 +149,7 @@ -- tables  -- | Tables (or arrays)-data Tab  +data Tab     = Tab (GE E)     | TabPre PreTab @@ -152,11 +165,11 @@     , preTabArgs    :: TabArgs }  -- Table size.-data TabSize +data TabSize     -- Size is fixed by the user.     = SizePlain Int     -- Size is relative to the renderer settings.-    | SizeDegree +    | SizeDegree     { hasGuardPoint :: Bool     , sizeDegree    :: Int      -- is the power of two     }@@ -165,9 +178,9 @@     def = SizeDegree         { hasGuardPoint = False         , sizeDegree = 0 }-    + -- Table arguments can be-data TabArgs +data TabArgs     -- absolute     = ArgsPlain (Reader Int [Double]) {-    -- or relative to the table size (used for tables that implement interpolation)@@ -177,7 +190,7 @@     | FileAccess String [Double]  renderPreTab :: PreTab -> GE E-renderPreTab a = (fmap D.int . saveGen) =<< fromPreTab a +renderPreTab a = (fmap D.int . saveGen) =<< fromPreTab a  getPreTabUnsafe :: String -> Tab -> PreTab getPreTabUnsafe msg x = case x of@@ -200,20 +213,20 @@ defineTabSize :: Int -> TabSize -> Int defineTabSize base x = case x of        SizePlain n -> n-       SizeDegree guardPoint degree ->          +       SizeDegree guardPoint degree ->                 byGuardPoint guardPoint $                 byDegree base degree-    where byGuardPoint guardPoint +    where byGuardPoint guardPoint             | guardPoint = (+ 1)             | otherwise  = id-            -          byDegree zero n = 2 ^ max 0 (zero + n)  +          byDegree zero n = 2 ^ max 0 (zero + n)+ defineTabArgs :: Int -> TabArgs -> ([Double], Maybe String) defineTabArgs size args = case args of     ArgsPlain as -> (runReader as size, Nothing)     FileAccess filename as -> (as, Just filename)-          + -- | Skips normalization (sets table size to negative value) skipNorm :: Tab -> Tab skipNorm x = case x of@@ -247,12 +260,12 @@ ---------------------------------------------------------------------------- -- Tab of tabs --- | Container list of tables +-- | Container list of tables data TabList = TabList { unTabList :: GE E }  tabList :: [Tab] -> TabList tabList xs = TabList $ saveTabs =<< mapM fromPreTab (getPreTabs xs)-    where +    where         getPreTabs xs = case xs of             []            -> []             Tab    _ : as -> getPreTabs as@@ -289,7 +302,7 @@ -- constants  -- | Querries a total duration of the note. It's equivallent to Csound's @p3@ field.-idur :: D +idur :: D idur = fromE $ pn 3  getSampleRate :: D@@ -337,14 +350,14 @@ hideGE :: Val a => GE a -> a hideGE = fromGE . join . fmap toGE -instance Val Sig    where -    fromGE = Sig    -    +instance Val Sig    where+    fromGE = Sig+     toGE x = case x of         Sig a       -> a         PrimSig d   -> return $ D.double d -instance Val D      where +instance Val D      where     fromGE  = D     toGE x  = case x of         D a     -> a@@ -356,8 +369,8 @@  instance Val TabList where { fromGE = TabList; toGE = unTabList } -instance Val Tab where -    fromGE = Tab +instance Val Tab where+    fromGE = Tab     toGE = unTab  unTab :: Tab -> GE E@@ -370,13 +383,13 @@     TabPre a -> saveGen =<< fromPreTab a     Tab _    -> error "table should be primitive" -instance Val BoolSig where -    fromGE = BoolSig +instance Val BoolSig where+    fromGE = BoolSig     toGE x = case x of         BoolSig a -> a         PrimBoolSig b -> return $ if b then true else false -instance Val BoolD   where +instance Val BoolD   where     fromGE = BoolD     toGE x = case x of         BoolD a -> a@@ -415,7 +428,7 @@ instance Default D      where def = 0 instance Default Tab    where def = fromE 0 instance Default Str    where def = text ""-instance Default Spec   where def = fromE 0 +instance Default Spec   where def = fromE 0  instance Default TabList where def = fromE 0 @@ -439,7 +452,7 @@     _                      -> on2 exprFun xa xb  -instance Num Sig where +instance Num Sig where     { (+) = sigOn2 (+) (+); (*) = sigOn2 (*) (*); negate = sigOn1 negate negate     ; (-) = sigOn2 (\a b -> a - b) (\a b -> a - b)     ; fromInteger = PrimSig . fromInteger; abs = sigOn1 abs abs; signum = sigOn1 signum signum }@@ -454,7 +467,7 @@     (PrimD a, PrimD b) -> PrimD $ numFun a b     _                      -> on2 exprFun xa xb -instance Num D where +instance Num D where     { (+) = dOn2 (+) (+); (*) = dOn2 (*) (*); negate = dOn1 negate negate     ; (-) = dOn2 (\a b -> a - b) (\a b -> a - b)     ; fromInteger = PrimD . fromInteger; abs = dOn1 abs abs; signum = dOn1 signum signum }@@ -479,7 +492,7 @@  instance IsPrim Sig where     type PrimOf Sig = Double-    +     getPrim x = case x of         PrimSig a -> Just a         _         -> Nothing@@ -488,7 +501,7 @@  instance IsPrim D where     type PrimOf D = Double-    +     getPrim x = case x of         PrimD a -> Just a         _         -> Nothing@@ -497,7 +510,7 @@  instance IsPrim BoolSig where     type PrimOf BoolSig = Bool-    +     getPrim x = case x of         PrimBoolSig a -> Just a         _         -> Nothing@@ -506,7 +519,7 @@  instance IsPrim BoolD where     type PrimOf BoolD = Bool-    +     getPrim x = case x of         PrimBoolD a -> Just a         _         -> Nothing@@ -528,8 +541,8 @@ int' = op1 (\x -> fromIntegral ((truncate x) :: Int)) intE round' = op1 (\x -> fromIntegral ((round x) :: Int)) roundE quot' = op2 (\a b -> fromIntegral $ quot ((truncate a) :: Int) ((truncate b):: Int)) quot-rem' = op2 (\a b -> fromIntegral $ rem ((truncate a) :: Int) ((truncate b):: Int)) rem  -div' = op2 (\a b -> fromIntegral $ div ((truncate a) :: Int) ((truncate b):: Int)) div   +rem' = op2 (\a b -> fromIntegral $ rem ((truncate a) :: Int) ((truncate b):: Int)) rem+div' = op2 (\a b -> fromIntegral $ div ((truncate a) :: Int) ((truncate b):: Int)) div mod' = op2 (\a b -> fromIntegral $ mod ((truncate a) :: Int) ((truncate b):: Int)) mod  -------------------------------------------------------------------------------@@ -539,38 +552,38 @@ boolSigOn1 = op1  boolSigOn2 :: (Bool -> Bool -> Bool) -> (E -> E -> E) -> BoolSig -> BoolSig -> BoolSig-boolSigOn2 = op2 +boolSigOn2 = op2  boolDOn1 :: (Bool -> Bool) -> (E -> E) -> BoolD -> BoolD boolDOn1 = op1  boolDOn2 :: (Bool -> Bool -> Bool) -> (E -> E -> E) -> BoolD -> BoolD -> BoolD-boolDOn2 = op2 +boolDOn2 = op2  instance Boolean BoolSig  where { true = PrimBoolSig True;  false = PrimBoolSig False;  notB = boolSigOn1 not notB;  (&&*) = boolSigOn2 (&&) (&&*);  (||*) = boolSigOn2 (||) (||*) } instance Boolean BoolD    where { true = PrimBoolD   True;  false = PrimBoolD   False;  notB = boolDOn1   not notB;  (&&*) = boolDOn2   (&&) (&&*);  (||*) = boolDOn2   (||) (||*) } -instance IfB Sig  where +instance IfB Sig  where     ifB x a b = case x of         PrimBoolSig cond -> if cond then a else b         _                -> on3 ifB x a b -instance IfB D    where +instance IfB D    where     ifB x a b = case x of         PrimBoolD cond -> if cond then a else b         _              -> on3 ifB x a b -instance IfB Tab  where +instance IfB Tab  where     ifB x a b = case x of         PrimBoolD cond -> if cond then a else b         _              -> on3 ifB x a b -instance IfB Str  where +instance IfB Str  where     ifB x a b = case x of         PrimBoolD cond -> if cond then a else b         _              -> on3 ifB x a b -instance IfB Spec where +instance IfB Spec where     ifB x a b = case x of         PrimBoolD cond -> if cond then a else b         _              -> on3 ifB x a b@@ -599,7 +612,7 @@         ifBegin (fst a)         snd a         elseIfs as-        elseBegin +        elseBegin         el         foldl1 (>>) $ replicate (length bodies) ifEnd     where elseIfs = mapM_ (\(p, body) -> elseBegin >> ifBegin p >> body)@@ -631,7 +644,7 @@         ifBeginD (fst a)         snd a         elseIfs as-        elseBegin +        elseBegin         el         foldl1 (>>) $ replicate (length bodies) ifEnd     where elseIfs = mapM_ (\(p, body) -> elseBegin >> ifBeginD p >> body)@@ -699,7 +712,7 @@ notEqualsTo = (/=*)  lessThan :: OrdB a => a -> a -> BooleanOf a-lessThan = (<*) +lessThan = (<*)  greaterThan :: OrdB a => a -> a -> BooleanOf a greaterThan = (>*)@@ -740,85 +753,7 @@ ------------------------------------------------- -- numeric instances -instance Num Sig2 where-    (a1, a2) + (b1, b2) = (a1 + b1, a2 + b2)-    (a1, a2) * (b1, b2) = (a1 * b1, a2 * b2)-    negate (a1, a2) = (negate a1, negate a2)--    fromInteger n = (fromInteger n, fromInteger n)-    signum (a1, a2) = (signum a1, signum a2)-    abs (a1, a2) = (abs a1, abs a2)--instance Fractional Sig2 where-    recip (a1, a2) = (recip a1, recip a2)-    fromRational n = (fromRational n, fromRational n)--instance Num Sig3 where-    (a1, a2, a3) + (b1, b2, b3) = (a1 + b1, a2 + b2, a3 + b3)-    (a1, a2, a3) * (b1, b2, b3) = (a1 * b1, a2 * b2, a3 * b3)-    negate (a1, a2, a3) = (negate a1, negate a2, negate a3)--    fromInteger n = (fromInteger n, fromInteger n, fromInteger n)-    signum (a1, a2, a3) = (signum a1, signum a2, signum a3)-    abs (a1, a2, a3) = (abs a1, abs a2, abs a3)--instance Fractional Sig3 where-    recip (a1, a2, a3) = (recip a1, recip a2, recip a3)-    fromRational n = (fromRational n, fromRational n, fromRational n)--instance Num Sig4 where-    (a1, a2, a3, a4) + (b1, b2, b3, b4) = (a1 + b1, a2 + b2, a3 + b3, a4 + b4)-    (a1, a2, a3, a4) * (b1, b2, b3, b4) = (a1 * b1, a2 * b2, a3 * b3, a4 * b4)-    negate (a1, a2, a3, a4) = (negate a1, negate a2, negate a3, negate a4)--    fromInteger n = (fromInteger n, fromInteger n, fromInteger n, fromInteger n)-    signum (a1, a2, a3, a4) = (signum a1, signum a2, signum a3, signum a4)-    abs (a1, a2, a3, a4) = (abs a1, abs a2, abs a3, abs a4)--instance Fractional Sig4 where-    recip (a1, a2, a3, a4) = (recip a1, recip a2, recip a3, recip a4)-    fromRational n = (fromRational n, fromRational n, fromRational n, fromRational n)--instance Num Sig5 where-    (a1, a2, a3, a4, a5) + (b1, b2, b3, b4, b5) = (a1 + b1, a2 + b2, a3 + b3, a4 + b4, a5 + b5)-    (a1, a2, a3, a4, a5) * (b1, b2, b3, b4, b5) = (a1 * b1, a2 * b2, a3 * b3, a4 * b4, a5 * b5)-    negate (a1, a2, a3, a4, a5) = (negate a1, negate a2, negate a3, negate a4, negate a5)--    fromInteger n = (fromInteger n, fromInteger n, fromInteger n, fromInteger n, fromInteger n)-    signum (a1, a2, a3, a4, a5) = (signum a1, signum a2, signum a3, signum a4, signum a5)-    abs (a1, a2, a3, a4, a5) = (abs a1, abs a2, abs a3, abs a4, abs a5)--instance Fractional Sig5 where-    recip (a1, a2, a3, a4, a5) = (recip a1, recip a2, recip a3, recip a4, recip a5)-    fromRational n = (fromRational n, fromRational n, fromRational n, fromRational n, fromRational n)--instance Num Sig6 where-    (a1, a2, a3, a4, a5, a6) + (b1, b2, b3, b4, b5, b6) = (a1 + b1, a2 + b2, a3 + b3, a4 + b4, a5 + b5, a6 + b6)-    (a1, a2, a3, a4, a5, a6) * (b1, b2, b3, b4, b5, b6) = (a1 * b1, a2 * b2, a3 * b3, a4 * b4, a5 * b5, a6 * b6)-    negate (a1, a2, a3, a4, a5, a6) = (negate a1, negate a2, negate a3, negate a4, negate a5, negate a6)--    fromInteger n = (fromInteger n, fromInteger n, fromInteger n, fromInteger n, fromInteger n, fromInteger n)-    signum (a1, a2, a3, a4, a5, a6) = (signum a1, signum a2, signum a3, signum a4, signum a5, signum a6)-    abs (a1, a2, a3, a4, a5, a6) = (abs a1, abs a2, abs a3, abs a4, abs a5, abs a6)--instance Fractional Sig6 where-    recip (a1, a2, a3, a4, a5, a6) = (recip a1, recip a2, recip a3, recip a4, recip a5, recip a6)-    fromRational n = (fromRational n, fromRational n, fromRational n, fromRational n, fromRational n, fromRational n)--instance Num Sig7 where-    (a1, a2, a3, a4, a5, a6, a7) + (b1, b2, b3, b4, b5, b6, b7) = (a1 + b1, a2 + b2, a3 + b3, a4 + b4, a5 + b5, a6 + b6, a7 + b7)-    (a1, a2, a3, a4, a5, a6, a7) * (b1, b2, b3, b4, b5, b6, b7) = (a1 * b1, a2 * b2, a3 * b3, a4 * b4, a5 * b5, a6 * b6, a7 * b7)-    negate (a1, a2, a3, a4, a5, a6, a7) = (negate a1, negate a2, negate a3, negate a4, negate a5, negate a6, negate a7)--    fromInteger n = (fromInteger n, fromInteger n, fromInteger n, fromInteger n, fromInteger n, fromInteger n, fromInteger n)-    signum (a1, a2, a3, a4, a5, a6, a7) = (signum a1, signum a2, signum a3, signum a4, signum a5, signum a6, signum a7)-    abs (a1, a2, a3, a4, a5, a6, a7) = (abs a1, abs a2, abs a3, abs a4, abs a5, abs a6, abs a7)--instance Fractional Sig7 where-    recip (a1, a2, a3, a4, a5, a6, a7) = (recip a1, recip a2, recip a3, recip a4, recip a5, recip a6, recip a7)-    fromRational n = (fromRational n, fromRational n, fromRational n, fromRational n, fromRational n, fromRational n, fromRational n)--instance Num Sig8 where+instance (Num a1, Num a2, Num a3, Num a4, Num a5, Num a6, Num a7, Num a8) => Num (a1, a2, a3, a4, a5, a6, a7, a8) where     (a1, a2, a3, a4, a5, a6, a7, a8) + (b1, b2, b3, b4, b5, b6, b7, b8) = (a1 + b1, a2 + b2, a3 + b3, a4 + b4, a5 + b5, a6 + b6, a7 + b7, a8 + b8)     (a1, a2, a3, a4, a5, a6, a7, a8) * (b1, b2, b3, b4, b5, b6, b7, b8) = (a1 * b1, a2 * b2, a3 * b3, a4 * b4, a5 * b5, a6 * b6, a7 + b7, a8 + b8)     negate (a1, a2, a3, a4, a5, a6, a7, a8) = (negate a1, negate a2, negate a3, negate a4, negate a5, negate a6, negate a7, negate a8)@@ -827,97 +762,6 @@     signum (a1, a2, a3, a4, a5, a6, a7, a8) = (signum a1, signum a2, signum a3, signum a4, signum a5, signum a6, signum a7, signum a8)     abs (a1, a2, a3, a4, a5, a6, a7, a8) = (abs a1, abs a2, abs a3, abs a4, abs a5, abs a6, abs a7, abs a8) -instance Fractional Sig8 where+instance (Fractional a1, Fractional a2, Fractional a3, Fractional a4, Fractional a5, Fractional a6, Fractional a7, Fractional a8) => Fractional (a1, a2, a3, a4, a5, a6, a7, a8) where     recip (a1, a2, a3, a4, a5, a6, a7, a8) = (recip a1, recip a2, recip a3, recip a4, recip a5, recip a6, recip a7, recip a8)     fromRational n = (fromRational n, fromRational n, fromRational n, fromRational n, fromRational n, fromRational n, fromRational n, fromRational n)--instance Num (Sig8, Sig8) where-    (a1, a2) + (b1, b2) = (a1 + b1, a2 + b2)-    (a1, a2) * (b1, b2) = (a1 * b1, a2 * b2)-    negate (a1, a2) = (negate a1, negate a2)--    fromInteger n = (fromInteger n, fromInteger n)-    signum (a1, a2) = (signum a1, signum a2)-    abs (a1, a2) = (abs a1, abs a2)--instance Fractional (Sig8, Sig8) where-    recip (a1, a2) = (recip a1, recip a2)-    fromRational n = (fromRational n, fromRational n)--instance Num (Sig8, Sig8, Sig8, Sig8) where-    (a1, a2, a3, a4) + (b1, b2, b3, b4) = (a1 + b1, a2 + b2, a3 + b3, a4 + b4)-    (a1, a2, a3, a4) * (b1, b2, b3, b4) = (a1 * b1, a2 * b2, a3 * b3, a4 * b4)-    negate (a1, a2, a3, a4) = (negate a1, negate a2, negate a3, negate a4)--    fromInteger n = (fromInteger n, fromInteger n, fromInteger n, fromInteger n)-    signum (a1, a2, a3, a4) = (signum a1, signum a2, signum a3, signum a4)-    abs (a1, a2, a3, a4) = (abs a1, abs a2, abs a3, abs a4)--instance Fractional (Sig8, Sig8, Sig8, Sig8) where-    recip (a1, a2, a3, a4) = (recip a1, recip a2, recip a3, recip a4)-    fromRational n = (fromRational n, fromRational n, fromRational n, fromRational n)--instance Num (Sig2, Sig2) where-    (a1, a2) + (b1, b2) = (a1 + b1, a2 + b2)-    (a1, a2) * (b1, b2) = (a1 * b1, a2 * b2)-    negate (a1, a2) = (negate a1, negate a2)--    fromInteger n = (fromInteger n, fromInteger n)-    signum (a1, a2) = (signum a1, signum a2)-    abs (a1, a2) = (abs a1, abs a2)--instance Fractional (Sig2, Sig2) where-    recip (a1, a2) = (recip a1, recip a2)-    fromRational n = (fromRational n, fromRational n)--instance Num (Sig2, Sig2, Sig2) where-    (a1, a2, a3) + (b1, b2, b3) = (a1 + b1, a2 + b2, a3 + b3)-    (a1, a2, a3) * (b1, b2, b3) = (a1 * b1, a2 * b2, a3 * b3)-    negate (a1, a2, a3) = (negate a1, negate a2, negate a3)--    fromInteger n = (fromInteger n, fromInteger n, fromInteger n)-    signum (a1, a2, a3) = (signum a1, signum a2, signum a3)-    abs (a1, a2, a3) = (abs a1, abs a2, abs a3)--instance Fractional (Sig2, Sig2, Sig2) where-    recip (a1, a2, a3) = (recip a1, recip a2, recip a3)-    fromRational n = (fromRational n, fromRational n, fromRational n)--instance Num (Sig2, Sig2, Sig2, Sig2) where-    (a1, a2, a3, a4) + (b1, b2, b3, b4) = (a1 + b1, a2 + b2, a3 + b3, a4 + b4)-    (a1, a2, a3, a4) * (b1, b2, b3, b4) = (a1 * b1, a2 * b2, a3 * b3, a4 * b4)-    negate (a1, a2, a3, a4) = (negate a1, negate a2, negate a3, negate a4)--    fromInteger n = (fromInteger n, fromInteger n, fromInteger n, fromInteger n)-    signum (a1, a2, a3, a4) = (signum a1, signum a2, signum a3, signum a4)-    abs (a1, a2, a3, a4) = (abs a1, abs a2, abs a3, abs a4)--instance Fractional (Sig2, Sig2, Sig2, Sig2) where-    recip (a1, a2, a3, a4) = (recip a1, recip a2, recip a3, recip a4)-    fromRational n = (fromRational n, fromRational n, fromRational n, fromRational n)--instance Num (Sig2, Sig2, Sig2, Sig2, Sig2) where-    (a1, a2, a3, a4, a5) + (b1, b2, b3, b4, b5) = (a1 + b1, a2 + b2, a3 + b3, a4 + b4, a5 + b5)-    (a1, a2, a3, a4, a5) * (b1, b2, b3, b4, b5) = (a1 * b1, a2 * b2, a3 * b3, a4 * b4, a5 * b5)-    negate (a1, a2, a3, a4, a5) = (negate a1, negate a2, negate a3, negate a4, negate a5)--    fromInteger n = (fromInteger n, fromInteger n, fromInteger n, fromInteger n, fromInteger n)-    signum (a1, a2, a3, a4, a5) = (signum a1, signum a2, signum a3, signum a4, signum a5)-    abs (a1, a2, a3, a4, a5) = (abs a1, abs a2, abs a3, abs a4, abs a5)--instance Fractional (Sig2, Sig2, Sig2, Sig2, Sig2) where-    recip (a1, a2, a3, a4, a5) = (recip a1, recip a2, recip a3, recip a4, recip a5)-    fromRational n = (fromRational n, fromRational n, fromRational n, fromRational n, fromRational n)--instance Num (Sig2, Sig2, Sig2, Sig2, Sig2, Sig2) where-    (a1, a2, a3, a4, a5, a6) + (b1, b2, b3, b4, b5, b6) = (a1 + b1, a2 + b2, a3 + b3, a4 + b4, a5 + b5, a6 + b6)-    (a1, a2, a3, a4, a5, a6) * (b1, b2, b3, b4, b5, b6) = (a1 * b1, a2 * b2, a3 * b3, a4 * b4, a5 * b5, a6 * b6)-    negate (a1, a2, a3, a4, a5, a6) = (negate a1, negate a2, negate a3, negate a4, negate a5, negate a6)--    fromInteger n = (fromInteger n, fromInteger n, fromInteger n, fromInteger n, fromInteger n, fromInteger n)-    signum (a1, a2, a3, a4, a5, a6) = (signum a1, signum a2, signum a3, signum a4, signum a5, signum a6)-    abs (a1, a2, a3, a4, a5, a6) = (abs a1, abs a2, abs a3, abs a4, abs a5, abs a6)--instance Fractional (Sig2, Sig2, Sig2, Sig2, Sig2, Sig2) where-    recip (a1, a2, a3, a4, a5, a6) = (recip a1, recip a2, recip a3, recip a4, recip a5, recip a6)-    fromRational n = (fromRational n, fromRational n, fromRational n, fromRational n, fromRational n, fromRational n)

@@ -1,11 +1,11 @@ {-# OPTIONS_GHC -fno-warn-orphans #-}-{-# Language -        TypeFamilies, -        MultiParamTypeClasses, -        FlexibleInstances, +{-# Language+        TypeFamilies,+        MultiParamTypeClasses,+        FlexibleInstances,         FlexibleContexts #-} module Csound.Typed.Types.SigSpace(-    SigSpace(..), BindSig(..), mul, mul', on, uon, At(..), MixAt(..), +    SigSpace(..), BindSig(..), mul, mul', on, uon, At(..), MixAt(..),     cfd, genCfds, cfd4, cfds,      -- * Stereo sig-space@@ -53,17 +53,17 @@ -- rescaling  -- | Rescaling of the bipolar signal (-1, 1) -> (a, b)--- +-- -- > on a b biSig on :: SigSpace a => Sig -> Sig -> a -> a-on a b x = uon a b $ mapSig unipolar x +on a b x = uon a b $ mapSig unipolar x     where unipolar a = 0.5 + 0.5 * a  -- | Rescaling of the unipolar signal (0, 1) -> (a, b)--- +-- -- > on a b uniSig uon :: SigSpace a => Sig -> Sig -> a -> a-uon a b = mapSig (\x -> a + (b - a) * x) +uon a b = mapSig (\x -> a + (b - a) * x)  -- | Crossfade. --@@ -72,16 +72,16 @@ -- If coeff equals 0 then we get the first signal and if it equals 1 we get the second signal. cfd :: (Num a, SigSpace a) => Sig -> a -> a -> a cfd coeff a b = (1 - coeff) `mul` a + coeff `mul` b-  + genCfds :: a -> (Sig -> a -> a -> a) -> [Sig] -> [a] -> a genCfds zero mixFun cs xs = case xs of     []   -> zero-    a:as -> foldl (\x f -> f x) a $ zipWith mix' cs as +    a:as -> foldl (\x f -> f x) a $ zipWith mix' cs as     where mix' c a b = mixFun c b a  -- | Bilinear interpolation for four signals. -- The signals are placed in the corners of the unit square.--- The first two signals are the xy coordinates in the square. +-- The first two signals are the xy coordinates in the square. -- -- > cfd4 x y a b c d --@@ -92,9 +92,9 @@ -- * (1, 1) is for c -- -- * (0, 1) is for d-cfd4 :: (Num a, SigSpace a) => Sig -> Sig -> a -> a -> a -> a -> a +cfd4 :: (Num a, SigSpace a) => Sig -> Sig -> a -> a -> a -> a -> a cfd4 x y a b c d = sum $ zipWith mul [(1 - x) * (1 - y), x * (1 - y) , x * y, (1 - x) * y] [a, b, c, d]-  + -- | Generic crossfade for n coefficients and n+1 signals. -- -- > cfds coeffs sigs@@ -105,59 +105,29 @@ instance SigSpace Sig   where  mapSig = id instance BindSig  Sig   where  bindSig = id -instance SigSpace (Sig, Sig) where  mapSig  f (a1, a2) = (f a1, f a2)-instance BindSig  (Sig, Sig) where  bindSig f (a1, a2) = (,) <$> f a1 <*> f a2--instance SigSpace (Sig, Sig, Sig) where mapSig  f (a1, a2, a3) = (f a1, f a2, f a3)-instance BindSig  (Sig, Sig, Sig) where bindSig f (a1, a2, a3) = (,,) <$> f a1 <*> f a2 <*> f a3--instance SigSpace (Sig, Sig, Sig, Sig) where mapSig  f (a1, a2, a3, a4) = (f a1, f a2, f a3, f a4)-instance BindSig  (Sig, Sig, Sig, Sig) where bindSig f (a1, a2, a3, a4) = (,,,) <$> f a1 <*> f a2 <*> f a3 <*> f a4--instance SigSpace (Sig, Sig, Sig, Sig, Sig) where mapSig  f (a1, a2, a3, a4, a5) = (f a1, f a2, f a3, f a4, f a5)-instance BindSig  (Sig, Sig, Sig, Sig, Sig) where bindSig f (a1, a2, a3, a4, a5) = (,,,,) <$> f a1 <*> f a2 <*> f a3 <*> f a4 <*> f a5--instance SigSpace (Sig, Sig, Sig, Sig, Sig, Sig) where mapSig  f (a1, a2, a3, a4, a5, a6) = (f a1, f a2, f a3, f a4, f a5, f a6)-instance BindSig  (Sig, Sig, Sig, Sig, Sig, Sig) where bindSig f (a1, a2, a3, a4, a5, a6) = (,,,,,) <$> f a1 <*> f a2 <*> f a3 <*> f a4 <*> f a5 <*> f a6--instance SigSpace (Sig, Sig, Sig, Sig, Sig, Sig, Sig) where mapSig  f (a1, a2, a3, a4, a5, a6, a7) = (f a1, f a2, f a3, f a4, f a5, f a6, f a7)-instance BindSig  (Sig, Sig, Sig, Sig, Sig, Sig, Sig) where bindSig f (a1, a2, a3, a4, a5, a6, a7) = (,,,,,,) <$> f a1 <*> f a2 <*> f a3 <*> f a4 <*> f a5 <*> f a6 <*> f a7--instance SigSpace (Sig, Sig, Sig, Sig, Sig, Sig, Sig, Sig) where mapSig  f (a1, a2, a3, a4, a5, a6, a7, a8) = (f a1, f a2, f a3, f a4, f a5, f a6, f a7, f a8)-instance BindSig  (Sig, Sig, Sig, Sig, Sig, Sig, Sig, Sig) where bindSig f (a1, a2, a3, a4, a5, a6, a7, a8) = (,,,,,,,) <$> f a1 <*> f a2 <*> f a3 <*> f a4 <*> f a5 <*> f a6 <*> f a7 <*> f a8 --instance SigSpace (Sig2, Sig2) where  mapSig  f (a1, a2) = (mapSig f a1, mapSig f a2)-instance BindSig  (Sig2, Sig2) where  bindSig f (a1, a2) = (,) <$> bindSig f a1 <*> bindSig f a2--instance SigSpace (Sig2, Sig2, Sig2) where  mapSig  f (a1, a2, a3) = (mapSig f a1, mapSig f a2, mapSig f a3)-instance BindSig  (Sig2, Sig2, Sig2) where  bindSig f (a1, a2, a3) = (,,) <$> bindSig f a1 <*> bindSig f a2 <*> bindSig f a3--instance SigSpace (Sig2, Sig2, Sig2, Sig2) where  mapSig  f (a1, a2, a3, a4) = (mapSig f a1, mapSig f a2, mapSig f a3, mapSig f a4)-instance BindSig  (Sig2, Sig2, Sig2, Sig2) where  bindSig f (a1, a2, a3, a4) = (,,,) <$> bindSig f a1 <*> bindSig f a2 <*> bindSig f a3 <*> bindSig f a4--instance SigSpace (Sig2, Sig2, Sig2, Sig2, Sig2) where  mapSig  f (a1, a2, a3, a4, a5) = (mapSig f a1, mapSig f a2, mapSig f a3, mapSig f a4, mapSig f a5)-instance BindSig  (Sig2, Sig2, Sig2, Sig2, Sig2) where  bindSig f (a1, a2, a3, a4, a5) = (,,,,) <$> bindSig f a1 <*> bindSig f a2 <*> bindSig f a3 <*> bindSig f a4 <*> bindSig f a5+instance (SigSpace a1, SigSpace a2) => SigSpace (a1, a2) where  mapSig  f (a1, a2) = (mapSig f a1, mapSig f a2)+instance (BindSig a1, BindSig a2) => BindSig  (a1, a2) where  bindSig f (a1, a2) = (,) <$> bindSig f a1 <*> bindSig f a2 -instance SigSpace (Sig2, Sig2, Sig2, Sig2, Sig2, Sig2) where  mapSig  f (a1, a2, a3, a4, a5, a6) = (mapSig f a1, mapSig f a2, mapSig f a3, mapSig f a4, mapSig f a5, mapSig f a6)-instance BindSig  (Sig2, Sig2, Sig2, Sig2, Sig2, Sig2) where  bindSig f (a1, a2, a3, a4, a5, a6) = (,,,,,) <$> bindSig f a1 <*> bindSig f a2 <*> bindSig f a3 <*> bindSig f a4 <*> bindSig f a5  <*> bindSig f a6+instance (SigSpace a1, SigSpace a2, SigSpace a3) => SigSpace (a1, a2, a3) where mapSig  f (a1, a2, a3) = (mapSig f a1, mapSig f a2, mapSig f a3)+instance (BindSig a1, BindSig a2, BindSig a3) => BindSig  (a1, a2, a3) where bindSig f (a1, a2, a3) = (,,) <$> bindSig f a1 <*> bindSig f a2 <*> bindSig f a3 -instance SigSpace (Sig8, Sig8) where  mapSig  f (a1, a2) = (mapSig f a1, mapSig f a2)-instance BindSig  (Sig8, Sig8) where  bindSig f (a1, a2) = (,) <$> bindSig f a1 <*> bindSig f a2+instance (SigSpace a1, SigSpace a2, SigSpace a3, SigSpace a4) => SigSpace (a1, a2, a3, a4) where mapSig  f (a1, a2, a3, a4) = (mapSig f a1, mapSig f a2, mapSig f a3, mapSig f a4)+instance (BindSig a1, BindSig a2, BindSig a3, BindSig a4) => BindSig  (a1, a2, a3, a4) where bindSig f (a1, a2, a3, a4) = (,,,) <$> bindSig f a1 <*> bindSig f a2 <*> bindSig f a3 <*> bindSig f a4 -instance SigSpace (Sig8, Sig8, Sig8, Sig8) where  mapSig  f (a1, a2, a3, a4) = (mapSig f a1, mapSig f a2, mapSig f a3, mapSig f a4)-instance BindSig  (Sig8, Sig8, Sig8, Sig8) where  bindSig f (a1, a2, a3, a4) = (,,,) <$> bindSig f a1 <*> bindSig f a2 <*> bindSig f a3 <*> bindSig f a4+instance (SigSpace a1, SigSpace a2, SigSpace a3, SigSpace a4, SigSpace a5) => SigSpace (a1, a2, a3, a4, a5) where mapSig  f (a1, a2, a3, a4, a5) = (mapSig f a1, mapSig f a2, mapSig f a3, mapSig f a4, mapSig f a5)+instance (BindSig a1, BindSig a2, BindSig a3, BindSig a4, BindSig a5) => BindSig  (a1, a2, a3, a4, a5) where bindSig f (a1, a2, a3, a4, a5) = (,,,,) <$> bindSig f a1 <*> bindSig f a2 <*> bindSig f a3 <*> bindSig f a4 <*> bindSig f a5 -instance SigSpace (SE Sig) where  mapSig  f = fmap (mapSig f)-instance BindSig  (SE Sig) where  bindSig f = fmap (bindSig f)+instance (SigSpace a1, SigSpace a2, SigSpace a3, SigSpace a4, SigSpace a5, SigSpace a6) => SigSpace (a1, a2, a3, a4, a5, a6) where mapSig  f (a1, a2, a3, a4, a5, a6) = (mapSig f a1, mapSig f a2, mapSig f a3, mapSig f a4, mapSig f a5, mapSig f a6)+instance (BindSig a1, BindSig a2, BindSig a3, BindSig a4, BindSig a5, BindSig a6) => BindSig  (a1, a2, a3, a4, a5, a6) where bindSig f (a1, a2, a3, a4, a5, a6) = (,,,,,) <$> bindSig f a1 <*> bindSig f a2 <*> bindSig f a3 <*> bindSig f a4 <*> bindSig f a5 <*> bindSig f a6 -instance SigSpace (SE (Sig, Sig)) where mapSig  f = fmap (mapSig f)-instance BindSig  (SE (Sig, Sig)) where bindSig f = fmap (bindSig f)+instance (SigSpace a1, SigSpace a2, SigSpace a3, SigSpace a4, SigSpace a5, SigSpace a6, SigSpace a7) => SigSpace (a1, a2, a3, a4, a5, a6, a7) where mapSig  f (a1, a2, a3, a4, a5, a6, a7) = (mapSig f a1, mapSig f a2, mapSig f a3, mapSig f a4, mapSig f a5, mapSig f a6, mapSig f a7)+instance (BindSig a1, BindSig a2, BindSig a3, BindSig a4, BindSig a5, BindSig a6, BindSig a7) => BindSig  (a1, a2, a3, a4, a5, a6, a7) where bindSig f (a1, a2, a3, a4, a5, a6, a7) = (,,,,,,) <$> bindSig f a1 <*> bindSig f a2 <*> bindSig f a3 <*> bindSig f a4 <*> bindSig f a5 <*> bindSig f a6 <*> bindSig f a7 -instance SigSpace (SE (Sig, Sig, Sig)) where mapSig  f = fmap (mapSig f)-instance BindSig  (SE (Sig, Sig, Sig)) where bindSig f = fmap (bindSig f)+instance (SigSpace a1, SigSpace a2, SigSpace a3, SigSpace a4, SigSpace a5, SigSpace a6, SigSpace a7, SigSpace a8) => SigSpace (a1, a2, a3, a4, a5, a6, a7, a8) where mapSig  f (a1, a2, a3, a4, a5, a6, a7, a8) = (mapSig f a1, mapSig f a2, mapSig f a3, mapSig f a4, mapSig f a5, mapSig f a6, mapSig f a7, mapSig f a8)+instance (BindSig a1, BindSig a2, BindSig a3, BindSig a4, BindSig a5, BindSig a6, BindSig a7, BindSig a8) => BindSig  (a1, a2, a3, a4, a5, a6, a7, a8) where bindSig f (a1, a2, a3, a4, a5, a6, a7, a8) = (,,,,,,,) <$> bindSig f a1 <*> bindSig f a2 <*> bindSig f a3 <*> bindSig f a4 <*> bindSig f a5 <*> bindSig f a6 <*> bindSig f a7 <*> bindSig f a8 -instance SigSpace (SE (Sig, Sig, Sig, Sig)) where mapSig  f = fmap (mapSig f)-instance BindSig  (SE (Sig, Sig, Sig, Sig)) where bindSig f = fmap (bindSig f)+instance SigSpace a => SigSpace (SE a) where  mapSig  f = fmap (mapSig f)+instance BindSig  a => BindSig  (SE a) where  bindSig f = fmap (bindSig f)  ---------------------------------------------------------------------------------------------------------- @@ -171,79 +141,79 @@ instance SigSpace2 (Sig, Sig) where  mapSig2  = id instance BindSig2  (Sig, Sig) where  bindSig2 = id -instance SigSpace2 (Sig, Sig, Sig) where +instance SigSpace2 (Sig, Sig, Sig) where     mapSig2  f (a1, a2, a3) = (b1, b2, toMono (b3, b4))         where             (b1, b2, b3, b4) = mapSig2 f (a1, a2, a3, a4)             a4 = a3 -instance BindSig2  (Sig, Sig, Sig) where +instance BindSig2  (Sig, Sig, Sig) where     bindSig2 f (a1, a2, a3) = do         (b1, b2, b3, b4) <- bindSig2 f (a1, a2, a3, a4)         return (b1, b2, toMono (b3, b4))         where             a4 = a3 -instance SigSpace2 (Sig, Sig, Sig, Sig) where +instance SigSpace2 (Sig, Sig, Sig, Sig) where     mapSig2  f (a1, a2, a3, a4) = (b1, b2, b3, b4)         where             (b1, b2) = f (a1, a2)             (b3, b4) = f (a3, a4) -instance BindSig2  (Sig, Sig, Sig, Sig) where +instance BindSig2  (Sig, Sig, Sig, Sig) where     bindSig2 f (a1, a2, a3, a4) = do             (b1, b2) <- f (a1, a2)             (b3, b4) <- f (a3, a4)-            return (b1, b2, b3, b4)       +            return (b1, b2, b3, b4) -instance SigSpace2 (Sig, Sig, Sig, Sig, Sig) where +instance SigSpace2 (Sig, Sig, Sig, Sig, Sig) where     mapSig2  f (a1, a2, a3, a4, a5) = (b1, b2, b3, b4, toMono (b5, b6))-        where +        where             (b1, b2, b3, b4, b5, b6) = mapSig2 f (a1, a2, a3, a4, a5, a6)             a6 = a5 -instance BindSig2 (Sig, Sig, Sig, Sig, Sig) where +instance BindSig2 (Sig, Sig, Sig, Sig, Sig) where     bindSig2 f (a1, a2, a3, a4, a5) = do         (b1, b2, b3, b4, b5, b6) <- bindSig2 f (a1, a2, a3, a4, a5, a6)         return (b1, b2, b3, b4, toMono (b5, b6))         where             a6 = a5 -instance SigSpace2 (Sig, Sig, Sig, Sig, Sig, Sig) where +instance SigSpace2 (Sig, Sig, Sig, Sig, Sig, Sig) where     mapSig2  f (a1, a2, a3, a4, a5, a6) = (b1, b2, b3, b4, b5, b6)         where             (b1, b2, b3, b4) = mapSig2 f (a1, a2, a3, a4)             (b5, b6) = f (a5, a6)-        -instance BindSig2  (Sig, Sig, Sig, Sig, Sig, Sig) where -    bindSig2 f (a1, a2, a3, a4, a5, a6) = do        ++instance BindSig2  (Sig, Sig, Sig, Sig, Sig, Sig) where+    bindSig2 f (a1, a2, a3, a4, a5, a6) = do         (b1, b2, b3, b4) <- bindSig2 f (a1, a2, a3, a4)-        (b5, b6) <- f (a5, a6)        +        (b5, b6) <- f (a5, a6)         return (b1, b2, b3, b4, b5, b6) -instance SigSpace2 (Sig, Sig, Sig, Sig, Sig, Sig, Sig) where +instance SigSpace2 (Sig, Sig, Sig, Sig, Sig, Sig, Sig) where     mapSig2  f (a1, a2, a3, a4, a5, a6, a7) = (b1, b2, b3, b4, b5, b6, toMono (b7, b8))         where             (b1, b2, b3, b4, b5, b6, b7, b8) = mapSig2 f (a1, a2, a3, a4, a5, a6, a7, a8)             a8 = a7 -instance BindSig2  (Sig, Sig, Sig, Sig, Sig, Sig, Sig) where +instance BindSig2  (Sig, Sig, Sig, Sig, Sig, Sig, Sig) where     bindSig2 f (a1, a2, a3, a4, a5, a6, a7) = do         (b1, b2, b3, b4, b5, b6, b7, b8) <- bindSig2 f (a1, a2, a3, a4, a5, a6, a7, a8)         return (b1, b2, b3, b4, b5, b6, toMono (b7, b8))         where             a8 = a7 -instance SigSpace2 (Sig, Sig, Sig, Sig, Sig, Sig, Sig, Sig) where +instance SigSpace2 (Sig, Sig, Sig, Sig, Sig, Sig, Sig, Sig) where     mapSig2  f (a1, a2, a3, a4, a5, a6, a7, a8) = (b1, b2, b3, b4, b5, b6, b7, b8)         where             (b1, b2, b3, b4, b5, b6) = mapSig2 f (a1, a2, a3, a4, a5, a6)             (b7, b8) = f (a7, a8) -instance BindSig2  (Sig, Sig, Sig, Sig, Sig, Sig, Sig, Sig) where -    bindSig2 f (a1, a2, a3, a4, a5, a6, a7, a8) = do        +instance BindSig2  (Sig, Sig, Sig, Sig, Sig, Sig, Sig, Sig) where+    bindSig2 f (a1, a2, a3, a4, a5, a6, a7, a8) = do         (b1, b2, b3, b4, b5, b6) <- bindSig2 f (a1, a2, a3, a4, a5, a6)-        (b7, b8) <- f (a7, a8)        +        (b7, b8) <- f (a7, a8)         return (b1, b2, b3, b4, b5, b6, b7, b8)  instance SigSpace2 (Sig2, Sig2) where  mapSig2  f (a1, a2) = (mapSig2 f a1, mapSig2 f a2)@@ -261,6 +231,12 @@ instance SigSpace2 (Sig2, Sig2, Sig2, Sig2, Sig2, Sig2) where  mapSig2  f (a1, a2, a3, a4, a5, a6) = (mapSig2 f a1, mapSig2 f a2, mapSig2 f a3, mapSig2 f a4, mapSig2 f a5, mapSig2 f a6) instance BindSig2  (Sig2, Sig2, Sig2, Sig2, Sig2, Sig2) where  bindSig2 f (a1, a2, a3, a4, a5, a6) = (,,,,,) <$> bindSig2 f a1 <*> bindSig2 f a2 <*> bindSig2 f a3 <*> bindSig2 f a4 <*> bindSig2 f a5  <*> bindSig2 f a6 +instance SigSpace2 (Sig2, Sig2, Sig2, Sig2, Sig2, Sig2, Sig2) where  mapSig2  f (a1, a2, a3, a4, a5, a6, a7) = (mapSig2 f a1, mapSig2 f a2, mapSig2 f a3, mapSig2 f a4, mapSig2 f a5, mapSig2 f a6, mapSig2 f a7)+instance BindSig2  (Sig2, Sig2, Sig2, Sig2, Sig2, Sig2, Sig2) where  bindSig2 f (a1, a2, a3, a4, a5, a6, a7) = (,,,,,,) <$> bindSig2 f a1 <*> bindSig2 f a2 <*> bindSig2 f a3 <*> bindSig2 f a4 <*> bindSig2 f a5  <*> bindSig2 f a6 <*> bindSig2 f a7++instance SigSpace2 (Sig2, Sig2, Sig2, Sig2, Sig2, Sig2, Sig2, Sig2) where  mapSig2  f (a1, a2, a3, a4, a5, a6, a7, a8) = (mapSig2 f a1, mapSig2 f a2, mapSig2 f a3, mapSig2 f a4, mapSig2 f a5, mapSig2 f a6, mapSig2 f a7, mapSig2 f a8)+instance BindSig2  (Sig2, Sig2, Sig2, Sig2, Sig2, Sig2, Sig2, Sig2) where  bindSig2 f (a1, a2, a3, a4, a5, a6, a7, a8) = (,,,,,,,) <$> bindSig2 f a1 <*> bindSig2 f a2 <*> bindSig2 f a3 <*> bindSig2 f a4 <*> bindSig2 f a5  <*> bindSig2 f a6 <*> bindSig2 f a7 <*> bindSig2 f a8+ instance SigSpace2 (Sig8, Sig8) where  mapSig2  f (a1, a2) = (mapSig2 f a1, mapSig2 f a2) instance BindSig2  (Sig8, Sig8) where  bindSig2 f (a1, a2) = (,) <$> bindSig2 f a1 <*> bindSig2 f a2 @@ -491,7 +467,7 @@     at f a = join $ bindSig f a  -------------------------------------------------------- mono to stereo +-- mono to stereo  instance At Sig Sig2 Sig where     type AtOut Sig Sig2 Sig = Sig2@@ -509,9 +485,9 @@     type AtOut Sig Sig2 (SE Sig2) = SE Sig2     at f a = fmap (at f) a ----------------------------------------------------------   +--------------------------------------------------------- ----------------------------------------------------------   +--------------------------------------------------------- -- Sig2 -> Sig2  fromMono a = (a, a)@@ -558,23 +534,23 @@ -- | It applies an effect and mixes the processed signal with original one. -- The first argument is for proportion of dry/wet (original/processed). -- It's like @at@ but it allows to balance processed signal with original one.-class (SigSpace b, At a b c) => MixAt a b c where    +class (SigSpace b, At a b c) => MixAt a b c where     mixAt :: Sig -> (a -> b) -> c -> AtOut a b c  --------------------------------------------------- -instance SigSpace a => MixAt Sig Sig a where    +instance SigSpace a => MixAt Sig Sig a where     mixAt k f a = mapSig (\x -> cfd k x (f x)) a  ------------------------------------------------------ -- for (Sig -> SE Sig) -instance MixAt Sig (SE Sig) Sig where    +instance MixAt Sig (SE Sig) Sig where     mixAt k f dry = do         wet <- f dry         return $ cfd k dry wet -instance MixAt Sig (SE Sig) Sig2 where    +instance MixAt Sig (SE Sig) Sig2 where     mixAt k f (dry1, dry2) = do         wet1 <- f dry1         wet2 <- f dry2@@ -587,7 +563,7 @@         wet3 <- f dry3         return $ cfd k (dry1, dry2, dry3) (wet1, wet2, wet3) -instance MixAt Sig (SE Sig) Sig4 where    +instance MixAt Sig (SE Sig) Sig4 where     mixAt k f (dry1, dry2, dry3, dry4) = do         wet1 <- f dry1         wet2 <- f dry2@@ -595,7 +571,7 @@         wet4 <- f dry4         return $ cfd k (dry1, dry2, dry3, dry4) (wet1, wet2, wet3, wet4) -instance MixAt Sig (SE Sig) (SE Sig) where    +instance MixAt Sig (SE Sig) (SE Sig) where     mixAt k f dry = do         dry1 <- dry         wet1 <- f dry1@@ -626,42 +602,42 @@         return $ cfd k (dry1, dry2, dry3, dry4) (wet1, wet2, wet3, wet4)  -------------------------------------------------------- mono to stereo +-- mono to stereo  instance MixAt Sig Sig2 Sig where     mixAt k f dry = cfd k (dry, dry) wet         where wet = f dry -instance MixAt Sig Sig2 (SE Sig) where    +instance MixAt Sig Sig2 (SE Sig) where     mixAt k f dry = fmap (\x -> cfd k (x, x) (f x)) dry -instance MixAt Sig Sig2 Sig2 where    +instance MixAt Sig Sig2 Sig2 where     mixAt k f dry = cfd k dry wet         where wet = 0.5 * (f (fst dry) + f (snd dry)) -instance MixAt Sig Sig2 (SE Sig2) where    +instance MixAt Sig Sig2 (SE Sig2) where     mixAt k f dry = do         (dry1, dry2) <- dry-        let wet = 0.5 * (f dry1 + f dry2)        +        let wet = 0.5 * (f dry1 + f dry2)         return $ cfd k (dry1, dry2) wet ----------------------------------------------------------   +--------------------------------------------------------- ----------------------------------------------------------   +--------------------------------------------------------- -- Sig2 -> Sig2 -instance MixAt Sig2 Sig2 Sig where    +instance MixAt Sig2 Sig2 Sig where     mixAt k f dry1 = cfd k dry wet-        where             +        where             dry = fromMono dry1             wet = f dry -instance MixAt Sig2 Sig2 Sig2 where    +instance MixAt Sig2 Sig2 Sig2 where     mixAt k f dry = cfd k dry wet         where             wet = f dry -instance MixAt Sig2 Sig2 (SE Sig) where    +instance MixAt Sig2 Sig2 (SE Sig) where     mixAt k f dry1 = do         dry <- fmap fromMono dry1         let wet = f dry@@ -677,19 +653,19 @@ --------------------------------------------- -- Sig2 -> SE Sig2 -instance MixAt Sig2 (SE Sig2) Sig where    +instance MixAt Sig2 (SE Sig2) Sig where     mixAt k f dry1 = do         wet <- f dry         return $ cfd k dry wet         where             dry = fromMono dry1 -instance MixAt Sig2 (SE Sig2) Sig2 where    +instance MixAt Sig2 (SE Sig2) Sig2 where     mixAt k f dry = do         wet <- f dry         return $ cfd k dry wet -instance MixAt Sig2 (SE Sig2) (SE Sig) where    +instance MixAt Sig2 (SE Sig2) (SE Sig) where     mixAt k f dry1 = do         dry <- fmap fromMono dry1         wet <- f dry

@@ -1,15 +1,15 @@ {-# OPTIONS_GHC -fno-warn-orphans #-}-{-# Language +{-# Language         TypeFamilies,         FlexibleContexts,         FlexibleInstances #-} module Csound.Typed.Types.Tuple(     -- ** Tuple-    Tuple(..), TupleMethods, makeTupleMethods, +    Tuple(..), TupleMethods, makeTupleMethods,     fromTuple, toTuple, tupleArity, tupleRates, defTuple, mapTuple,-    +     -- ** Outs-    Sigs, outArity, +    Sigs, outArity, Sig2s,      -- *** Multiple outs     multiOuts,@@ -34,6 +34,8 @@ import Data.Default import Data.Boolean +import Data.NumInstances.Tuple+ import Csound.Dynamic import Csound.Typed.Types.Prim import Csound.Typed.Types.SigSpace@@ -52,7 +54,7 @@     , tupleRates_ :: a -> [Rate]     , defTuple_   :: a } -fromTuple :: Tuple a => a -> GE [E] +fromTuple :: Tuple a => a -> GE [E] fromTuple = fromTuple_ tupleMethods  toTuple :: Tuple a => GE [E] -> a@@ -72,9 +74,9 @@  -- | Defines instance of type class 'Tuple' for a new type in terms of an already defined one. makeTupleMethods :: (Tuple a) => (a -> b) -> (b -> a) -> TupleMethods b-makeTupleMethods to from = TupleMethods +makeTupleMethods to from = TupleMethods     { fromTuple_  = fromTuple . from-    , toTuple_    = to . toTuple +    , toTuple_    = to . toTuple     , tupleArity_ = const $ tupleArity $ proxy to     , tupleRates_ = tupleRates . from     , defTuple_   = to defTuple }@@ -84,7 +86,7 @@ -- Tuple instances  primTupleMethods :: (Val a, Default a) => Rate -> TupleMethods a-primTupleMethods rate = TupleMethods +primTupleMethods rate = TupleMethods         { fromTuple_ = fmap return . toGE         , toTuple_ = fromGE . fmap head         , tupleArity_ = const 1@@ -92,14 +94,14 @@         , defTuple_   = def }  instance Tuple Unit where-    tupleMethods = TupleMethods +    tupleMethods = TupleMethods         { fromTuple_  = \x -> unUnit x >> (return [])         , toTuple_    = \es -> Unit $ es >> return ()         , tupleArity_ = const 0         , tupleRates_ = const []         , defTuple_   = Unit $ return () } -instance Tuple Sig   where tupleMethods = primTupleMethods Ar        +instance Tuple Sig   where tupleMethods = primTupleMethods Ar instance Tuple D     where tupleMethods = primTupleMethods Kr instance Tuple Tab   where tupleMethods = primTupleMethods Kr instance Tuple Str   where tupleMethods = primTupleMethods Sr@@ -107,16 +109,16 @@  instance Tuple TabList where tupleMethods = primTupleMethods Kr -instance (Tuple a, Tuple b) => Tuple (a, b) where    +instance (Tuple a, Tuple b) => Tuple (a, b) where     tupleMethods = TupleMethods fromTuple' toTuple' tupleArity' tupleRates' defTuple'-        where +        where             fromTuple' (a, b) = liftA2 (++) (fromTuple a) (fromTuple b)             tupleArity' x = let (a, b) = proxy x in tupleArity a + tupleArity b                 where proxy :: (a, b) -> (a, b)-                      proxy = const (undefined, undefined)  +                      proxy = const (undefined, undefined)             toTuple' xs = (a, b)                 where a = toTuple $ fmap (take (tupleArity a)) xs-                      xsb = fmap (drop (tupleArity a)) xs  +                      xsb = fmap (drop (tupleArity a)) xs                       b = toTuple $ fmap (take (tupleArity b)) xsb              tupleRates' (a, b) = tupleRates a ++ tupleRates b@@ -142,31 +144,29 @@ ar6 :: (Sig, Sig, Sig, Sig, Sig, Sig) -> (Sig, Sig, Sig, Sig, Sig, Sig) ar8 :: (Sig, Sig, Sig, Sig, Sig, Sig, Sig, Sig) -> (Sig, Sig, Sig, Sig, Sig, Sig, Sig, Sig) -ar1 = id;   ar2 = id;   ar4 = id;   ar6 = id;   ar8 = id   +ar1 = id;   ar2 = id;   ar4 = id;   ar6 = id;   ar8 = id  --------------------------------------------------------------------------------- -- out instances  -- | The tuples of signals.-class (Tuple a, Num a, Fractional a, SigSpace a, BindSig a,  SigSpace2 a, BindSig2 a) => Sigs a where+class (Tuple a, Num a, Fractional a, SigSpace a, BindSig a) => Sigs a where+class (Sigs a, SigSpace2 a, BindSig2 a) => Sig2s a where  instance Sigs Sig-instance Sigs Sig2-instance Sigs Sig3-instance Sigs Sig4-instance Sigs Sig5-instance Sigs Sig6-instance Sigs Sig7-instance Sigs Sig8--instance Sigs (Sig2, Sig2)-instance Sigs (Sig2, Sig2, Sig2)-instance Sigs (Sig2, Sig2, Sig2, Sig2)-instance Sigs (Sig2, Sig2, Sig2, Sig2, Sig2)-instance Sigs (Sig2, Sig2, Sig2, Sig2, Sig2, Sig2)+instance (Sigs a1, Sigs a2) => Sigs (a1, a2)+instance (Sigs a1, Sigs a2, Sigs a3) => Sigs (a1, a2, a3)+instance (Sigs a1, Sigs a2, Sigs a3, Sigs a4) => Sigs (a1, a2, a3, a4)+instance (Sigs a1, Sigs a2, Sigs a3, Sigs a4, Sigs a5) => Sigs (a1, a2, a3, a4, a5)+instance (Sigs a1, Sigs a2, Sigs a3, Sigs a4, Sigs a5, Sigs a6) => Sigs (a1, a2, a3, a4, a5, a6)+instance (Sigs a1, Sigs a2, Sigs a3, Sigs a4, Sigs a5, Sigs a6, Sigs a7) => Sigs (a1, a2, a3, a4, a5, a6, a7)+instance (Sigs a1, Sigs a2, Sigs a3, Sigs a4, Sigs a5, Sigs a6, Sigs a7, Sigs a8) => Sigs (a1, a2, a3, a4, a5, a6, a7, a8) -instance Sigs (Sig8, Sig8)-instance Sigs (Sig8, Sig8, Sig8, Sig8)+instance Sig2s Sig+instance Sig2s Sig2+instance Sig2s Sig4+instance Sig2s Sig6+instance Sig2s Sig8  outArity :: Tuple a => SE a -> Int outArity = tupleArity . proxy@@ -205,10 +205,10 @@ toNote :: Arg a => a -> GE [E] toNote a = zipWithM phi (tupleRates a) =<< fromTuple a     where-        phi rate x = case rate of            +        phi rate x = case rate of             Sr -> saveStr $ getStringUnsafe x             _  -> return x-            +         getStringUnsafe x = case getPrimUnsafe x of             PrimString y    -> y             _               -> error "Arg(Str):getStringUnsafe value is not a string"@@ -229,7 +229,7 @@ type instance BooleanOf BoolTuple = BoolSig  instance IfB BoolTuple where-    ifB mp (BoolTuple mas) (BoolTuple mbs) = BoolTuple $ +    ifB mp (BoolTuple mas) (BoolTuple mbs) = BoolTuple $         liftA3 (\p as bs -> zipWith (ifB p) as bs) (toGE mp) mas mbs  -- | @ifB@ for tuples of csound values.@@ -257,7 +257,7 @@ type instance BooleanOf BoolArg = BoolD  instance IfB BoolArg where-    ifB mp (BoolArg mas) (BoolArg mbs) = BoolArg $ +    ifB mp (BoolArg mas) (BoolArg mbs) = BoolArg $         liftA3 (\p as bs -> zipWith (ifB p) as bs) (toGE mp) mas mbs  -- | @ifB@ for constants.@@ -281,11 +281,9 @@  dirtyTuple :: Tuple a => GE (MultiOut [E]) -> SE a dirtyTuple a = res-    where -        res = fmap (toTuple . return) $ SE +    where+        res = fmap (toTuple . return) $ SE                 $ mapM depT =<< (lift $ fmap ($ (tupleArity $ proxy res)) a)          proxy :: SE a -> a         proxy = const undefined-     -