packages feed

csound-expression 1.1.1 → 3.0.0

raw patch · 57 files changed

+2938/−7069 lines, 57 filesdep +csound-expression-opcodesdep +csound-expression-typeddep −arraydep −containersdep −data-fix

Dependencies added: csound-expression-opcodes, csound-expression-typed

Dependencies removed: array, containers, data-fix, data-fix-cse, stable-maps, transformers, wl-pprint

Files

csound-expression.cabal view
@@ -1,5 +1,5 @@ Name:          csound-expression-Version:       1.1.1+Version:       3.0.0 Cabal-Version: >= 1.6 License:       BSD3 License-file:  LICENSE@@ -15,51 +15,72 @@     Let's make music with text! We can use Csound to describe our music. Csound has so many fantastic sound generators.     It's very efficient. But sometimes Csound is too low level. So many details: integer identifiers for instruments      and arrays, should I use control rate or audio rate signals, lack of abstractions, no nested expressions and it has limited set of types. -    This library embeds Csound in Haskell. It's Csound code generator. We can use powerful Csound's primitives and glue them-    together with Haskell abstractions. Start with the module "Csound.Base". It contains basic types and functions.     +    This library embeds Csound in Haskell. We can use powerful Csound's primitives and glue them+    together with Haskell abstractions. The module "Csound.Base" exports all types and functions.     .+    Tutorials:+    .+    * Quickstart guide <http://github.com/anton-k/csound-expression/blob/master/tutorial/QuickStart.markdown>+    .+    * Overview of the library <http://github.com/anton-k/csound-expression/blob/master/tutorial/Overview.markdown>+    .+    * Introduction to Csound and library for Haskell users <http://github.com/anton-k/csound-expression/blob/master/tutorial/CsoundInstro.markdown>+    .+    * There are examples in the source code archive <http://github.com/anton-k/csound-expression/tree/master/examples>. +    .     Key principles     .-    * Keep it simple and compact.+    * Keep it simple and compact (as functional as possible).     .-    * Try to hide low level csound's wiring as much as we can (no ids for ftables, instruments, global variables).+    * Make it open (No dependency on Score-generation libraries. Score (or list of events) +    is represented with type class. You can use your favorite Score-generation library +    if you provide an instance for the CsdSco type class. +    Currently there is support for temporal-music-notation library (see temporal-csound package).      .-    * Don't describe the whole csound in all it's generality but give the user some handy tools-    to play with sound.+    How to install (for Csound and Haskell users)     .-    * No distinction between audio and control rates on the type level. Derive all rates from the context.-    If the user plugs signal to an opcode that expects an audio rate signal the argument is converted to the right rate.-    .  -    * Watch out for side-effects. There is a special type called 'SE'. It functions as 'IO' in Haskell.     +    To use the library we need:     .-    * Less typing, more music. Use short names for all types. Make library so that all expressions can be-    built without type annotations. Make it simple for the compiler to derive all types. Don't use complex type classes.-    . -    * Make low level opcode definitions simple. Let user define his own opcodes (if they are missing).+    *   GHC - haskell compiler. This library uses GHC-specific features (<www.haskell.org/ghc>).     .-    * Ensure that output signal is limited by amplitude. Csound can produce signals with HUGE amplitudes. Little typo can damage your ears -    and your speakers. In generated code all signals are clipped by 0dbfs value. 0dbfs is set to 1. Just as in Pure Data. So 1 is absolute maximum value-    for amplitude. -    . -    * No dependency on Score-generation libraries. Score (or list of events) is represented with type class. You can use your favorite Score-generation library if you provide an instance for the CsdSco type class. Currently there is support for temporal-music-notation library (see temporal-csound package).+    *   cabal-install to install haskell packages (<www.haskell.org/cabal>).     .-    For the future-    .        -    * Make composable guis. Just plug the slider in the opcode and see it on the screen. Interactive instruments should be easy to make.+    *   Csound compiler (version 5.13 or higher). You must get it installed on your system.+    Since we are going to generate the csound code we need to compile it to sound somehow.+    We can find out how to install the Csound on <www.csounds.com>. +    To test whether csound is installed open the command line and type:     .-    * Remove score/instrument barrier. Let instrument play a score within a note and trigger-    other instruments. +    > csound     .-    * Timing of events. User can set the beat rate and align events by beat events.+    It should print a long message with version and available flags and libraries.     .-    * Set Csound flags with meaningful (well-typed) values. Derive as much as you can from the context.+    If everything is installed to install the library we can open the command line terminal and type:     .-    * Optimization of the memory allocation (liveness analysis).+    > cabal install csound-expression+    .+    Acknowledgements (I'd like to mention those who supported me a lot with their music and ideas):+    .+    * music: entertainment for the braindead, ann's'annat & alizbar, toe, iamthemorning, atoms for piece / radiohead, loscil, boards of canada,+    Hozan Yamamoto, Tony Scott and Shinichi Yuize. +    .+    * ideas: Conal Elliott, Oleg Kiselyov, Paul Hudak, Gabriel Gonzalez, Rich Hickey and Csound's community.+    .     Extra-Source-Files : +    examples/README.txt+         examples/Test.hs     examples/Heartbeat.hs+    +    examples/Color.hs+    examples/Gm.hs+    examples/Tibetan.hs+    examples/Wind.hs +    examples/Midi.hs+    examples/Events.hs+    examples/Guis.hs+ Homepage:        https://github.com/anton-k/csound-expression Bug-Reports:     https://github.com/anton-k/csound-expression/issues @@ -71,49 +92,35 @@ Library   Ghc-Options:    -Wall   Build-Depends:-        base >= 4, base < 5, containers, array, transformers, wl-pprint, stable-maps >= 0.0.3.3, process,-        data-default, Boolean >= 0.1.0, data-fix, data-fix-cse+        base >= 4, base < 5, process, data-default, Boolean >= 0.1.0,+        csound-expression-typed, csound-expression-opcodes   Hs-Source-Dirs:      src/   Exposed-Modules:         Csound.Base+         Csound.Air++        Csound.Types         Csound.Tab-        Csound.LowLevel-        Csound.Opcode-        Csound.Opcode.Basic-        Csound.Opcode.Advanced-        Csound.Opcode.Data-        Csound.Opcode.Interaction           -  Other-Modules:-        Csound.Exp        -        Csound.Exp.Wrapper-        Csound.Exp.GE-        Csound.Exp.SE-        Csound.Exp.Ref-        Csound.Exp.Cons-        Csound.Exp.Logic-        Csound.Exp.Numeric       -        Csound.Exp.Arg-        Csound.Exp.Tuple-        Csound.Exp.Mix-        Csound.Exp.Event-        Csound.Exp.Instr-        Csound.Exp.Gui-        Csound.Exp.Widget-        Csound.Exp.Options-        Csound.Exp.EventList-       +        Csound.SigSpace         Csound.IO+        Csound.Options -        Csound.Tfm.DeduceTypes       -        Csound.Tfm.UnfoldMultiOuts-        Csound.Tfm.Tab       +        Csound.Control+        Csound.Control.Evt+        Csound.Control.Instr+        Csound.Control.SE -        Csound.Render-        Csound.Render.Pretty-        Csound.Render.Options-        Csound.Render.Instr-        Csound.Render.Channel-       +--        Csound.Gui+--        Csound.Gui.Widget+--        Csound.Gui.Props+--        Csound.Gui.Layout++--        Csound.LowLevel+  Other-Modules:+        Csound.Control.Overload+        Csound.Control.Overload.Instr+        Csound.Control.Overload.MidiInstr+        Csound.Control.Overload.SpecInstr
+ examples/Color.hs view
@@ -0,0 +1,164 @@+-- | A gallery of instruments (found in Csound catalog).+module Color where++import Csound++bass (amp, cps) = sig amp * once env * osc (sig cps)+    where env = eexps [1, 0.00001]++pluckSynth (amp, cps1, cps2) = 0.5 * sig amp * once env * pluck 1 (sig cps1) cps2 def 3+    where env = eexps [1, 0.004]++marimbaSynth :: (D, D) -> Sig+marimbaSynth (amp, cps) = a6+    where+        bias = 0.11+        i2  = log cps / 10 - bias+        k1 = (0.1 * ) $ once $ lins [0.00001, 30, 1, 50, 0.5, 100, 0.00001]+--        k1  = expseg [0.0001, 0.03, amp * 0.7, idur - 0.03, 0.001]+--            * linseg [1, 0.03, 1, idur - 0.03, 3]+        k10 = linseg [2.25, 0.03, 3, idur - 0.03, 2] +        a1  = gbuzz k1 (sig cps) k10 0 35 (sines3 [(1, 1, 90)])+        a2  = reson' a1 500 50 +        a3  = reson' a2 150 100 +        a4  = reson' a3 3500 150 +        a5  = reson' a4 3500 150 +        a6  = balance a5 a1+        reson' a b c = reson a b c `withD` 1++phasing (amp, cps) = aout+    where+        rise = 1+        dec = 0.5++        env = linen (sig amp) rise idur dec+        osc' tab k ph = oscBy tab (sig $ cps * k) `withD` ph+        osc1 = osc' sine+        osc2 = osc' $ sines [1, 0, 0.9, 0, 0.8, 0, 0.7, 0, 0.6, 0, 0.5, 0, 0.4, 0, 0.3, 0, 0.2, 0, 0.1] +        asum = env * mean +                [ osc1 1 0+                , osc2 1.008 0.02+                , osc1 0.992 0.04+                , osc2 2     0.06+                , osc2 1     0.08+                , osc1 1     0.01 ]+        kosc1 = 0.5 * once sine +        kosc2 = 0.5 * once sine `withD` 0.4+        kosc3 = 1.0 * once sine `withD` 0.8++        afilt  = sum +                [ butbp asum kosc1 1000+                , butbp asum kosc2 300+                , butbp asum kosc3 20 ]++        aout  = mean [afilt, asum]++blurp amp = do+    cps <- acps+    return $ 0.1 * sig amp * osc cps +    where+        dec = linseg [11, idur * 0.75, 11, idur * 0.25, 0]+        kgate = kr $ oscil 1 dec (elins [1, 0, 0])+        anoise = noise 11000 0.99+        acps = fmap (flip samphold kgate) anoise+ ++wind (amp, bandRise, bandDec, freqRise, freqDec, pan, winds) = +    fmap fromRnd $ rand (sig $ amp / 400)+    where+        valu1 = 100+        valu2 = 50+        winde = 1 - winds+        ramp a b = linseg [a, idur, b]+        fromRnd a = (sig pan * aout, (1 - sig pan) * aout )+            where+                a2 = butbp a  (ramp freqRise freqDec) (ramp bandRise bandDec) +                a3 = butbp a2 (ramp (freqRise - valu1) (freqDec + valu2))+                              (ramp (bandRise + valu1) (bandDec - valu2))+                +                aout = (a2 + a3) * linseg [0, idur * winds, 1, idur * winde, 0]++noiz (amp, cps) = fmap a2 k2+    where +        k1 = linseg [1, 0.05, 100, 0.2, 100, 2, 1, idur, 1]+        k2 = fmap ( `withD` 1) $ rand 500   ++        buzz' kamp kcps = buzz kamp (sig $ kcps * cps)  k1 sine+        +        a1 = mean $ zipWith buzz' [0.3, 1, 1] [1, 0.5, 0.501]+        a2 k = 0.5 * a1 * sig amp * osc k++noiseGliss (amp, cps) = fmap ares anoise+    where+        ramp = linseg [0, idur * 0.8, amp, idur * 0.2, 0]+        env1 = linen (sig amp) 0 idur 10+        anoise = randi ramp env1++        ares a =  reson (a * osc (sig cps)) 100 100 `withD` 2+++ivory (amp, cps, vibRate, glisDur, cpsCoeff) = sig amp * mean +    --    vibrato env                amplitude env               freq bias   phase   vibrato coeff   wave+    [ alg (linseg [0, idur, 5])      (lincone 0 0.7 1 0.3 0)     0           0       1               sine+    , alg (lincone 0 0.6 6 0.4 0)    (lincone 0 0.9 1 0.1 0)     0.009       0.2     0.9             (sines [10, 9 .. 1])+    , alg (lincone 9 0.7 1 0.3 1)    (linenIdur 0.5 0.333)       0.007       0.3     1.2             (sines [10, 0, 9, 0, 8, 0, 7, 0, 6, 0, 5])+    , alg (expcone 1 0.4 3 0.6 0.02) +          (expcone 0.0001 0.8 1 0.2 0.0001)                      0.005       0.5     0.97            (sines [10, 10, 9, 0, 0, 0, 3, 2, 0, 0, 1])  +    , alg (expcone 1 0.4 3 0.6 0.02) +          (expdur [0.001, 0.5, 1, 0.1, 0.6, 0.2, 0.97, 0.2, 0.001])+                                                                 0.003       0.8     0.99            (sines [10, 0, 0, 0, 5, 0, 0, 0, 0, 0, 3])+    , alg (expcone 4 0.91 1 0.09 1)  +          (expdur [0.001, 0.6, 1, 0.2, 0.8, 0.1, 0.98, 0.1, 0.001])+                                                                 0.001       1.3     1.4             (sines [10, 0, 0, 0, 0, 3, 1])+    ]+    where+        alg :: Sig -> Sig -> D -> D -> D -> Tab -> Sig    +        alg vibrEnv ampEnv cpsBias phsBias vibrCoeff wave = +            ampEnv * (oscBy wave ((sig (cps + cpsBias) + vibr) * glis) `withD` phsBias)+            where glis = expseg [1, glisDur, 1, idur - glisDur, cpsCoeff]+                  vibr = vibrEnv * osc (sig $ vibRate * vibrCoeff)+                +        cone a x1 b x2 c = [a, x1 * idur, b, x2 * idur, c]+        lincone a x1 b x2 c = linseg $ cone a x1 b x2 c+        expcone a x1 b x2 c = expseg $ cone a x1 b x2 c+        linenIdur a b = linen 1 (a * idur) idur (b * idur)+++-- snow flakes+blue (amp, cps, lfoCps, harmNum, sweepRate) = fmap aout k1+    where +        k1 = randi 1 50+        k2 = lindur [0, 0.5, 1, 0.5, 0]+        k3 = lindur [0.005, 0.71, 0.015, 0.29, 0.01]+        k4 = k2 * (kr $ osc (sig lfoCps) `withD` 0.2)+        k5 = k4 + 2++        ksweep = lindur [harmNum, sweepRate, 1, 1 - sweepRate, 1]+        kenv = expdur [0.001, 0.01, amp, 0.99, 0.001]+        aout k = gbuzz kenv (sig cps + k3) k5 ksweep k (sines3 [(1, 1, 90)])++i2 t0 dt amp cps lfoCps harmNum sweepRate = +    t0 +| (dt *| temp (amp, cps, lfoCps, harmNum, sweepRate))++blueSco = sco blue $ har +    [ i2 0 4 0.5 440 23 10 0.72+    , i2 0 4 0.5 330 20 6  0.66+    ]++-- 4pok+black (amp, cps, filterSweepStart, filterSweepEnd, bandWidth) = +    fmap aout $ rand 1+    where +        k1 = expdur [filterSweepStart, 1, filterSweepEnd]+        a1 noise = reson noise k1 (k1 / sig bandWidth) `withD` 1+        k3 = expdur [0.001, 0.001, amp, 0.999, 0.001]+        a2 = k3 * osc (sig cps + 0.6 * (osc 11.3 `withD` 0.1))+        aout noise = 0.5 * (a1 noise + a2)++i4 t0 dt amp cps filt0 filt1 bw =+    t0 +| (dt *| temp (amp, cps, filt0, filt1, bw))++blackSco = str 1.5 $ sco black $ har +    [ i4 0 1 0.7 220 6000 30 10+    , i4 0 1 0.7 330 8000 20 6+    ]
+ examples/Events.hs view
@@ -0,0 +1,72 @@+-- | Test for different types of events.+module Main where++import Csound.Base+import Data.Monoid++-- | Outputs the drummy sound.+pureTone :: (D, D) -> SE Sig+pureTone (amp, cps) = do+    print' [amp, cps]+    return $ env * sig amp * osc (sig cps)+    where env = expseg [1, idur, 1e-6]++-- | Just prints the argument on the screen.+echo :: D -> SE ()+echo a = print' [a]+++-- | A single metronome (four beats per second).+src = metroE 4++e1, e2, e3, e4, e5, e6, e7, e8 :: Evt D++e1 = cycleE (fmap int [1 .. 5]) src++e2 = iterateE 0 (+ 1) src++e3 = fmap (flip mod' 4) e2++e4 = appendE 0 (+) $ repeatE 1 src++e5 = mappendE e2++e51 :: Evt (D, D)+e51 = mappend +        (repeatE (0.7, 220) (metroE (2/7)))+        (cycleE [(0.5, 440), (0.5, 330)] (metroE 2))++-- rands++e6 = randDs src++e7 = randInts (0, 10) src++e8 = oneOf [100, 200, 300] src++e9 = avgSum $ freqOf [(0.1, 0), (0.9, 1)] src++avgSum :: Evt D -> Evt D+avgSum = accumE (0, 0) $ \a (s, n) ->     +    let s1 = s + a+        n1 = n + 1+    in  (s1 / n1, (s1, n1))++-- mask++e10 :: Evt (D, D)+e10 = withDur 0.5 $ filterE (>* 110) $ mconcat +    [ every 0 [5,7] $ repeatE 330 src+    , every 3 [11] $ repeatE 550 src+    , every 2 [2] $ repeatE 440 src+    , every 0 [4, 1, 3] $ repeatE 220 src]++-----------------------++res e = sched_ echo $ withDur 0.1 e++-- output with sound+resSnd e = sched pureTone $ withDur 0.1 e++main = dac $ res e7+
+ examples/Gm.hs view
@@ -0,0 +1,122 @@+{-# Language DeriveFunctor #-}+-- | Accords in just intonation Gm with 14/8 beat.+module Main where++import Csound++import Color(marimbaSynth)++instr (amp, cps) = sig amp * env * osc (sig cps)+    where+        env = once $ lins [0.00001, 30, 1, 50, 0.5, 100, 0.00001]++type N = (D, D)+type Sco = Score N++-- volumes+baseVolume = 0.35+v3 = baseVolume * 0.8+v2 = baseVolume * 0.7+v1 = baseVolume * 0.5++-- pitches (Gm + Ab)+baseTone = 391.995   -- G+-- phrygian scale: sTTTsTT +tones = [1, 16/15, 6/5, 4/3, 3/2, 8/5, 9/5]        ++cpsMap f x = fmap phi x+    where phi (amp, cps) = (amp, f cps)++lo1, hi1 :: Functor f => f (a, Int) -> f (a, Int) +lo1 = cpsMap (\x -> x - 7)+hi1 = cpsMap (\x -> x + 7)++trip2cps = cpsMap t2cps++t2cps :: Int -> D+t2cps n = double $ (2 ^^ oct) * baseTone * tones !! step+    where (oct, step) = divMod n 7++data Trip a = Trip+    { lead :: [a]+    , body :: (a, a) +    } deriving (Functor)++-- single lead+trip lead = Trip (repeat lead)++-- main left/right hand pattern++-- the first accent is a bit louder than other ones. v3 vs v2+rhp :: Trip a -> Score (D, a)+rhp (Trip leads (a, b)) = en $ mel $ zipWith ($) [triple v3, triple v2, quatra, doub, doub] leads+    where+        triple acc lead = firstLead acc [lead, a, b]  +        quatra     lead = firstLead v3  [lead, a, b, a]+        doub       lead = firstLead v2  [lead, a]++lhp :: Trip a -> Score (D, a)+lhp (Trip leads (a, b)) = en $ mel $ zipWith ($) [triple v3, triple v2, quatra, quatra]  leads+    where+        triple acc lead = firstLead acc [lead, a, b]  +        quatra     lead = firstLead v2  [lead, a, b, a]++firstLead :: D -> [a] -> Score (D, a)+firstLead accVol (a:as) = melMap temp $ (accVol, a) : fmap (\x -> (v1, x)) as ++bass = fmap (\x -> x - 7)++-- First part+tr = trip 4 (2, 0)         -- left tonic+tl = bass $ trip 0 (2, 4)  -- right tonic++t = (0, 2, 4)++firstPart = loop 2 $ har [leftHand1, rightHand1]++rightHand1 = melMap rhp' +        [ t+        , (0, 2, 5)+        , (0, 1, 5)+        , t+        , t+        , (1, 2, 3)+        , (0, 2, 3)+        , t]+        +rhp' (a, b, c) = rhp $ trip c (b, a)++leftHand1 = melMap lhp' +        [ (0, 2, 3) +        , (0, 2, 5)+        , (1, 2, 5)+        , t+        , (0, 2, 3)+        , (1, 2, 3)+        , (-2, 1, 3)+        , t]+        +lhp' (a, b, c) = lhp $ bass $ trip a (b, c)++-- Second part++secondPart = loop 2 $ har [leftHand2, rightHand2] ++leftHand2 = loop 2 $ melMap lhp' +        [ (-2, 1, 2)+        , (-3, 1, 2)]++rightHand2 = mel +    [ t, e, t, s ]+    where p a b (star1, star2) = rhp $ Trip [a, a, b, star1, star2] (2, 0)+          t = p 4 4 (4, 4)   +          e = p 4 5 (4, 4)+          s = p 4 4 (9, 7)  +        +-- all++tot = mel [loop 2 firstPart, secondPart, firstPart]++res = str 1.7 $ sco (onCps marimbaSynth) $ sustain 0.35 $ loop 4 $ trip2cps $ tot++main = dac $ mix res
+ examples/Guis.hs view
@@ -0,0 +1,61 @@+-- | Test for GUI-elements. Right now this example is a total mess and shouldn't work.+-- see you in the next version...+module Main where++import qualified Data.Colour.Names as C++import Control.Applicative++import Csound.Base+++unit = ValSpan (ValDiap 0 1) Linear++linenWidget :: Source Sig+linenWidget = do+    (g1, r1) <- slider unit 0.5+    (g2, r2) <- slider unit 0.5+    let out = liftA2 fun r1 r2        +    source (ver [g1, g2]) out+    where fun a b = linseg [0, a', 1, idur - a' - b', 1, b', 0]+                where a' = idur * ir a+                      b' = idur * ir b  ++instr :: SE Sig -> D -> SE Sig+instr env cps = do+    e <- env+    return $ 0.5 * e * osc (sig cps)++pureTone () = 0.7 * osc 440 +    +u = fmap (props [SetSliderType Fill] . fst) $ slider unit 0.5+v = fmap fst $ knob unit 0.5+r = fmap fst $ roller unit 0.001 0.01+c1 = fmap fst $ count (ValDiap 0 10) 1 Nothing 2+c2 = fmap fst $ count (ValDiap 0 10) 1 (Just 2) 4+b = fmap (setLabel "push me" . fst) button+bb = fmap fst $ butBank 5 3+tb = fmap (setLabel "i'm the toggle" . fst) toggle +j = fmap fst $ joy unit unit (0.2, 0.2)++d = fmap (setBoxType BorderBox) $ box $ t ++ t ++ t+    where t = " Hello everybody, let's look at some cool text in the box "++f = setColors C.green C.magenta++main = dac $ do+    g1 <- u+    g2 <- u+    g3 <- u+    g4 <- r+    g5 <- c1 +    g6 <- c2+    g7 <- b+    g8 <- bb+    g9 <- d+    g10 <- j+    g11 <- tb++    let g = setTextColor C.azure $ hor [sca 3 $ sca 1.5 $ f $ ver [setLabel "Amplitude" g1, setLabel "Frequency" g2, hor [g5, g6]], setBorder ThinDown $ ver [g7, setTextColor C.azure $ ver [f $ setTextColor C.blue $ setButtonType RoundButton g11], sca 2 space ]]+   +    panel (ver [sca 4 g, hor [g7, g7]])
examples/Heartbeat.hs view
@@ -1,4 +1,4 @@--- The Heartbeat by Julie Friedman (without crackle)+-- | The Heartbeat by Julie Friedman (without crackle) -- -- requires temporal-csound --@@ -70,7 +70,10 @@           ar1 = 0.5 * (asig1 + asig3)           ar2 = 0.5 * (asig2 + asig3)                               -          f9 phs = oscil 1 phs $ sines [0.28, 1, 0.74, 0.66, 0.78, 0.48, 0.05, 0.33, 0.12, 0.08, 0.01, 0.54, 0.19, 0.08, 0.05, 0.16, 0.01, 0.11, 0.3, 0.02, 0.2] +          f9 phs = oscil 1 phs $ sines +                        [ 0.28, 1, 0.74, 0.66, 0.78, 0.48, 0.05, 0.33, 0.12+                        , 0.08, 0.01, 0.54, 0.19, 0.08, 0.05, 0.16, 0.01+                        , 0.11, 0.3, 0.02, 0.2]             instr1 :: D -> Sig2 instr1 amp = (a, a)@@ -86,30 +89,30 @@ instrCrackle :: D -> Sig2 instrCrackle cps = crackle (0.5::D) cps 12 20 -scoBeat = sco instr1 $ delay 2 $ loop 32 $ line [0.25 *| lineMap temp [0.5, 0.3], rest 1.5]+scoBeat = sco (onArg instr1) $ del 2 $ loop 32 $ mel [0.25 *| melTemp [0.5, 0.3], rest 1.5] -scoPluck = sco instrPluck $ delay 8 $ line $ take n $ zipWith (\amp pan -> 0.5 *| temp (amp, pan)) -    ([0, (v/40) .. v] ++ repeat v) (cycle [0.2, 0.8])+scoPluck = sco (onArg instrPluck) $ del 8 $ mel $ take n $ zipWith (\amp pan -> 0.5 *| temp (amp, pan)) +    (fmap double $ [0, (v/40) .. v] ++ repeat v) (cycle [0.2, 0.8])     where v = 0.6           dur = 65           n = floor $ (dur - 8)/0.5  -scoChorusel = sco instrChorusel $ chord $ unroll =<< [+scoChorusel = sco (onArg instrChorusel) $ har $ unroll =<< [     (0, 15, (0.4, [7, 7.07, 6, 8], 10, 5)),     (18, 17, (0.27, [6, 7, 7.07, 8.02, 8.03, 5], 9, 6)),     (34, 21, (0.35, [6], 8, 8)),     (40, 15, (0.35, [6.07], 7, 7)),     (48, 7,  (0.35, [7.05], 3.5, 3.5)),     (55, 10, (0.35, [7, 8, 7.07, 6], 5, 8))]-    where unroll (t, dur, (amp, cps, rise, dec)) = [delay t $ stretch dur $ temp (amp, c, rise, dec) | c <- cps]+    where unroll (t, dur, (amp, cps, rise, dec)) = [del t $ str dur $ temp (amp, c, rise, dec) | c <- cps]     -scoCrackle = sco instrCrackle $ chord [-    event 8 100,-    delay 13 $ event 5 50]   +scoCrackle = sco (onArg instrCrackle) $ har [+    str 8 $ temp 100,+    del 13 $ str 5 $ temp 50]       -main = totem $ chord [-    scoBeat, -    scoChorusel, -    scoPluck, -    scoCrackle]+main = dac $ mix $ har [+   scoBeat, +   scoChorusel,+   scoPluck+   ]
+ examples/Midi.hs view
@@ -0,0 +1,30 @@+module Main where+ +-- imports everything+import Csound.Base++-- Let's define a simple sound unit that +-- reads in cycles the table that contains a single sine partial.+-- oscil1 is the standard oscillator with linear interpolation.+-- 1 - means the amplitude, cps - is cycles per second and the last argument+-- is the table that we want to read. +myOsc :: Sig -> Sig+myOsc cps = oscili 1 cps (sines [1])++-- Let's define a simple instrument that plays a sound on the specified frequency.+-- We use @sig@ to convert a constant value to signal and then plug it in the osc unit. +-- We make it a bit quieter by multiplying with 0.5.+pureTone :: (D, D) -> Sig+pureTone (amp, cps) = 0.4 * sig amp * env * (myOsc $ sig cps)+    where env = linsegr [0, 0.2, 1, 1, 0.5] 1.5 0++-- Renders generated csd-file to the "tmp.csd" and runs it with flags +-- for real time output and listening for the midi events from all devices.+main :: IO ()+main = vdac $ midi $ onMsg pureTone++-- If we don't have any midi devices +-- we can try with virtual midi:++-- main = vdac $ midi $ onMsg pureTone+
+ examples/README.txt view
@@ -0,0 +1,35 @@+Here you can try the csound-expression out. ++Requirements:++*   GHC - haskell compiler. This library uses GHC-specific features.++    www.haskell.org/ghc++*   cabal-install (to install haskell packages).+  +    www.haskell.org/cabal++*   Csound compiler (version 5.13 or higher). You must get it installed on your system+    since we are going to generate the csound code we need to compile it to sound somehow.+    We can find out how to install the Csound on www.csounds.com.++    To test whether csound is installed open the command line and type:++    > csound++    It should print a long message with version and available flags and libraries.++*   temporal-csound package. It brings together temporal-music-notation and csound-expression packages.+    It's used to make the process of score-writing more convenient.++    > cabal install temporal-csound+++When  everything is installed examples should work as executable programs.+So you can type in the command line:++> runhaskell AnExample.hs ++and get the sound or csound-file. +
examples/Test.hs view
@@ -14,16 +14,12 @@ -- Let's define a simple instrument that plays a sound on the specified frequency. -- We use @sig@ to convert a constant value to signal and then plug it in the osc unit.  -- We make it a bit quieter by multiplying with 0.5.-pureTone :: D -> Sig-pureTone cps = 0.5 * (myOsc $ sig cps)+pureTone :: D -> SE Sig+pureTone cps = return $ 0.4 * (myOsc $ sig cps) --- Let's trigger the instrument from the score section.--- It plays a single note that starts at 1 and lasts for 3 seconds and --- triggers the instrument 'instr' with frequency of 440 (Hz).--- A function 'temp' always creates a note that starts right away and --- lasts for 1 second. Then we can 'stretch' this note or 'delay' it.-res = sco pureTone $ CsdEventList 5 [(0, 1, 440), (1, 2, 330), (3, 2, 220)]+-- Let's trigger the instrument from the score section. It plays three notes.+res = sco pureTone $ CsdEventList 5 [(0, 1, 440), (1, 1, 330), (2, 1, 220)]  -- Renders generated csd-file to the "tmp.csd". main :: IO ()-main = writeCsd "tmp.csd" res+main = dac $ mixLoop res
+ examples/Tibetan.hs view
@@ -0,0 +1,216 @@+{- | additional parameters: ioff, irise, idec++This remarkable tibetan harmonic chant like effect is created by nine sinusoidal +oscillators, whose frequencies are almost identical: separated by a fraction of +1 Hz from each other. Thus for each component, amplitude modulation leads to its +enhancement or cancelling out in turn. In his composition 'Mutations', Risset +gives the instrument two different envelopes: one with sharp rise and one is a +more gradual rise.+-}+module Tibetan where++import Data.List(zip4)+import Data.Traversable(traverse)++import Control.Monad.Trans.State+import Control.Applicative hiding ((<*))++import System.Random++import Csound +import Color(blurp, blue)++-- | A pure tibetan instrument with randomized parameters.+tibetan :: (D, D, D, D) -> SE Sig+tibetan (amp, cps, rise, dec) = fmap (\x -> pureTibetan (amp, cps, x, rise, dec)) off+    where off = fmap (\x -> 0.3 + ir x) $ rand 0.15++pureTibetan :: (D, D, D, D, D) -> Sig+pureTibetan (amp, cps, off, rise, dec) = mean $ fmap partial $ 0 : offs ++ (fmap negate offs)+    where offs = fmap int [1 .. 4]+          partial rat = linen (sig amp) rise idur dec * oscBy wave (sig $ cps + off * rat)   +          wave = ifB (cps <* 230) (waveBy 5) (ifB (cps <* 350) (waveBy 3) (waveBy 1))+          waveBy n = sines $ [0.3, 0, 0, 0] ++ replicate n 0.1++-----------------------------------------------------------+-- scores++-- tibetan++instant = 1+med = 3+long = 5++-- intersection+deep = 50+shallow = 90+sym = 70++-- myxo mode+ts = [1, 9/8, 5/4, 4/3, 3/2, 5/3, 16/9]++id2cps oct n = baseTone * (2 ^^ (oct + curOct)) * ts !! curId+    where (curOct, curId) = divMod n 7++data Act = Tone Int | Repeat Int | Wait Double++r = Repeat+w = Wait++instance Num Act where    +    fromInteger = Tone . fromInteger++type N = (Double, Double, D, D, D, D)+++data St = St +    { stRepeat :: Int+    , stWait   :: Double+    , stSpan   :: (Double, Double)    +    , stRnds   :: [Double] }++-- constants+baseTone = 110 -- an A+innerOverlap = 0.5+noteLength = 25+fixedNoteLength = 15+offset = 0.03+rise = 5+dec = 15+durStep = 7++initRepeat = 2+initWait = 0.7+initSpan = (0, 0)++updateSt f = modify f >> return []++turtle :: Act -> State St [N]+turtle x = case x of+    Repeat n -> updateSt $ \s -> s{ stRepeat = n }+    Wait n -> updateSt $ \s -> s{ stWait = n } +    -- tones+    Tone t -> state (getNotes t)++getNotes :: Int -> St -> ([N], St)+getNotes k st = (notes, st') +    where t0s = startTimes (offsetStartTime (stWait st) $ stSpan st) durStep+          dts = durs noteLength+          cpss = freqs (ts !! (k - 1))+          amps = fmap cps2amp cpss+          offs = offsets offset+          decs = decays dec+          riss = rises rise++          notes = take (stRepeat st) $ getZipList $ (\t0 dt amp cps ris dec -> +                (t0, dt, double amp, double cps, double ris, double dec)) <$>+                ZipList t0s <*> ZipList dts <*> ZipList amps <*> ZipList cpss <*> ZipList decs <*> ZipList riss++          st' = st{ stSpan = getSpan (stRepeat st) t0s dts }++offsetStartTime :: Double -> (Double, Double) -> Double+offsetStartTime k (t0, dt) = t0 + k * dt++startTimes :: Double -> Double -> [Double]+startTimes t0 step = fmap (+ t0) $ [0, step ..]++durs    = repeat+offsets = repeat+rises   = repeat+decays  = repeat++getSpan :: Int -> [Double] -> [Double] -> (Double, Double)+getSpan num starts durs = (starts !! n, durs !! n)+    where n = num - 1++freqs k = fmap (* base) octs+    where octs = cycle [1, 0.5, 2, 1, 2, 1, 1, 0.5]+          base = k * baseTone  ++cps2amp a = 0.5 * full a+    where full x+            | x < 100 = 1+            | x < 200 = 0.8+            | x < 300 = 0.6+            | x < 400 = 0.5+            | otherwise = 0.4++run :: [Act] -> IO [N]+run as = fmap concat $ fmap (evalState (mapM turtle as)) initSt+    where initSt = fmap (St initRepeat initWait initSpan) $ fmap (randomRs (0, 1)) newStdGen+   +acts :: [Act]+acts = concat $ replicate 2 $ [1, 1, 5, 2, 5, 7, 5, 1, 1, 3, 5, 3, 1, 1, 1, 5, 1, 5, 6, 3, 2, 1, 1, 5, 1, 6, 4, 5, 1, 1]++    +note (start, dur, amp, cps, rise, dec) = del start $ str dur $ +                temp (amp, cps, rise, dec)++globalEffect =  eff (bindSig $ return . blp 5000 . (0.3 * )) . eff rever++res2 ns = har [res ns, del 13 $ res ns] ++res ns = sco tibetan $ har $ fmap note ns++rever x = do+    _ <- delayr 3+    [aleft, aright] <- mapM deltap3 [2.50, 1.25]+    delayw x+    return (f aleft, f aright)+    where x1 = reverb2 (0.6 * x) 6 0.5+          f a = 0.5 * (x1 + a)+++------------------------------------------------------------+-- blurp++blurpVol = 0.5+introDur = 15++toStereo = eff $ \x -> return (x, x)++introBlurp = toStereo $ sco blurp $ introDur *| temp (0.7 * blurpVol)++blurpSco = toStereo $ mel [rest 100, cone 15 0.7, rest 120, cone 10 0.4]+    where cone dt v = eff (\x -> return $ linen x (0.25 * idur) idur (0.25 * idur)) $ sco blurp $ dt *| temp (v * blurpVol)++------------------------------------------------------------+-- stars++starLength      = 2.5 * 60+starParams      = zip4 starVolumes starLfos starHarms starSweeps++starVolume      = 0.3+starVolumes     = fmap (starVolume * ) $ cycle [0.7, 0.3, 0.5, 0.8, 0.9, 0.5, 0.2]+starLfos        = cycle [23, 10, 5, 15, 17]+starHarms       = cycle [10, 6, 7, 10]+starSweeps      = cycle [0.7, 0.6, 0.6, 0.5, 0.8, 0.9, 0.25, 0.7, 0.5, 0.5, 0.6]++starTotalDelay  = 5 * 60+starInitDelays  =              [ 0, 11,  2, 8,  21, 25]+starPeriods     = fmap (* 2.5) [ 7, 23, 77, 13, 17, 31]++starChord       = [0, 1, 2, 4, 7]++starSco = sco blue $+    flip evalState starParams $ traverse addParam $ +    takeS starLength $ har $ zipWith3 phi starInitDelays starPeriods starChord+    where phi dt period note = del dt $ loop 200 $ har [4 *| temp (double $ id2cps 2 note), rest period] ++          addParam cps = state $ \((amp, lfo, harm, sweep) : params) -> +            ((amp, cps, lfo, harm, sweep), params) +             +------------------------------------------------------------++main = do+    notes <- run acts+    dac $ mix $ har +        [ introBlurp+        , del (introDur * 0.70) $ har +            [ globalEffect $ har +                [res2 notes+                , del starTotalDelay $ starSco+                , del (3 * starTotalDelay) $ starSco]+            , blurpSco+            ]]+
+ examples/Wind.hs view
@@ -0,0 +1,72 @@+-- | A whisper of the wind.+module Main where++import Csound++-------------------------------------------------------------+-- orchestra++-- | An instrument that implements a wind sound.+wind (amp, bandRise, bandDec, freqRise, freqDec, pan, winds) = +    fmap fromRnd $ rand (sig $ amp / 400)+    where+        valu1 = 100+        valu2 = 50+        winde = 1 - winds+        ramp a b = linseg [a, idur, b]+        fromRnd a = (sig pan * aout, (1 - sig pan) * aout )+            where+                a2 = butbp a  (ramp freqRise freqDec) (ramp bandRise bandDec) +                a3 = butbp a2 (ramp (freqRise - valu1) (freqDec + valu2))+                              (ramp (bandRise + valu1) (bandDec - valu2))+                +                aout = (a2 + a3) * linseg [0, idur * winds, 1, idur * winde, 0]++-------------------------------------------------------------+-- scores++-- | This example shows the flexibility of the Haskell. Here we can+-- write the scores in the manner of the native Csound style.+i21 t0 dt amp bandRise bandDec freqRise freqDec pan winds = +    del t0 $ dt *| temp (amp, bandRise, bandDec, freqRise, freqDec, pan, winds)++windRes = sco (onArg wind) $ har+    [ i21  0    12   60   500  0    555  111  0     0.2+    , i21  4    8    70   400  0    444  111  0.3   0.6+    , i21  6    8    75   300  0    333  111  0.7   0.7+    , i21  8.5  7    77   300  0    222  111  0.9   0.9++    , i21  12   12   70   500  0    666  444  0.1   0.4+    , i21  15   15   76   600  0    333  333  0.5   0.7+    , i21  17   7    73   500  0    444  333  0.7   0.7+    , i21  18   7    70   400  0    333  333  0.9   0.8++    , i21  20   12   72   500  0    555  333  0.0   0.4+    , i21  24   8    74   600  0    444  333  0.1   0.6+    , i21  28   6    71   500  0    333  333  0.5   0.7+    , i21  28.5 7    70   71   500  666  333  0.9   0.7++    , i21  32   12   76   500  0    666  222  0.1   0.6+    , i21  35   15   72   500  0    333  333  0.5   0.7+    , i21  37   7    74   600  0    444  333  0.7   0.7+    , i21  38   7    72   300  0    333  333  0.9   0.8++    , i21  40   15   70   500  0    555  111  0     0.4+    , i21  44   10   74   600  0    444  111  0.5   0.6+    , i21  48   8    77   500  0    333  111  0.7   0.7+    , i21  48.5 9    76   500  0    222  111  0.9   0.9 ++    , i21  50   12   72   500  0    666  222  0.1   0.6+    , i21  55   15   74   500  0    333  333  0.5   0.7+    , i21  58   8    73   600  0    444  333  0.7   0.7+    , i21  65   9    72   300  0    333  333  0.9   0.8++    , i21  58   12   74   500  0    666  222  0.1   0.6+    , i21  61   15   76   500  0    333  333  0.5   0.7+    , i21  63   12   73   600  0    444  333  0.7   0.7+    , i21  64   12   72   300  0    333  333  0.9   0.8+    ]++-- | Let's repeat everything 10 times and add the sustain for 2 seconds per note.+main = totem $ mix $ sustain 2 $ loop 3 windRes+
src/Csound/Air.hs view
@@ -1,13 +1,24 @@--- | The vital tools. module Csound.Air (-    -- * Oscillators-    +    -- * Basic waveforms+    -- | Basic waveforms that are used most often. A waveform function take in a time varied frequency (in Hz).+     -- ** Bipolar-    osc, oscBy, saw, sq, tri, -- pulse, ramp,-    +    osc, oscBy, saw, isaw, pulse, sqr, tri, blosc,+     -- ** Unipolar-    unipolar, uosc, uoscBy, usaw, usq, utri, -- upulse, uramp,-    +    unipolar, bipolar, uosc, uoscBy, usaw, uisaw, upulse, usqr, utri, ublosc,++    -- * Envelopes++    -- ** Relative duration+    onIdur, lindur, expdur, linendur,+    onDur, lindurBy, expdurBy, linendurBy,+    once, onceBy, several, +    -- ** Looping envelopes+    oscLins, oscElins, oscExps, oscEexps, oscLine, +    -- ** Faders+    fadeIn, fadeOut, fades, expFadeIn, expFadeOut, expFades,+     -- * Filters     -- | Arguemnts are inversed to get most out of curruing. First come parameters and the last one is the signal.     @@ -16,117 +27,171 @@          -- ** Butterworth filters     blp, bhp, bbp, bbr,-    -    -- * Patterns-    once, several, sine, mean,-    -    -- ** Series-    hase, whase,-    haseS, whaseS,-    -    -- ** Crossfade-    cfd, cfds, cfdSpec, cfdsSpec-) where -import Csound.Exp(Tab)-import Csound.Exp.Wrapper(Sig, Spec, sig, kr, Cps)-import Csound.Exp.SE-import Csound.Opcode(idur, oscil3, pvscross, -    atone, tone, areson, reson,-    buthp, butbp, butlp, butbr)-import Csound.Tab(sines)+    -- ** Balanced filters+    -- | Applies filter and balances the output by the input signal.+    lpb, hpb, bpb, brb, blpb, bhpb, bbpb, bbrb, ------------------------------------------------------------------------------ oscillators+    -- * Patterns+    mean, vibrate, randomPitch, chorus, resons, resonsBy, modes, dryWet,     --- | Pure tone.-osc :: Cps -> Sig-osc cps = oscil3 1 cps (sines [1])+    -- ** List functions+    odds, evens, --- | Oscillates with the given table (cubic interpolation).-oscBy :: Tab -> Cps -> Sig-oscBy tab cps = oscil3 1 cps tab+    -- * Other+    reverbsc1 -resolution :: Int-resolution = 12+) where --- | Sawtooth.-saw :: Cps -> Sig-saw cps = oscil3 1 cps (sines $ take resolution $ fmap (1 / ) [1 .. ])--- vco 1 cps 1 0.5 `withInits` (sines [1])+import Data.List(intersperse)+import Data.Boolean +import Csound.Typed+import Csound.Typed.Opcode --- | Square wave.-sq :: Cps -> Sig-sq cps = oscil3 1 cps (sines $ take resolution $ fmap f [(1::Int) .. ])-    where f :: Int -> Double-          f x-            | even x    = 0-            | otherwise = 1 / fromIntegral x--- vco 1 cps 2 0.5 `withInits` (sines [1])+import Csound.Tab(sine) --- | Triangle wave.-tri :: Cps -> Sig-tri cps = oscil3 1 cps (sines $ take resolution $ zipWith f (cycle [1, -1]) [1 ..])-    where f :: Double -> Int -> Double-          f a x-            | even x    = 0-            | otherwise = a / fromIntegral (x ^ (2::Int))--- vco 1 cps 3 0.5 `withInits` (sines [1])+-------------------------------------------------------------------+-- waveforms -{---- | Square wave with variable dty cycle.------ > pulse duty cps------ First argument varies between 0 and 1 (0.5 equals to square wave)-pulse :: Sig -> Sig -> Sig-pulse duty cps = vco 1 cps 2 duty `withInits` (sines [1])+-- | A pure tone (sine wave).+osc :: Sig -> Sig+osc cps = oscil3 1 cps sine --- | Triangle wave with variable ramp character.------ > ramp angle cps------ First argument varies between 0 and 1 (0.5 equals to triangle wave)-ramp :: Sig -> Sig -> Sig-ramp angle cps = vco 1 cps 3 angle `withInits` (sines [1])--}+-- | An oscillator with user provided waveform.+oscBy :: Tab -> Sig -> Sig+oscBy tb cps = oscil3 1 cps tb --- unipolar waves+-- unipolar waveforms  -- | Turns a bipolar sound (ranges from -1 to 1) to unipolar (ranges from 0 to 1) unipolar :: Sig -> Sig unipolar a = 0.5 + 0.5 * a +-- | Turns an unipolar sound (ranges from 0 to 1) to bipolar (ranges from -1 to 1)+bipolar :: Sig -> Sig+bipolar a = 2 * a - 1+ -- | Unipolar pure tone.-uosc :: Cps -> Sig+uosc :: Sig -> Sig uosc = unipolar . osc  -- | Unipolar 'Csound.Air.oscBy'.-uoscBy :: Tab -> Cps -> Sig-uoscBy tab = unipolar . oscBy tab+uoscBy :: Tab -> Sig -> Sig+uoscBy tb = unipolar . oscBy tb  -- | Unipolar sawtooth.-usaw :: Cps -> Sig+usaw :: Sig -> Sig usaw = unipolar . saw +-- | Unipolar integrated sawtooth.+uisaw :: Sig -> Sig+uisaw = unipolar . isaw+ -- | Unipolar square wave.-usq :: Cps -> Sig-usq = unipolar . sq+usqr :: Sig -> Sig+usqr = unipolar . sqr  -- | Unipolar triangle wave.-utri :: Cps -> Sig+utri :: Sig -> Sig utri = unipolar . tri -{- -- | Unipolar pulse.-upulse :: Sig -> Sig -> Sig-upulse a = unipolar . pulse a+upulse :: Sig -> Sig+upulse = unipolar . pulse -uramp :: Sig -> Sig -> Sig-uramp a = unipolar . ramp a--}+-- | Unipolar band-limited oscillator.+ublosc :: Tab -> Sig -> Sig+ublosc tb = unipolar . blosc tb+ --------------------------------------------------------------------------+-- envelopes++-- | Makes time intervals relative to the note's duration. So that:+--+-- > onIdur [a, t1, b, t2, c]+--+-- becomes: +--+-- > [a, t1 * idur, b, t2 * idur, c]+onIdur :: [D] -> [D]+onIdur = onDur idur++-- | Makes time intervals relative to the note's duration. So that:+--+-- > onDur dt [a, t1, b, t2, c]+--+-- becomes: +--+-- > [a, t1 * dt, b, t2 * dt, c]+onDur :: D -> [D] -> [D]+onDur dur xs = case xs of+    a:b:as -> a : b * dur : onDur dur as+    _ -> xs++-- | The opcode 'Csound.Opcode.linseg' with time intervals +-- relative to the total duration of the note.+lindur :: [D] -> Sig+lindur = linseg . onIdur++-- | The opcode 'Csound.Opcode.expseg' with time intervals +-- relative to the total duration of the note.+expdur :: [D] -> Sig+expdur = expseg . onIdur++-- | The opcode 'Csound.Opcode.linseg' with time intervals +-- relative to the total duration of the note given by the user.+lindurBy :: D -> [D] -> Sig+lindurBy dt = linseg . onDur dt++-- | The opcode 'Csound.Opcode.expseg' with time intervals +-- relative to the total duration of the note given by the user.+expdurBy :: D -> [D] -> Sig+expdurBy dt = expseg . onDur dt++-- | The opcode 'Csound.Opcode.linen' with time intervals relative to the total duration of the note. Total time is set to the value of idur.+--+-- > linendur asig rise decay+linendur :: Sig -> D -> D -> Sig+linendur = linendurBy idur++-- | The opcode 'Csound.Opcode.linen' with time intervals relative to the total duration of the note. Total time is set to the value of+-- the first argument.+--+-- > linendurBy dt asig rise decay+linendurBy :: D -> Sig -> D -> D -> Sig+linendurBy dt asig ris dec = linen asig (ris * dt) dt (dec * dt)++        +-- | Fades in with the given attack time.+fadeIn :: D -> Sig+fadeIn att = linseg [0, att, 1]++-- | Fades out with the given attack time.+fadeOut :: D -> Sig+fadeOut dec = linsegr [1] dec 0+        +-- | Fades in by exponent with the given attack time.+expFadeIn :: D -> Sig+expFadeIn att = expseg [0.0001, att, 1]++-- | Fades out by exponent with the given attack time.+expFadeOut :: D -> Sig+expFadeOut dec = expsegr [1] dec 0.0001++-- | A combination of fade in and fade out.+--+-- > fades attackDuration decayDuration+fades :: D -> D -> Sig+fades att dec = fadeIn att * fadeOut dec++-- | A combination of exponential fade in and fade out.+--+-- > expFades attackDuration decayDuration+expFades :: D -> D -> Sig+expFades att dec = expFadeIn att * expFadeOut dec++-------------------------------------------------------------------------- -- filters  -- | High-pass filter.@@ -179,71 +244,201 @@ bbr :: Sig -> Sig -> Sig -> Sig  bbr freq band a = butbr a freq band +-- Balanced filters +balance1 :: (Sig -> Sig -> Sig) -> (Sig -> Sig -> Sig)+balance1 f = \cfq asig -> balance (f cfq asig) asig++balance2 :: (Sig -> Sig -> Sig -> Sig) -> (Sig -> Sig -> Sig -> Sig)+balance2 f = \cfq bw asig -> balance (f cfq bw asig) asig++-- | Balanced low-pass filter.+lpb :: Sig -> Sig -> Sig+lpb = balance1 lp++-- | Balanced high-pass filter.+hpb :: Sig -> Sig -> Sig+hpb = balance1 hp++-- | Balanced band-pass filter.+bpb :: Sig -> Sig -> Sig -> Sig+bpb = balance2 bp++-- | Balanced band-reject filter.+brb :: Sig -> Sig -> Sig -> Sig+brb = balance2 br++-- | Balanced butterworth low-pass filter.+blpb :: Sig -> Sig -> Sig+blpb = balance1 blp++-- | Balanced butterworth high-pass filter.+bhpb :: Sig -> Sig -> Sig+bhpb = balance1 bhp++-- | Balanced butterworth band-pass filter.+bbpb :: Sig -> Sig -> Sig -> Sig+bbpb = balance2 bbp++-- | Balanced butterworth band-reject filter.+bbrb :: Sig -> Sig -> Sig -> Sig+bbrb = balance2 bbr+ -------------------------------------------------------------------------- -- patterns --- | Table for pure sine wave.-sine :: Tab-sine = sines [1]+-- | Selects odd elements from the list.+odds :: [a] -> [a]+odds as = fmap snd $ filter fst $ zip (cycle [True, False]) as  +-- | Selects even elements from the list.+evens :: [a] -> [a]+evens as +    | null as   = []+    | otherwise = odds $ tail as+ -- | Reads table once during the note length.  once :: Tab -> Sig-once a = kr $ oscil3 1 (1 / sig idur) a+once = onceBy idur +-- | Reads table once during a given period of time. +onceBy :: D -> Tab -> Sig+onceBy dt tb = kr $ oscBy tb (1 / sig dt) + -- | Reads table several times during the note length.   several :: Tab -> Sig -> Sig-several tab rate = kr $ oscil3 1 (rate / sig idur) tab+several tb rate = kr $ oscil3 1 (rate / sig idur) tb +-- | Loops over line segments with the given rate.+--+-- > oscLins [a, durA, b, durB, c, durC ..] cps+--+-- where +--+-- * @a@, @b@, @c@ ... -- values+--+-- * durA, durB, durC -- durations of the segments relative to the current frequency.+oscLins :: [D] -> Sig -> Sig+oscLins points cps = loopseg cps 0 0 (fmap sig points) ++-- | Loops over equally spaced line segments with the given rate.+--+-- > oscElins [a, b, c] === oscLins [a, 1, b, 1, c]+oscElins :: [D] -> Sig -> Sig+oscElins points = oscLins (intersperse 1 points)++-- | +--+-- > oscLine a b cps+--+-- Goes from @a@ to @b@ and back by line segments. One period is equal to @2\/cps@ so that one period is passed by @1\/cps@ seconds.+oscLine :: D -> D -> Sig -> Sig+oscLine a b cps = oscElins [a, b, a] (cps / 2)++-- | Loops over exponential segments with the given rate.+--+-- > oscLins [a, durA, typeA, b, durB, typeB, c, durC, typeC ..] cps+--+-- where +--+-- * @a@, @b@, @c@ ... -- values+--+-- * durA, durB, durC -- durations of the segments relative to the current frequency.+--+-- * typeA, typeB, typeC, ... -- shape of the envelope. If the value is 0 then the shap eis linear; otherwise it is an concave exponential (positive type) or a convex exponential (negative type).+oscExps :: [D] -> Sig -> Sig+oscExps points cps = looptseg cps 0 (fmap sig points)++-- | Loops over equally spaced exponential segments with the given rate.+--+-- > oscLins [a, typeA, b, typeB, c, typeC ..] === oscLins [a, 1, typeA, b, 1, typeB, c, 1, typeC ..]+oscEexps :: [D] -> Sig -> Sig+oscEexps points = oscExps (insertOnes points)+    where insertOnes xs = case xs of+            a:b:as  -> a:1:b:insertOnes as+            _       -> xs+ -- | Mean value. mean :: Fractional a => [a] -> a mean xs = sum xs / (fromIntegral $ length xs) --- | Harmonic series. Takes a function that transforms the signal by some parameter--- and the list of parameters. It constructs the series of transformers and sums them--- at the end with equal strength.-hase :: (a -> Sig -> Sig) -> [a] -> Sig -> Sig-hase f as x = mean $ fmap (( $ x) . f) as --- | Harmonic series, but now you can specify the weights of the final sum.-whase :: (a -> Sig -> Sig) -> [(Sig, a)] -> Sig -> Sig-whase f as x = sum $ fmap (\(weight, param) -> weight * f param x) as+-- | Adds vibrato to the sound unit. Sound units is a function that takes in a frequency. +vibrate :: Sig -> Sig -> (Sig -> a) -> (Sig -> a)+vibrate vibDepth vibRate f cps = f (cps * (1 + kvib))+    where kvib = vibDepth * kr (osc vibRate)  --- | Harmonic series for functions with side effects.-haseS :: (a -> Sig -> SE Sig) -> [a] -> Sig -> SE Sig-haseS mf as x = fmap mean $ mapM (\param -> mf param x) as+-- | Adds a random vibrato to the sound unit. Sound units is a function that takes in a frequency. +randomPitch :: Sig -> Sig -> (Sig -> a) -> (Sig -> SE a)+randomPitch rndAmp rndCps f cps = fmap go $ randh (cps * rndAmp) rndCps+    where go krand = f (cps + krand) --- | Weighted harmonic series for functions with side effects.-whaseS :: (a -> Sig -> SE Sig) -> [(Sig, a)] -> Sig -> SE Sig-whaseS mf as x = fmap sum $ mapM (\(weight, param) -> fmap (weight * ) (mf param x)) as +-- | Chorus takes a list of displacments from the base frequencies and a sound unit.+-- Output is mean of signals with displacments that is applied to the base frequency. +chorus :: Fractional a => [Sig] -> (Sig -> a) -> Sig -> a+chorus ks f = \cps -> mean $ fmap (f . (+ cps)) ks --- | Crossfade.+-- | Applies a resonator to the signals. A resonator is+-- a list of band pass filters. A list contains the parameters for the filters: ----- > cfd coeff sig1 sig2+-- > [(centerFrequency, bandWidth)]+resons :: [(Sig, Sig)] -> Sig -> Sig+resons = resonsBy bp++-- | A resonator with user defined band pass filter.+-- Warning: a filter takes in a center frequency, band width and the signal.+-- The signal comes last (this order is not standard in the Csound but it's more+-- convinient to use with Haskell).+resonsBy :: (cps -> bw -> Sig -> Sig) -> [(cps, bw)] -> Sig -> Sig+resonsBy filt ps asig = mean $ fmap (( $ asig) . uncurry filt) ps++-- | Mixes dry and wet signals.  ----- If coeff equals 0 then we get the first signal and if it equals 1 we get the second signal.-cfd :: Sig -> Sig -> Sig -> Sig-cfd coeff a b = (1 - coeff) * a + coeff * 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 -    where mix' c a b = mixFun c b a-  --- | Generic crossfade for n coefficients and n+1 signals.+-- > dryWet ratio effect asig ----- > cfds coeffs sigs-cfds :: [Sig] -> [Sig] -> Sig-cfds = genCfds 0 cfd+-- * @ratio@ - of dry signal to wet+--+-- * @effect@ - means to wet the signal+--+-- * @asig@ -- processed signal+dryWet :: Sig -> (Sig -> Sig) -> Sig -> Sig+dryWet k ef asig = k * asig + (1 - k) * ef asig --- | Spectral crossfade.-cfdSpec :: Sig -> Spec -> Spec -> Spec-cfdSpec coeff a b = pvscross a b (1 - coeff) coeff --- | Generic spectral crossfade.-cfdsSpec :: [Sig] -> [Spec] -> Spec-cfdsSpec = genCfds undefined cfdSpec+-- | Chain of mass-spring-damping filters.+--+-- > modes params baseCps exciter +--+-- * params - a list of pairs @(resonantFrequencyRatio, filterQuality)@+--+-- * @baseCps@ - base frequency of the resonator+--+-- * exciter - an impulse that starts a resonator.+modes :: [(Sig, Sig)] -> Sig -> Sig -> Sig+modes = relResonsBy (\cf q asig -> mode asig cf q) -    +relResonsBy :: (Sig -> a -> Sig -> Sig) -> [(Sig, a)] -> Sig -> Sig -> Sig+relResonsBy resonator ms baseCps apulse = (recip normFactor * ) $ sum $ fmap (\(cf, q) -> harm cf q apulse) ms+    where +        -- limit modal frequency to prevent explosions by +        -- skipping if the maximum value is exceeded (with a little headroom)+        gate :: Sig -> Sig+        gate cps = ifB (sig getSampleRate >* pi * cps) 1 0        ++        normFactor = sum $ fmap (gate . (* baseCps) . fst) ms++                                    -- an ugly hack to make filter stable for forbidden values)+        harm cf q x = g * resonator (1 - g + g * cps) q x+            where cps = cf * baseCps+                  g   = gate cps  ++++-- | Mono version of the cool reverberation opcode reverbsc.+--+-- > reverbsc1 asig feedbackLevel cutOffFreq+reverbsc1 :: Sig -> Sig -> Sig -> Sig+reverbsc1 x k co = 0.5 * (a + b)+    where (a, b) = ar2 $ reverbsc x x k co+
src/Csound/Base.hs view
@@ -1,361 +1,39 @@ -- | Basic types and functions. --+-- This module re-exports everything.+-- -- WARNING (for Csound users): the maximum amplitude is 1.0. There is no way to alter it.  -- Don't define your amplitudes with 9000 or 11000. But the good news are: all signals -- are clipped by 1 so that you can not damage your ears and your speakers by a little typo. module Csound.Base(-    -- * Introduction to Csound for Haskell users-    -    -- | We are going to make electronic music. But what is Csound? And why should we use it?    -    ---    -- Csound is a domain specific programming language. It helps you to define synthesizers and make some music with them (<http://www.csounds.com>). -    -- Csound was born in 1985 (a bit older than Haskell) at MIT by Barry Vercoe. It's widely used in the academia.-    -- It has a long history. So with Csound we get a lot of music dsp-algorithms ready to be used. It's written in C.-    -- So it's very efficient. It's driven by text, so we can generate it. Csound's community is very friendly (what a coincidence!). -    -- Csound is very well documented.-    --     -    -    -- ** Making music with Csound-        -    -- | You don't need to know Csound to use this library.-    -- but it's helpful to know the main features of the Csound: how can you create music with Csound in general, -    -- what design choices were made, basic features and quirks. Csound belongs to the MUSIC N family -    -- of  programming languages. What does it mean? It means that description of the music is divided in two parts:-    ---    -- 1. Orchestra. User defines instruments-    ---    -- 2. Scores. User triggers instruments with a list of notes-    ---    -- An instrument is something that listens to notes and converts them to signals. -    -- Note is a tuple: (instrument name, start time, duration, parameters). Parameters cell is-    -- a tuple of primitive types: numbers ('Csound.Base.D'), strings ('Csound.Base.Str') and tables or arrays of numbers ("Csound.Tab").-    -- -    -- Scores are very simple yet powerful. Csound handles polyphony for you. If you trigger-    -- several notes at the same time on the same instrument you get three instances of the same-    -- instrument running in parallel. It's very cool feature (not so easy thing to do with Pd).-    ---    -- But main strength lies in the Orchestra section. Here you can define the timbres for-    -- your musical journey. Csound is mostly for making strange sounds. How you can do it?-    -- You do it with instruments. An instrument is a sequence of statements that define a flow-graph-    -- for your sound waves. For an instrument you can use predefined sound generators and transformers ("Csound.Opcode" and "Csound.Air").-    -- -    -- Score/Orchestra division stays in this library too. You define your instruments of the type-    ---    -- > (Arg a, Out b) => a -> b-    ---    -- An instrument is something that converts arguments-like things (tuple of primitive values) to output-like things (tuple of signals).-    ---    -- When you are done with the orchestra section you can trigger the instruments with the function 'Csound.Base.sco'-    ---    -- > sco :: (Arg a, Out b, CsdSco f) => (a -> b) -> f a -> f (Mix (NoSE b))-    ---    -- It takes an instrument and the bunch of notes for this instrument. Bunch of notes is represented with @f@-container.-    -- It's parametrized with note type. f belongs to the type class 'Csound.Base.CsdSco'. -    -- This library lets you use your own representation of scores. The default one is-    -- 'Csound.Base.CsdEventList'. It is close to the Csound native representation of the scores (so it is not very-    -- convinient to use it). You can use a package temporal-csound as an alternative. -    ---    -- The output looks scary but let's try to understand it by bits:-    ---    -- * @CsdSco f => f a@ - you can think of it as a container of some values of type @a@ (every value of type @a@ -    -- starts at some time and lasts for some time in seconds)-    ---    -- * @Mix a@ - is an output of Csound instrument it can be one or several signals ('Csound.Base.Sig' or 'Csound.Base.CsdTuple'). -    ---    -- * @NoSE a@ - it's a tricky part of the output. 'NoSE' means literaly 'no SE'. It tells to the type checker that it can skip -    -- the 'Csound.Base.SE' wrapper from the type 'a' so that @SE a@ becomes just @a@ or @SE (a, SE b, c)@ becomes @(a, b, c)@. -    -- Why should it be? I need 'SE' to deduce the order of the-    -- opcodes that have side effects. I need it within one instrument. But when instrument is rendered I no longer need 'SE' type. -    -- So 'NoSE' lets me drop it from the output type. -    ---    ---    -- If you got used to Csound you can ask -- where is the instrument name in the score? No need to worry about names -    -- they are generated automatically.-    ---    -- In Csound to apply some effect one must use the global variables. There are some instruments that produce signals and write them to-    -- the global variables and there is an instrument that functions as mixer. It's turned on for the whole piece and it reads the global-    -- variables and applies the effects to the sound and finally writes it to the file or to the speakers. In this library it's very easy-    -- to apply an effect to the outputs of the instruments. There is a function 'Csound.Base.mix':-    ---    -- > mix :: (Out a, Out b, CsdSco f) => (a -> b) -> f (Mix a) -> f (Mix (NoSE a))-    ---    -- Looks like the function 'Csound.Base.sco'. But now the first argument is an effect. It takes not a note but a signal (or a tuple of signals)-    -- and gives back some signal. The second argument holds the sound that we'd like to apply the effect to. With this function we can apply reverb or-    -- adjust the gain levels or apply some envelope, any valid csound transformation will do. -    -    -- ** Flags and options-    -    -- | Music is defined in two parts. They are Orchestra and Scores. But there is a third one. It's used-    -- to set the global settings like sample rate or control rate values (block size). In this library you-    -- can set the initial values with 'Csound.Base.CsdOptions'.-    -    -- ** Features and quirks-    -    -- *** Audio and control rates-    -    -- | Csound has made a revolution in electronic music technology. It introduced two types of signals.-    -- They are audio rate and control rate signals. The audio rate signals is what we hear and control rate-    -- signals is what changes the parameters of sound. Control rate is smaller then audio rate. It speeds-    -- up performance dramatically. Let's look at one of the sound units (they are called opcodes)-    ---    -- > ares buthp asig, kfreq [, iskip]-    ---    -- It's a butterworth high pass filter as it defined in the Csound. a-sig - means sig at audio rate.-    -- k-freq means freq at control rate (for historical reasons it is k not c). iskip means skip at i-rate.-    -- i-rate means init time rate. It is when an instruments instance is initialized to play a note. i-rate-    -- values stays the same for the whole note. So we can see that signal is filtered at audio rate but-    -- the center frequency of the filter changes at the control rate. In this library I've merged the -    -- two types together ('Csound.Base.Sig'). If you plug a signal into kfreq we can infer that you want this-    -- signal to be control rate. In Csound some opcodes exist go in pairs. One that produces audio signals-    -- and one that produces control rate signals. By default if there is no constraint for the signal it is rendered-    -- at the audio rate except for those units that produce sound envelopes (like 'Csound.Opcode.Basic.linseg').    -    ---    -- You can change this behaviour with functions 'Csound.Base.ar' and 'Csound.Base.kr'. They set the signal-like things to-    -- audio or control rate. For instance if you want your envelope to run-    -- at control rate, write:-    ---    -- > env = ar $ linseg [0, idur/2, 1, idur/2, 0]-    -    -- *** Table size-    -    -- | For speed table size should be the power of two or power of two plus one (all tables for oscillators). -    -- In this library you can specify the relative size (see 'Csound.Base.CsdOptions').-    -- I've tried to hide the size definition to make sings easier.     -    -    -- ** How to read the Csound docs-    -    -- | You'd better get acquainted with Csound docs. Docs are very good. How to read them? For instance you want to use an oscillator with cubic interpolation -    -- so you dig into the "Csound.Opcode.Basic" and find the function:-    ---    -- > oscil3 :: Sig -> Sig -> Tab -> Sig-    ---    -- From Hackage we can guess that it takes two signals and table and returns a signal. It's a clue but a vogue one.-    -- Let's read along, in the docs you can see a short description (taken from Csound docs):-    ---    -- > oscil3 reads table ifn sequentially and repeatedly at a frequency xcps. -    -- > The amplitude is scaled by xamp. Cubic interpolation is applied for table look up from internal phase values. -    -- -    -- and here is the Csound types (the most useful part of it)  -    ---    -- > ares oscil3 xamp, xcps, ifn [, iphs]-    -- > kres oscil3 kamp, kcps, ifn [, iphs]-    ---    -- We see a two versions of the opcode. For audio and control rate signals. By default first is rendered-    -- if we don't plug it in something that expects control rates. It's all about rates, but what can we find out-    -- about the arguments?-    -- -    -- First letter signifies the type of the argument and the rest is the name. We can see that first signal is amp with x rate.-    -- and the second one is cps with x rate. We can guess that amp is the amplitude and cps is cycles per second. This unit-    -- reads the table with given amplitude (it is a signal) and frequency (it is a signal too). Or we can just read about it-    -- in the docs if we follow the link that comes at the very last line in the comments:-    ---    -- * doc: <http://www.csounds.com/manual/html/oscil3.html>-    -- -    -- I've said about a-, k- and i-rates. But what is the x-rate? Is it about X-files or something? X means a-rate or k-rate.-    -- You can use both of them for this argument. Let's go through all types that you can find:-    ---    -- * asig -- audio rate ('Csound.Base.Sig')-    ---    -- * ksig -- control rate ('Csound.Base.Sig')-    ---    -- * xsig -- audio or control rate ('Csound.Base.Sig')-    ---    -- * inum -- constant number ('Csound.Base.D')-    ---    -- * ifn -- table ('Csound.Tab.Tab'). They are called functional tables in Csound.-    ---    -- * Sfile -- string, probably a file name ('Csound.Base.Str')-    ---    -- * fsrc -- spectrum ('Csound.Base.Spec'). Yes, you can mess with sound in the space domain.   -    ---    -- Often you will see the auxiliary arguments, user can skip them in Csound. So we can do it in Haskell too.-    -- But what if we want to supply them? We can use the function 'Csound.Base.withInits' for this purpose.--       -    -- ** Example (a concert A)-    -    -- |-    -- > module Main where-    -- > -    -- > -- imports everything-    -- > import Csound.Base-    -- > -    -- > -- Let's define a simple sound unit that -    -- > -- reads in cycles the table that contains a single sine partial.-    -- > -- oscil1 is the standard oscillator with linear interpolation.-    -- > -- 1 - means the amplitude, cps - is cycles per second and the last argument-    -- > -- is the table that we want to read. -    -- > myOsc :: Sig -> Sig-    -- > myOsc cps = oscili 1 cps (sines [1])-    -- > -    -- > -- Let's define a simple instrument that plays a sound on the specified frequency.-    -- > -- We use sig to convert a constant value to signal and then plug it in the osc unit. -    -- > -- We make it a bit quieter by multiplying with 0.5.-    -- > pureTone :: D -> Sig-    -- > pureTone cps = 0.5 * (myOsc $ sig cps)-    -- > -    -- > -- Let's trigger the instrument from the score section.-    -- > -- It plays a three notes. One starts at 0 and lasts for one second with frequency of 440,-    -- another one starts at 1 second and lasts for 2 seconds, and the last note lasts for 2 seconds-    -- at the frequency 220 Hz. -    -- > res = sco pureTone $ CsdEventList 5 [(0, 1, 440), (1, 2, 330), (3, 2, 220)]-    -- > -    -- > -- Renders generated csd-file to the "tmp.csd".-    -- > main :: IO ()-    -- > main = writeCsd "tmp.csd" res-    ---    -- Now you can invoke Csound on tmp.csd and listen to the result with your favourite player.-    ---    -- > csound tmp.csd -o a.wav  -    ---    -- That's it @csound@ is a separate program that we have to run to compile our csd-files to sounds.-    -- We can listen to the sound as it runs. It can be configured with flags.-    -    -- ** More examples-    -    -- | You can find many examples at:-    ---    -- * A translation of the Amsterdam catalog of Csound computer instruments: <https://github.com/anton-k/amsterdam>-    ---    -- * Csound expression Tutorial at (TODO).-        -    -- ** References-    -    -- | Got interested in Csound? Csound is very well documented. There are good tutorials, read about it at:-    --    -    -- * Reference manual: <http://www.csounds.com/manual/html/index.html >-    ---    -- * Floss tutorials: <http://en.flossmanuals.net/csound/>-    ---    -- * Amsterdam catalog of Csound computer instruments: <http://www.codemist.co.uk/AmsterdamCatalog/>-    ---    -- * Lots of wonderful real-time examples by Iain McCurdy: <http://iainmccurdy.org/csound.html>-    ---    -- * Outdated but short manual on Csound <http://cara.gsu.edu/courses/csound_users_seminar/csound/3.46/CsIntro.html>-   -    -- * Types-    Val, arity,-    -    -- ** Constants     -    -- | A constant value doesn't change while instrument is playing a note.-    -- Only constants can be passed as arguments to the instruments.-    D, Str,-    withInits,-    -    -- ** Tables-    -- | In Csound tables can be treated as primitive values. They can be passed to instruments in the score events.-    -- There are limited set of functions which you can use to make new tables. Look at the following module for details:+    module Csound.Types, +    module Csound.Control,+    module Csound.IO,+    module Csound.Air,     module Csound.Tab,-    -    -- ** Signals-    -- | Signals can be audio or control rate. Rate is derived from the code.-    -- If there are rate-collisions, values will be converted to the right rates.    -    -- For example, if you are trying to apply an opcode that expects control-    -- rate signal to some audio rate signal, the signal will be downsampled behind the scenes.-    Sig, Spec,-   -    -- ** Booleans-    -- | Use functions from the module "Data.Boolean" to make boolean expressions.-    BoolSig, BoolD,  -    module Data.Boolean,--    -- ** Side effects-    SE,    --    -- ** Tuples-    CsdTuple,-    -    -- ** Converters-    ToSig(..), ar, kr, ir, sig, double, str,          -        -    -- * Making a sound-    -    -- | Let's make some noise. Sound is build from list of tracks ('SigOut').-    Out,-    -    -- ** Handy short-cuts-    Sig2, Sig3, Sig4, Ksig, Amp, Cps, Iamp, Icps,-     -    -- ** Scores-    -- | We can define an instrument and tell it to play some notes.-    Arg(..), ArgMethods, makeArgMethods,-    Mix, sco, mix, CsdEvent, CsdEventList(..), CsdSco(..),-    -    -- ** Effects-    effect, effectS,--    -- ** Midi-    -- | We can define a midi-instrument. Then we can trigger the instrument with a midi-keyboard.-    --Msg, midi, pgmidi,--    -- ** Rendering-    -- | Now we are ready to create a csound-file. The function 'renderCsd' creates a 'String' that-    -- contains the description of our music. We can save it to a file and compile it with our @csound@-    -- wizard. -    renderCsd, writeCsd, playCsd,-    -    -- *** Players (Linux)-    -- | Handy short-cuts for function 'Csound.Base.playCsd'.-    mplayer, totem, -    -    -- *** Players (Windows)-    -- | Handy short-cuts for function 'Csound.Base.playCsd'.-    ---    -- TODO (you can send me your definitions)--    -- *** Players (OS X)-    -- | Handy short-cuts for function 'Csound.Base.playCsd'.-    ---    -- TODO (you can send me your definitions)--   -    -- ** Opcodes    -    -- | Some colors to paint our soundscapes.-    module Csound.Opcode,-    -    -- ** Patterns-    -- | Frequently used combinations of opcodes.-    module Csound.Air,        +    module Csound.Options,+    module Csound.SigSpace, -    -- ** Options-    -- | We can set some csound options.-    Channel, CtrlId, CsdOptions(..), module Data.Default,-        -    renderCsdBy, writeCsdBy, playCsdBy,  -    -    -- *** Players (Linux)-    -- | Handy short-cuts for function 'Csound.Base.playCsdBy'.-    mplayerBy, totemBy-    -    -    -- *** Players (Windows)-    -- | Handy short-cuts for function 'Csound.Base.playCsd'.-    ---    -- TODO (you can send me your definitions)+    -- * Standard classes+    module Data.Boolean,+    module Data.Default,+    module Data.Monoid, -    -- *** Players (OS X)-    -- | Handy short-cuts for function 'Csound.Base.playCsd'.-    ---    -- TODO (you can send me your definitions)+    -- * Opcodes+    module Csound.Typed.Opcode ) where -import Data.Default-import Data.Boolean import Csound.Air --import Csound.Exp-import Csound.Exp.Cons-import Csound.Exp.Wrapper-import Csound.Exp.Tuple-import Csound.Exp.Arg import Csound.Tab-import Csound.Exp.Logic-import Csound.Exp.SE-import Csound.Exp.Options-import Csound.Exp.Mix-import Csound.Exp.EventList--import Csound.Opcode+import Csound.Types+import Csound.Control import Csound.IO+import Csound.SigSpace+import Csound.Options +import Data.Boolean+import Data.Default+import Data.Monoid+    +import Csound.Typed.Opcode
+ src/Csound/Control.hs view
@@ -0,0 +1,19 @@+-- | The module contains the modules that are responsible+-- for converting events to signals +module Csound.Control(+    -- * Side effects+    -- | A Csound's equivallent for IO monad.+    module Csound.Control.SE, +    -- * Events+    -- | Handy functions to arrange the event streams (periodic and random).+    module Csound.Control.Evt,+    -- * Instruments+    -- | Invoking the instruments+    module Csound.Control.Instr+) where++import Csound.Control.SE        +import Csound.Control.Evt+import Csound.Control.Instr++
+ src/Csound/Control/Evt.hs view
@@ -0,0 +1,201 @@+{-#Language BangPatterns, TupleSections, FlexibleContexts #-}+module Csound.Control.Evt(+    Evt(..), Bam, ++    -- * Core functions+    boolToEvt, evtToBool, sigToEvt, stepper,+    filterE, filterSE, accumSE, accumE, filterAccumE, filterAccumSE,+    Snap, snapshot, snaps,+    +    -- * Opcodes+    metroE, changedE, triggerE, ++    -- * Higher-level event functions+    cycleE, iterateE, repeatE, appendE, mappendE,+    oneOf, freqOf, freqAccum, +    randDs, randInts, randSkip, randSkipBy, +    range, listAt,   +    every, masked        +) where++import Data.Monoid++import Data.Boolean++import Csound.Typed+import Csound.Typed.Opcode++-- | Behaves like 'Csound.Opcode.Basic.metro', but returns an event stream.+metroE :: Sig -> Evt ()+metroE = sigToEvt . metro++-- | Behaves like 'Csound.Opcode.Basic.changed', but returns an event stream.+changedE :: [Sig] -> Evt ()+changedE = sigToEvt . changed++-- | Behaves like 'Csound.Opcode.Basic.trigger', but returns an event stream.+triggerE :: Sig -> Sig -> Sig -> Evt ()+triggerE a1 a2 a3 = sigToEvt $ trigger a1 a2 a3++----------------------------------------------------------------------+-- higher level evt-funs++-- | Constructs an event stream that contains an infinite repetition+-- values from the given list. When an event happens this function takes +-- the next value from the list, if there is no values left it starts+-- from the beggining of the list.+cycleE :: (Tuple a, Arg a) => [a] -> Evt b -> Evt a+cycleE vals evts = listAt vals $ range (0, int $ length vals) evts++-- | Turns an event of indices to the event of the values from the list.+-- A value is taken with index. +listAt :: (Tuple a, Arg a) => [a] -> Evt D -> Evt a+listAt vals evt+    | null vals = mempty+    | otherwise = fmap (atArg vals) $ filterE within evt+    where+        within x = (x >=* 0) &&* (x <* len)+        len = int $ length vals++atArg :: (Tuple a, Arg a) => [a] -> D -> a+atArg as ind = guardedArg (zip (fmap (\x -> int x ==* ind) [0 .. ]) as) (head as)++-- | +--+-- > range (xMin, xMax) === cycleE [xMin .. pred xMax]+range :: (D, D) -> Evt b -> Evt D+range (xMin, xMax) = iterateE xMin $ \x -> ifB ((x + 1) >=* xMax) xMin (x + 1)++-- | An event stream of the integers taken from the given diapason.+randInts :: (D, D) -> Evt b -> Evt D+randInts (xMin, xMax) = accumSE (0 :: D) $ const $ \s -> fmap (, s) $ getRnd+    where getRnd = fmap (int' . readSnap) $ random (sig $ int' xMin) (sig $ int' xMax)++-- | An event stream of the random values in the interval @(0, 1)@.+randDs :: Evt b -> Evt D+randDs = accumSE (0 :: D) $ const $ \s -> fmap (, s) $ fmap readSnap $ random (0::D) 1 ++-- | Skips elements at random.+--+-- > randSkip prob+--+-- where @prob@ is probability of includinng the element in the output stream. +randSkip :: D -> Evt a -> Evt a+randSkip d = filterSE (const $ fmap (<=* d) $ random (0::D) 1)++-- | Skips elements at random.+--+-- > randSkip probFun+--+-- It behaves just like @randSkip@, but probability depends on the value.+randSkipBy :: (a -> D) -> Evt a -> Evt a+randSkipBy d = filterSE (\x -> fmap (<=* d x) $ random (0::D) 1)++-- | When something happens on the given event stream resulting+-- event stream contains an application of some unary function to the +-- given initial value. So the event stream contains the values:+--+-- > [s0, f s0, f (f s0), f (f (f s0)), ...]+iterateE :: (Tuple a) => a -> (a -> a) -> Evt b -> Evt a+iterateE s0 f = accumE s0 (const phi)+    where phi s = (s, f s)++-- | Substitutes all values in the input stream with the given constant value.+repeatE :: Tuple a => a -> Evt b -> Evt a+repeatE a = fmap (const a)++-- | Accumulates a values from the given event stream with binary function.+-- It's a variant of the fold for event streams.+--+-- > appendE z f evt+--+-- When value @a@ happens with @evt@, the resulting event stream contains+-- a value (z `f` a) and in the next time @z@ equals to this value.+appendE :: Tuple a => a -> (a -> a -> a) => Evt a -> Evt a+appendE empty append = accumE empty phi+    where phi a s = let s1 = s `append` a in (s1, s1)++-- | A special variant of the function `appendE` for the monoids. +-- Initial value is `mempty` and binary function is `mappend` which+-- belong to the instance of the class `Monoid`.+mappendE :: (Monoid a, Tuple a) => Evt a -> Evt a+mappendE = appendE mempty mappend++-- | Constructs an event stream that contains values from the+-- given list which are taken in the random order.+oneOf :: (Tuple a, Arg a) => [a] -> Evt b -> Evt a+oneOf vals evt = listAt vals $ randInts (0, int $ length vals) evt++-- | Represents a values with frequency of occurence.+type Rnds a = [(D, a)]+++-- | Constructs an event stream that contains values from the+-- given list which are taken in the random order. In the list we specify+-- not only values but the frequencies of occurrence. Sum of the frequencies +-- should be equal to one.+freqOf :: (Tuple a, Arg a) => Rnds a -> Evt b -> Evt a+freqOf rnds evt = fmap (takeByWeight accs vals) $ randDs evt +    where+        accs = accumWeightList $ fmap fst rnds+        vals = fmap snd rnds++takeByWeight :: (Tuple a, Arg a) => [D] -> [a] -> D -> a+takeByWeight accumWeights vals at = +    guardedArg (zipWith (\w val -> (at <* w, val)) accumWeights vals) (last vals)++accumWeightList :: Num a => [a] -> [a]+accumWeightList = go 0+    where go !s xs = case xs of+            []   -> []+            a:as -> a + s : go (a + s) as+   +-- | This function combines the functions 'Csound.Control.Evt.accumE' and+-- 'Csound.Control.Evt.freqOf'. We transform the values of the event stream+-- with stateful function that produce not just values but the list of values+-- with frequencies of occurrence. We apply this function to the current state+-- and the value and then at random pick one of the values.+freqAccum :: (Tuple s, Tuple (b, s), Arg (b, s)) +    => s -> (a -> s -> Rnds (b, s)) -> Evt a -> Evt b +freqAccum s0 f = accumSE s0 $ \a s -> +    let rnds = f a s+        accs = accumWeightList $ fmap fst rnds+        vals = fmap snd rnds+    in  fmap (takeByWeight accs vals . readSnap) $ random (0 :: D) 1++-- | Specialization of the function 'Csound.Control.Evt.masked'. +--+-- > every n [a, b, c, ..] evt+--+-- constructs a mask that skips first @n@ elements and then produces+-- an event and skips next (a - 1) events, then produces an event and+-- skips next (b - 1) events and so on. It's useful for construction of +-- the percussive beats. For example +--+-- > every 0 [2] (metroE 2)+--+-- triggers an event on the odd beats. With this function we can +-- create a complex patterns of cyclic events.+--+every :: (Tuple a, Arg a) => Int -> [Int] -> Evt a -> Evt a+every empties beats = masked mask  +    where mask = (fmap (\x -> if x then 1 else 0) $ (replicate empties False) ++ patternToMask beats)++-- | Filters events with the mask. A mask is a list of ones and zeroes. +-- n'th element from the given list should be included in the resulting stream+-- if the n'th element from the list equals to one or skipped if the element +-- equals to zero.+masked :: (Tuple a, Arg a) => [D] -> Evt a -> Evt a+masked ms = filterAccumE 0 $ \a s -> +    let n  = int $ length ms+        s1 = ifB (s + 1 <* n) (s + 1) 0+    in  (atArg ms s ==* 1, a, s1)++patternToMask :: [Int] -> [Bool]+patternToMask xs = case xs of+    []   -> []+    a:as -> single a ++ patternToMask as+    where single n +            | n <= 0    = []+            | otherwise = True : replicate (n - 1) False+
+ src/Csound/Control/Instr.hs view
@@ -0,0 +1,132 @@+{-# Language TypeFamilies, FlexibleContexts, FlexibleInstances #-}+-- | We can convert notes to sound signals with instruments. +-- An instrument is a function:+--+-- > (Arg a, Sigs b) => a -> SE b+--+-- It takes a tuple of primitive Csound values (number, string or array) and converts+-- it to the tuple of signals and it makes some side effects along the way so+-- the output is wrapped in the 'Csound.Base.SE'-monad.+--+-- There are only three ways of making a sound with an instrument:+--+-- * Suplpy an instrument with notes (@Mix@-section).+--+-- * Trigger an instrument with event stream (@Evt@-section).+--+-- * By using midi-instruments (@Midi@-section).+--+-- Sometimes we don't want to produce any sound. Our instrument is just+-- a procedure that makes something useful without being noisy about it. +-- It's type is:+--+-- > (Arg a) => a -> SE ()+-- +-- To invoke the procedures there are functions with trailing underscore.+-- For example we have the function @trig@ to convert event stream to sound:+--+-- > trig :: (Arg a, Sigs b) => (a -> SE b) -> Evts (D, D, a) -> b +--+-- and we have a @trig@ with underscore to convert the event stream to+-- the sequence of the procedure invkations:+--+-- > trig_ :: (Arg a) => (a -> SE ()) -> Evts (D, D, a) -> SE () +--+-- To invoke instruments from another instrumetnts we use artificial closures+-- made with functions with trailing xxxBy. For example:+--+-- > trigBy :: (Arg a, Arg c, Sigs b) => (a -> SE b) -> (c -> Evts (D, D, a)) -> (c -> b)+-- +-- Notice that the event stream depends on the argument of the type c. Here goes+-- all the parameters that we want to pass from the outer instrument. Unfortunately+-- we can not just create the closure, because our values are not the real values.+-- It's a text of the programm (a tiny snippet of it) to be executed. For a time being+-- I don't know how to make it better. So we need to pass the values explicitly. +--+-- For example, if we want to make an arpeggiator:+--+-- > pureTone :: D -> SE Sig+-- > pureTone cps = return $ mul env $ osc $ sig cps+-- >    where env = linseg [0, 0.01, 1, 0.25, 0]+-- > +-- > majArpeggio :: D -> SE Sig+-- > majArpeggio = return . schedBy pureTone evts+-- >     where evts cps = withDur 0.5 $ fmap (* cps) $ cycleE [1, 5/3, 3/2, 2] $ metroE 5+-- > +-- > main = dac $ mul 0.5 $ midi $ onMsg majArpeggio+--+-- We should use 'Csound.Base.schedBy' to pass the frequency as a parameter to the event stream.+module Csound.Control.Instr(+    -- * Mix+    -- | We can invoke instrument with specified notes. +    -- Eqch note happens at some time and lasts for some time. It contains +    -- the argument for the instrument. +    --+    -- We can invoke the instrument on the sequence of notes (@sco@), process+    -- the sequence of notes with an effect (@eff@) and convert everything in+    -- the plain sound signals (to send it to speakers or write to file or +    -- use it in some another instrument).+    --+    -- The sequence of notes is represented with type class @CsdSco@. Wich+    -- has a very simple methods. So you can use your own favorite library +    -- to describe the list of notes. If your type supports the scaling in +    -- the time domain (stretching the timeline) you can do it in the Mix-version+    -- (after the invokation of the instrument). All notes are rescaled all the+    -- way down the Score-structure. +    CsdSco(..), Mix, sco, mix, eff, CsdEventList(..), CsdEvent, +    mixLoop, sco_, mix_, mixLoop_, mixBy, ++    -- * Midi+    Msg, Channel, midi, midin, pgmidi, ampCps,+    midi_, midin_, pgmidi_,+    -- ** Reading midi note parameters+    cpsmidi, ampmidi,++    -- * Evt            +    trig, sched, schedHarp,+    trig_, sched_, +    trigBy, schedBy, schedHarpBy,+    withDur,++    -- * Overload+    -- | Converters to make it easier a construction of the instruments.+    Instr(..), MidiInstr(..), AmpInstr(..), CpsInstr(..)+) where++import Csound.Typed+import Csound.Typed.Opcode+import Csound.Control.Overload++import Csound.Control.Evt(metroE, repeatE)++--------------------------------------------------------------------------+-- midi++ampCps :: Msg -> (D, D)+ampCps msg = (ampmidi msg 1, cpsmidi msg)++-- | Sets the same duration for all events. It's useful with the functions @sched@, @schedBy@, @sched_@. +--+-- > withDur dur events === fmap (\x -> (dur, x)) events+withDur :: D -> Evt a -> Evt (D, a)+withDur dt = fmap $ \x -> (dt, x) +++-- | Mixes the scores and plays them in the loop.+mixLoop :: (CsdSco f, Sigs a) => f (Mix a) -> a+mixLoop a = sched instr $ withDur dur $ repeatE unit $ metroE $ sig $ 1 / dur+    where +        notes = toCsdEventList a+        dur   = double $ csdEventListDur notes++        instr _ = return $ mix notes++-- | Mixes the procedures and plays them in the loop.+mixLoop_ :: (CsdSco f) => f (Mix Unit) -> SE ()+mixLoop_ a = sched_ instr $ withDur dur $ repeatE unit $ metroE $ sig $ 1 / dur+    where +        notes = toCsdEventList a+        dur   = double $ csdEventListDur notes++        instr _ = mix_ notes+
+ src/Csound/Control/Overload.hs view
@@ -0,0 +1,8 @@+module Csound.Control.Overload(+    Instr(..), MidiInstr(..), AmpInstr(..), CpsInstr(..)        +) where++import Csound.Control.Overload.Instr+import Csound.Control.Overload.MidiInstr+import Csound.Control.Overload.SpecInstr+
+ src/Csound/Control/Overload/Instr.hs view
@@ -0,0 +1,74 @@+{-# Language TypeFamilies, FlexibleInstances, FlexibleContexts #-}+module Csound.Control.Overload.Instr(+    Instr(..)+) where++import Csound.Typed++-- | Converts a value to the instrument that is used with the functions 'Csound.Base.sco' or 'Csound.Base.eff'.+class Instr a where+    type InstrIn  a :: *+    type InstrOut a :: *++    onArg :: a -> InstrIn a -> SE (InstrOut a)++instance Instr (a -> Sig) where+    type InstrIn  (a -> Sig) = a+    type InstrOut (a -> Sig) = Sig++    onArg f = return . f++instance Instr (a -> (Sig, Sig)) where+    type InstrIn  (a -> (Sig, Sig)) = a+    type InstrOut (a -> (Sig, Sig))  = (Sig, Sig)++    onArg f = return . f++instance Instr (a -> (Sig, Sig, Sig)) where+    type InstrIn  (a -> (Sig, Sig, Sig)) = a+    type InstrOut (a -> (Sig, Sig, Sig)) = (Sig, Sig, Sig)++    onArg f = return . f++instance Instr (a -> (Sig, Sig, Sig, Sig)) where+    type InstrIn  (a -> (Sig, Sig, Sig, Sig)) = a+    type InstrOut (a -> (Sig, Sig, Sig, Sig)) = (Sig, Sig, Sig, Sig)++    onArg f = return . f++instance Instr (a -> (Sig, Sig, Sig, Sig, Sig)) where+    type InstrIn  (a -> (Sig, Sig, Sig, Sig, Sig)) = a+    type InstrOut (a -> (Sig, Sig, Sig, Sig, Sig)) = (Sig, Sig, Sig, Sig, Sig)++    onArg f = return . f++instance Instr (a -> SE Sig) where+    type InstrIn  (a -> SE Sig) = a+    type InstrOut (a -> SE Sig) = Sig++    onArg f = f++instance Instr (a -> SE (Sig, Sig)) where+    type InstrIn  (a -> SE (Sig, Sig)) = a+    type InstrOut (a -> SE (Sig, Sig)) = (Sig, Sig)++    onArg f = f++instance Instr (a -> SE (Sig, Sig, Sig)) where+    type InstrIn  (a -> SE (Sig, Sig, Sig)) = a+    type InstrOut (a -> SE (Sig, Sig, Sig)) = (Sig, Sig, Sig)++    onArg f = f++instance Instr (a -> SE (Sig, Sig, Sig, Sig)) where+    type InstrIn  (a -> SE (Sig, Sig, Sig, Sig)) = a+    type InstrOut (a -> SE (Sig, Sig, Sig, Sig)) = (Sig, Sig, Sig, Sig)++    onArg f = f++instance Instr (a -> SE (Sig, Sig, Sig, Sig, Sig)) where+    type InstrIn  (a -> SE (Sig, Sig, Sig, Sig, Sig)) = a+    type InstrOut (a -> SE (Sig, Sig, Sig, Sig, Sig)) = (Sig, Sig, Sig, Sig, Sig)++    onArg f = f+
+ src/Csound/Control/Overload/MidiInstr.hs view
@@ -0,0 +1,362 @@+{-# Language TypeFamilies, FlexibleInstances, FlexibleContexts #-}+module Csound.Control.Overload.MidiInstr(+    MidiInstr(..)+) where++import Csound.Typed+import Csound.Typed.Opcode++ampCps :: Msg -> (D, D)+ampCps msg = (ampmidi msg 1, (cpsmidi msg))++-------------------------------------------------------------------------------++-- | Converts a value to the midi-instrument. It's used with the functions 'Csound.Base.midi', 'Csound.Base.midin'.+class MidiInstr a where+    type MidiInstrOut a :: *++    onMsg :: a -> Msg -> SE (MidiInstrOut a)++-- just sig++instance MidiInstr (Msg -> Sig) where+    type MidiInstrOut (Msg -> Sig) = Sig++    onMsg f = return . f++instance MidiInstr (Msg -> (Sig, Sig)) where+    type MidiInstrOut (Msg -> (Sig, Sig)) = (Sig, Sig)++    onMsg f = return . f++instance MidiInstr (Msg -> (Sig, Sig, Sig)) where+    type MidiInstrOut (Msg -> (Sig, Sig, Sig)) = (Sig, Sig, Sig)++    onMsg f = return . f++instance MidiInstr (Msg -> (Sig, Sig, Sig, Sig)) where+    type MidiInstrOut (Msg -> (Sig, Sig, Sig, Sig)) = (Sig, Sig, Sig, Sig)++    onMsg f = return . f++-- se sig++instance MidiInstr (Msg -> SE Sig) where+    type MidiInstrOut (Msg -> SE Sig) = Sig++    onMsg f = f++instance MidiInstr (Msg -> SE (Sig, Sig)) where+    type MidiInstrOut (Msg -> SE (Sig, Sig)) = (Sig, Sig)++    onMsg f = f++instance MidiInstr (Msg -> SE (Sig, Sig, Sig)) where+    type MidiInstrOut (Msg -> SE (Sig, Sig, Sig)) = (Sig, Sig, Sig)++    onMsg f = f++instance MidiInstr (Msg -> SE (Sig, Sig, Sig, Sig)) where+    type MidiInstrOut (Msg -> SE (Sig, Sig, Sig, Sig)) = (Sig, Sig, Sig, Sig)++    onMsg f = f++-- by (Sig, Sig)++sig2 :: Msg -> (Sig, Sig)+sig2 msg = (sig amp, sig cps)+    where (amp, cps) = ampCps msg++instance MidiInstr ((Sig, Sig) -> Sig) where+    type MidiInstrOut ((Sig, Sig) -> Sig) = Sig++    onMsg f = return . f . sig2++instance MidiInstr ((Sig, Sig) -> (Sig, Sig)) where+    type MidiInstrOut ((Sig, Sig) -> (Sig, Sig)) = (Sig, Sig)++    onMsg f = return . f . sig2++instance MidiInstr ((Sig, Sig) -> (Sig, Sig, Sig)) where+    type MidiInstrOut ((Sig, Sig) -> (Sig, Sig, Sig)) = (Sig, Sig, Sig)++    onMsg f = return . f . sig2++instance MidiInstr ((Sig, Sig) -> (Sig, Sig, Sig, Sig)) where+    type MidiInstrOut ((Sig, Sig) -> (Sig, Sig, Sig, Sig)) = (Sig, Sig, Sig, Sig)++    onMsg f = return . f . sig2++-- se sig++instance MidiInstr ((Sig, Sig) -> SE Sig) where+    type MidiInstrOut ((Sig, Sig) -> SE Sig) = Sig++    onMsg f = f . sig2++instance MidiInstr ((Sig, Sig) -> SE (Sig, Sig)) where+    type MidiInstrOut ((Sig, Sig) -> SE (Sig, Sig)) = (Sig, Sig)++    onMsg f = f . sig2++instance MidiInstr ((Sig, Sig) -> SE (Sig, Sig, Sig)) where+    type MidiInstrOut ((Sig, Sig) -> SE (Sig, Sig, Sig)) = (Sig, Sig, Sig)++    onMsg f = f . sig2++instance MidiInstr ((Sig, Sig) -> SE (Sig, Sig, Sig, Sig)) where+    type MidiInstrOut ((Sig, Sig) -> SE (Sig, Sig, Sig, Sig)) = (Sig, Sig, Sig, Sig)++    onMsg f = f . sig2++-- by Sig / D++dsig :: Msg -> (D, Sig)+dsig msg = (amp, sig cps)+    where (amp, cps) = ampCps msg++instance MidiInstr ((D, Sig) -> Sig) where+    type MidiInstrOut ((D, Sig) -> Sig) = Sig++    onMsg f = return . f . dsig++instance MidiInstr ((D, Sig) -> (Sig, Sig)) where+    type MidiInstrOut ((D, Sig) -> (Sig, Sig)) = (Sig, Sig)++    onMsg f = return . f . dsig++instance MidiInstr ((D, Sig) -> (Sig, Sig, Sig)) where+    type MidiInstrOut ((D, Sig) -> (Sig, Sig, Sig)) = (Sig, Sig, Sig)++    onMsg f = return . f . dsig++instance MidiInstr ((D, Sig) -> (Sig, Sig, Sig, Sig)) where+    type MidiInstrOut ((D, Sig) -> (Sig, Sig, Sig, Sig)) = (Sig, Sig, Sig, Sig)++    onMsg f = return . f . dsig++-- se sig++instance MidiInstr ((D, Sig) -> SE Sig) where+    type MidiInstrOut ((D, Sig) -> SE Sig) = Sig++    onMsg f = f . dsig++instance MidiInstr ((D, Sig) -> SE (Sig, Sig)) where+    type MidiInstrOut ((D, Sig) -> SE (Sig, Sig)) = (Sig, Sig)++    onMsg f = f . dsig++instance MidiInstr ((D, Sig) -> SE (Sig, Sig, Sig)) where+    type MidiInstrOut ((D, Sig) -> SE (Sig, Sig, Sig)) = (Sig, Sig, Sig)++    onMsg f = f . dsig++instance MidiInstr ((D, Sig) -> SE (Sig, Sig, Sig, Sig)) where+    type MidiInstrOut ((D, Sig) -> SE (Sig, Sig, Sig, Sig)) = (Sig, Sig, Sig, Sig)++    onMsg f = f . dsig++-- by Sig / D++sigd :: Msg -> (Sig, D)+sigd msg = (sig amp, cps)+    where (amp, cps) = ampCps msg++instance MidiInstr ((Sig, D) -> Sig) where+    type MidiInstrOut ((Sig, D) -> Sig) = Sig++    onMsg f = return . f . sigd++instance MidiInstr ((Sig, D) -> (Sig, Sig)) where+    type MidiInstrOut ((Sig, D) -> (Sig, Sig)) = (Sig, Sig)++    onMsg f = return . f . sigd++instance MidiInstr ((Sig, D) -> (Sig, Sig, Sig)) where+    type MidiInstrOut ((Sig, D) -> (Sig, Sig, Sig)) = (Sig, Sig, Sig)++    onMsg f = return . f . sigd++instance MidiInstr ((Sig, D) -> (Sig, Sig, Sig, Sig)) where+    type MidiInstrOut ((Sig, D) -> (Sig, Sig, Sig, Sig)) = (Sig, Sig, Sig, Sig)++    onMsg f = return . f . sigd++-- se sig++instance MidiInstr ((Sig, D) -> SE Sig) where+    type MidiInstrOut ((Sig, D) -> SE Sig) = Sig++    onMsg f = f . sigd++instance MidiInstr ((Sig, D) -> SE (Sig, Sig)) where+    type MidiInstrOut ((Sig, D) -> SE (Sig, Sig)) = (Sig, Sig)++    onMsg f = f . sigd++instance MidiInstr ((Sig, D) -> SE (Sig, Sig, Sig)) where+    type MidiInstrOut ((Sig, D) -> SE (Sig, Sig, Sig)) = (Sig, Sig, Sig)++    onMsg f = f . sigd++instance MidiInstr ((Sig, D) -> SE (Sig, Sig, Sig, Sig)) where+    type MidiInstrOut ((Sig, D) -> SE (Sig, Sig, Sig, Sig)) = (Sig, Sig, Sig, Sig)++    onMsg f = f . sigd++-- d2++d2 :: Msg -> (D, D)+d2 = ampCps++instance MidiInstr ((D, D) -> Sig) where+    type MidiInstrOut ((D, D) -> Sig) = Sig++    onMsg f = return . f . d2 ++instance MidiInstr ((D, D) -> (Sig, Sig)) where+    type MidiInstrOut ((D, D) -> (Sig, Sig)) = (Sig, Sig)++    onMsg f = return . f . d2++instance MidiInstr ((D, D) -> (Sig, Sig, Sig)) where+    type MidiInstrOut ((D, D) -> (Sig, Sig, Sig)) = (Sig, Sig, Sig)++    onMsg f = return . f . d2++instance MidiInstr ((D, D) -> (Sig, Sig, Sig, Sig)) where+    type MidiInstrOut ((D, D) -> (Sig, Sig, Sig, Sig)) = (Sig, Sig, Sig, Sig)++    onMsg f = return . f . d2++-- se sig++instance MidiInstr ((D, D) -> SE Sig) where+    type MidiInstrOut ((D, D) -> SE Sig) = Sig++    onMsg f = f . d2++instance MidiInstr ((D, D) -> SE (Sig, Sig)) where+    type MidiInstrOut ((D, D) -> SE (Sig, Sig)) = (Sig, Sig)++    onMsg f = f . d2++instance MidiInstr ((D, D) -> SE (Sig, Sig, Sig)) where+    type MidiInstrOut ((D, D) -> SE (Sig, Sig, Sig)) = (Sig, Sig, Sig)++    onMsg f = f . d2++instance MidiInstr ((D, D) -> SE (Sig, Sig, Sig, Sig)) where+    type MidiInstrOut ((D, D) -> SE (Sig, Sig, Sig, Sig)) = (Sig, Sig, Sig, Sig)++    onMsg f = f . d2++-- sig++instance MidiInstr (Sig -> Sig) where+    type MidiInstrOut (Sig -> Sig) = Sig++    onMsg f msg = return $ sig (ampmidi msg 1) * f (sig (cpsmidi msg))+    +instance MidiInstr (Sig -> (Sig, Sig)) where+    type MidiInstrOut (Sig -> (Sig, Sig)) = (Sig, Sig)++    onMsg f msg = return $ (sig (ampmidi msg 1) * a1, sig (ampmidi msg 1) * a2)+        where (a1, a2) = f (sig (cpsmidi msg))++instance MidiInstr (Sig -> (Sig, Sig, Sig)) where+    type MidiInstrOut (Sig -> (Sig, Sig, Sig)) = (Sig, Sig, Sig)++    onMsg f msg = return $ (sig (ampmidi msg 1) * a1, sig (ampmidi msg 1) * a2, sig (ampmidi msg 1) * a3)+        where (a1, a2, a3) = f (sig (cpsmidi msg))++instance MidiInstr (Sig -> (Sig, Sig, Sig, Sig)) where+    type MidiInstrOut (Sig -> (Sig, Sig, Sig, Sig)) = (Sig, Sig, Sig, Sig)++    onMsg f msg = return $ (sig (ampmidi msg 1) * a1, sig (ampmidi msg 1) * a2, sig (ampmidi msg 1) * a3, sig (ampmidi msg 1) * a4)+        where (a1, a2, a3, a4) = f (sig (cpsmidi msg))++    +instance MidiInstr (Sig -> SE Sig) where+    type MidiInstrOut (Sig -> SE Sig) = Sig++    onMsg f msg = do+        a1 <- f (sig (cpsmidi msg))+        return $ sig (ampmidi msg 1) * a1+    +instance MidiInstr (Sig -> SE (Sig, Sig)) where+    type MidiInstrOut (Sig -> SE (Sig, Sig)) = (Sig, Sig)++    onMsg f msg = do+        (a1, a2) <- f (sig (cpsmidi msg))+        return $ (sig (ampmidi msg 1) * a1, sig (ampmidi msg 1) * a2)++instance MidiInstr (Sig -> SE (Sig, Sig, Sig)) where+    type MidiInstrOut (Sig -> SE (Sig, Sig, Sig)) = (Sig, Sig, Sig)++    onMsg f msg = do+        (a1, a2, a3) <- f (sig (cpsmidi msg))+        return $ (sig (ampmidi msg 1) * a1, sig (ampmidi msg 1) * a2, sig (ampmidi msg 1) * a3)++instance MidiInstr (Sig -> SE (Sig, Sig, Sig, Sig)) where+    type MidiInstrOut (Sig -> SE (Sig, Sig, Sig, Sig)) = (Sig, Sig, Sig, Sig)++    onMsg f msg = do+        (a1, a2, a3, a4) <- f (sig (cpsmidi msg))+        return $ (sig (ampmidi msg 1) * a1, sig (ampmidi msg 1) * a2, sig (ampmidi msg 1) * a3, sig (ampmidi msg 1) * a4)++-- d++instance MidiInstr (D -> Sig) where+    type MidiInstrOut (D -> Sig) = Sig++    onMsg f msg = return $ sig (ampmidi msg 1) * f (cpsmidi msg)+    +instance MidiInstr (D -> (Sig, Sig)) where+    type MidiInstrOut (D -> (Sig, Sig)) = (Sig, Sig)++    onMsg f msg = return $ (sig (ampmidi msg 1) * a1, sig (ampmidi msg 1) * a2)+        where (a1, a2) = f (cpsmidi msg)++instance MidiInstr (D -> (Sig, Sig, Sig)) where+    type MidiInstrOut (D -> (Sig, Sig, Sig)) = (Sig, Sig, Sig)++    onMsg f msg = return $ (sig (ampmidi msg 1) * a1, sig (ampmidi msg 1) * a2, sig (ampmidi msg 1) * a3)+        where (a1, a2, a3) = f (cpsmidi msg)++instance MidiInstr (D -> (Sig, Sig, Sig, Sig)) where+    type MidiInstrOut (D -> (Sig, Sig, Sig, Sig)) = (Sig, Sig, Sig, Sig)++    onMsg f msg = return $ (sig (ampmidi msg 1) * a1, sig (ampmidi msg 1) * a2, sig (ampmidi msg 1) * a3, sig (ampmidi msg 1) * a4)+        where (a1, a2, a3, a4) = f (cpsmidi msg)++instance MidiInstr (D -> SE Sig) where+    type MidiInstrOut (D -> SE Sig) = Sig++    onMsg f msg = do+        a1 <- f ((cpsmidi msg))+        return $ sig (ampmidi msg 1) * a1+    +instance MidiInstr (D -> SE (Sig, Sig)) where+    type MidiInstrOut (D -> SE (Sig, Sig)) = (Sig, Sig)++    onMsg f msg = do+        (a1, a2) <- f ((cpsmidi msg))+        return $ (sig (ampmidi msg 1) * a1, sig (ampmidi msg 1) * a2)++instance MidiInstr (D -> SE (Sig, Sig, Sig)) where+    type MidiInstrOut (D -> SE (Sig, Sig, Sig)) = (Sig, Sig, Sig)++    onMsg f msg = do+        (a1, a2, a3) <- f ((cpsmidi msg))+        return $ (sig (ampmidi msg 1) * a1, sig (ampmidi msg 1) * a2, sig (ampmidi msg 1) * a3)++instance MidiInstr (D -> SE (Sig, Sig, Sig, Sig)) where+    type MidiInstrOut (D -> SE (Sig, Sig, Sig, Sig)) = (Sig, Sig, Sig, Sig)++    onMsg f msg = do+        (a1, a2, a3, a4) <- f ((cpsmidi msg))+        return $ (sig (ampmidi msg 1) * a1, sig (ampmidi msg 1) * a2, sig (ampmidi msg 1) * a3, sig (ampmidi msg 1) * a4)++
+ src/Csound/Control/Overload/SpecInstr.hs view
@@ -0,0 +1,170 @@+{-# Language TypeFamilies, FlexibleInstances, FlexibleContexts #-}+module Csound.Control.Overload.SpecInstr(+    AmpInstr(..), CpsInstr(..)      +) where++import Control.Arrow(first, second)++import Csound.Typed++-- | Constructs a drum-like instrument.+-- Drum like instrument has a single argument that +-- signifies an amplitude.+class AmpInstr a where+    type AmpInstrOut a :: *+    onAmp :: a -> D -> SE (AmpInstrOut a)++instance AmpInstr (D -> SE Sig) where+    type AmpInstrOut (D -> SE Sig) = Sig+    onAmp = id++instance AmpInstr (D -> SE (Sig, Sig)) where+    type AmpInstrOut (D -> SE (Sig, Sig)) = (Sig, Sig)+    onAmp = id++instance AmpInstr (D -> Sig) where+    type AmpInstrOut (D -> Sig) = Sig+    onAmp f = return . f++instance AmpInstr (D -> (Sig, Sig)) where+    type AmpInstrOut (D -> (Sig, Sig)) = (Sig, Sig)+    onAmp f = return . f++instance AmpInstr (Sig -> SE Sig) where+    type AmpInstrOut (Sig -> SE Sig) = Sig+    onAmp f = f . sig++instance AmpInstr (Sig -> SE (Sig, Sig)) where+    type AmpInstrOut (Sig -> SE (Sig, Sig)) = (Sig, Sig)+    onAmp f = f . sig++instance AmpInstr (Sig -> Sig) where+    type AmpInstrOut (Sig -> Sig) = Sig+    onAmp f = return . f . sig++instance AmpInstr (Sig -> (Sig, Sig)) where+    type AmpInstrOut (Sig -> (Sig, Sig)) = (Sig, Sig)+    onAmp f = return . f . sig++instance AmpInstr (SE Sig) where+    type AmpInstrOut (SE Sig) = Sig+    onAmp a amp = fmap (sig amp * ) a++instance AmpInstr (SE (Sig, Sig)) where+    type AmpInstrOut (SE (Sig, Sig)) = (Sig, Sig)+    onAmp a amp = fmap (\(a1, a2) -> (sig amp * a1, sig amp * a2)) a ++instance AmpInstr Sig where+    type AmpInstrOut Sig = Sig+    onAmp a amp = return $ a * sig amp++instance AmpInstr (Sig, Sig) where+    type AmpInstrOut (Sig, Sig) = (Sig, Sig)+    onAmp (a1, a2) amp = return (a1 * sig amp, a2 * sig amp)++------------------------------------------------------------------------++-- | Constructs a simple instrument that takes in a tuple of two arguments.+-- They are amplitude and the frequency (in Hz or cycles per second).+class CpsInstr a where+    type CpsInstrOut a :: *+    onCps :: a -> (D, D) -> SE (CpsInstrOut a)++instance CpsInstr ((D, D) -> SE Sig) where+    type CpsInstrOut ((D, D) -> SE Sig) = Sig+    onCps = id++instance CpsInstr ((D, D) -> SE (Sig, Sig)) where+    type CpsInstrOut ((D, D) -> SE (Sig, Sig)) = (Sig, Sig)+    onCps = id++instance CpsInstr ((D, D) -> Sig) where+    type CpsInstrOut ((D, D) -> Sig) = Sig+    onCps f = return . f++instance CpsInstr ((D, D) -> (Sig, Sig)) where+    type CpsInstrOut ((D, D) -> (Sig, Sig)) = (Sig, Sig)+    onCps f = return . f++instance CpsInstr ((D, Sig) -> SE Sig) where+    type CpsInstrOut ((D, Sig) -> SE Sig) = Sig+    onCps f = f . second sig++instance CpsInstr ((D, Sig) -> SE (Sig, Sig)) where+    type CpsInstrOut ((D, Sig) -> SE (Sig, Sig)) = (Sig, Sig)+    onCps f = f . second sig++instance CpsInstr ((D, Sig) -> Sig) where+    type CpsInstrOut ((D, Sig) -> Sig) = Sig+    onCps f = return . f . second sig++instance CpsInstr ((D, Sig) -> (Sig, Sig)) where+    type CpsInstrOut ((D, Sig) -> (Sig, Sig)) = (Sig, Sig)+    onCps f = return . f . second sig++instance CpsInstr ((Sig, D) -> SE Sig) where+    type CpsInstrOut ((Sig, D) -> SE Sig) = Sig+    onCps f = f . first sig++instance CpsInstr ((Sig, D) -> SE (Sig, Sig)) where+    type CpsInstrOut ((Sig, D) -> SE (Sig, Sig)) = (Sig, Sig)+    onCps f = f . first sig++instance CpsInstr ((Sig, D) -> Sig) where+    type CpsInstrOut ((Sig, D) -> Sig) = Sig+    onCps f = return . f . first sig++instance CpsInstr ((Sig, D) -> (Sig, Sig)) where+    type CpsInstrOut ((Sig, D) -> (Sig, Sig)) = (Sig, Sig)+    onCps f = return . f . first sig++instance CpsInstr ((Sig, Sig) -> SE Sig) where+    type CpsInstrOut ((Sig, Sig) -> SE Sig) = Sig+    onCps f = f . first sig . second sig++instance CpsInstr ((Sig, Sig) -> SE (Sig, Sig)) where+    type CpsInstrOut ((Sig, Sig) -> SE (Sig, Sig)) = (Sig, Sig)+    onCps f = f . first sig . second sig++instance CpsInstr ((Sig, Sig) -> Sig) where+    type CpsInstrOut ((Sig, Sig) -> Sig) = Sig+    onCps f = return . f . first sig . second sig++instance CpsInstr ((Sig, Sig) -> (Sig, Sig)) where+    type CpsInstrOut ((Sig, Sig) -> (Sig, Sig)) = (Sig, Sig)+    onCps f = return . f . first sig . second sig++instance CpsInstr (D -> SE Sig) where+    type CpsInstrOut (D -> SE Sig) = Sig+    onCps f (amp, cps) = fmap (* sig amp) $ f cps++instance CpsInstr (D -> SE (Sig, Sig)) where+    type CpsInstrOut (D -> SE (Sig, Sig)) = (Sig, Sig)+    onCps f (amp, cps) = fmap (first (* sig amp) . second (* sig amp)) $ f cps++instance CpsInstr (D -> Sig) where+    type CpsInstrOut (D -> Sig) = Sig+    onCps f (amp, cps) = return $ sig amp * f cps++instance CpsInstr (D -> (Sig, Sig)) where+    type CpsInstrOut (D -> (Sig, Sig)) = (Sig, Sig)+    onCps f (amp, cps) = return $ first (* sig amp) $ second (* sig amp) $ f cps++instance CpsInstr (Sig -> SE Sig) where+    type CpsInstrOut (Sig -> SE Sig) = Sig+    onCps f (amp, cps) = fmap (* sig amp) $ f $ sig cps++instance CpsInstr (Sig -> SE (Sig, Sig)) where+    type CpsInstrOut (Sig -> SE (Sig, Sig)) = (Sig, Sig)+    onCps f (amp, cps) = fmap (first (* sig amp) . second (* sig amp)) $ f $ sig cps++instance CpsInstr (Sig -> Sig) where+    type CpsInstrOut (Sig -> Sig) = Sig+    onCps f (amp, cps) = return $ sig amp * f (sig cps)++instance CpsInstr (Sig -> (Sig, Sig)) where+    type CpsInstrOut (Sig -> (Sig, Sig)) = (Sig, Sig)+    onCps f (amp, cps) = return $ first (* sig amp) $ second (* sig amp) $ f $ sig cps+++
+ src/Csound/Control/SE.hs view
@@ -0,0 +1,6 @@+module Csound.Control.SE(+    SE, SERef(..), newSERef, sensorsSE        +) where++import Csound.Typed.Control+
− src/Csound/Exp.hs 
@@ -1,322 +0,0 @@--- | Main types-{-# Language DeriveFunctor, DeriveFoldable, DeriveTraversable #-}-module Csound.Exp(-    E, RatedExp(..), RatedVar, ratedVar, ratedVarRate, ratedVarId, Exp, toPrimOr, PrimOr(..), MainExp(..), Name, -    InstrId(..), intInstrId, ratioInstrId,-    VarType(..), Var(..), Info(..), OpcFixity(..), Rate(..), -    Signature(..), isProcedure, isInfix, isPrefix,    -    Prim(..), LowTab(..), Tab(..), TabSize(..), TabArgs(..), TabMap, TabFi(..),-    Inline(..), InlineExp(..), PreInline(..),-    BoolExp, CondInfo, CondOp(..), isTrue, isFalse,    -    NumExp, NumOp(..), Msg(..), Note,    -    StringMap-) where--import Control.Applicative-import Data.Traversable-import Data.Foldable hiding (concat)--import Data.Default--import Data.Map(Map)-import qualified Data.IntMap as IM-import qualified Data.Map    as M-import Data.Fix--import qualified Csound.Tfm.DeduceTypes as R(Var(..)) --type Name = String--data InstrId = InstrId -    { instrIdFrac :: Maybe Int-    , instrIdCeil :: Int -    } deriving (Show, Eq, Ord)--intInstrId :: Int -> InstrId-intInstrId n = InstrId Nothing n--ratioInstrId :: Int -> Int -> InstrId-ratioInstrId beforeDot afterDot = InstrId (Just $ afterDot) beforeDot---- | The inner representation of csound expressions.-type E = Fix RatedExp--data RatedExp a = RatedExp -    { ratedExpRate      :: Maybe Rate       -        -- ^ Rate (can be undefined or Nothing, -        -- it means that rate should be deduced automatically from the context)-    , ratedExpDepends   :: Maybe a          -        -- ^ Dependency (it is used for expressions with side effects,-        -- value contains the privious statement)-    , ratedExpExp       :: Exp a    -        -- ^ Main expression-    } deriving (Show, Eq, Ord, Functor, Foldable, Traversable)---- | RatedVar is for pretty printing of the wiring ports.-type RatedVar = R.Var Rate--ratedVar :: Rate -> Int -> RatedVar-ratedVar     = flip R.Var--ratedVarRate :: RatedVar -> Rate-ratedVarRate = R.varType--ratedVarId :: RatedVar -> Int-ratedVarId   = R.varId---- | It's a primitive value or something else. It's used for inlining--- of the constants (primitive values).-newtype PrimOr a = PrimOr { unPrimOr :: Either Prim a }-    deriving (Show, Eq, Ord, Functor)---- | Constructs PrimOr values from the expressions. It does inlining in--- case of primitive values.-toPrimOr :: E -> PrimOr E-toPrimOr a = PrimOr $ case ratedExpExp $ unFix a of-    ExpPrim (PString _) -> Right a-    ExpPrim p -> Left p-    _         -> Right a---- Expressions with inlining.-type Exp a = MainExp (PrimOr a)---- Csound expressions-data MainExp a -    -- | Primitives-    = ExpPrim Prim-    -- | Application of the opcode: we have opcode information (Info) and the arguments [a] -    | Tfm Info [a]-    -- | Rate conversion-    | ConvertRate Rate Rate a-    -- | Selects a cell from the tuple, here argument is always a tuple (result of opcode that returns several outputs)-    | Select Rate Int a-    -- | if-then-else-    | If (CondInfo a) a a    -    -- | Boolean expressions (rendered in infix notation in the Csound)-    | ExpBool (BoolExp a)-    -- | Numerical expressions (rendered in infix notation in the Csound)-    | ExpNum (NumExp a)-    -- | Reading/writing a named variable-    | InitVar Var a-    | ReadVar Var-    | WriteVar Var a    -    -- | Imperative If-then-else-    | IfBegin a-    | ElseIfBegin a-    | ElseBegin-    | IfEnd-    deriving (Show, Eq, Ord, Functor, Foldable, Traversable)  ---- Named variable-data Var -    = Var-        { varType :: VarType    -- global / local-        , varRate :: Rate-        , varName :: Name } -    | VarVerbatim -        { varRate :: Rate-        , varName :: Name        -        } deriving (Show, Eq, Ord)       -        --- Variables can be global (then we have to prefix them with `g` in the rendering) or local.-data VarType = LocalVar | GlobalVar-    deriving (Show, Eq, Ord)---- Opcode information.-data Info = Info -    -- Opcode name-    { infoName          :: Name     -    -- Opcode type signature-    , infoSignature     :: Signature-    -- Opcode can be infix or prefix-    , infoOpcFixity     :: OpcFixity-    , infoNextSE        :: Maybe Int-    } deriving (Show, Eq, Ord)           -  -isPrefix, isInfix, isProcedure :: Info -> Bool--isPrefix = (Prefix ==) . infoOpcFixity-isInfix  = (Infix  ==) . infoOpcFixity-isProcedure = (Procedure ==) . infoOpcFixity- --- Opcode fixity-data OpcFixity = Prefix | Infix | Procedure-    deriving (Show, Eq, Ord)---- | The Csound rates.-data Rate   -- rate:-    -----------------------------    = Xr    -- audio or control (and I use it for opcodes that produce no output, ie procedures)-    | Ar    -- audio -    | Kr    -- control -    | Ir    -- init (constants)    -    | Sr    -- strings-    | Fr    -- spectrum (for pvs opcodes)-    deriving (Show, Eq, Ord, Enum, Bounded)-    --- Opcode type signature. Opcodes can produce single output (SingleRate) or multiple outputs (MultiRate).--- In Csound opcodes are often have several signatures. That is one opcode name can produce signals of the --- different rate (it depends on the type of the outputs). Here we assume (to make things easier) that--- opcodes that MultiRate-opcodes can produce only the arguments of the same type. -data Signature -    -- For SingleRate-opcodes type signature is the Map from output rate to the rate of the arguments.-    -- With it we can deduce the type of the argument from the type of the output.-    = SingleRate (Map Rate [Rate]) -    -- For MultiRate-opcodes Map degenerates to the singleton. We have only one link. -    -- It contains rates for outputs and inputs.-    | MultiRate -        { outMultiRate :: [Rate] -        , inMultiRate  :: [Rate] } -    deriving (Show, Eq, Ord)---- Primitive values-data Prim -    -- instrument p-arguments-    = P Int -    | PString Int       -- >> p-string: -    | PrimInt Int -    | PrimDouble Double -    | PrimString String -    | PrimInstrId InstrId-    -- Here we use Tab and well LowTab. Tab contains no size. It is deduced -    -- from the renderer settings.-    | PrimTab (Either Tab LowTab)-    deriving (Show, Eq, Ord)---- Map from tables to unique identifiers.-type TabMap = M.Map LowTab Int---- Table that has all parameters calculated.-data LowTab = LowTab -    { lowTabSize    :: Int-    , lowTabGen     :: Int-    , lowTabArgs    :: [Double]-    } deriving (Show, Eq, Ord)---- Table that can have relative size (to be defined from the renderer settings).---- | Csound f-tables. You can make a value of 'Tab' with the function 'Csound.Tab.gen' or--- use more higher level functions.-data Tab -    = TabExp E-    | Tab -    { tabSize :: TabSize-    , tabGen  :: Int-    , tabArgs :: TabArgs-    } deriving (Show, Eq, Ord)--instance Default TabSize where-    def = SizeDegree-        { hasGuardPoint = False-        , sizeDegree = 0 }---- Table size.-data TabSize -    -- Size is fixed by the user.-    = SizePlain Int-    -- Size is relative to the renderer settings.-    | SizeDegree -    { hasGuardPoint :: Bool-    , sizeDegree    :: Int      -- is the power of two-    } deriving (Show, Eq, Ord)-    --- Table arguments can be-data TabArgs -    -- absolute-    = ArgsPlain [Double]-    -- or relative to the table size (used for tables that implement interpolation)-    | ArgsRelative [Double]-    deriving (Show, Eq, Ord)----- | Table size fidelity (how many points in the table by default).-data TabFi = TabFi-    { tabFiBase   :: Int-    , tabFiGens   :: IM.IntMap Int }---- | Midi messages.-data Msg = Msg---- Csound note-type Note = [Prim]-------------------------------------------------------------- Strings --type StringMap = M.Map String Int----------------------------------------------------------------- types for arithmetic and boolean expressions--data Inline a b = Inline -    { inlineExp :: InlineExp a-    , inlineEnv :: IM.IntMap b    -    } deriving (Show, Eq, Ord, Functor, Foldable, Traversable)---- Inlined expression. -data InlineExp a-    = InlinePrim Int-    | InlineExp a [InlineExp a]-    deriving (Show, Eq, Ord)---- Expression as a tree (to be inlined)-data PreInline a b = PreInline a [b]-    deriving (Show, Eq, Ord, Functor, Foldable, Traversable)---- booleans--type BoolExp a = PreInline CondOp a-type CondInfo a = Inline CondOp a---- Conditional operators-data CondOp  -    = TrueOp | FalseOp | And | Or-    | Equals | NotEquals | Less | Greater | LessEquals | GreaterEquals-    deriving (Show, Eq, Ord)    --isTrue, isFalse :: CondInfo a -> Bool--isTrue  = isCondOp TrueOp-isFalse = isCondOp FalseOp--isCondOp :: CondOp -> CondInfo a -> Bool-isCondOp op = maybe False (op == ) . getCondInfoOp--getCondInfoOp :: CondInfo a -> Maybe CondOp-getCondInfoOp x = case inlineExp x of-    InlineExp op _ -> Just op-    _ -> Nothing---- Numeric expressions (or Csound infix operators)--type NumExp a = PreInline NumOp a--data NumOp -    = Add | Sub | Neg | Mul | Div-    | Pow | Mod -    | Sin | Cos | Sinh | Cosh | Tan | Tanh | Sininv | Cosinv | Taninv-    | Ceil | Floor | Frac | Round | IntOp-    | Abs | ExpOp | Log | Log10 | Logbtwo | Sqrt    -    | Ampdb | Ampdbfs | Dbamp | Dbfsamp -    | Cent | Cpsmidinn | Cpsoct | Cpspch | Octave | Octcps | Octmidinn | Octpch | Pchmidinn | Pchoct | Semitone-    deriving (Show, Eq, Ord)------------------------------------------------------------ instances for cse that ghc was not able to derive for me--instance Foldable PrimOr where foldMap = foldMapDefault--instance Traversable PrimOr where-    traverse f x = case unPrimOr x of-        Left  p -> pure $ PrimOr $ Left p-        Right a -> PrimOr . Right <$> f a----- comments--- --- p-string ------    separate p-param for strings (we need it to read strings from global table) ---    Csound doesn't permits us to use more than four string params so we need to---    keep strings in the global table and use `strget` to read them-
− src/Csound/Exp/Arg.hs 
@@ -1,142 +0,0 @@--- | instrument p-arguments-module Csound.Exp.Arg(        -    Arg(..), arg, toNote, arity, -    ArgMethods, toArg, makeArgMethods,-) where--import Control.Applicative--import Csound.Exp-import Csound.Exp.Wrapper(Val, toExp, D, Str, p)----------------------------------------------------- basic extractor--getPrimUnsafe :: Val a => a -> Prim-getPrimUnsafe x = case toExp x of-    ExpPrim a -> a-    _ -> error "Arg.hs:getPrimUnsafe - value is not prim"---- | The abstract type of methods for the class 'Arg'.-data ArgMethods a = ArgMethods -    { arg_    :: Int -> a-    , toNote_ :: a -> [Prim]-    , arity_  :: a -> Int }--arg :: Arg a => Int -> a-arg = arg_ argMethods--toNote :: Arg a => a -> [Prim]-toNote = toNote_ argMethods--arity :: Arg a => a -> Int-arity = arity_ argMethods--toArg :: Arg a => a-toArg = arg 4---- | Defines instance of type class 'Arg' for a new type in terms of an already defined one.-makeArgMethods :: (Arg a) => (a -> b) -> (b -> a) -> ArgMethods b-makeArgMethods to from = ArgMethods {-    arg_ = to . arg,-    toNote_ = toNote . from,-    arity_ = const $ arity $ proxy to }-    where proxy :: (a -> b) -> a-          proxy = undefined---- | Describes all Csound values that can be used in the score section. --- Instruments are triggered with the values from this type class.--- Actual methods are hidden, but you can easily make instances for your own types--- with function 'makeArgMethods'. You need to describe the new instance in  terms --- of some existing one. For example:------ > data Note = Note --- >     { noteAmplitude    :: D--- >     , notePitch        :: D--- >     , noteVibrato      :: D--- >     , noteSample       :: S--- >     }--- > --- > instance Arg Note where--- >     argMethods = makeArgMethods to from--- >         where to (amp, pch, vibr, sample) = Note amp pch vibr sample--- >               from (Note amp pch vibr sample) = (amp, pch, vibr, sample)--- --- Then you can use this type in an instrument definition.--- --- > instr :: Note -> Out--- > instr x = ...--class Arg a where-    argMethods :: ArgMethods a--instance Arg () where-    argMethods = ArgMethods -        { arg_ = const ()-        , toNote_ = const []-        , arity_ = const 0 }--instance Arg InstrId where-    argMethods = ArgMethods -        { arg_ = error "method arg is undefined for InstrId"-        , toNote_ = pure . PrimInstrId-        , arity_ = const 0 }--instance Arg D where-    argMethods = ArgMethods {-        arg_ = p,-        toNote_ = pure . getPrimUnsafe,-        arity_ = const 1 }--instance Arg Str where-    argMethods = ArgMethods {-        arg_ = p,-        toNote_ = pure . getPrimUnsafe,-        arity_ = const 1 }--instance Arg Tab where-    argMethods = ArgMethods {-        arg_ = p,-        toNote_ = pure . getPrimUnsafe,-        arity_ = const 1 }--instance (Arg a, Arg b) => Arg (a, b) where-    argMethods = ArgMethods arg' toNote' arity' -        where arg' n = (a, b)-                  where a = arg n-                        b = arg (n + arity a)-              toNote' (a, b) = toNote a ++ toNote b-              arity' x = let (a, b) = proxy x in arity a + arity b    -                  where proxy :: (a, b) -> (a, b)-                        proxy = const (undefined, undefined)--instance (Arg a, Arg b, Arg c) => Arg (a, b, c) where-    argMethods = makeArgMethods to from-        where to (a, (b, c)) = (a, b, c)-              from (a, b, c) = (a, (b, c))--instance (Arg a, Arg b, Arg c, Arg d) => Arg (a, b, c, d) where-    argMethods = makeArgMethods to from-        where to (a, (b, c, d)) = (a, b, c, d)-              from (a, b, c, d) = (a, (b, c, d))--instance (Arg a, Arg b, Arg c, Arg d, Arg e) => Arg (a, b, c, d, e) where-    argMethods = makeArgMethods to from-        where to (a, (b, c, d, e)) = (a, b, c, d, e)-              from (a, b, c, d, e) = (a, (b, c, d, e))--instance (Arg a, Arg b, Arg c, Arg d, Arg e, Arg f) => Arg (a, b, c, d, e, f) where-    argMethods = makeArgMethods to from-        where to (a, (b, c, d, e, f)) = (a, b, c, d, e, f)-              from (a, b, c, d, e, f) = (a, (b, c, d, e, f))--instance (Arg a, Arg b, Arg c, Arg d, Arg e, Arg f, Arg g) => Arg (a, b, c, d, e, f, g) where-    argMethods = makeArgMethods to from-        where to (a, (b, c, d, e, f, g)) = (a, b, c, d, e, f, g)-              from (a, b, c, d, e, f, g) = (a, (b, c, d, e, f, g))--instance (Arg a, Arg b, Arg c, Arg d, Arg e, Arg f, Arg g, Arg h) => Arg (a, b, c, d, e, f, g, h) where-    argMethods = makeArgMethods to from-        where to (a, (b, c, d, e, f, g, h)) = (a, b, c, d, e, f, g, h)-              from (a, b, c, d, e, f, g, h) = (a, (b, c, d, e, f, g, h))-
− src/Csound/Exp/Cons.hs 
@@ -1,173 +0,0 @@--- |  Constructors-module Csound.Exp.Cons (-    Spec1, Specs,-    withInits,-    bi,-    spec1, specs,-    opcs, opc0, opc1, opc2, opc3, opc4, opc5, opc6, opc7, opc8, opc9, opc10, opc11, opc12,-    mopcs, mopc0, mopc1, mopc2, mopc3, mopc4, mopc5, mopc6, mopc7-) where--import qualified Data.Map as M(fromList)--import Csound.Exp-import Csound.Exp.Wrapper(Sig, Val(..), tfm, pref, onExp)-import Csound.Exp.Tuple(CsdTuple, fromCsdTuple, multiOuts)---- | Appends initialisation arguments. It's up to you to supply arguments with the right types. For example:------ > oscil 0.5 440 sinWave `withInits` (0.5 :: D)-withInits :: (Val a, CsdTuple inits) => a -> inits -> Sig-withInits a b = fromE $ onExp phi $ toE a-    where phi x = case x of-            Tfm t xs -> Tfm t (xs ++ (fmap toPrimOr $ fromCsdTuple b))-            _        -> x----------------------------------------------------- constructor for simple arithmetic operators--bi :: (Val a1, Val a2, Val b) => Name -> a1 -> a2 -> b-bi name = opc2 name biSignature--biSignature :: Spec1-biSignature = [-    (Ar, [Ar, Ar]),-    (Kr, [Kr, Kr]),-    (Ir, [Ir, Ir])]--------------------------------- constructors for opcodes (single or multiple rates)--tfms :: (Val a, Val b) => Info -> [a] -> b-tfms t as = tfm t $ map toE as--tfm0 :: (Val a) => Info -> a-tfm0 t = tfm t []--tfm1 :: (Val a, Val b) => Info -> a -> b-tfm1 t a = tfm t [toE a]--tfm2 :: (Val a1, Val a2, Val b) => Info -> a1 -> a2 -> b-tfm2 t a1 a2 = tfm t [toE a1, toE a2]--tfm3 :: (Val a1, Val a2, Val a3, Val b) => Info -> a1 -> a2 -> a3 -> b-tfm3 t a1 a2 a3 = tfm t [toE a1, toE a2, toE a3]--tfm4 :: (Val a1, Val a2, Val a3, Val a4, Val b) => Info -> a1 -> a2 -> a3 -> a4 -> b-tfm4 t a1 a2 a3 a4 = tfm t [toE a1, toE a2, toE a3, toE a4]--tfm5 :: (Val a1, Val a2, Val a3, Val a4, Val a5, Val b) => Info -> a1 -> a2 -> a3 -> a4 -> a5 -> b-tfm5 t a1 a2 a3 a4 a5 = tfm t [toE a1, toE a2, toE a3, toE a4, toE a5]--tfm6 :: (Val a1, Val a2, Val a3, Val a4, Val a5, Val a6, Val b) => Info -> a1 -> a2 -> a3 -> a4 -> a5 -> a6 -> b-tfm6 t a1 a2 a3 a4 a5 a6 = tfm t [toE a1, toE a2, toE a3, toE a4, toE a5, toE a6]--tfm7 :: (Val a1, Val a2, Val a3, Val a4, Val a5, Val a6, Val a7, Val b) => Info -> a1 -> a2 -> a3 -> a4 -> a5 -> a6 -> a7 -> b-tfm7 t a1 a2 a3 a4 a5 a6 a7 = tfm t [toE a1, toE a2, toE a3, toE a4, toE a5, toE a6, toE a7]--tfm8 :: (Val a1, Val a2, Val a3, Val a4, Val a5, Val a6, Val a7, Val a8, Val b) => Info -> a1 -> a2 -> a3 -> a4 -> a5 -> a6 -> a7 -> a8 -> b-tfm8 t a1 a2 a3 a4 a5 a6 a7 a8 = tfm t [toE a1, toE a2, toE a3, toE a4, toE a5, toE a6, toE a7, toE a8]--tfm9 :: (Val a1, Val a2, Val a3, Val a4, Val a5, Val a6, Val a7, Val a8, Val a9, Val b) => Info -> a1 -> a2 -> a3 -> a4 -> a5 -> a6 -> a7 -> a8 -> a9 -> b-tfm9 t a1 a2 a3 a4 a5 a6 a7 a8 a9 = tfm t [toE a1, toE a2, toE a3, toE a4, toE a5, toE a6, toE a7, toE a8, toE a9]--tfm10 :: (Val a1, Val a2, Val a3, Val a4, Val a5, Val a6, Val a7, Val a8, Val a9, Val a10, Val b) => Info -> a1 -> a2 -> a3 -> a4 -> a5 -> a6 -> a7 -> a8 -> a9 -> a10 -> b-tfm10 t a1 a2 a3 a4 a5 a6 a7 a8 a9 a10 = tfm t [toE a1, toE a2, toE a3, toE a4, toE a5, toE a6, toE a7, toE a8, toE a9, toE a10]--tfm11 :: (Val a1, Val a2, Val a3, Val a4, Val a5, Val a6, Val a7, Val a8, Val a9, Val a10, Val a11, Val b) => Info -> a1 -> a2 -> a3 -> a4 -> a5 -> a6 -> a7 -> a8 -> a9 -> a10 -> a11 -> b-tfm11 t a1 a2 a3 a4 a5 a6 a7 a8 a9 a10 a11 = tfm t [toE a1, toE a2, toE a3, toE a4, toE a5, toE a6, toE a7, toE a8, toE a9, toE a10, toE a11]--tfm12 :: (Val a1, Val a2, Val a3, Val a4, Val a5, Val a6, Val a7, Val a8, Val a9, Val a10, Val a11, Val a12, Val b) => Info -> a1 -> a2 -> a3 -> a4 -> a5 -> a6 -> a7 -> a8 -> a9 -> a10 -> a11 -> a12 -> b-tfm12 t a1 a2 a3 a4 a5 a6 a7 a8 a9 a10 a11 a12 = tfm t [toE a1, toE a2, toE a3, toE a4, toE a5, toE a6, toE a7, toE a8, toE a9, toE a10, toE a11, toE a12]------------------------------------ single output---- User friendly type for single output type signatures-type Spec1 = [(Rate, [Rate])]--spec1 :: Spec1 -> Signature-spec1 = SingleRate . M.fromList--opcs :: (Val a, Val b) => Name -> Spec1 -> [a] -> b-opcs name signature = tfms (pref name $ spec1 signature)--opc0 :: (Val a) => Name -> Spec1 -> a-opc0 name signature = tfm0 (pref name $ spec1 signature)--opc1 :: (Val a, Val b) => Name -> Spec1 -> a -> b-opc1 name signature = tfm1 (pref name $ spec1 signature)--opc2 :: (Val a1, Val a2, Val b) => Name -> Spec1 -> a1 -> a2 -> b-opc2 name signature = tfm2 (pref name $ spec1 signature)--opc3 :: (Val a1, Val a2, Val a3, Val b) => Name -> Spec1 -> a1 -> a2 -> a3 -> b-opc3 name signature = tfm3 (pref name $ spec1 signature)--opc4 :: (Val a1, Val a2, Val a3, Val a4, Val b) => Name -> Spec1 -> a1 -> a2 -> a3 -> a4 -> b-opc4 name signature = tfm4 (pref name $ spec1 signature)--opc5 :: (Val a1, Val a2, Val a3, Val a4, Val a5, Val b) => Name -> Spec1 -> a1 -> a2 -> a3 -> a4 -> a5 -> b-opc5 name signature = tfm5 (pref name $ spec1 signature)--opc6 :: (Val a1, Val a2, Val a3, Val a4, Val a5, Val a6, Val b) => Name -> Spec1 -> a1 -> a2 -> a3 -> a4 -> a5 -> a6 -> b-opc6 name signature = tfm6 (pref name $ spec1 signature)--opc7 :: (Val a1, Val a2, Val a3, Val a4, Val a5, Val a6, Val a7, Val b) => Name -> Spec1 -> a1 -> a2 -> a3 -> a4 -> a5 -> a6 -> a7 -> b-opc7 name signature = tfm7 (pref name $ spec1 signature)--opc8 :: (Val a1, Val a2, Val a3, Val a4, Val a5, Val a6, Val a7, Val a8, Val b) => Name -> Spec1 -> a1 -> a2 -> a3 -> a4 -> a5 -> a6 -> a7 -> a8 -> b-opc8 name signature = tfm8 (pref name $ spec1 signature)--opc9 :: (Val a1, Val a2, Val a3, Val a4, Val a5, Val a6, Val a7, Val a8, Val a9, Val b) => Name -> Spec1 -> a1 -> a2 -> a3 -> a4 -> a5 -> a6 -> a7 -> a8 -> a9 -> b-opc9 name signature = tfm9 (pref name $ spec1 signature)--opc10 :: (Val a1, Val a2, Val a3, Val a4, Val a5, Val a6, Val a7, Val a8, Val a9, Val a10, Val b) => Name -> Spec1 -> a1 -> a2 -> a3 -> a4 -> a5 -> a6 -> a7 -> a8 -> a9 -> a10 -> b-opc10 name signature = tfm10 (pref name $ spec1 signature)--opc11 :: (Val a1, Val a2, Val a3, Val a4, Val a5, Val a6, Val a7, Val a8, Val a9, Val a10, Val a11, Val b) => Name -> Spec1 -> a1 -> a2 -> a3 -> a4 -> a5 -> a6 -> a7 -> a8 -> a9 -> a10 -> a11 -> b-opc11 name signature = tfm11 (pref name $ spec1 signature)--opc12 :: (Val a1, Val a2, Val a3, Val a4, Val a5, Val a6, Val a7, Val a8, Val a9, Val a10, Val a11, Val a12, Val b) => Name -> Spec1 -> a1 -> a2 -> a3 -> a4 -> a5 -> a6 -> a7 -> a8 -> a9 -> a10 -> a11 -> a12 -> b-opc12 name signature = tfm12 (pref name $ spec1 signature)------------------------------------- multiple outputs---- User friendly type for multiple outputs type signatures-type Specs = ([Rate], [Rate])--specs :: Specs -> Signature-specs = uncurry MultiRate --mo :: (CsdTuple a) => E -> a-mo = multiOuts--mopcs :: (Val a, CsdTuple b) => Name -> Specs -> [a] -> b-mopcs name signature as = mo $ tfms (pref name $ specs signature) as--mopc0 :: (CsdTuple a) => Name -> Specs -> a-mopc0 name signature = mo $ tfm0 (pref name $ specs signature)--mopc1 :: (Val a, CsdTuple b) => Name -> Specs -> a -> b-mopc1 name signature a1 = mo $ tfm1 (pref name $ specs signature) a1--mopc2 :: (Val a1, Val a2, CsdTuple b) => Name -> Specs -> a1 -> a2 -> b-mopc2 name signature a1 a2 = mo $ tfm2 (pref name $ specs signature) a1 a2--mopc3 :: (Val a1, Val a2, Val a3, CsdTuple b) => Name -> Specs -> a1 -> a2 -> a3 -> b-mopc3 name signature a1 a2 a3 = mo $ tfm3 (pref name $ specs signature) a1 a2 a3--mopc4 :: (Val a1, Val a2, Val a3, Val a4, CsdTuple b) => Name -> Specs -> a1 -> a2 -> a3 -> a4 -> b-mopc4 name signature a1 a2 a3 a4 = mo $ tfm4 (pref name $ specs signature) a1 a2 a3 a4--mopc5 :: (Val a1, Val a2, Val a3, Val a4, Val a5, CsdTuple b) => Name -> Specs -> a1 -> a2 -> a3 -> a4 -> a5 -> b-mopc5 name signature a1 a2 a3 a4 a5 = mo $ tfm5 (pref name $ specs signature) a1 a2 a3 a4 a5--mopc6 :: (Val a1, Val a2, Val a3, Val a4, Val a5, Val a6, CsdTuple b) => Name -> Specs -> a1 -> a2 -> a3 -> a4 -> a5 -> a6 -> b-mopc6 name signature a1 a2 a3 a4 a5 a6 = mo $ tfm6 (pref name $ specs signature) a1 a2 a3 a4 a5 a6--mopc7 :: (Val a1, Val a2, Val a3, Val a4, Val a5, Val a6, Val a7, CsdTuple b) => Name -> Specs -> a1 -> a2 -> a3 -> a4 -> a5 -> a6 -> a7 -> b-mopc7 name signature a1 a2 a3 a4 a5 a6 a7 = mo $ tfm7 (pref name $ specs signature) a1 a2 a3 a4 a5 a6 a7-
− src/Csound/Exp/Event.hs 
@@ -1,119 +0,0 @@-{-# Language TypeFamilies, FlexibleContexts #-}-module Csound.Exp.Event(-    Evt(..), Trig, Snap,-    trigger, filterEvt, accumEvt, snapshot,-    stepper, schedule, toggle-) where--import Data.Monoid--import Csound.Exp-import Csound.Exp.Wrapper-import Csound.Exp.Logic-import Csound.Exp.Tuple-import Csound.Exp.Arg-import Csound.Exp.GE-import Csound.Exp.SE-import Csound.Exp.Ref-import Csound.Exp.Instr--import Csound.Render.Channel(event, instrOn, instrOff)--type Bam a = a -> SE ()-type Trig = Evt ()--newtype Evt a = Evt { runEvt :: Bam a -> SE () }--trigger :: BoolSig -> Evt ()-trigger cond = Evt $ \bam -> when cond $ bam ()--instance Functor Evt where-    fmap f evt = Evt $ \bam -> runEvt evt (bam . f)--instance Monoid (Evt a) where-    mempty = Evt $ const $ return ()-    mappend a b = Evt $ \bam -> runEvt a bam >> runEvt b bam--filterEvt :: (a -> BoolD) -> Evt a -> Evt a-filterEvt cond evt = Evt $ \bam -> runEvt evt $ \a ->-    when (toBoolSig $ cond a) $ bam a--accumEvt :: (CsdTuple s) => s -> (a -> s -> (b, s)) -> Evt a -> Evt b-accumEvt s0 update evt = Evt $ \bam -> do-    (readSt, writeSt) <- sensorsSE s0-    runEvt evt $ \a -> do-        s1 <- readSt-        let (b, s2) = update a s1-        writeSt s2-        bam b--snapshot :: (CsdTuple a) => (Snap a -> b -> c) -> a -> Evt b -> Evt c-snapshot f asig evt = Evt $ \bam -> runEvt evt $ \a -> -    bam (f (readSnap asig) a)--toBoolSig :: BoolD -> BoolSig-toBoolSig = undefined--readSnap :: CsdTuple a => a -> Snap a-readSnap = undefined------------------------------------------------------------------------ snap --type family Snap a :: *--type instance Snap D   = D-type instance Snap Str = Str-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)---------------------------------------------------------evtToBool :: Evt a -> SE BoolSig-evtToBool = undefined--stepper :: CsdTuple a => a -> Evt a -> SE a-stepper initVal evt = do-    (readSt, writeSt) <- sensorsSE initVal-    runEvt evt $ \a -> writeSt a-    readSt --schedule :: (Arg a, Out b, Out (NoSE b)) => (a -> b) -> Evt (D, a) -> GE (SE (NoSE b))-schedule instr evt = do    -    ref <- newGERef defCsdTuple-    instrId <- saveSourceInstr =<< trigExp (writeGERef ref) instr -    _ <- saveAlwaysOnInstr $ scheduleInstr instrId evt-    return $ readGERef ref--scheduleInstr :: (Arg a) => InstrId -> Evt (D, a) -> E-scheduleInstr instrId evt = execSE $ -    runEvt evt $ \(dt, a) -> do-        event instrId 0 dt a-  -toggle :: (Arg a, Out b, Out (NoSE b)) => (a -> b) -> Evt a -> Evt c -> GE (SE (NoSE b))-toggle instr onEvt offEvt = do-    ref <- newGERef defCsdTuple-    instrId <- saveSourceInstr =<< trigExp (writeGERef ref) instr -    _ <- saveAlwaysOnInstr $ scheduleToggleInstr instrId onEvt offEvt-    return $ readGERef ref--scheduleToggleInstr :: (Arg a) => InstrId -> Evt a -> Evt c -> E-scheduleToggleInstr instrId onEvt offEvt = execSE $ do-    runEvt onEvt $ \a -> do-        instrOn instrId a 0-    cond <- evtToBool offEvt-    when cond $ do-        instrOff instrId-        -        --    ---
− src/Csound/Exp/EventList.hs 
@@ -1,47 +0,0 @@-{-# Language DeriveFunctor, DeriveFoldable, DeriveTraversable #-}-module Csound.Exp.EventList(-    CsdSco(..),-    CsdEvent, csdEventStart, csdEventDur, csdEventContent,-    CsdEventList(..), delayCsdEventList, rescaleCsdEventList-) where--import Data.Traversable-import Data.Foldable--type CsdEvent a = (Double, Double, a)--csdEventStart   :: CsdEvent a -> Double-csdEventDur     :: CsdEvent a -> Double-csdEventContent :: CsdEvent a -> a--csdEventStart   (a, _, _) = a-csdEventDur     (_, a, _) = a-csdEventContent (_, _, a) = a--class CsdSco f where    -    toCsdEventList :: f a -> CsdEventList a-    singleCsdEvent :: Double -> Double -> a -> f a--data CsdEventList a = CsdEventList-    { csdEventListDur   :: Double-    , csdEventListNotes :: [CsdEvent a] -    } deriving (Eq, Show, Functor, Foldable, Traversable)--instance CsdSco CsdEventList where-    toCsdEventList = id-    singleCsdEvent start dur a = CsdEventList (start + dur) [(start, dur, a)]--delayCsdEventList :: Double -> CsdEventList a -> CsdEventList a-delayCsdEventList k (CsdEventList totalDur events) = -    CsdEventList (k + totalDur) (fmap (delayCsdEvent k) events)--delayCsdEvent :: Double -> CsdEvent a -> CsdEvent a -delayCsdEvent k (start, dur, a) = (k + start, dur, a)--rescaleCsdEventList :: Double -> CsdEventList a -> CsdEventList a-rescaleCsdEventList k (CsdEventList totalDur events) = -    CsdEventList (k * totalDur) (fmap (rescaleCsdEvent k) events)--rescaleCsdEvent :: Double -> CsdEvent a -> CsdEvent a-rescaleCsdEvent k (start, dur, a) = (k * start, k * dur, a)-
− src/Csound/Exp/GE.hs 
@@ -1,235 +0,0 @@--- | Global side effects-module Csound.Exp.GE(-    GE(..), runGE, execGE, History(..),-    getHistory, getOptions, withHistory, putHistory,--    Instrs(..),-    saveMixerInstr, saveSourceInstr, saveAlwaysOnInstr, saveSourceInstrCached,    -    saveMixerNotes, --    saveTab, saveStr,--    Scos(..),-    LowLevelSco, saveAlwaysOnNote,--    Globals(..), Global(..),--    appendToGui, newGuiId,-    newGlobalVar-) where--import qualified System.Mem.StableName.Dynamic.Map as DM(Map, empty, insert, lookup)-import qualified System.Mem.StableName.Dynamic     as DM(DynamicStableName, makeDynamicStableName)--import Control.Applicative-import Control.Monad(ap)-import Control.Monad.Trans.State.Strict-import Control.Monad.Trans.Reader-import Data.Default--import qualified Data.IntMap as IM--import Csound.Exp-import Csound.Exp.EventList(CsdEvent)-import Csound.Exp.Wrapper-import Csound.Exp.Options-import Csound.Exp.SE-import Csound.Exp.Gui(Gui)--import Csound.Tfm.Tab--newtype GE a = GE { unGE :: ReaderT CsdOptions (StateT History IO) a }--instance Functor GE where-    fmap f = GE . fmap f . unGE--instance Applicative GE where-    pure = return-    (<*>) = ap--instance Monad GE where-    return = GE . return-    ma >>= mf = GE $ unGE ma >>= unGE . mf--data History = History -    { tabIndex :: Index LowTab-    , strIndex :: Index String-    , midis    :: [MidiAssign]-    , instrs   :: Instrs-    , scos     :: Scos-    , guis     :: Guis -    , globals  :: Globals }--instance Default History where -    def = History def def def def def def def--execGE :: GE a -> CsdOptions -> IO History-execGE a opt = fmap snd $ runGE a opt--runGE :: GE a -> CsdOptions -> IO (a, History)-runGE (GE a) options = runStateT (runReaderT a options) def--ge :: (CsdOptions -> History -> IO (a, History)) -> GE a-ge phi = GE $ ReaderT $ \opt -> StateT $ \history -> phi opt history    --getHistory :: GE History-getHistory = ge $ \_ h -> return (h, h)--putHistory :: History -> GE ()-putHistory h = ge $ \_ _ -> return ((), h)--getOptions :: GE CsdOptions-getOptions = ge $ \opt h -> return (opt, h)--exec :: IO a -> GE a-exec act = ge $ \_ h -> do-    a <- act-    return (a, h)--withHistory :: (History -> (a, History)) -> GE a-withHistory phi = ge $ \_ history -> return $ phi history--modifyHistory :: (History -> History) -> GE ()-modifyHistory f = withHistory $ \h -> ((), f h)----------------------------------------------------------- tables--type TabId = Int-type StrId = Int--saveTab :: LowTab -> GE TabId-saveTab x = withHistory $ \history -> -    let (n, tabs') = indexInsert x (tabIndex history)-    in  (n, history{ tabIndex = tabs' })--saveStr :: String -> GE StrId-saveStr x = withHistory $ \history -> -    let (n, strs') = indexInsert x (strIndex history)-    in  (n, history{ strIndex = strs' })------------------------------------------------------------ instruments--data Instrs = Instrs -    { instrSources  :: [(InstrId, E)]-    , instrMixers   :: [(InstrId, E)]     -    , instrCounter  :: Int-    , instrCache    :: DM.Map Int-    , mixerNotes    :: IM.IntMap LowLevelSco }--instance Default Instrs where-    def = Instrs def def 1 DM.empty def--saveSourceInstrCached :: a -> (a -> GE E) -> GE InstrId-saveSourceInstrCached instr render = do-    h <- getHistory-    let cache = instrCache $ instrs h-    name <- exec $ DM.makeDynamicStableName instr-    case DM.lookup name cache of-        Just n  -> return $ intInstrId n-        Nothing -> do-            instrId <- saveSourceInstr =<< render instr-            saveToCache name (instrIdCeil instrId)-            return instrId--saveToCache :: DM.DynamicStableName -> Int -> GE ()-saveToCache name counter = modifyHistory $ \h ->-    let x = instrs h-    in  h { instrs = x { instrCache = DM.insert name counter (instrCache x) }}--saveAlwaysOnInstr :: E -> GE InstrId-saveAlwaysOnInstr expr = do-    instrId <- saveSourceInstr expr-    saveAlwaysOnNote instrId-    return instrId--saveSourceInstr :: E -> GE InstrId-saveSourceInstr = saveInstr $ \a s -> s{ instrSources = a : instrSources s }--saveMixerInstr :: E -> GE InstrId-saveMixerInstr = saveInstr $ \a s -> s{ instrMixers = a : instrMixers s }--saveInstr :: ((InstrId, E) -> Instrs -> Instrs) -> E -> GE InstrId-saveInstr save expr = withHistory $ \h ->-    let ins = instrs h-        counter' = succ $ instrCounter ins-        instrId  = intInstrId counter'-    in  (instrId, h{ instrs = save (instrId, expr) $ ins { instrCounter = counter' }})--saveMixerNotes :: IM.IntMap LowLevelSco -> GE ()-saveMixerNotes sco = modifyHistory $ \h -> -    let x = instrs h-    in  h { instrs = x{ mixerNotes = sco }}------------------------------------------------------------- scores--data Scos = Scos -    { alwaysOnInstrs :: [InstrId] }--type LowLevelSco = [(InstrId, CsdEvent Note)]--instance Default Scos where-    def = Scos def--saveAlwaysOnNote :: InstrId -> GE ()-saveAlwaysOnNote instrId = modifyHistory $ \h -> -    let x = scos h-    in  h { scos = x{ alwaysOnInstrs = instrId : alwaysOnInstrs x } }------------------------------------------------------------- guis--data Guis = Guis-    { guiStateNewId     :: Int-    , guiStateInstr     :: SE ()-    , guiStateToDraw    :: [Gui] }--instance Default Guis where -    def = Guis 0 (return ()) []--newGuiId :: GE Int -newGuiId = withHistory $ \h -> -    let (n, g') = bumpGuiStateId $ guis h-    in  (n, h{ guis = g' })--appendToGui :: Gui -> SE () -> GE ()-appendToGui gui act = withHistory $ \h ->-    ((), h{ guis = appendToGuiState gui act $ guis h })--bumpGuiStateId :: Guis -> (Int, Guis)-bumpGuiStateId s = (guiStateNewId s, s{ guiStateNewId = succ $ guiStateNewId s })--appendToGuiState :: Gui -> SE () -> Guis -> Guis-appendToGuiState gui act s = s-    { guiStateToDraw = gui : guiStateToDraw s-    , guiStateInstr  = guiStateInstr s >> act }------------------------------------------------------------- globals--data Globals = Globals-    { newGlobalVarId :: Int-    , globalsSoFar   :: [Global] }--instance Default Globals where -    def = Globals 0 []--data Global = Global -    { globalVar     :: Var-    , globalInit    :: E }---newGlobalVarOnGlobals :: Val a => Rate -> a -> Globals -> (Var, Globals)-newGlobalVarOnGlobals rate a s = -    (v, s{ newGlobalVarId = succ n, globalsSoFar = g : globalsSoFar s })-    where n = newGlobalVarId s-          v = Var GlobalVar rate (show n)-          g = Global v (toE a)  --newGlobalVar :: Val a => Rate -> a -> GE Var-newGlobalVar rate initVal = withHistory $ \h -> -    let (v, globals') = newGlobalVarOnGlobals rate initVal (globals h)-    in  (v, h{ globals = globals' })-
− src/Csound/Exp/Gui.hs 
@@ -1,11 +0,0 @@-module Csound.Exp.Gui where--data Gui -    = Comp [Gui] -    | Prim Int Label Elem--data Elem = Slider | Btn | Radio | Text--type Label = String--
− src/Csound/Exp/Instr.hs 
@@ -1,84 +0,0 @@-{-# Language ScopedTypeVariables #-}-module Csound.Exp.Instr(-    soundSourceExp,-    effectExp,-    trigExp-) where--import Control.Monad(zipWithM_)-import qualified Data.Map as M--import Csound.Exp-import Csound.Exp.Wrapper-import Csound.Exp.SE-import Csound.Exp.GE-import Csound.Exp.Tuple-import Csound.Exp.Arg-import Csound.Exp.Options--import Csound.Render.Channel-import Csound.Tfm.Tab---funProxy :: (a -> b) -> (a, b)-funProxy = const (undefined, undefined)    --soundSourceExp :: (Arg a, Out b) => (a -> b) -> GE E-soundSourceExp instr = substTabs expr-    where insArity = arity $ fst $ funProxy instr-          expr = instrExp insArity $ toOut $ instr toArg--effectExp :: (Out a, Out b) => (a -> b) -> GE E-effectExp eff = substTabs $ mixerExp $ do-    inputs <- ins $ outArity $ fst $ funProxy eff-    toOut $ eff $ fromOut $ inputs-    --substTabs :: E -> GE E-substTabs expr = do-    opt <- getOptions-    let expr' = defineInstrTabs (tabFi opt) expr-        tabs  = getInstrTabs expr'-    ids <- mapM saveTab tabs-    let tabMap = M.fromList $ zip tabs ids-    return $ substInstrTabs tabMap expr'-   -trigExp :: (Arg a, Out b) => (NoSE b -> SE ()) -> (a -> b) -> GE E-trigExp writer instr = substTabs $ execSE $ -    writer . toCsdTuple . fmap toE =<< (toOut $ instr toArg)---------------------------------------------------------------- simple instrument trigered with score---- How to render an instrument-mixerExp :: SE [Sig] -> E---- 4 + arity because there are 3 first arguments (instrId, start, dur) and arity params comes next-mixerExp   = instrExpGen (outs 4) -- for mixing instruments we expect the port number to be the fourth parameter--instrExp :: Int -> SE [Sig] -> E-instrExp insArity = instrExpGen (outs (4 + insArity))--instrExpGen :: ([Sig] -> SE ()) -> SE [Sig] -> E-instrExpGen formOuts instrBody = execSE $ formOuts =<< instrBody------ other outputs--outs :: Int -> [Sig] -> SE ()-outs readChnId sigs = zipWithM_ (out readChnId) [1 .. ] sigs-    where out chnId n asig = chnmix asig $ chnName n (p chnId) ---- inputs--ins :: Int -> SE [Sig]-ins n = mapM in_ [1 .. n] -    where in_ x = do-              let name = chnName x $ readVar chnVar-              asig <- chnget name-              chnclear name-              return asig--
− src/Csound/Exp/Logic.hs 
@@ -1,180 +0,0 @@-{-# OPTIONS_GHC -fno-warn-orphans #-}-{-# Language TypeFamilies #-}-module Csound.Exp.Logic(-    BoolSig, BoolD, when-) where--import Control.Monad.Trans.State(State, state, evalState)-import qualified Data.IntMap as IM(fromList)--import Data.Boolean--import Csound.Exp-import Csound.Exp.Wrapper(-    Sig, D, Str,  -    setRate, noRate,-    Val(..), toExp, onExp, onE1)--import Csound.Exp.SE(SE, se_, stmtOnly)----------------------------------------------------------- imperative if-then-else--when :: BoolSig -> SE () -> SE ()-when p body = do-    ifBegin p-    body-    ifEnd--ifBegin :: Val a => a -> SE ()-ifBegin = withCond IfBegin--{--elseIfBegin :: Val a => a -> SE ()-elseIfBegin = withCond ElseIfBegin--elseBegin :: SE ()-elseBegin = stmtOnly ElseBegin--}--ifEnd :: SE ()-ifEnd = stmtOnly IfEnd--withCond :: Val a => (E -> MainExp E) -> a -> SE ()-withCond stmt p = se_ $ fromE $ noRate $ fmap (PrimOr . Right) $ stmt (toE p)--- booleans---- | Boolean signals. -newtype BoolSig = BoolSig { unBoolSig :: E }---- | Boolean constants. -newtype BoolD = BoolD { unBoolD :: E }--instance Val BoolSig    where { toE = unBoolSig;fromE = BoolSig }-instance Val BoolD      where { toE = unBoolD;  fromE = BoolD }---- booleans for signals--instance Boolean BoolSig where-    true = boolOp0 TrueOp-    false = boolOp0 FalseOp-    notB = onE1 notE-    (&&*) = boolOp2 And-    (||*) = boolOp2 Or--type instance BooleanOf Sig = BoolSig--instance IfB Sig where-    ifB = condExp-    -instance EqB Sig where-    (==*) = boolOp2 Equals-    (/=*) = boolOp2 NotEquals-    -instance OrdB Sig where-    (<*) = boolOp2 Less-    (>*) = boolOp2 Greater-    (<=*) = boolOp2 LessEquals-    (>=*) = boolOp2 GreaterEquals---- booleans for inits--instance Boolean BoolD where-    true = boolOp0 TrueOp-    false = boolOp0 FalseOp-    notB = onE1 notE-    (&&*) = boolOp2 And-    (||*) = boolOp2 Or--type instance BooleanOf D = BoolD--instance IfB D where-    ifB = condExp-    -instance EqB D where-    (==*) = boolOp2 Equals-    (/=*) = boolOp2 NotEquals-    -instance OrdB D where-    (<*) = boolOp2 Less-    (>*) = boolOp2 Greater-    (<=*) = boolOp2 LessEquals-    (>=*) = boolOp2 GreaterEquals---- booleans for tables--type instance BooleanOf Tab = BoolD--instance IfB Tab where-    ifB = condExp---- booleans for strings--type instance BooleanOf Str = BoolD--instance IfB Str where-    ifB = condExp------------------------------------------------------------------------------- if-then-else------ performs inlining of the boolean expressions--boolExp :: a -> [b] -> PreInline a b-boolExp = PreInline--condExp :: (Val bool, Val a) => bool -> a -> a -> a-condExp p t e = fromE $ mkCond (condInfo $ toPrimOr $ toE p) (toE t) (toE e)-    where mkCond :: CondInfo (PrimOr E) -> E -> E -> E-          mkCond pr th el -            | isTrue pr = th-            | isFalse pr = el-            | otherwise = noRate $ If pr (toPrimOr th) (toPrimOr el)            --condInfo :: PrimOr E -> CondInfo (PrimOr E)-condInfo expr = (\(a, b) -> Inline a (IM.fromList b)) $ evalState (condInfo' expr) 0-    where condInfo' :: PrimOr E -> State Int (InlineExp CondOp, [(Int, PrimOr E)])-          condInfo' e = maybe (onLeaf e) (onExpr e) $ parseNode e-          onLeaf e = state $ \n -> ((InlinePrim n, [(n, e)]), n+1)  -          onExpr  _ (op, args) = fmap mkNode $ mapM condInfo' args-              where mkNode as = (InlineExp op (map fst as), concat $ map snd as) --          parseNode :: PrimOr E -> Maybe (CondOp, [PrimOr E])-          parseNode x = case unPrimOr $ fmap toExp x of-              Right (ExpBool (PreInline op args)) -> Just (op, args)-              _ -> Nothing    ------------------------------------------------------------------------------------- constructors for boolean expressions---- generic constructor-boolOps :: (Val a) => CondOp -> [E] -> a-boolOps op as = noRate $ ExpBool $ boolExp op $ fmap toPrimOr as---- constructors by arity--boolOp0 :: Val a => CondOp -> a-boolOp0 op = boolOps op []--boolOp2 :: (Val a1, Val a2, Val b) => CondOp -> a1 -> a2 -> b-boolOp2 op a b = boolOps op $ map (setRate Kr) [toE a, toE b]---------------------------------------------------------------------------------- no support for not in csound so we perform not-elimination-notE :: E -> E-notE x = onExp phi x-    where phi (ExpBool (PreInline op args)) = ExpBool $ case op of-            TrueOp            -> boolExp FalseOp        []-            FalseOp           -> boolExp TrueOp         []-            And               -> boolExp Or             $ fmap (fmap notE) args-            Or                -> boolExp And            $ fmap (fmap notE) args-            Equals            -> boolExp NotEquals      args-            NotEquals         -> boolExp Equals         args-            Less              -> boolExp GreaterEquals  args-            Greater           -> boolExp LessEquals     args-            LessEquals        -> boolExp Greater        args-            GreaterEquals     -> boolExp Less           args--          phi _ = error "Logic.hs:notE - expression is not Boolean"  --
− src/Csound/Exp/Mix.hs 
@@ -1,153 +0,0 @@-module Csound.Exp.Mix(-    -- * Container for sounds (triggered with notes and mixers)-    Mix(..), M(..), nchnls,--    effect, effectS,-    sco, mix, --, midi, pgmidi--    rescaleCsdEventListM-) where--import Data.Traversable(traverse)-import qualified Data.Map    as M--import Csound.Tfm.Tab--import Csound.Exp-import Csound.Exp.Wrapper-import Csound.Exp.SE-import Csound.Exp.GE-import Csound.Exp.Instr-import Csound.Exp.Arg-import Csound.Exp.Tuple(Out(..), CsdTuple, fromCsdTuple, toCsdTuple, outArity)-import Csound.Exp.Options-import Csound.Exp.EventList--newtype Mix a = Mix { unMix :: GE M } --data M -    = Snd InstrId (CsdEventList Note)-    | Eff InstrId (CsdEventList M)    --nchnls :: Out a => f (Mix a) -> Int-nchnls = outArity . proxy  -    where proxy :: f (Mix a) -> a-          proxy = undefined  ---- | Play a bunch of notes with the given instrument.------ > res = sco instrument scores ------ * @instrument@ is a function that takes notes and produces a ---   tuple of signals (maybe with some side effect)---  --- * @scores@ are some notes (see the module "Temporal.Media" ---   on how to build complex scores out of simple ones)------ Let's try to understand the type of the output. It's @Score (Mix (NoSE a))@. --- What does it mean? Let's look at the different parts of this type:------ * @Score a@ - you can think of it as a container of some values of ---   type @a@ (every value of type @a@ starts at some time and lasts ---   for some time in seconds)------ * @Mix a@ - is an output of Csound instrument it can be one or several ---   signals ('Csound.Base.Sig' or 'Csound.Base.CsdTuple'). ------ *NoSE a* - it's a tricky part of the output. 'NoSE' means literaly 'no SE'. --- It tells to the type checker that it can skip the 'Csound.Base.SE' wrapper--- from the type 'a' so that @SE a@ becomes just @a@ or @SE (a, SE b, c)@ --- becomes @(a, b, c)@. Why should it be? I need 'SE' to deduce the order of the--- instruments that have side effects. I need it within one instrument. But when --- instrument is rendered i no longer need 'SE' type. So 'NoSE' lets me drop it--- from the output type. -sco :: (Arg a, Out b, CsdSco f) => (a -> b) -> f a -> f (Mix (NoSE b))-sco instr notes = singleCsdEvent 0 (csdEventListDur events) $ Mix $ do    -    events'  <- traverse renderNote events-    instrId <- saveSourceInstrCached instr soundSourceExp-    return $ Snd instrId events'-    where events = toCsdEventList notes--renderNote :: (Arg a) => a -> GE [Prim]-renderNote a = tfmNoteStrs =<< tfmNoteTabs (toNote a) --tfmNoteTabs :: Note -> GE Note-tfmNoteTabs xs = do-    opt <- getOptions-    let xs' = defineNoteTabs (tabFi opt) xs-        tabs = getPrimTabs =<< xs'-    ids <- mapM saveTab tabs-    let tabMap = M.fromList $ zip tabs ids-    return $ substNoteTabs tabMap xs'--tfmNoteStrs :: Note -> GE Note-tfmNoteStrs xs = do    -    ids <- mapM saveStr strs-    let strMap = M.fromList $ zip strs ids-    return $ substNoteStrs strMap xs   -    where strs = getStrings xs----- | Applies an effect to the sound. Effect is applied to the sound on the give track. ------ > res = mix effect sco ------ * @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.mix' or 'Csound.Base.midi'. ------ With the function 'Csound.Base.mix' 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 the --- module "Temporal.Media". You can delay it mix with some other track and --- apply some another effect on top of it!-mix :: (Out a, Out b, CsdSco f) => (a -> b) -> f (Mix a) -> f (Mix (NoSE b))-mix eff sigs = singleCsdEvent 0 (csdEventListDur events) $ Mix $ do-    notes <- traverse unMix events-    instrId <- saveMixerInstr =<< effectExp eff-    return $ Eff instrId notes -    where events = toCsdEventList sigs-    -{---- | Triggers a midi-instrument (like Csound's massign). The result type --- is a fake one. It's wrapped in the 'Csound.Base.Score' for the ease of mixing.--- you can not delay or stretch it. The only operation that is meaningful --- for it is 'Temporal.Media.chord'. But you can add effects to it with 'Csound.Base.mix'!-midi :: (Out a) => Channel -> (Msg -> a) -> Score (Mix (NoSE a))-midi = genMidi Massign---- | Triggers a - midi-instrument (like Csound's pgmassign). -pgmidi :: (Out a) => Maybe Int -> Channel -> (Msg -> a) -> Score (Mix (NoSE a))-pgmidi mchn = genMidi (Pgmassign mchn)--genMidi :: (Out a) => MidiType -> Channel -> (Msg -> a) -> Score (Mix (NoSE a))-genMidi midiType chn f = temp $ Mid $ mkInstr getMidiArity Msg f (Just (midiType, chn))-    where getMidiArity = mkArity (const 0) outArity--}---- | Constructs the effect that applies a given function on every channel.-effect :: (CsdTuple a, Out a) => (Sig -> Sig) -> (a -> a)-effect f = toCsdTuple . fmap (toE . f . fromE) . fromCsdTuple---- | Constructs the effect that applies a given function with side effect --- (it uses random opcodes or delays) on every channel.-effectS :: (CsdTuple a, Out a) => (Sig -> SE Sig) -> (a -> SE a)-effectS f a = fmap fromOut $ mapM f =<< toOut a--rescaleCsdEventListM :: CsdEventList M -> CsdEventList M-rescaleCsdEventListM es = -    es { csdEventListNotes = fmap rescaleCsdEventM $ csdEventListNotes es }--rescaleCsdEventM :: CsdEvent M -> CsdEvent M-rescaleCsdEventM (start, dur, evt) = (start, dur, phi evt)-    where phi x = case x of-            Snd n evts -> Snd n $ rescaleCsdEventList (dur/localDur) evts-            Eff n evts -> Eff n $ rescaleCsdEventListM $ rescaleCsdEventList (dur/localDur) evts            -            where localDur = case x of-                    Snd _ evts -> csdEventListDur evts-                    Eff _ evts -> csdEventListDur evts---
− src/Csound/Exp/Numeric.hs 
@@ -1,328 +0,0 @@-{-# OPTIONS_GHC -fno-warn-orphans #-}-{-# Language TypeSynonymInstances, FlexibleInstances #-}-module Csound.Exp.Numeric(-    fracD, floorD, ceilD, intD, roundD,-    fracSig, floorSig, ceilSig, intSig, roundSig-) where--import Data.Monoid-import Csound.Exp-import Csound.Exp.Wrapper(-    Sig, D, prim, noRate,-    Val(..), toExp, onE1, onE2)-------------------------------------------------- monoid--instance Monoid Sig where-    mempty  = 0-    mappend = (+)--instance Monoid D where-    mempty  = 0-    mappend = (+)------------------------------------------------- numeric instances--instance Num E where    -    (+) a b -        | isZero a = b-        | isZero b = a-        | otherwise = biOpt (+) Add a b-        -    (*) a b -        | isZero a || isZero b = fromDouble 0-        | otherwise = biOpt (*) Mul a b-        -    (-) a b  -        | isZero a = negate b-        | isZero b = a-        | otherwise = biOpt (-) Sub a b    -    -    negate = unOpt negate Neg-    -    fromInteger = fromDouble . fromInteger-    abs = unOpt abs Abs-    signum = undefined--instance Fractional E where-    (/) a b -        | isZero a = fromDouble 0-        | isZero b = error "csound (/): division by zero" -        | otherwise = biOpt (/) Div a b--    fromRational = fromDouble . fromRational    --instance Floating E where-    pi = fromDouble pi-    exp = unOpt exp ExpOp-    sqrt = unOpt sqrt Sqrt-    log = unOpt log Log-    logBase a n = case n of-        2 -> unOpt (flip logBase 2) Logbtwo a-        10 -> unOpt (flip logBase 10) Log10 a-        b -> log a / log b-    (**) = biOpt (**) Pow-    sin = unOpt sin Sin -    tan = unOpt tan Tan-    cos = unOpt cos Cos-    asin = unOpt asin Sininv-    atan = unOpt atan Taninv-    acos = unOpt acos Cosinv-    sinh = unOpt sinh Sinh-    tanh = unOpt tanh Tanh-    cosh = unOpt cosh Cosh-    asinh a = log $ a + sqrt (a * a + 1)-    acosh a = log $ a + sqrt (a + 1) * sqrt (a - 1)-    atanh a = 0.5 * log ((1 + a) / (1 - a))--enumError :: String -> a-enumError name = error $ name ++ " -- is defined only for literals"-    -instance Enum E where-    succ = (+1)-    pred = \x -> x - 1-    toEnum = fromDouble . fromIntegral-    fromEnum = undefined-    enumFrom a = a : enumFrom (a+1)-    -    enumFromThen a b = a : enumFromThen (a + b) b-     -    enumFromTo a b = case (toNumOpt a, toNumOpt b) of-        (Left x, Left y) -> fmap fromDouble $ enumFromTo x y-        _ -> enumError "[a .. b]"-            -    enumFromThenTo a b c = case (toNumOpt a, toNumOpt b, toNumOpt c) of-        (Left x, Left y, Left z) -> fmap fromDouble $ enumFromThenTo x y z-        _ -> enumError "[a, b .. c]"-    -    -instance Real E where toRational = undefined-        -instance Integral E where-    quot a b = intE $ (intE a) / (intE b)-    rem a b = (a `quot` b) * b - a-    mod = mod'-    div a b = intE $ a - mod a b / b-    quotRem a b = (quot a b, rem a b)-    divMod a b = (div a b, mod a b)-    toInteger = undefined    --onConst :: Val b => (a -> E) -> (a -> b)-onConst f = fromE . f ------------------------------------------------ wrappers--instance Real Sig where  toRational = undefined-instance Ord  Sig where  compare    = undefined-instance Eq   Sig where  (==)       = undefined-instance Real D   where  toRational = undefined-instance Ord  D   where  compare    = undefined-instance Eq   D   where  (==)       = undefined--instance Enum Sig where-    succ = onE1 succ-    pred = onE1 pred-    toEnum = fromE . toEnum-    fromEnum = fromEnum . toE-    enumFrom a = fmap fromE $ enumFrom $ toE a-    enumFromThen a b = fmap fromE $ enumFromThen (toE a) (toE b)-    enumFromTo   a b = fmap fromE $ enumFromTo   (toE a) (toE b)-    enumFromThenTo a b c = fmap fromE $ enumFromThenTo (toE a) (toE b) (toE c)     --instance Enum D where-    succ = onE1 succ-    pred = onE1 pred-    toEnum = fromE . toEnum-    fromEnum = fromEnum . toE-    enumFrom a = fmap fromE $ enumFrom $ toE a-    enumFromThen a b = fmap fromE $ enumFromThen (toE a) (toE b)-    enumFromTo   a b = fmap fromE $ enumFromTo   (toE a) (toE b)-    enumFromThenTo a b c = fmap fromE $ enumFromThenTo (toE a) (toE b) (toE c)  --instance Integral Sig where-    quot = onE2 quot-    rem  = onE2 rem-    div  = onE2 div-    mod  = onE2 mod-    quotRem a b = (fromE x, fromE y)        -        where (x, y) = quotRem (toE a) (toE b)-    divMod a b = (fromE x, fromE y)-        where (x, y) = divMod (toE a) (toE b)-    toInteger = toInteger . toE-        -instance Integral D where-    quot = onE2 quot-    rem  = onE2 rem-    div  = onE2 div-    mod  = onE2 mod-    quotRem a b = (fromE x, fromE y)        -        where (x, y) = quotRem (toE a) (toE b) -    divMod a b = (fromE x, fromE y)-        where (x, y) = divMod (toE a) (toE b)-    toInteger = toInteger . toE---- | Fractional part of the signal.-fracSig :: Sig -> Sig-fracSig = onE1 fracE---- | Floor operator for signals.-floorSig :: Sig -> Sig -floorSig = onE1 floorE---- | Ceiling operator for signals.-ceilSig :: Sig -> Sig-ceilSig = onE1 ceilE---- | Integer part of the number for signals.-intSig :: Sig -> Sig -intSig = onE1 intE---- | Round operator for signals.-roundSig :: Sig -> Sig-roundSig = onE1 roundE---- | Fractional part of the number.-fracD :: D -> D-fracD = onE1 fracE---- | Floor operator for numbers.-floorD :: D -> D -floorD = onE1 floorE---- | Ceiling operator for numbers.-ceilD :: D -> D-ceilD = onE1 ceilE---- | Integer part of the number.-intD :: D -> D -intD = onE1 intE---- | Round operator for numbers.-roundD :: D -> D-roundD = onE1 roundE---instance Num Sig where    -    (+) = onE2 (+)-    (*) = onE2 (*)-    (-) = onE2 (-)-    negate = onE1 negate-    fromInteger = onConst fromInteger-    abs = onE1 abs-    signum = onE1 signum--instance Num D where-    (+) = onE2 (+)-    (*) = onE2 (*)-    (-) = onE2 (-)-    negate = onE1 negate-    fromInteger = onConst fromInteger-    abs = onE1 abs-    signum = onE1 signum--instance Fractional Sig where-    (/) = onE2 (/)-    fromRational = onConst fromRational--instance Fractional D where-    (/) = onE2 (/)-    fromRational = onConst fromRational--instance Floating Sig where-    pi = fromE pi-    exp = onE1 exp-    sqrt = onE1 sqrt-    log = onE1 log-    logBase = onE2 logBase-    (**) = onE2 (**)-    sin = onE1 sin-    tan = onE1 tan-    cos = onE1 cos-    asin = onE1 asin-    atan = onE1 atan-    acos = onE1 acos-    sinh = onE1 sinh-    tanh = onE1 tanh-    cosh = onE1 cosh-    asinh = onE1 asinh-    acosh = onE1 acosh-    atanh = onE1 atanh-   -instance Floating D where-    pi = fromE pi-    exp = onE1 exp-    sqrt = onE1 sqrt-    log = onE1 log-    logBase = onE2 logBase-    (**) = onE2 (**)-    sin = onE1 sin-    tan = onE1 tan-    cos = onE1 cos-    asin = onE1 asin-    atan = onE1 atan-    acos = onE1 acos-    sinh = onE1 sinh-    tanh = onE1 tanh-    cosh = onE1 cosh-    asinh = onE1 asinh-    acosh = onE1 acosh-    atanh = onE1 atanh----------------------------------------------------------------- Optimizations for constants------ If an arithmetic expression contains constants we can execute--- it and render as constant. We check wether all arguments --- are constants. If it's so we apply some numeric function and--- propogate a constant value.--toNumOpt :: E -> Either Double E-toNumOpt x = case toExp x of-    ExpPrim (PrimDouble d) -> Left d-    _ -> Right x--fromNumOpt :: Either Double E -> E-fromNumOpt = either (prim . PrimDouble) id --expNum :: NumExp E -> E-expNum = noRate . ExpNum . fmap toPrimOr--fromDouble :: Double -> E-fromDouble = fromNumOpt . Left--isZero :: E -> Bool-isZero a = either ( == 0) (const False) $ toNumOpt a---- optimization for unary functions-unOpt :: (Double -> Double) -> NumOp -> E -> E-unOpt doubleOp op a = fromNumOpt $ either (Left . doubleOp) (Right . noOpt1) $ toNumOpt a-    where noOpt1 x = expNum $ PreInline op [x] ---- optimization for binary functions-biOpt :: (Double -> Double -> Double) -> NumOp -> E -> E -> E-biOpt doubleOp op a b = fromNumOpt $ case (toNumOpt a, toNumOpt b) of-    (Left da, Left db) -> Left $ doubleOp da db-    _ -> Right $ noOpt2 a b-    where noOpt2 x y = expNum $ PreInline op [x, y]--doubleToInt :: (Double -> Int) -> NumOp -> E -> E-doubleToInt fun = unOpt (fromIntegral . fun) ---- arithmetic--mod' :: E -> E -> E-mod' = biOpt (\a b -> fromIntegral $ mod (floor a :: Int) (floor b)) Pow- --- other functions--ceilE, floorE, fracE, intE, roundE :: E -> E--ceilE   = doubleToInt ceiling Ceil -floorE  = doubleToInt floor Floor-roundE  = doubleToInt round Round-fracE   = unOpt (snd . (properFraction :: (Double -> (Int, Double)))) Frac -intE    = doubleToInt truncate IntOp -
− src/Csound/Exp/Options.hs 
@@ -1,45 +0,0 @@-module Csound.Exp.Options where--import Data.Default-import Csound.Tab(TabFi, fineFi, idSegs, idExps, idConsts)--type CtrlId = Int-type Channel = Int---- | Csound options. The default value is------ > instance Default CsdOptions where--- >     def = CsdOptions --- >             { flags = "-d"           -- suppress ftable printing--- >             , sampleRate  = 44100--- >             , blockSize = 64--- >             , seed = Nothing--- >             , initc7 = []--- >             , tabFi = fineFi 13 [(idSegs, 10), (idExps, 10), (idConsts, 8)] } -- all tables have 8192 points but tables for linear, exponential and constant segments. --data CsdOptions = CsdOptions -    { flags         :: String       -    , sampleRate    :: Int          -    , blockSize     :: Int          -    , seed          :: Maybe Int    -    , initc7        :: [(Channel, CtrlId, Double)]-    , tabFi         :: TabFi-    }--instance Default CsdOptions where-    def = CsdOptions -            { flags = "-d"-            , sampleRate  = 44100-            , blockSize = 64-            , seed = Nothing-            , initc7 = []-            , tabFi = fineFi 13 [(idSegs, 10), (idExps, 10), (idConsts, 8)] }--data MidiType = Massign | Pgmassign (Maybe Int)--data MidiAssign = MidiAssign -    { midiAssignType    :: MidiType-    , midiAssignChannel :: Channel-    , midiAssignInstr   :: Int }--
− src/Csound/Exp/Ref.hs 
@@ -1,50 +0,0 @@-module Csound.Exp.Ref(-    -- * GERef-    GERef, newGERef, readGERef, writeGERef, -    sensorsGE, --    -- * SERef-    SERef, newSERef, readSERef, writeSERef, -    sensorsSE-) where--import Control.Monad(zipWithM, zipWithM_)--import Csound.Exp.Tuple-import Csound.Exp.GE-import Csound.Exp.SE---- global references--data GERef a = GERef -    { readGERef  :: SE a-    , writeGERef :: a -> SE () }--sensorsGE :: CsdTuple a => a -> GE (SE a, a -> SE ())-sensorsGE a = do-    vs <- zipWithM newGlobalVar (ratesCsdTuple a) (fromCsdTuple a)-    let reader = return $ toCsdTuple $ fmap readVar vs-        writer x = zipWithM_ writeVar vs (fromCsdTuple x)-    return (reader, writer)--newGERef :: CsdTuple a => a -> GE (GERef a)-newGERef a = fmap (uncurry GERef) $ sensorsGE a---- local references--data SERef a = SERef-    { readSERef  :: SE a-    , writeSERef :: a -> SE () }--newSERef :: CsdTuple a => a -> SE (SERef a)-newSERef a = fmap (uncurry SERef) (sensorsSE a)--sensorsSE :: CsdTuple a => a -> SE (SE a, a -> SE ())-sensorsSE a = do-    vs <- zipWithM newLocalVar (ratesCsdTuple a) (fromCsdTuple a)-    let reader = return $ toCsdTuple $ fmap readVar vs-        writer x = zipWithM_ writeVar vs (fromCsdTuple x)-    return (reader, writer)-    --
− src/Csound/Exp/SE.hs 
@@ -1,111 +0,0 @@--- | side effects-module Csound.Exp.SE(-    Outs,-    SE(..), LocalHistory(..), -    se, se_, stmtOnly, runSE, execSE, -    writeVar, readVar, initVar, newLocalVar-) where--import Control.Applicative-import Control.Monad(ap)-import Control.Monad.Trans.State.Strict-import Data.Default-import Data.Maybe(fromJust)-import Data.Fix(Fix(..))--import Csound.Exp-import Csound.Exp.Wrapper---type Outs = SE [Sig]---- | Csound's synonym for 'IO'-monad. 'SE' means Side Effect. --- You will bump into 'SE' trying to read and write to delay lines,--- making random signals or trying to save your audio to file. --- Instrument is expected to return a value of @SE [Sig]@. --- So it's okay to do some side effects when playing a note.-newtype SE a = SE { unSE :: State LocalHistory a }--data LocalHistory = LocalHistory-    { expDependency     :: Maybe E-    , locals            :: Locals }---instance Default LocalHistory where-    def = LocalHistory def def--data Locals = Locals -    { newVarId          :: Int-    , localInits        :: [SE ()] }--instance Default Locals where-    def = Locals def def--instance Functor SE where-    fmap f = SE . fmap f . unSE--instance Applicative SE where-    pure = return-    (<*>) = ap--instance Monad SE where-    return = SE . return-    ma >>= mf = SE $ unSE ma >>= unSE . mf--runSE :: SE a -> (a, LocalHistory)-runSE a = runState (unSE a) def--execSE :: SE a -> E-execSE a -    | null initList = expr-    | otherwise     = execSE $ applyInitList initList expr >> clearInitList-    where st = snd $ runSE a-          expr = fromJust $ expDependency st-          initList = localInits $ locals st-          clearInitList = SE $ modify $ \s -> s{ locals = def }-          applyInitList inits xs = sequence_ inits >> se_ xs---- dependency tracking--se :: (Val a) => E -> SE a-se a = SE $ state $ \s -> -    let x = Fix $ (unFix a) { ratedExpDepends = expDependency s }-    in  (fromE x, s{ expDependency = Just x } )--se_ :: E -> SE ()-se_ = fmap (const ()) . (se :: E -> SE E)--stmtOnly :: Exp E -> SE ()-stmtOnly stmt = se_ $ fromE $ noRate stmt-------------------------------------------------------- variables---- generic funs--writeVar :: (Val a) => Var -> a -> SE ()-writeVar v x = se_ $ noRate $ WriteVar v $ toPrimOr $ toE x --readVar :: (Val a) => Var -> a-readVar v = noRate $ ReadVar v--initVar :: (Val a) => Var -> a -> SE ()-initVar v x = se_ $ noRate $ InitVar v $ toPrimOr $ toE x---- new local variables--newLocalVar :: Val a => Rate -> a -> SE Var-newLocalVar rate initVal = SE $ do-    s <- get-    let (var, locals') = newVarOnLocals rate initVal (locals s)-    put $ s { locals = locals' }-    return var--newVarOnLocals :: Val a => Rate -> a -> Locals -> (Var, Locals)-newVarOnLocals rate initVal st = -    (var, st { newVarId = succ n, localInits = initStmt : localInits st })-    where var = Var LocalVar rate (show n)-          n = newVarId st  -          initStmt = initVar var initVal-
− src/Csound/Exp/Tuple.hs 
@@ -1,238 +0,0 @@-{-# Language -        TypeFamilies,-        FlexibleContexts #-}-module Csound.Exp.Tuple(-    CsdTuple(..), -    fromCsdTuple, toCsdTuple, arityCsdTuple, ratesCsdTuple, defCsdTuple,-    Out(..), multiOuts, outArity-) where--import Data.Default--import Control.Applicative(liftA2)-import Control.Monad(join)--import Csound.Exp-import Csound.Exp.Wrapper(Val(..), Sig, D, Str, Spec, onExp, toExp, -    withRate, getRates)-import Csound.Exp.SE(SE)---- | Describes tuples of Csound values. It's used for functions that can return --- several results (such as 'soundin' or 'diskin2'). Tuples can be nested. -class CsdTuple a where-    csdTupleMethods :: CsdTupleMethods a--data CsdTupleMethods a = CsdTupleMethods-    { fromCsdTuple_  :: a -> [E]-    , toCsdTuple_    :: [E] -> a-    , arityCsdTuple_ :: a -> Int-    , ratesCsdTuple_ :: a -> [Rate]-    , defCsdTuple_   :: a }--fromCsdTuple :: CsdTuple a => a -> [E] -fromCsdTuple = fromCsdTuple_ csdTupleMethods--toCsdTuple :: CsdTuple a => [E] -> a-toCsdTuple = toCsdTuple_ csdTupleMethods--arityCsdTuple :: CsdTuple a => a -> Int-arityCsdTuple = arityCsdTuple_ csdTupleMethods--ratesCsdTuple :: CsdTuple a => a -> [Rate]-ratesCsdTuple = ratesCsdTuple_ csdTupleMethods--defCsdTuple :: CsdTuple a => a-defCsdTuple = defCsdTuple_ csdTupleMethods---- | Defines instance of type class 'Arg' for a new type in terms of an already defined one.-makeCsdTupleMethods :: (CsdTuple a) => (a -> b) -> (b -> a) -> CsdTupleMethods b-makeCsdTupleMethods to from = CsdTupleMethods -    { fromCsdTuple_  = fromCsdTuple . from-    , toCsdTuple_    = to . toCsdTuple -    , arityCsdTuple_ = const $ arityCsdTuple $ proxy to-    , ratesCsdTuple_ = ratesCsdTuple . from-    , defCsdTuple_   = to defCsdTuple }-    where proxy :: (a -> b) -> a-          proxy = undefined---- | Output of the instrument.-class CsdTuple (NoSE a) => Out a where-    type NoSE a :: *-    toOut :: a -> SE [Sig]-    fromOut :: [Sig] -> a--outArity :: Out a => a -> Int-outArity a = arityCsdTuple (proxy a)-    where proxy :: Out a => a -> NoSE a-          proxy = undefined  ---- CsdTuple instances--instance CsdTuple () where-    csdTupleMethods = CsdTupleMethods -        { fromCsdTuple_  = return []-        , toCsdTuple_    = const ()-        , arityCsdTuple_ = const 0-        , ratesCsdTuple_ = const []-        , defCsdTuple_   = () }--instance CsdTuple Sig where-    csdTupleMethods = CsdTupleMethods -        { fromCsdTuple_ = return . toE-        , toCsdTuple_ = fromE . head-        , arityCsdTuple_ = const 1-        , ratesCsdTuple_ = const [Ar]-        , defCsdTuple_   = def }-        -instance CsdTuple D where-    csdTupleMethods = CsdTupleMethods -        { fromCsdTuple_ = return . toE-        , toCsdTuple_ = fromE . head-        , arityCsdTuple_ = const 1-        , ratesCsdTuple_ = const [Ir]-        , defCsdTuple_   = def }--instance CsdTuple Tab where-    csdTupleMethods = CsdTupleMethods -        { fromCsdTuple_ = return . toE-        , toCsdTuple_ = fromE . head-        , arityCsdTuple_ = const 1-        , ratesCsdTuple_ = const [Ir]-        , defCsdTuple_   = def }--instance CsdTuple Str where-    csdTupleMethods = CsdTupleMethods -        { fromCsdTuple_ = return . toE-        , toCsdTuple_ = fromE . head-        , arityCsdTuple_ = const 1-        , ratesCsdTuple_ = const [Sr]-        , defCsdTuple_   = def }--instance CsdTuple Spec where-    csdTupleMethods = CsdTupleMethods -        { fromCsdTuple_ = return . toE-        , toCsdTuple_ = fromE . head-        , arityCsdTuple_ = const 1-        , ratesCsdTuple_ = const [Fr]-        , defCsdTuple_   = def }--instance (CsdTuple a, CsdTuple b) => CsdTuple (a, b) where    -    csdTupleMethods = CsdTupleMethods fromCsdTuple' toCsdTuple' arityCsdTuple' ratesCsdTuple' defCsdTuple'-        where -            fromCsdTuple' (a, b) = fromCsdTuple a ++ fromCsdTuple b-            arityCsdTuple' x = let (a, b) = proxy x in arityCsdTuple a + arityCsdTuple b-                where proxy :: (a, b) -> (a, b)-                      proxy = const (undefined, undefined)  -            toCsdTuple' xs = (a, b)-                where a = toCsdTuple $ take (arityCsdTuple a) xs-                      xsb = drop (arityCsdTuple a) xs  -                      b = toCsdTuple (take (arityCsdTuple b) xsb)--            ratesCsdTuple' (a, b) = ratesCsdTuple a ++ ratesCsdTuple b-            defCsdTuple' = (defCsdTuple, defCsdTuple)--instance (CsdTuple a, CsdTuple b, CsdTuple c) => CsdTuple (a, b, c) where-    csdTupleMethods = makeCsdTupleMethods to from-        where to (a, (b, c)) = (a, b, c)-              from (a, b, c) = (a, (b, c))  --instance (CsdTuple a, CsdTuple b, CsdTuple c, CsdTuple d) => CsdTuple (a, b, c, d) where-    csdTupleMethods = makeCsdTupleMethods to from-        where to (a, (b, c, d)) = (a, b, c, d)-              from (a, b, c, d) = (a, (b, c, d))  --instance (CsdTuple a, CsdTuple b, CsdTuple c, CsdTuple d, CsdTuple e) => CsdTuple (a, b, c, d, e) where-    csdTupleMethods = makeCsdTupleMethods to from-        where to (a, (b, c, d, e)) = (a, b, c, d, e)-              from (a, b, c, d, e) = (a, (b, c, d, e))  --instance (CsdTuple a, CsdTuple b, CsdTuple c, CsdTuple d, CsdTuple e, CsdTuple f) => CsdTuple (a, b, c, d, e, f) where-    csdTupleMethods = makeCsdTupleMethods to from-        where to (a, (b, c, d, e, f)) = (a, b, c, d, e, f)-              from (a, b, c, d, e, f) = (a, (b, c, d, e, f))  --instance (CsdTuple a, CsdTuple b, CsdTuple c, CsdTuple d, CsdTuple e, CsdTuple f, CsdTuple g) => CsdTuple (a, b, c, d, e, f, g) where-    csdTupleMethods = makeCsdTupleMethods to from-        where to (a, (b, c, d, e, f, g)) = (a, b, c, d, e, f, g)-              from (a, b, c, d, e, f, g) = (a, (b, c, d, e, f, g))  --instance (CsdTuple a, CsdTuple b, CsdTuple c, CsdTuple d, CsdTuple e, CsdTuple f, CsdTuple g, CsdTuple h) => CsdTuple (a, b, c, d, e, f, g, h) where-    csdTupleMethods = makeCsdTupleMethods to from-        where to (a, (b, c, d, e, f, g, h)) = (a, b, c, d, e, f, g, h)-              from (a, b, c, d, e, f, g, h) = (a, (b, c, d, e, f, g, h))  ----------------------------------------------------- multiple outs--multiOuts :: CsdTuple a => E -> a-multiOuts expr = res-    where res = toCsdTuple $ multiOutsSection (arityCsdTuple res) expr--multiOutsSection :: Int -> E -> [E]-multiOutsSection n e = zipWith (\cellId r -> select cellId r e') [0 ..] outRates-    where outRates = take n $ getRates $ toExp e          -          e' = onExp (setMultiRate outRates) e-          -          setMultiRate rates (Tfm info xs) = Tfm (info{ infoSignature = MultiRate rates ins }) xs -              where ins = case infoSignature info of-                        MultiRate _ a -> a-                        _ -> error "Tuple.hs: multiOutsSection -- should be multiOut expression" -          setMultiRate _ _ = error "Tuple.hs: multiOutsSection -- argument should be Tfm-expression"  -            -          select cellId rate expr = withRate rate $ Select rate cellId (PrimOr $ Right expr)----------------------------------------------------- instrument outs--instance Out () where-    type NoSE () = ()-    toOut = const (return [])-    fromOut = const ()--instance Out Sig where-    type NoSE Sig = Sig-    toOut = return . return-    fromOut = head  --instance (Out a, CsdTuple a) => Out (SE a) where-    type NoSE (SE a) = a-    toOut = join . fmap toOut-    fromOut = return . fromOut---instance (CsdTuple a, CsdTuple b, Out a, Out b) => Out (a, b) where-    type NoSE (a, b) = (NoSE a, NoSE b)-    toOut (a, b) = liftA2 (++) (toOut a) (toOut b)-    fromOut = toCsdTuple . fmap toE--    -instance (CsdTuple a, CsdTuple b, CsdTuple c, Out a, Out b, Out c) => Out (a, b, c) where-    type NoSE (a, b, c) = (NoSE a, NoSE b, NoSE c)-    toOut (a, b, c) = toOut (a, (b, c))-    fromOut = toCsdTuple . fmap toE-    -instance (CsdTuple a, CsdTuple b, CsdTuple c, CsdTuple d, Out a, Out b, Out c, Out d) => Out (a, b, c, d) where-    type NoSE (a, b, c, d) = (NoSE a, NoSE b, NoSE c, NoSE d)-    toOut (a, b, c, d) = toOut (a, (b, c, d))-    fromOut = toCsdTuple . fmap toE-    -instance (CsdTuple a, CsdTuple b, CsdTuple c, CsdTuple d, CsdTuple e, Out a, Out b, Out c, Out d, Out e) => Out (a, b, c, d, e) where-    type NoSE (a, b, c, d, e) = (NoSE a, NoSE b, NoSE c, NoSE d, NoSE e)-    toOut (a, b, c, d, e) = toOut (a, (b, c, d, e))-    fromOut = toCsdTuple . fmap toE-    -instance (CsdTuple a, CsdTuple b, CsdTuple c, CsdTuple d, CsdTuple e, CsdTuple f, Out a, Out b, Out c, Out d, Out e, Out f) => Out (a, b, c, d, e, f) where-    type NoSE (a, b, c, d, e, f) = (NoSE a, NoSE b, NoSE c, NoSE d, NoSE e, NoSE f)-    toOut (a, b, c, d, e, f) = toOut (a, (b, c, d, e, f))-    fromOut = toCsdTuple . fmap toE-    -instance (CsdTuple a, CsdTuple b, CsdTuple c, CsdTuple d, CsdTuple e, CsdTuple f, CsdTuple g, Out a, Out b, Out c, Out d, Out e, Out f, Out g) => Out (a, b, c, d, e, f, g) where-    type NoSE (a, b, c, d, e, f, g) = (NoSE a, NoSE b, NoSE c, NoSE d, NoSE e, NoSE f, NoSE g)-    toOut (a, b, c, d, e, f, g) = toOut (a, (b, c, d, e, f, g))-    fromOut = toCsdTuple . fmap toE-    -instance (CsdTuple a, CsdTuple b, CsdTuple c, CsdTuple d, CsdTuple e, CsdTuple f, CsdTuple g, CsdTuple h, Out a, Out b, Out c, Out d, Out e, Out f, Out g, Out h) => Out (a, b, c, d, e, f, g, h) where-    type NoSE (a, b, c, d, e, f, g, h) = (NoSE a, NoSE b, NoSE c, NoSE d, NoSE e, NoSE f, NoSE g, NoSE h)-    toOut (a, b, c, d, e, f, g, h) = toOut (a, (b, c, d, e, f, g, h))-    fromOut = toCsdTuple . fmap toE-
− src/Csound/Exp/Widget.hs 
@@ -1,129 +0,0 @@-module Csound.Exp.Widget where--import Control.Applicative--import Csound.Exp.Gui--import Csound.Exp-import Csound.Exp.Wrapper-import Csound.Exp.SE-import Csound.Exp.GE-import Csound.Exp.Logic-import Csound.Exp.Event--import Csound.Opcode(idur, linseg)--change :: Sig -> BoolSig-change = undefined--mkGuiVar :: Int -> Var-mkGuiVar n = Var GlobalVar Kr ("fl_" ++ show n)--mkGuiHandle :: Int -> Var-mkGuiHandle n = Var GlobalVar Ir ("hfl_" ++ show n)--type Reader a = SE a-type Writer a = a -> SE ()-type Inner    = SE ()--noWrite :: Writer ()-noWrite = return --noRead :: Reader ()-noRead  = return ()--noInner :: Inner-noInner = return ()--newtype Widget a b = Widget { unWidget :: GE (Gui, Writer a, Reader b, Inner) }--type Sink   a = Widget a ()-type Source a = Widget () a-type Display  = Widget () ()--widget :: Widget a b -> GE (Gui, Writer a, Reader b)-widget a = do -    (gui, writer, reader, inner) <- unWidget a-    appendToGui gui inner-    return (gui, writer, reader)--sink :: Widget a b -> GE (Gui, Writer a)-sink a = do-    (gui, writer, _) <- widget a-    return (gui, writer)--source :: Widget a b -> GE (Gui, Reader b)-source a = do-    (gui, _, reader) <- widget a-    return (gui, reader)--mkWidgetWith :: GE (Gui, Writer a, Reader b, Inner) -> Widget a b-mkWidgetWith = Widget--mkDisplayWith :: GE (Gui, Inner) -> Display -mkDisplayWith a = mkWidgetWith $ do-    (gui, inner) <- a-    return (gui, noWrite, noRead, inner)-    -mkWidget :: GE (Gui, Writer a, Reader b) -> Widget a b-mkWidget = Widget . fmap appendEmptyBody-    where appendEmptyBody (a, b, c) = (a, b, c, noInner)--mkSink :: GE (Gui, Writer a) -> Sink a-mkSink a = mkWidget $ do-    (gui, writer) <- a -    return (gui, writer, noRead)--mkSource :: GE (Gui, Reader b) -> Source b-mkSource a = mkWidget $ do-    (gui, reader) <- a -    return (gui, noWrite, reader)-    -mkDisplay :: GE Gui -> Display-mkDisplay a = mkWidget $ do-    gui <- a-    return (gui, noWrite, noRead)-------------------------------------------------------------------------------  --- primitive elements--slider :: Label -> Widget Sig Sig-slider label = mkWidget $ do-    name <- newGuiId-    let gui = Prim name label Slider-        var = mkGuiVar name-        writer = writeVar var-        reader = return $ readVar var-    return (gui, writer, reader)--btn :: Label -> Source (Evt ()) -btn label = mkSource $ do-    name <- newGuiId -    let gui = Prim name label Btn-        var = mkGuiVar name-        reader = return $ trigger $ change $ readVar var-    return (gui, reader)--text :: Display -text = mkDisplay $ do-    name <- newGuiId-    return $ Prim name "" Text----------------------------------------------------------------------------------------linenWidget :: Source Sig-linenWidget = mkSource $ do-    (g1, r1) <- source $ slider "first"-    (g2, r2) <- source $ slider "second"-    let out = liftA2 fun r1 r2        -    return (Comp [g1, g2], out)-    where fun a b = linseg [0, ir a, 1, idur - ir a - ir b, 1, ir b, 0]--adder :: Display-adder = mkDisplayWith $ do-    (ga, ina)   <- source $ slider "a"-    (gb, inb)   <- source $ slider "b"-    (gres, res) <- sink   $ slider "res"-    return (Comp [ga, gb, gres], -            res =<< liftA2 (+) ina inb)-
− src/Csound/Exp/Wrapper.hs 
@@ -1,191 +0,0 @@-{-# OPTIONS_GHC -fno-warn-orphans #-}-{-# Language -        TypeFamilies,-        TypeSynonymInstances,-        FlexibleInstances,-        FlexibleContexts #-}-module Csound.Exp.Wrapper(-    onE1, onE2, toExp, onExp,-    Sig, D, Str, Spec, ToSig(..),-    Sig2, Sig3, Sig4, Ksig, Amp, Cps, Iamp, Icps,-    Val(..),-    str, double, ir, ar, kr, sig,-    tfm, pref, prim, p,    -    noRate, setRate, withRate,-    getRates, isMultiOutSignature-) where--import Data.Fix-import Data.Default-import Data.String--import Csound.Exp--type Sig2 = (Sig, Sig)-type Sig3 = (Sig, Sig, Sig)-type Sig4 = (Sig, Sig, Sig, Sig)---- | An alias for control rate signals (it's used only to clarify that 'Csound.Base.kr' was applied to the signal).-type Ksig = Sig---- | An alias for amplitude.-type Amp = Sig---- | An alias for cycles per second.-type Cps = Sig---- | An alias for amplitude as number.-type Iamp = D---- | An alias for cycles per second as number.-type Icps = D---- | Audio or control rate signals. -newtype Sig = Sig { unSig :: E }---- | Doubles.-newtype D = D { unD :: E }---- | Strings.-newtype Str = Str { unStr :: E }---- | Spectrum of the signal (see FFT and Spectral Processing at "Csound.Opcode.Advanced"). -newtype Spec = Spec { unSpec :: E }------------------------------------------------------------ values--instance IsString Str where-    fromString = str--class Val a where-    toE     :: a -> E-    fromE   :: E -> a--instance Val E          where { toE = id;       fromE = id }    -instance Val (Exp E)    where { toE = noRate;   fromE = toExp }-instance Val Sig        where { toE = unSig;    fromE = Sig }-instance Val D          where { toE = unD;      fromE = D }-instance Val Str        where { toE = unStr;    fromE = Str }-instance Val Spec       where { toE = unSpec;   fromE = Spec }--instance Val Tab    where-    fromE = TabExp-    toE x = case x of-        TabExp e -> e-        primTab -> (prim . PrimTab . Left) primTab--onE1 :: (Val a, Val b) => (E -> E) -> (a -> b)-onE1 f = fromE . f . toE--onE2 :: (Val a, Val b, Val c) => (E -> E -> E) -> (a -> b -> c)-onE2 f a b = fromE $ f (toE a) (toE b)--toExp :: Val a => a -> Exp E-toExp = ratedExpExp . unFix . toE---- Lifts transformation of main expression-onExp :: (Exp E -> Exp E) -> E -> E-onExp f x = case unFix x of-    a -> Fix $ a{ ratedExpExp = f (ratedExpExp a) }----------------------------------------------------- basic constructors-  -noRate :: Val a => Exp E -> a-noRate = ratedExp Nothing-  -withRate :: Val a => Rate -> Exp E -> a-withRate r = ratedExp (Just r)--ratedExp :: Val a => Maybe Rate -> Exp E -> a-ratedExp r = fromE . Fix . RatedExp r Nothing--prim :: Val a => Prim -> a-prim = noRate . ExpPrim --pref :: Name -> Signature -> Info-pref name signature = Info name signature Prefix Nothing--tfm :: Val a => Info -> [E] -> a-tfm info args = noRate $ Tfm info $ fmap toPrimOr args---- variables--p :: Val a => Int -> a-p = prim . P---- | Converts Haskell's doubles to Csound's doubles-double :: Double -> D-double = prim . PrimDouble---- | Converts Haskell's strings to Csound's strings-str :: String -> Str-str = prim . PrimString--getRates :: MainExp a -> [Rate]-getRates (Tfm info _) = case infoSignature info of-    MultiRate outs _ -> outs-    _ -> error "Wrapper.hs:getRates - argument should be multiOut"-getRates _ = error "Wrapper.hs:getRates - argument should be Tfm-expression"-    -isMultiOutSignature :: Signature -> Bool-isMultiOutSignature x = case x of-    MultiRate _ _ -> True-    _ -> False------------------------------------------------- signals from primitive types---- | Values that can be converted to signals. -class ToSig a where-    toSig :: a -> Sig    -    -instance ToSig D where-    toSig = sig--instance ToSig Sig where-    toSig = id-    -instance ToSig Int where-    toSig = sig . double . fromIntegral-   -instance ToSig Double where-    toSig = sig . double------------------------------------------------- rate conversion --setRate :: (Val a, Val b) => Rate -> a -> b-setRate r a = fromE $ Fix $ (\x -> x { ratedExpRate = Just r }) $ unFix $ toE a---- | Sets rate to audio rate.-ar :: Sig -> Sig-ar = setRate Ar---- | Sets rate to control rate.-kr :: Sig -> Sig -kr = setRate Kr---- | Converts signal to double.-ir :: Sig -> D-ir = setRate Ir---- | Converts numbers to signals. It creates constant signal.-sig :: D -> Sig-sig (D a) = Sig a------------------------------------------------- defaults--instance Default E   where def = prim $ PrimDouble 0--instance Default Sig  where def = fromE def    -instance Default D    where def = fromE def-instance Default Tab  where def = fromE def-instance Default Spec where def = fromE def--instance Default Str  where def = prim $ PrimString ""--
src/Csound/IO.hs view
@@ -1,71 +1,209 @@-module Csound.IO (-    renderCsd, renderCsdBy, -    writeCsd, writeCsdBy, playCsd, playCsdBy, +{-# Language FlexibleInstances #-}+-- | Rendering of Csound files and playing the music in real time.+--+-- How are we going to get the sound out of Haskell code? +-- Instruments are ready and we have written all the scores for them. +-- Now, it's time to use the rendering functions. We can render haskell expressions+-- to Csound code. A rendering function takes a value that represents a sound (it's a tuple of signals)+-- and produces a string with Csound code. It can take a value that represents +-- the flags for the csound compiler and global settings ('Csound.Options'). +-- Then we can save this string to file and convert it to sound with csound compiler+--+-- > csound -o music.wav music.csd+--+-- Or we can play it in real time with -odac flag. It sends the sound directly to+-- soundcard. It's usefull when we are using midi or tweek the parameters in real time+-- with sliders or knobs.+--+-- > csound -odac music.csd+--+-- The main function of this module is 'Csound.IO.renderCsdBy'. Other function are nothing but+-- wrappers that produce the Csound code and make something useful with it (saving to file,+-- playing with specific player or in real time).  +module Csound.IO (    +    -- * Rendering+    RenderCsd(..),+    renderCsd,  +    writeCsd, writeCsdBy, +    +    -- * Playing the sound+    playCsd, playCsdBy,      mplayer, mplayerBy, totem, totemBy,-) where +    -- * Live performance+    dac, dacBy, vdac, vdacBy, +    -- * Render and run+    csd, csdBy+) where+ import System.Cmd(system) import Data.Default+import Csound.Typed -import Csound.Exp.EventList(CsdSco)-import Csound.Exp.Mix(Mix)-import Csound.Exp.Options(CsdOptions)-import Csound.Render(render)-import Csound.Exp.Tuple(Out)+render :: Sigs a => Options -> SE a -> IO String+render = renderOutBy  +render_ :: Options -> SE () -> IO String+render_ = renderOutBy_ ++class RenderCsd a where+    renderCsdBy :: Options -> a -> IO String++instance RenderCsd (SE ()) where+    renderCsdBy = render_++instance RenderCsd Sig where+    renderCsdBy opt a = render opt (return a)++instance RenderCsd (Sig, Sig) where+    renderCsdBy opt a = render opt (return a)++instance RenderCsd (Sig, Sig, Sig, Sig) where+    renderCsdBy opt a = render opt (return a)++instance RenderCsd (Sig, Sig, Sig, Sig, Sig, Sig) where+    renderCsdBy opt a = render opt (return a)++instance RenderCsd (Sig, Sig, Sig, Sig, Sig, Sig, Sig, Sig) where+    renderCsdBy opt a = render opt (return a)++instance RenderCsd +    ( (Sig, Sig, Sig, Sig, Sig, Sig, Sig, Sig)+    , (Sig, Sig, Sig, Sig, Sig, Sig, Sig, Sig) ) where  +    renderCsdBy opt a = render opt (return a)++instance RenderCsd +    ( (Sig, Sig, Sig, Sig, Sig, Sig, Sig, Sig)+    , (Sig, Sig, Sig, Sig, Sig, Sig, Sig, Sig)+    , (Sig, Sig, Sig, Sig, Sig, Sig, Sig, Sig)+    , (Sig, Sig, Sig, Sig, Sig, Sig, Sig, Sig) ) where  +    renderCsdBy opt a = render opt (return a)++instance RenderCsd (SE Sig) where+    renderCsdBy opt a = render opt a++instance RenderCsd (SE (Sig, Sig)) where+    renderCsdBy opt a = render opt a++instance RenderCsd (SE (Sig, Sig, Sig, Sig)) where+    renderCsdBy opt a = render opt a++instance RenderCsd (SE (Sig, Sig, Sig, Sig, Sig, Sig)) where+    renderCsdBy opt a = render opt a++instance RenderCsd (SE (Sig, Sig, Sig, Sig, Sig, Sig, Sig, Sig)) where+    renderCsdBy opt a = render opt a++instance RenderCsd (SE +    ( (Sig, Sig, Sig, Sig, Sig, Sig, Sig, Sig)+    , (Sig, Sig, Sig, Sig, Sig, Sig, Sig, Sig) )) where  +    renderCsdBy opt a = render opt a++instance RenderCsd (SE +    ( (Sig, Sig, Sig, Sig, Sig, Sig, Sig, Sig)+    , (Sig, Sig, Sig, Sig, Sig, Sig, Sig, Sig)+    , (Sig, Sig, Sig, Sig, Sig, Sig, Sig, Sig)+    , (Sig, Sig, Sig, Sig, Sig, Sig, Sig, Sig) )) where  +    renderCsdBy opt a = render opt a++instance (Sigs a, Sigs b) => RenderCsd (a -> b) where+    renderCsdBy opt f = renderEffBy opt (return . f)++instance (Sigs a, Sigs b) => RenderCsd (a -> SE b) where+    renderCsdBy opt f = renderEffBy opt f+ -- | Renders Csound file.-renderCsd :: (Out a, CsdSco sco) => sco (Mix a) -> IO String+renderCsd :: RenderCsd a => a -> IO String renderCsd = renderCsdBy def --- | Renders Csound file with options.-renderCsdBy :: (Out a, CsdSco sco) => CsdOptions -> sco (Mix a) -> IO String-renderCsdBy opt as = render opt as- -- | Render Csound file and save it to the give file.-writeCsd :: (Out a, CsdSco sco) => String -> sco (Mix a) -> IO ()-writeCsd file sco = writeFile file =<< renderCsd sco +writeCsd :: RenderCsd a => String -> a -> IO ()+writeCsd file a = writeFile file =<< renderCsd a  -- | Render Csound file with options and save it to the give file.-writeCsdBy :: (Out a, CsdSco sco) => CsdOptions -> String -> sco (Mix a) -> IO ()-writeCsdBy opt file sco = writeFile file =<< renderCsdBy opt sco+writeCsdBy :: RenderCsd a => Options -> String -> a -> IO ()+writeCsdBy opt file a = writeFile file =<< renderCsdBy opt a --- | RenderCsound file save it to the given file, render with csound command and play it with the given program.+-- | Renders Csound file, saves it to the given file, renders with csound command and plays it with the given program. -- --- > playCsd program file sco +-- > playCsd program file csd  -- -- Produces files @file.csd@ (with 'Csound.Render.Mix.renderCsd') and @file.wav@ (with @csound@) and then invokes: ----- > program file.wav-playCsd :: (Out a, CsdSco sco) => String -> String -> sco (Mix a) -> IO ()+-- > program "file.wav"+playCsd :: (RenderCsd a) => (String -> IO ()) -> String -> a -> IO () playCsd = playCsdBy def  -- | Works just like 'Csound.Render.Mix.playCsd' but you can supply csound options.-playCsdBy :: (Out a, CsdSco sco) => CsdOptions -> String -> String -> sco (Mix a) -> IO ()-playCsdBy opt player file sco = do-    writeCsdBy opt fileCsd sco+playCsdBy :: (RenderCsd a) => Options -> (String -> IO ()) -> String -> a -> IO ()+playCsdBy opt player file a = do+    writeCsdBy opt fileCsd a     _ <- system $ "csound -o " ++ fileWav ++ " " ++ fileCsd-    _ <- system $ player ++ " " ++ fileWav+    player fileWav     return ()     where fileCsd = file ++ ".csd"           fileWav = file ++ ".wav"   ---------------------------------------------------------+simplePlayCsdBy :: (RenderCsd a) => Options -> String -> String -> a -> IO ()+simplePlayCsdBy opt player = playCsdBy opt phi+    where phi file = do+            _ <- system $ player ++ " " ++ file+            return ()+            ++-- | Renders csound code to file @tmp.csd@ and plays it with @-odac@ option+-- (sound output goes to soundcard in real time).+dac :: (RenderCsd a) => a -> IO ()+dac = dacBy def++-- | 'Csound.Base.dac' with options.+dacBy :: (RenderCsd a) => Options -> a -> IO ()+dacBy opt a = do+    writeCsdBy opt "tmp.csd" a+    _ <- system $ "csound -odac " ++ "tmp.csd" +    return ()++-- | Output to dac with virtual midi keyboard.+vdac :: (RenderCsd a) => a -> IO ()+vdac = dacBy (setVirtual def) ++-- | Output to dac with virtual midi keyboard with specified options.+vdacBy :: (RenderCsd a) => Options -> a -> IO ()+vdacBy opt = dacBy (setVirtual opt) ++setVirtual :: Options -> Options +setVirtual a = a { csdFlags = (csdFlags a) { rtmidi = Just VirtualMidi, midiRT = m { midiDevice = Just "0" } } }+    where m = midiRT $ csdFlags a++-- | Renders to file @tmp.csd@ and invokes the csound on it.+csd :: (RenderCsd a) => a -> IO ()+csd = csdBy def++-- | Renders to file @tmp.csd@ and invokes the csound on it.+csdBy :: (RenderCsd a) => Options -> a -> IO ()+csdBy options a = do+    writeCsdBy options "tmp.csd" a+    _ <- system $ "csound tmp.csd" +    return ()++---------------------------------------------------------- -- players  -- | Renders to tmp.csd and tmp.wav and plays with mplayer.-mplayer :: (Out a, CsdSco sco) => sco (Mix a) -> IO ()+mplayer :: (RenderCsd a) => a -> IO () mplayer = mplayerBy def  -- | Renders to tmp.csd and tmp.wav and plays with mplayer.-mplayerBy :: (Out a, CsdSco sco) => CsdOptions -> sco (Mix a) -> IO ()-mplayerBy opt = playCsdBy opt "mplayer" "tmp"+mplayerBy :: (RenderCsd a) => Options -> a -> IO ()+mplayerBy opt = simplePlayCsdBy opt "mplayer" "tmp"  -- | Renders to tmp.csd and tmp.wav and plays with totem player.-totem :: (Out a, CsdSco sco) => sco (Mix a) -> IO ()+totem :: (RenderCsd a) => a -> IO () totem = totemBy def  -- | Renders to tmp.csd and tmp.wav and plays with totem player.-totemBy :: (Out a, CsdSco sco) => CsdOptions -> sco (Mix a) -> IO ()-totemBy opt = playCsdBy opt "totem" "tmp"+totemBy :: (RenderCsd a) => Options -> a -> IO ()+totemBy opt = simplePlayCsdBy opt "totem" "tmp"+
− src/Csound/LowLevel.hs 
@@ -1,85 +0,0 @@--- | Functions to make your own opcodes.--- You can find a lot of examples in source code (see directory @Csound/Opcode@)-module Csound.LowLevel(-    -- * Types    -    Rate(..), Name, E, Val(..),--    -- * Handy shortcuts-    i, k, a, x, s, f, is, ks, as,--    -- * Standard opcodes--    -- | Example:-    ---    -- > oscil :: Sig -> Sig -> Tab -> Sig -    -- > oscil = opc3 "oscil" [-    -- >     (a, [x, x, i, i]),-    -- >     (k, [k, k, i, i])]--    Spec1, -    opcs, opc0, opc1, opc2, opc3, opc4, opc5, opc6, opc7, opc8, opc9, opc10, opc11, opc12,--    -- * Multiple outputs-    -- | Examples:-    ---    -- > pan2 :: Sig -> Sig -> (Sig, Sig)-    -- > pan2 = mopc2 "pan2" ([a, a], [a, x, i])-    ---    -- When you don't want to specify precise number of outputs:-    ---    -- > soundin :: CsdTuple a => S -> a-    -- > soundin = mopc1 "soundin" (repeat a, s : is 4)--    Specs,-    mopcs, mopc0, mopc1, mopc2, mopc3, mopc4, mopc5, mopc6, mopc7,--    -- * Side effects--    -- | Examples:-    ---    -- > delayr :: D -> SE Sig-    -- > delayr a1 = se $ opc1 "delayr" [(a, [i])] a1-    -- > -    -- > delayw :: Sig -> SE ()-    -- > delayw a1 = se_ $ opc1 "delayw" [(x, [a])] a1-    ---    -- Functions that produce no values (procedures) should return value of the type 'Xr'.--    -- * When standard functions are not enough-    -    -- | Sometimes Csound opcodes take too many parameters. If you want to -    -- use them, you can always use functions that are defined on lists ('opcs' or 'mopcs').-    -- But in this case you have to convert all arguments to the same type 'E':-    ---    -- For example:-    ---    -- > oscil :: Sig -> Sig -> Tab -> Sig -    -- > oscil a1 a2 a3 = opcs "oscil" signature [toE a1, toE a2, toE a3]-    -- >    where signature = [-    -- >            (a, [x, x, i, i]),-    -- >            (k, [k, k, i, i])]-    -    se, se_-) where--import Csound.Exp-import Csound.Exp.Wrapper-import Csound.Exp.SE-import Csound.Exp.Cons--i, k, a, x, s, f :: Rate--i = Ir-k = Kr-a = Ar-x = Xr-s = Sr-f = Fr--is, ks, as :: Int -> [Rate]--is n = replicate n i-ks n = replicate n k -as n = replicate n a  --
− src/Csound/Opcode.hs 
@@ -1,23 +0,0 @@--- | Here you will find all opcodes from the Csound floss manual (<http://en.flossmanuals.net/csound/overview/>). --- If you are missing some opcodes feel free to use "Csound.LowLevel". It's easy. If it's some opcode you like a lot you can send--- it to me by email and I will include it here.------ All opcodes are defined without initialisation arguments. If you want to supply the auxiliary arguments--- use the function 'Csound.Base.withInits'.-module Csound.Opcode (-    module Csound.Opcode.Basic,-    module Csound.Opcode.Advanced,-    module Csound.Opcode.Data,-    module Csound.Opcode.Interaction-) where--import Csound.Opcode.Basic-import Csound.Opcode.Advanced-import Csound.Opcode.Data-import Csound.Opcode.Interaction--       ----
− src/Csound/Opcode/Advanced.hs 
@@ -1,936 +0,0 @@--- | Advanced Signal Processing-module Csound.Opcode.Advanced (-    ------------------------------------------------------    -- * Modulation and Distortion--    -- ** Frequency Modulation-    foscil, foscili,-    crossfm, crossfmi, crosspm, crosspmi, crossfmpm, crossfmpmi,--    -- ** Distortion and Wave Shaping-    distort, distort1, powershape, polynomial, chebyshevpoly,  --    -- ** Flanging, Phasing, Phase Shaping-    flanger, harmon, phaser1, phaser2, pdclip, pdhalf, pdhalfy,--    -- ** Doppler Shift-    doppler,-    --    ------------------------------------------------------    -- * Granular Synthesis-    fof,-    -    ------------------------------------------------------    -- * Convolution-    pconvolve, convolve, ftconv, dconv,  --    ------------------------------------------------------    -- * FFT and Spectral Processing--    -- ** Realtime Analysis And Resynthesis-    pvsanal, pvstanal, pvsynth, pvsadsyn,--    -- ** Writing FFT Data To A File And Reading From It-    pvswrite, pvsfread, pvsdiskin,-    -    -- ** FFT Info-    pvsinfo, pvsbin, pvscent,  --    -- ** Manipulating FFT Signals-    pvscale, pvshift, pvsbandp, pvsbandr, pvsmix, pvscross, pvsfilter,-    pvsvoc, pvsmorph, pvsfreeze, pvsmaska, pvsblur, pvstencil, pvsarp, pvsmooth,-   -    ------------------------------------------------------    -- * Physical Models and FM Instruments--    -- ** Waveguide Physical Modelling-    streson, pluck, repluck, wgbow, wgbowedbar, wgbrass,-    wgclar, wgflute, wgpluck, wgpluck2, wguide1, wguide2,--    -- ** FM Instrument Models-    fmb3, fmbell, fmmetal, fmpercfl, fmrhode, fmvoice, fmwurlie,-    -    -- ** PhISEM opcodes-    -- | PhISEM (Physically Informed Stochastic Event Modeling) is an algorithmic approach for simulating collisions of multiple independent sound producing objects. -    bamboo, cabasa, crunch, dripwater, guiro, sandpaper, sekere, sleighbells, stix, tambourine,-    -    -- ** Some Perry Cook's instruments-    -- | The method is a physically inspired model developed from Perry Cook, but re-coded for Csound.  -    gogobel, marimba, shaker, vibes,-    -    -- ** Other Models      -    barmodel, mandol, moog, voice-) where--import Csound.Exp-import Csound.Exp.Wrapper-import Csound.Exp.SE-import Csound.Exp.Tuple-import Csound.LowLevel---------------------------------------------------------- * Modulation and Distortion---------------------------------------------------------- ** Frequency Modulation---- | A basic frequency modulated oscillator. ------ > ares foscil xamp, kcps, xcar, xmod, kndx, ifn [, iphs]------ doc: <http://www.csounds.com/manual/html/foscil.html>-foscil :: Amp -> Cps -> Sig -> Sig -> Sig -> Tab -> Sig-foscil = opc6 "foscil" [(a, [x, k, x, x, k, i, i])]---- | Basic frequency modulated oscillator with linear interpolation. ------ > ares foscili xamp, kcps, xcar, xmod, kndx, ifn [, iphs]------ doc: <http://www.csounds.com/manual/html/foscili.html>-foscili :: Amp -> Cps -> Sig -> Sig -> Sig -> Tab -> Sig-foscili = opc6 "foscili" [(a, [x, k, x, x, k, i, i])]----- | Two oscillators, mutually frequency and/or phase modulated by each other. ------ > a1, a2 crossfm xfrq1, xfrq2, xndx1, xndx2, kcps, ifn1, ifn2 [, iphs1] [, iphs2]--- > a1, a2 crossfmi xfrq1, xfrq2, xndx1, xndx2, kcps, ifn1, ifn2 [, iphs1] [, iphs2]--- > a1, a2 crosspm xfrq1, xfrq2, xndx1, xndx2, kcps, ifn1, ifn2 [, iphs1] [, iphs2]--- > a1, a2 crosspmi xfrq1, xfrq2, xndx1, xndx2, kcps, ifn1, ifn2 [, iphs1] [, iphs2]--- > a1, a2 crossfmpm xfrq1, xfrq2, xndx1, xndx2, kcps, ifn1, ifn2 [, iphs1] [, iphs2]--- > a1, a2 crossfmpmi xfrq1, xfrq2, xndx1, xndx2, kcps, ifn1, ifn2 [, iphs1] [, iphs2]------ doc: <http://www.csounds.com/manual/html/crossfm.html> -crossfmGen :: Name -> Sig -> Sig -> Sig -> Sig -> Sig -> Tab -> Tab -> (Sig, Sig)-crossfmGen name = mopc7 name ([a, a], [x, x, x, x, k, i, i, i, i])--crossfm, crossfmi, crosspm, crosspmi, crossfmpm, crossfmpmi :: Cps -> Cps -> Sig -> Sig -> Sig -> Tab -> Tab -> (Sig, Sig)--crossfm = crossfmGen "crossfm"-crossfmi = crossfmGen "crossfmi"-crosspm = crossfmGen "crosspm"-crosspmi = crossfmGen "crosspmi"-crossfmpm = crossfmGen "crossfmpm"-crossfmpmi = crossfmGen "crossfmpmi"---------------------------------------------------------- ** Distortion and Wave Shaping---- | Distort an audio signal via waveshaping and optional clipping. ------ > ar distort asig, kdist, ifn[, ihp, istor]------ doc: <http://www.csounds.com/manual/html/distort.html>-distort :: Sig -> Sig -> Tab -> Sig-distort = opc3 "distort" [(a, [a, k, i, i, i])]---- | Implementation of modified hyperbolic tangent distortion. distort1 can be used to generate wave shaping distortion based on a modification of the tanh function.------ >          exp(asig * (shape1 + pregain)) - exp(asig * (shape2 - pregain))--- >   aout = ------------------------------------------------------------------ >          exp(asig * pregain)            + exp(-asig * pregain)------ > ares distort1 asig, kpregain, kpostgain, kshape1, kshape2[, imode]------ doc: <http://www.csounds.com/manual/html/distort1.html>-distort1 :: Sig -> Sig -> Sig -> Sig -> Sig -> Sig-distort1 = opc5 "distort1" [(a, [a, k, k, k, k, i])]---- | The powershape opcode raises an input signal to a power with pre- and post-scaling of the signal so that --- the output will be in a predictable range. It also processes negative inputs in a symmetrical way to positive inputs, calculating a dynamic transfer function that is useful for waveshaping. ------ > aout powershape ain, kShapeAmount [, ifullscale]------ doc: <http://www.csounds.com/manual/html/powershape.html>-powershape :: Sig -> Sig -> Sig-powershape = opc2 "powershape" [(a, [a, k, i])]---- | The polynomial opcode calculates a polynomial with a single a-rate input variable. The polynomial is a sum --- of any number of terms in the form kn*x^n where kn is the nth coefficient of the expression. These coefficients are k-rate values. ------ > aout polynomial ain, k0 [, k1 [, k2 [...]]]------ doc: <http://www.csounds.com/manual/html/polynomial.html>-polynomial :: Sig -> [Sig] -> Sig-polynomial a1 a2 = opcs "polynomial" [(a, a:repeat k)] (a1:a2)---- | The chebyshevpoly opcode calculates the value of a polynomial expression with a single a-rate input variable that is --- made up of a linear combination of the first N Chebyshev polynomials of the first kind. Each Chebyshev polynomial, Tn(x), --- is weighted by a k-rate coefficient, kn, so that the opcode is calculating a sum of any number of terms in the form kn*Tn(x). --- Thus, the chebyshevpoly opcode allows for the waveshaping of an audio signal with a dynamic transfer function that gives --- precise control over the harmonic content of the output. ------ > aout chebyshevpoly ain, k0 [, k1 [, k2 [...]]]------ doc: <http://www.csounds.com/manual/html/chebyshevpoly.html>-chebyshevpoly :: Sig -> [Sig] -> Sig-chebyshevpoly a1 a2 = opcs "chebyshevpoly" [(a, a:repeat k)] (a1:a2)---------------------------------------------------------- ** Flanging, Phasing, Phase Shaping---- | A user controlled flanger. ------ > ares flanger asig, adel, kfeedback [, imaxd]------ doc: <http://www.csounds.com/manual/html/flanger.html>-flanger :: Sig -> Sig -> Sig -> Sig-flanger = opc3 "flanger" [(a, [a, a, k, i])]---- | Analyze an audio input and generate harmonizing voices in synchrony. ------ > ares harmon asig, kestfrq, kmaxvar, kgenfreq1, kgenfreq2, imode, \--- >       iminfrq, iprd------ doc: <http://www.csounds.com/manual/html/harmon.html>-harmon :: Sig -> Sig -> Sig -> Sig -> Sig -> D -> D -> D -> Sig  -harmon = opc8 "harmon" [(a, [a, k, k, k, k, i, i, i])]---- | An implementation of iord number of first-order allpass filters in series. ------ > ares phaser1 asig, kfreq, kord, kfeedback [, iskip]------ doc: <http://www.csounds.com/manual/html/phaser1.html>-phaser1 :: Sig -> Sig -> Sig -> Sig -> Sig-phaser1 = opc4 "phaser1" [(a, [a, k, k, k, i])]---- | An implementation of iord number of second-order allpass filters in series. ------ > ares phaser2 asig, kfreq, kq, kord, kmode, ksep, kfeedback------ doc: <http://www.csounds.com/manual/html/phaser2.html>-phaser2 :: Sig -> Sig -> Sig -> Sig -> Sig -> Sig -> Sig -> Sig-phaser2 = opc7 "phaser2" [(a, [a, k, k, k, k, k, k])]---- | The pdclip opcode allows a percentage of the input range of a signal to be clipped to fullscale. --- It is similar to simply multiplying the signal and limiting the range of the result, but pdclip --- allows you to think about how much of the signal range is being distorted instead of the scalar --- factor and has a offset parameter for assymetric clipping of the signal range. pdclip is also useful--- for remapping phasors for phase distortion synthesis. ------ > aout pdclip ain, kWidth, kCenter [, ibipolar [, ifullscale]]------ doc: <http://www.csounds.com/manual/html/pdclip.html>-pdclip :: Sig -> Sig -> Sig -> Sig-pdclip = opc3 "pdclip" [(a, [a, k, k, i, i])]---- | The pdhalf opcode is designed to emulate the "classic" phase distortion synthesis method of the --- Casio CZ-series of synthesizers from the mid-1980's. This technique reads the first and second halves --- of a function table at different rates in order to warp the waveform. For example, pdhalf can smoothly --- transform a sine wave into something approximating the shape of a saw wave. ------ > aout pdhalf ain, kShapeAmount [, ibipolar [, ifullscale]]------ doc: <http://www.csounds.com/manual/html/pdhalf.html>-pdhalf :: Sig -> Sig -> Sig -> Sig-pdhalf = opc3 "pdhalf" [(a, [a, k, k, i, i])]---- | The pdhalfy opcode is a variation on the phase distortion synthesis method of the pdhalf opcode. --- It is useful for distorting a phasor in order to read two unequal portions of a table in the same number of samples. ------ > aout pdhalfy ain, kShapeAmount [, ibipolar [, ifullscale]]------ doc: <http://www.csounds.com/manual/html/pdhalfy.html>-pdhalfy :: Sig -> Sig -> Sig -> Sig-pdhalfy = opc3 "pdhalfy" [(a, [a, k, k, i, i])]---------------------------------------------------------- ** Doppler Shift---- | A fast and robust method for approximating sound propagation, achieving convincing --- Doppler shifts without having to solve equations. The method computes frequency shifts --- based on reading an input delay line at a delay time computed from the distance between --- source and mic and the speed of sound. One instance of the opcode is required for each --- dimension of space through which the sound source moves. If the source sound moves at --- a constant speed from in front of the microphone, through the microphone, to behind --- the microphone, then the output will be frequency shifted above the source frequency --- at a constant frequency while the source approaches, then discontinuously will be --- shifted below the source frequency at a constant frequency as the source recedes from --- the microphone. If the source sound moves at a constant speed through a point to one --- side of the microphone, then the rate of change of position will not be constant, and --- the familiar Doppler frequency shift typical of a siren or engine approaching and --- receding along a road beside a listener will be heard. ------ > ashifted doppler asource, ksourceposition, kmicposition [, isoundspeed, ifiltercutoff]------ doc: <http://www.csounds.com/manual/html/doppler.html>-doppler :: Sig -> Sig -> Sig -> Sig-doppler = opc3 "doppler" [(a, [a, k, k, i, i])]---------------------------------------------------------- * Granular Synthesis---- | Audio output is a succession of sinusoid bursts initiated at frequency--- xfund with a spectral peak at xform. For xfund above 25 Hz these burts produce --- a speech-like formant with spectral characteristics determined by the k-input parameters.--- For lower fundamentals this generator provides a special form of granular synthesis.------ > ar fof xamp, xfund, xform, koct, kband, kris, kdur, kdec, iolaps, ifna, ifnb, itotdur, [iphs, ifmode]------ doc: <http://www.csounds.com/manual/html/fof.html>-fof :: Amp -> Cps -> Sig -> Sig -> Sig -> Sig -> Sig -> Sig -> D -> Tab -> Tab -> D -> Sig-fof = opc12 "fof" [(a, [x, x, x, k, k, k, k, k, i, i, i, i, i, i, i])]   ---------------------------------------------------------- * Convolution---- | Convolution based on a uniformly partitioned overlap-save algorithm. Compared to the convolve opcode, pconvolve has these benefits:------    * small delay------    * possible to run in real-time for shorter impulse files------    * no pre-process analysis pass------    * can often render faster than convolve--------- > ar1 [, ar2] [, ar3] [, ar4] pconvolve ain, ifilcod [, ipartitionsize, ichannel]------ doc: <http://www.csounds.com/manual/html/pconvolve.html>-pconvolve :: CsdTuple a => Sig -> Str -> a-pconvolve = mopc2 "pconvolve" ([a,a,a,a], [a,s,i,i])---- | Output is the convolution of signal ain and the impulse response contained in ifilcod. If more than one --- output signal is supplied, each will be convolved with the same impulse response. Note that it is --- considerably more efficient to use one instance of the operator when processing a mono input to create stereo, or quad, outputs. ------ > ar1 [, ar2] [, ar3] [, ar4] convolve ain, ifilcod [, ichannel]------ doc: <http://www.csounds.com/manual/html/convolve.html>-convolve :: CsdTuple a => Sig -> D -> a-convolve = mopc2 "convolve" ([a, a, a, a], [a, i, i])---- | Low latency multichannel convolution, using a function table as impulse response source. The algorithm is to split the --- impulse response to partitions of length determined by the iplen parameter, and delay and mix partitions so that the original, --- full length impulse response is reconstructed without gaps. The output delay (latency) is iplen samples, and does not depend --- on the control rate, unlike in the case of other convolve opcodes. ------ > a1[, a2[, a3[, ... a8]]] ftconv ain, ift, iplen[, iskipsamples \--- >      [, iirlen[, iskipinit]]]------ doc: <http://www.csounds.com/manual/html/ftconv.html>-ftconv :: CsdTuple a => Sig -> Tab -> D -> a-ftconv = mopc3 "ftconv" (as 8, [a,i,i,i,i,i])---- | A direct convolution opcode. ------ > ares dconv asig, isize, ifn------ doc: <http://www.csounds.com/manual/html/dconv.html>-dconv :: Sig -> D -> Tab -> Sig-dconv = opc3 "dconv" [(a, [a,i,i])]---------------------------------------------------------- * FFT and Spectral Processing---------------------------------------------------------- ** Realtime Analysis And Resynthesis---- | Generate an fsig from a mono audio source ain, using phase vocoder overlap-add analysis. ------ > fsig pvsanal ain, ifftsize, ioverlap, iwinsize, iwintype [, iformat] [, iinit]------ doc: <http://www.csounds.com/manual/html/pvsanal.html>-pvsanal :: Sig -> D -> D -> D -> D -> Spec-pvsanal = opc5 "pvsanal" [(f, a:is 6)]---- | pvstanal implements phase vocoder analysis by reading function tables containing sampled-sound sources, with GEN01, and pvstanal will accept deferred allocation tables.--- --- This opcode allows for time and frequency-independent scaling. Time is advanced internally, but controlled by a tempo scaling parameter; when an onset is detected, --- timescaling is momentarily stopped to avoid smearing of attacks. The quality of the effect is generally improved with phase locking switched on.--- --- pvstanal will also scale pitch, independently of frequency, using a transposition factor (k-rate). ------ > fsig pvstanal ktimescal, kamp, kpitch, ktab, [kdetect, kwrap, ioffset,ifftsize, ihop, idbthresh]------ doc: <http://www.csounds.com/manual/html/pvstanal.html>-pvstanal :: Sig -> Sig -> Sig -> Sig -> Spec-pvstanal = opc4 "pvstanal" [(f, ks 6 ++ is 4)]---- | Resynthesise phase vocoder data (f-signal) using a FFT overlap-add. ------ > ares pvsynth fsrc, [iinit]------ doc: <http://www.csounds.com/manual/html/pvsynth.html>-pvsynth :: Spec -> Sig-pvsynth = opc1 "pvsynth" [(a, [f,i])]---- | Resynthesize using a fast oscillator-bank. ------ > ares pvsadsyn fsrc, inoscs, kfmod [, ibinoffset] [, ibinincr] [, iinit]------ doc: <http://www.csounds.com/manual/html/pvsadsyn.html>-pvsadsyn :: Spec -> D -> Sig -> Sig-pvsadsyn = opc3 "pvsadsyn" [(a, [f,i,k,i,i,i])]---------------------------------------------------------- ** Writing FFT Data To A File And Reading From It---- | This opcode writes a fsig to a PVOCEX file (which in turn can be read by pvsfread or other programs that support PVOCEX file input). ------ > pvsfwrite fsig, ifile------ doc: <http://www.csounds.com/manual/html/pvsfwrite.html>-pvswrite :: Spec -> Str -> SE ()-pvswrite a1 a2 = se_ $ opc2 "pvswrite" [(x, [f,s])] a1 a2---- | Create an fsig stream by reading a selected channel from a PVOC-EX analysis file loaded into memory, with frame --- interpolation. Only format 0 files (amplitude+frequency) are currently supported. The operation of this opcode --- mirrors that of pvoc, but outputs an fsig instead of a resynthesized signal. ------ > fsig pvsfread ktimpt, ifn [, ichan]------ doc: <http://www.csounds.com/manual/html/pvsfread.html>-pvsfread :: Sig -> Str -> Spec-pvsfread = opc2 "pvsfread" [(f, [k,s,i])]---- | Create an fsig stream by reading a selected channel from a PVOC-EX analysis file, with frame interpolation. ------ > fsig pvsdiskin SFname,ktscal,kgain[,ioffset, ichan]------ doc: <http://www.csounds.com/manual/html/pvsdiskin.html>-pvsdiskin :: Str -> Sig -> Sig -> Spec-pvsdiskin = opc3 "pvsdiskin" [(f, [s,k,k,i,i])]---------------------------------------------------------- ** FFT Info---- | Get format information about fsrc, whether created by an opcode such as pvsanal, or obtained from --- a PVOCEX file by pvsfread. This information is available at init time, and can be used to set parameters --- for other pvs opcodes, and in particular for creating function tables (e.g. for pvsftw), or setting --- the number of oscillators for pvsadsyn. ------ > ioverlap, inumbins, iwinsize, iformat pvsinfo fsrc------ doc: <http://www.csounds.com/manual/html/pvsinfo.html>-pvsinfo :: Spec -> (D, D, D, D)-pvsinfo = mopc1 "pvsinfo" ([i,i,i,i], [f])---- | Obtain the amp and freq values off a PVS signal bin as k-rate variables. ------ > kamp, kfr pvsbin fsig, kbin------ doc: <http://www.csounds.com/manual/html/pvsbin.html>-pvsbin :: Spec -> Sig -> (Sig, Sig)-pvsbin = mopc2 "pvsbin" ([k,k], [f,k])---- | Calculate the spectral centroid of a signal from its discrete Fourier transform. ------ > kcent pvscent fsig------ doc: <http://www.csounds.com/manual/html/pvscent.html>-pvscent :: Spec -> Sig-pvscent = opc1 "pvscent" [(k, [f])]---------------------------------------------------------- ** Manipulating FFT Signals---- | Scale the frequency components of a pv stream, resulting in pitch shift. Output amplitudes can be optionally modified in order to attempt formant preservation. ------ > fsig pvscale fsigin, kscal[, kkeepform, kgain, kcoefs]------ doc: <http://www.csounds.com/manual/html/pvscale.html>-pvscale :: Spec -> Sig -> Spec-pvscale = opc2 "pvscale" [(f, [f,k,k,k,k])]---- | Shift the frequency components of a pv stream, stretching/compressing its spectrum. ------ > fsig pvshift fsigin, kshift, klowest[, kkeepform, igain, kcoefs]------ doc: <http://www.csounds.com/manual/html/pvshift.html>-pvshift :: Spec -> Sig -> Sig -> Spec-pvshift = opc3 "pvshift" [(f, [f,k,k,k,i,k])]---- | Filter the pvoc frames, passing bins whose frequency is within a band, and with linear interpolation for transitional bands. ------ > fsig pvsbandp fsigin, xlowcut, xlowfull, \--- >       xhighfull, xhighcut[, ktype]------ doc: <http://www.csounds.com/manual/html/pvsbandp.html>-pvsbandp :: Spec -> Sig -> Sig -> Sig -> Sig -> Spec -pvsbandp = opc5 "pvsbandp" [(f, [f,x,x,x,x,k])]---- | Filter the pvoc frames, rejecting bins whose frequency is within a band, and with linear interpolation for transitional bands. ------ > fsig pvsbandr fsigin, xlowcut, xlowfull, \--- >       xhighfull, xhighcut[, ktype]------ doc: <http://www.csounds.com/manual/html/pvsbandr.html>-pvsbandr :: Spec -> Sig -> Sig -> Sig -> Sig -> Spec -pvsbandr = opc5 "pvsbandr" [(f, [f,x,x,x,x,k])]---- | Mix 'seamlessly' two pv signals. This opcode combines the most prominent components of two pvoc streams into a single mixed stream. ------ > fsig pvsmix fsigin1, fsigin2------ doc: <http://www.csounds.com/manual/html/pvsmix.html>-pvsmix :: Spec -> Spec -> Spec-pvsmix = opc2 "pvsmix" [(f, [f,f])]---- | Performs cross-synthesis between two source fsigs. ------ > fsig pvscross fsrc, fdest, kamp1, kamp2------ doc: <http://www.csounds.com/manual/html/pvscross.html>-pvscross :: Spec -> Spec -> Sig -> Sig -> Spec-pvscross = opc4 "pvscross" [(f, [f,f,k,k])]---- | Multiply amplitudes of a pvoc stream by those of a second pvoc stream, with dynamic scaling. ------ > fsig pvsfilter fsigin, fsigfil, kdepth[, igain]------ doc: <http://www.csounds.com/manual/html/pvsfilter.html>-pvsfilter :: Spec -> Spec -> Sig -> Spec-pvsfilter = opc3 "pvsfilter" [(f, [f,f,k,i])]---- | This opcode provides support for cross-synthesis of amplitudes and frequencies. It takes the amplitudes --- of one input fsig and combines with frequencies from another. It is a spectral version of the well-known channel vocoder. ------ > fsig pvsvoc famp, fexc, kdepth, kgain [,kcoefs]------ doc: <http://www.csounds.com/manual/html/pvsvoc.html>-pvsvoc :: Spec -> Spec -> Sig -> Sig -> Spec-pvsvoc = opc4 "pvsvoc" [(f, [f,f,k,k,k])]---- | Performs morphing (or interpolation) between two source fsigs. ------ > fsig pvsmorph fsrc, fdest, kamp1, kamp2------ doc: <http://www.csounds.com/manual/html/pvsmotph.html>-pvsmorph :: Spec -> Spec -> Sig -> Sig -> Spec-pvsmorph = opc4 "pvsmorph" [(f, [f,f,k,k])]---- | This opcodes 'freezes' the evolution of pvs stream by locking into steady amplitude and/or frequency --- values for each bin. The freezing is controlled, independently for amplitudes and frequencies, by a --- control-rate trigger, which switches the freezing 'on' if equal to or above 1 and 'off' if below 1. ------ > fsig pvsfreeze fsigin, kfreeza, kfreezf------ doc: <http://www.csounds.com/manual/html/pvsfreeze.html>-pvsfreeze :: Spec -> Sig -> Sig -> Sig-pvsfreeze = opc3 "pvsfreeze" [(f, [f,k,k])]---- | Modify amplitudes of fsrc using function table, with dynamic scaling. ------ > fsig pvsmaska fsrc, ifn, kdepth------ doc: <http://www.csounds.com/manual/html/pvsmaska.html>-pvsmaska :: Spec -> Tab -> Sig -> Spec-pvsmaska = opc3 "pvsmaska" [(f, [f,i,k])]---- | Average the amp/freq time functions of each analysis channel for a specified time (truncated to number of frames). As a side-effect the input pvoc stream will be delayed by that amount. ------ > fsig pvsblur fsigin, kblurtime, imaxdel------ doc: <http://www.csounds.com/manual/html/pvsblur.html>-pvsblur :: Spec -> Sig -> D -> Spec-pvsblur = opc3 "pvsblur" [(f, [f,k,i])]---- | Transforms a pvoc stream according to a masking function table; if the pvoc stream amplitude --- falls below the value of the function for a specific pvoc channel, it applies a gain to that channel.--- --- The pvoc stream amplitudes are compared to a masking table, if the fall below the table values, they--- are scaled by kgain. Prior to the operation, table values are scaled by klevel, which can be used as masking depth control.--- --- Tables have to be at least fftsize/2 in size; for most GENS it is important to use an extended-guard --- point (size power-of-two plus one), however this is not necessary with GEN43.--- --- One of the typical uses of pvstencil would be in noise reduction. A noise print can be analysed with --- pvanal into a PVOC-EX file and loaded in a table with GEN43. This then can be used as the masking table--- for pvstencil and the amount of reduction would be controlled by kgain. Skipping post-normalisation will --- keep the original noise print average amplitudes. This would provide a good starting point for a successful --- noise reduction (so that klevel can be generally set to close to 1).--- --- Other possible transformation effects are possible, such as filtering and `inverse-masking'.------ > fsig pvstencil fsigin, kgain, klevel, iftable------ doc: <http://www.csounds.com/manual/html/pvstencil.html>-pvstencil :: Spec -> Sig -> Sig -> Tab -> Sig-pvstencil = opc4 "pvstencil" [(f, [f,k,k,i])]---- | This opcode arpeggiates spectral components, by amplifying one bin and attenuating all the others around --- it. Used with an LFO it will provide a spectral arpeggiator similar to Trevor Wishart's CDP program specarp. ------ > fsig pvsarp fsigin, kbin, kdepth, kgain------ doc: <http://www.csounds.com/manual/html/pvsarp.html>-pvsarp :: Spec -> Sig -> Sig -> Sig -> Spec-pvsarp = opc4 "pvsarp" [(f, [f,k,k,k])]---- | Smooth the amplitude and frequency time functions of a pv stream using a 1st order lowpass IIR with time-varying --- cutoff frequency. This opcode uses the same filter as the tone opcode, but this time acting separately on the amplitude--- and frequency time functions that make up a pv stream. The cutoff frequency parameter runs at the control-rate, but unlike --- tone and tonek, it is not specified in Hz, but as fractions of 1/2 frame-rate (actually the pv stream sampling rate),--- which is easier to understand. This means that the highest cutoff frequency is 1 and the lowest 0; the lower the --- frequency the smoother the functions and more pronounced the effect will be.--- --- These are filters applied to control signals so the effect is basically blurring the spectral evolution. The effects --- produced are more or less similar to pvsblur, but with two important differences: 1.smoothing of amplitudes and --- frequencies use separate sets of filters; and 2. there is no increase in computational cost when higher amounts --- of "blurring" (smoothing) are desired. ------ > fsig pvsmooth fsigin, kacf, kfcf------ doc: <http://www.csounds.com/manual/html/pvsmooth.html>-pvsmooth :: Spec -> Sig -> Sig -> Spec-pvsmooth = opc3 "pvsmooth" [(f, [f,k,k])]---------------------------------------------------------- * Physical Models and FM Instruments---------------------------------------------------------- ** Waveguide Physical Modelling---- | An audio signal is modified by a string resonator with variable fundamental frequency. ------ > ares streson asig, kfr, ifdbgain------ doc: <http://www.csounds.com/manual/html/streson.html>-streson :: Sig -> Sig -> D -> Sig-streson = opc3 "streson" [(a, [a,k,i])]---- | Audio output is a naturally decaying plucked string or drum sound based on the Karplus-Strong algorithms. ------ > ares pluck kamp, kcps, icps, ifn, imeth [, iparm1] [, iparm2]     ------ doc: <http://www.csounds.com/manual/html/pluck.html>-pluck :: Amp -> Cps -> Icps -> Tab -> D -> Sig-pluck = opc5 "pluck" [(a, [k,k,i,i,i,i,i])]---- | repluck is an implementation of the physical model of the plucked string. A user can control the pluck point, --- the pickup point, the filter, and an additional audio signal, axcite. axcite is used to excite the 'string'. Based on the Karplus-Strong algorithm. ------ > ares repluck iplk, kamp, icps, kpick, krefl, axcite------ doc: <http://www.csounds.com/manual/html/repluck.html>-repluck :: D -> Amp -> Icps -> Sig -> Sig -> Sig -> Sig-repluck = opc6 "repluck" [(a, [i,k,i,k,k,a])]---- | Audio output is a tone similar to a bowed string, using a physical model developed from Perry Cook, but re-coded for Csound. ------ > ares wgbow kamp, kfreq, kpres, krat, kvibf, kvamp, ifn [, iminfreq]------ doc: <http://www.csounds.com/manual/html/wgbow.html>-wgbow :: Amp -> Cps -> Sig -> Sig -> Sig -> Sig -> Tab -> Sig-wgbow = opc7 "wgbow" [(a, ks 6 ++ is 2)]---- | A physical model of a bowed bar, belonging to the Perry Cook family of waveguide instruments. ------ > ares wgbowedbar kamp, kfreq, kpos, kbowpres, kgain [, iconst] [, itvel] \--- >      [, ibowpos] [, ilow]------ doc: <http://www.csounds.com/manual/html/wgbowedbar.html>-wgbowedbar :: Amp -> Cps -> Sig -> Sig -> Sig -> Sig-wgbowedbar = opc5 "wgbowedbar" [(a, ks 5 ++ is 2)]---- | Audio output is a tone related to a brass instrument, using a physical model developed from Perry Cook, but re-coded for Csound. ------ > ares wgbrass kamp, kfreq, ktens, iatt, kvibf, kvamp, ifn [, iminfreq]   ------ doc: <http://www.csounds.com/manual/html/wgbrass.html>-wgbrass :: Amp -> Cps -> Sig -> D -> Sig -> Sig -> Tab -> Sig -wgbrass = opc7 "wgbrass" [(a, [k,k,k,i,k,k,i,i])]---- | Audio output is a tone similar to a clarinet, using a physical model developed from Perry Cook, but re-coded for Csound. ------ > ares wgclar kamp, kfreq, kstiff, iatt, idetk, kngain, kvibf, kvamp, ifn \--- >       [, iminfreq]------ doc: <http://www.csounds.com/manual/html/wgclar.html>-wgclar :: Amp -> Cps -> Sig -> D -> D -> Sig -> Sig -> Sig -> Tab -> Sig-wgclar = opc9 "wgclar" [(a, [k,k,k,i,i,k,k,k,i,i])]---- | Audio output is a tone similar to a flute, using a physical model developed from Perry Cook, but re-coded for Csound. ------ > ares wgflute kamp, kfreq, kjet, iatt, idetk, kngain, kvibf, kvamp, ifn \--- >      [, iminfreq] [, ijetrf] [, iendrf]------ doc: <http://www.csounds.com/manual/html/wgflute.html>-wgflute :: Amp -> Cps -> Sig -> D -> D -> Sig -> Sig -> Sig -> Tab -> Sig-wgflute = opc9 "wgflute" [(a, [k,k,k,i,i,k,k,k,i,i,i,i])]---- | A high fidelity simulation of a plucked string, using interpolating delay-lines. ------ > ares wgpluck icps, iamp, kpick, iplk, idamp, ifilt, axcite------ doc: <http://www.csounds.com/manual/html/wgpluck.html>-wgpluck :: Icps -> Iamp -> Sig -> D -> D -> D -> Sig -> Sig-wgpluck = opc7 "wgplusk" [(a, [i,i,k,i,i,i,a])]---- | wgpluck2 is an implementation of the physical model of the plucked string, with control over the pluck point, the pickup point and the filter. Based on the Karplus-Strong algorithm. ------ > ares wgpluck2 iplk, kamp, icps, kpick, krefl------ doc: <http://www.csounds.com/manual/html/wgpluck2.html>-wgpluck2 :: D -> Amp -> D -> Sig -> Sig -> Sig-wgpluck2 = opc5 "wgpluck2" [(a, [i,k,i,k,k])]---- | A simple waveguide model consisting of one delay-line and one first-order lowpass filter. ------ > ares wguide1 asig, xfreq, kcutoff, kfeedback------ doc: <http://www.csounds.com/manual/html/wguide1.html>-wguide1 :: Amp -> Cps -> Sig -> Sig -> Sig-wguide1 = opc4 "wguide1" [(a, [a,x,k,k])]---- | A model of beaten plate consisting of two parallel delay-lines and two first-order lowpass filters. ------ > ares wguide2 asig, xfreq1, xfreq2, kcutoff1, kcutoff2, \--- >       kfeedback1, kfeedback2------ doc: <http://www.csounds.com/manual/html/wguide2.html>-wguide2 ::  Amp -> Cps -> Cps -> Sig -> Sig -> Sig -> Sig -> Sig-wguide2 = opc7 "wguide2" [(a, [a,x,x,k,k,k,k])]-  -------------------------------------------------------- ** FM Instrument Models---fmGen :: Name -> Sig -> Sig -> Sig -> Sig -> Sig -> Sig -> Tab -> Tab -> Tab -> Tab -> Tab -> Sig-fmGen name = opc11 name [(a, ks 6 ++ is 6)]----- | Uses FM synthesis to create a Hammond B3 organ sound. It comes from a family of FM sounds, all using 4 basic oscillators and various architectures, as used in the TX81Z synthesizer. ------ > ares fmb3 kamp, kfreq, kc1, kc2, kvdepth, kvrate, ifn1, ifn2, ifn3, \--- >      ifn4, ivfn------ doc: <http://www.csounds.com/manual/html/fmb3.html>-fmb3 :: Amp -> Cps -> Sig -> Sig -> Sig -> Sig -> Tab -> Tab -> Tab -> Tab -> Tab -> Sig----- | Uses FM synthesis to create a tublar bell sound. It comes from a family of FM sounds, all using 4 basic oscillators and various architectures, as used in the TX81Z synthesizer. ------ > ares fmbell kamp, kfreq, kc1, kc2, kvdepth, kvrate, ifn1, ifn2, ifn3, \--- >       ifn4, ivfn[, isus]------ doc: <http://www.csounds.com/manual/html/fmbell.html>-fmbell :: Amp -> Cps -> Sig -> Sig -> Sig -> Sig -> Tab -> Tab -> Tab -> Tab -> Tab -> Sig---- | Uses FM synthesis to create a “Heavy Metal” sound. It comes from a family of FM sounds, all using 4 basic oscillators and various architectures, as used in the TX81Z synthesizer. ------ > ares fmmetal kamp, kfreq, kc1, kc2, kvdepth, kvrate, ifn1, ifn2, ifn3, \--- >       ifn4, ivfn------ doc: <http://www.csounds.com/manual/html/fmmetal.html>-fmmetal :: Amp -> Cps -> Sig -> Sig -> Sig -> Sig -> Tab -> Tab -> Tab -> Tab -> Tab -> Sig---- | Uses FM synthesis to create a percussive flute sound. It comes from a family of FM sounds, all using 4 basic oscillators and various architectures, as used in the TX81Z synthesizer. ------ > ares fmpercfl kamp, kfreq, kc1, kc2, kvdepth, kvrate, ifn1, ifn2, \--- >       ifn3, ifn4, ivfn------ doc: <http://www.csounds.com/manual/html/fmpercfl.html>-fmpercfl :: Amp -> Cps -> Sig -> Sig -> Sig -> Sig -> Tab -> Tab -> Tab -> Tab -> Tab -> Sig---- | Uses FM synthesis to create a Fender Rhodes electric piano sound. It comes from a family of FM sounds, all using 4 basic oscillators and various architectures, as used in the TX81Z synthesizer. ------ > ares fmrhode kamp, kfreq, kc1, kc2, kvdepth, kvrate, ifn1, ifn2, \--- >       ifn3, ifn4, ivfn------ doc: <http://www.csounds.com/manual/html/fmrhode.html>--fmrhode :: Amp -> Cps -> Sig -> Sig -> Sig -> Sig -> Tab -> Tab -> Tab -> Tab -> Tab -> Sig---- | FM Singing Voice Synthesis ------ > ares fmvoice kamp, kfreq, kvowel, ktilt, kvibamt, kvibrate, ifn1, \--- >      ifn2, ifn3, ifn4, ivibfn------ doc: <http://www.csounds.com/manual/html/fmvoice.html>-fmvoice :: Amp -> Cps -> Sig -> Sig -> Sig -> Sig -> Tab -> Tab -> Tab -> Tab -> Tab -> Sig---fmwurlie :: Amp -> Cps -> Sig -> Sig -> Sig -> Sig -> Tab -> Tab -> Tab -> Tab -> Tab -> Sig-      -fmb3 = fmGen "fmb3"-fmbell = fmGen "fmbell"-fmmetal = fmGen "fmmetal"-fmpercfl = fmGen "fmpercfl"-fmrhode = fmGen "fmrhode"-fmvoice = fmGen "fmvoice"-fmwurlie = fmGen "fmwurlie"------------------------------------------------------------------------- PhISEM percussion opcodes. ---- | bamboo is a semi-physical model of a bamboo sound.--- --- > ares bamboo kamp, idettack [, inum] [, idamp] [, imaxshake] [, ifreq] \--- >      [, ifreq1] [, ifreq2]------ doc: <http://www.csounds.com/manual/html/bamboo.html> --bamboo :: Amp -> D -> Sig-bamboo = opc2 "bamboo" [(a, k:is 7)]---- | cabasa is a semi-physical model of a cabasa sound.------ > ares cabasa iamp, idettack [, inum] [, idamp] [, imaxshake]------ doc: <http://www.csounds.com/manual/html/cabasa.html> -cabasa :: Iamp -> D -> Sig-cabasa = opc2 "cabasa" [(a, is 5)]---- | crunch is a semi-physical model of a crunch sound.------ > ares crunch iamp, idettack [, inum] [, idamp] [, imaxshake]------ doc: <http://www.csounds.com/manual/html/crunch.html> --crunch :: Iamp -> D -> Sig-crunch = opc2 "crunch" [(a, is 5)]---- | dripwater is a semi-physical model of a water drop.------ > ares dripwater kamp, idettack [, inum] [, idamp] [, imaxshake] [, ifreq] \--- >       [, ifreq1] [, ifreq2]------ doc: <http://www.csounds.com/manual/html/dripwater.html> --dripwater :: Amp -> D -> Sig-dripwater = opc2 "dripwater" [(a, k:is 7)]---- | guiro is a semi-physical model of a guiro sound.------ > ares guiro kamp, idettack [, inum] [, idamp] [, imaxshake] [, ifreq] [, ifreq1]------ doc: <http://www.csounds.com/manual/html/guiro.html> --guiro :: Amp -> D -> Sig-guiro = opc2 "guiro" [(a, k:is 7)]---- | sandpaper is a semi-physical model of a sandpaper sound.------ > ares sandpaper iamp, idettack [, inum] [, idamp] [, imaxshake]------ doc: <http://www.csounds.com/manual/html/sandpaper.html> --sandpaper :: Iamp -> D -> Sig-sandpaper = opc2 "sandpaper" [(a, is 5)]---- | sekere is a semi-physical model of a sekere sound.------ > ares sekere iamp, idettack [, inum] [, idamp] [, imaxshake]------ doc: <http://www.csounds.com/manual/html/sekere.html> --sekere :: Iamp -> D -> Sig-sekere = opc2 "sekere" [(a, is 5)]---- | sleighbells is a semi-physical model of a sleighbell sound.------ > ares sleighbells kamp, idettack [, inum] [, idamp] [, imaxshake] [, ifreq] \--- >      [, ifreq1] [, ifreq2]------ doc: <http://www.csounds.com/manual/html/sleighbells.html> --sleighbells :: Amp -> D -> Sig-sleighbells = opc2 "sleighbells" [(a, k:is 7)]---- | stix is a semi-physical model of a stick sound.------ > ares stix iamp, idettack [, inum] [, idamp] [, imaxshake]------ doc: <http://www.csounds.com/manual/html/stix.html> --stix :: Iamp -> D -> Sig-stix = opc2 "stix" [(a, is 5)]---- | tambourine is a semi-physical model of a tambourine sound.------ > ares tambourine kamp, idettack [, inum] [, idamp] [, imaxshake] [, ifreq] \--- >      [, ifreq1] [, ifreq2]------ doc: <http://www.csounds.com/manual/html/tambourine.html> -tambourine :: Amp -> D -> Sig-tambourine = opc2 "tambourine" [(a, k:is 7)]------------------------------------------------------------------ by Perry Cook---- | Audio output is a tone related to the striking of a cow bell or similar. ------ > ares gogobel kamp, kfreq, ihrd, ipos, imp, kvibf, kvamp, ivfn------ doc: <http://www.csounds.com/manual/html/gogobel.html> --gogobel :: Amp -> Cps -> D -> D -> D -> Sig -> Sig -> Tab -> Sig-gogobel = opc8 "gogobel" [(a, [k,k,i,i,i,k,k,i])]----- | Audio output is a tone related to the striking of a wooden block as found in a marimba.------ > ares marimba kamp, kfreq, ihrd, ipos, imp, kvibf, kvamp, ivibfn, idec \--- >      [, idoubles] [, itriples]------ doc: <http://www.csounds.com/manual/html/marimba.html> --marimba :: Amp -> Cps -> D -> D -> Tab -> Sig -> Sig -> Tab -> D -> Sig-marimba = opc9 "marimba" [(a, [k,k,i,i,i,k,k,i,i,i,i])]---- | Audio output is a tone related to the shaking of a maraca or similar gourd instrument.------ > ares shaker kamp, kfreq, kbeans, kdamp, ktimes [, idecay]------ doc: <http://www.csounds.com/manual/html/shaker.html> --shaker :: Amp -> Cps -> Sig -> Sig -> Sig -> Sig-shaker = opc5 "shaker" [(a, ks 5 ++ [i])]----- | Audio output is a tone related to the striking of a metal block as found in a vibraphone.------ > ares vibes kamp, kfreq, ihrd, ipos, imp, kvibf, kvamp, ivibfn, idec------ doc: <http://www.csounds.com/manual/html/vibes.html> --vibes :: Amp -> Cps -> D -> D -> Tab -> Sig -> Sig -> Tab -> D -> Sig-vibes = opc9 "vibes" [(a, [k,k,i,i,i,k,k,i,i])]-------------------------------------------------------------------- other models----- | Audio output is a tone similar to a struck metal bar, using a physical model developed from solving the partial--- differential equation. There are controls over the boundary conditions as well as the bar characteristics. ------ > ares barmodel kbcL, kbcR, iK, ib, kscan, iT30, ipos, ivel, iwid------ doc: <http://www.csounds.com/manual/html/barmodel.html> -barmodel :: Sig -> Sig -> D -> D -> Sig -> D -> D -> D -> D -> Sig-barmodel = opc9 "barmodel" [(a, [k,k,i,i,k,i,i,i,i])]---- | An emulation of a mandolin. ------ > ares mandol kamp, kfreq, kpluck, kdetune, kgain, ksize, ifn [, iminfreq]------ doc: <http://www.csounds.com/manual/html/mandol.html> --mandol :: Amp -> Cps -> Sig -> Sig -> Sig -> Sig -> Tab -> Sig-mandol = opc7 "mandol" [(a, ks 6 ++ is 2)]----- | An emulation of a mini-Moog synthesizer. ------ > ares moog kamp, kfreq, kfiltq, kfiltrate, kvibf, kvamp, iafn, iwfn, ivfn------ doc: <http://www.csounds.com/manual/html/moog.html> --moog :: Amp -> Cps -> Sig -> Sig -> Sig -> Sig -> Tab -> Tab -> Tab -> Sig-moog = opc9 "moog" [(a, ks 6 ++ is 3)]- ---- | An emulation of a human voice. ------ > ares voice kamp, kfreq, kphoneme, kform, kvibf, kvamp, ifn, ivfn------ doc: <http://www.csounds.com/manual/html/voice.html> --voice :: Amp -> Cps -> Sig -> Sig -> Sig -> Sig -> Sig -> Tab -> Tab -> Sig-voice = opc9 "voice" [(a, [k,k,k,k,k,k,k,i,i])]-      -
− src/Csound/Opcode/Basic.hs 
@@ -1,1056 +0,0 @@--- | Basic signal processing-module Csound.Opcode.Basic(-    ------------------------------------------------------    -- * Global constants-    idur, zeroDbfs, getSampleRate, getBlockSize,--    ------------------------------------------------------    -- * Oscillators and phasors--    -- ** Standard Oscillators-    oscils, poscil, poscil3, oscil, oscili, oscil3, oscil1i,--    -- ** Dynamic Sprectrum Oscillators-    buzz, gbuzz, mpulse, vco, vco2,  --    -- ** Phasors-    phasor, syncphasor,--    ------------------------------------------------------    -- * Random and Noise generators    -    rand, randi, randh, rnd31, random, randomi, randomh, pinkish, noise, pinkish', noise',--    ------------------------------------------------------    -- * Envelopes-    linseg, expseg, linsegr, expsegr,-    lpshold, loopseg, looptseg,    -    linen, linenr, envlpx, -    -    ------------------------------------------------------    -- * Delays--    -- ** Audio delays-    vdelay, vdelayx, vdelayxw,-    delayr, delayw, deltap, deltapi, deltap3, deltapx, deltapxw,--    -- ** Control delays--    ------------------------------------------------------    -- * Filters--    -- ** Low Pass Filters-    tone, butlp,--    -- ** High Pass Filters-    atone, buthp,--    -- ** Band Pass And Resonant Filters-    reson, butbp,--    -- ** Band Reject Filters-    areson, butbr,--    -- ** Filters For Smoothing Control Signals-    port, portk,--    -- ** Other filters-    moogladder, vcomb, bqrez, comb,--    ------------------------------------------------------    -- * Reverb-    freeverb, reverbsc, reverb, reverb2, nreverb, babo, --    ------------------------------------------------------    -- * Signal Measurement, Dynamic Processing, Sample Level Operations--    -- ** Amplitude Measurement And Following-    rms, balance, follow, follow2, peak, max_k,--    -- ** Pitch Estimation-    ptrack, pitch, pitchamdf, tempest,--    -- ** Tempo Estimation--    -- ** Dynamic Processing-    compress, dam, clip, --    -- ** Sample Level Operations-    limit, samphold, vaget, vaset,  --    ------------------------------------------------------    -- * Spatialization--    -- ** Panning-    pan, pan2,--    -- ** Binaural / HTRF-    hrtfstat, hrtfmove, hrtfmove2,--    ------------------------------------------------------    -- * Other -    xtratim-) where--import Csound.Exp-import Csound.Exp.Wrapper-import Csound.Exp.SE-import Csound.LowLevel---- | Reads @p3@-argument for the current instrument.-idur :: D-idur = p 3-        --- | Reads @0dbfs@ value.-zeroDbfs :: D-zeroDbfs = (setRate Ir :: E -> D) $ readVar (VarVerbatim Ir "0dbfs")---- | Reads @sr@ value.-getSampleRate :: D-getSampleRate = (setRate Ir :: E -> D) $ readVar (VarVerbatim Ir "sr")---- | Reads @ksmps@ value.-getBlockSize :: D-getBlockSize = (setRate Ir :: E -> D) $ readVar (VarVerbatim Ir "ksmps")---------------------------------------------------------- Standard Oscillators----- | Simple, fast sine oscillator, that uses only one multiply, and two add operations to generate one sample of output, and does not require a function table. ------ > ares oscils iamp, icps, iphs [, iflg]------ doc: <http://www.csounds.com/manual/html/oscils.html>-oscils :: Iamp -> Icps -> D -> Sig-oscils = opc3 "oscils" [(a, [i, i, i])]--oscGen :: Name -> Sig -> Sig -> Tab -> Sig -oscGen name = opc3 name [-    (a, [x, x, i, i]),-    (k, [k, k, i, i])]---- | oscil reads table ifn sequentially and repeatedly at a frequency xcps. The amplitude is scaled by xamp. ------ > ares oscil xamp, xcps, ifn [, iphs]--- > kres oscil kamp, kcps, ifn [, iphs]------ doc: <http://www.csounds.com/manual/html/oscil.html>-oscil :: Amp -> Cps -> Tab -> Sig-oscil = oscGen "oscil"---- |  oscili reads table ifn sequentially and repeatedly at a frequency xcps. The amplitude is scaled by xamp. Linear interpolation is applied for table look up from internal phase values. ------ > ares oscili xamp, xcps, ifn [, iphs]--- > kres oscili kamp, kcps, ifn [, iphs]------ doc: <http://www.csounds.com/manual/html/oscili.html>-oscili :: Amp -> Cps -> Tab -> Sig-oscili = oscGen "oscili"---- |  oscil3 reads table ifn sequentially and repeatedly at a frequency xcps. The amplitude is scaled by xamp. Cubic interpolation is applied for table look up from internal phase values. ------ > ares oscil3 xamp, xcps, ifn [, iphs]--- > kres oscil3 kamp, kcps, ifn [, iphs]------ doc: <http://www.csounds.com/manual/html/oscil3.html>--oscil3 :: Amp -> Cps -> Tab -> Sig-oscil3 = oscGen "oscil3"---- | High precision oscillator. ------ > ares poscil xamp, xcps, ifn [, iphs]--- > kres poscil kamp, kcps, ifn [, iphs]------ doc: <http://www.csounds.com/manual/html/poscil.html>--poscil :: Amp -> Cps -> Tab -> Sig-poscil = oscGen "poscil"---- | High precision oscillator with cubic interpolation. ------ > ares poscil3 xamp, xcps, ifn [, iphs]--- > kres poscil3 kamp, kcps, ifn [, iphs]------ doc: <http://www.csounds.com/manual/html/poscil3.html>--poscil3 :: Amp -> Cps -> Tab -> Sig-poscil3 = oscGen "poscil3"---- | Accesses table values by incremental sampling with linear interpolation. ------ > kres oscil1i idel, kamp, idur, ifn------ doc: <http://www.csounds.com/manual/html/oscil1i.html>-oscil1i :: D -> Amp -> D -> Tab -> Sig-oscil1i = opc4 "oscil1i" [(k, [i, k, i, i])]---------------------------------------------------------- Dynamic Sprectrum Oscillators---- buzz, gbuzz, mpulse, vco, vco2  ---- |  Output is a set of harmonically related sine partials. ------ > ares buzz xamp, xcps, knh, ifn [, iphs]------ doc: <http://www.csounds.com/manual/html/buzz.html> --buzz :: Amp -> Cps -> Sig -> Tab -> Sig-buzz = opc4 "buzz" [(a, [x, x, k, i, i])]---- |  Output is a set of harmonically related cosine partials. ------ > ares gbuzz xamp, xcps, knh, klh, kmul, ifn [, iphs]------ doc: <http://www.csounds.com/manual/html/gbuzz.html> --gbuzz :: Amp -> Cps -> Sig -> Sig -> Sig -> Tab -> Sig-gbuzz = opc6 "gbuzz" [(a, [x, x, k, k, k, i, i])]---- | Generates a set of impulses of amplitude kamp separated by kintvl seconds (or samples if kintvl is negative). The first impulse is generated after a delay of ioffset seconds. ------ > ares mpulse kamp, kintvl [, ioffset]------ doc: <http://www.csounds.com/manual/html/mpulse.html> --mpulse :: Amp -> Sig -> Sig-mpulse = opc2 "mpulse" [(a, [k, k, i])]---- | Implementation of a band limited, analog modeled oscillator, based on integration of band limited impulses. vco can be used to simulate a variety of analog wave forms. ------ > ares vco xamp, xcps, iwave, kpw [, ifn] [, imaxd] [, ileak] [, inyx] \--- >     [, iphs] [, iskip]------ doc: <http://www.csounds.com/manual/html/vco.html> --vco :: Amp -> Cps -> D -> Sig -> Sig-vco = opc4 "vco" [(a, [x, x, i, k] ++ is 6)]---- | vco2 is similar to vco. But the implementation uses pre-calculated tables of band-limited waveforms (see also GEN30) --- rather than integrating impulses. This opcode can be faster than vco (especially if a low control-rate is used) and also --- allows better sound quality. Additionally, there are more waveforms and oscillator phase can be modulated at k-rate. --- The disadvantage is increased memory usage. For more details about vco2 tables, see also vco2init and vco2ft.------ > ares vco2 kamp, kcps [, imode] [, kpw] [, kphs] [, inyx]------ doc: <http://www.csounds.com/manual/html/vco2.html> --vco2 :: Amp -> Cps -> Sig-vco2 = opc2 "vco2" [(a, [k, k, i, k, k, i])]----------------------------------------------------------- Phasors---- | Produce a normalized moving phase value. ------ > ares phasor xcps [, iphs]--- > kres phasor kcps [, iphs]------ doc: <http://www.csounds.com/manual/html/phasor.html> --phasor :: Cps -> Sig -phasor = opc1 "phasor" [-    (a, [x, i]),-    (k, [x, i])]---- | Produces a moving phase value between zero and one and an extra impulse output ("sync out") whenever its phase value--- crosses or is reset to zero. The phase can be reset at any time by an impulse on the "sync in" parameter. ------ > aphase, asyncout syncphasor xcps, asyncin, [, iphs]------ doc: <http://www.csounds.com/manual/html/syncphasor.html> --syncphasor :: Sig -> Sig -> (Sig, Sig)-syncphasor = mopc2 "syncphasor" ([a, a], [x, a, i])----------------------------------------------------------- Random---- | Output is a controlled random number series between -amp and +amp ------ > ares rand xamp [, iseed] [, isel] [, ioffset]--- > kres rand xamp [, iseed] [, isel] [, ioffset]------ doc: <http://www.csounds.com/manual/html/rand.html> --rand :: Amp -> SE Sig-rand asig = se $ opc1 "rand" [-    (a, x:rest),-    (k, k:rest)] asig-    where rest = is 3---- | Generates a controlled random number series with interpolation between each new number. ------ > ares randi xamp, xcps [, iseed] [, isize] [, ioffset]--- > kres randi kamp, kcps [, iseed] [, isize] [, ioffset]------ doc: <http://www.csounds.com/manual/html/randi.html> --randi :: Amp -> Sig -> SE Sig-randi = randiGen "randi"---- | Generates random numbers and holds them for a period of time. ------ > ares randh xamp, xcps [, iseed] [, isize] [, ioffset]--- > kres randh kamp, kcps [, iseed] [, isize] [, ioffset]------ doc: <http://www.csounds.com/manual/html/randh.html> --randh :: Amp -> Sig -> SE Sig-randh = randiGen "randh"--randiGen :: Name -> Sig -> Sig -> SE Sig-randiGen name a1 a2 = se $ opc2 name [-    (a, x:x:rest),-    (k, k:k:rest)] a1 a2-    where rest = is 3---- | 31-bit bipolar random opcodes with controllable distribution. These units are portable, i.e. using the same seed --- value will generate the same random sequence on all systems. The distribution of --generated random numbers can be varied at k-rate. ------ > ax rnd31 kscl, krpow [, iseed]--- > ix rnd31 iscl, irpow [, iseed]--- > kx rnd31 kscl, krpow [, iseed]------ doc: <http://www.csounds.com/manual/html/rnd31.html> --rnd31 :: Sig -> Sig -> SE Sig-rnd31 a1 a2 = se $ opc2 "rnd31" [-    (a, [k, k, i]),-    (k, [k, k, i]),-    (i, [i, i, i])] a1 a2---- | Generates is a controlled pseudo-random number series between min and max values. ------ > ax random kscl, krpow--- > ix random iscl, irpow--- > kx random kscl, krpow------ doc: <http://www.csounds.com/manual/html/random.html> --random :: Sig -> Sig -> SE Sig-random a1 a2 = se $ opc2 "random" [-    (a, [k, k]),-    (k, [k, k]),-    (i, [i, i])] a1 a2---- | Generates a user-controlled random number series with interpolation between each new number. ------ > ares randomi kmin, kmax, xcps [,imode] [,ifirstval]--- > kres randomi kmin, kmax, kcps [,imode] [,ifirstval]------ doc: <http://www.csounds.com/manual/html/randomi.html> -randomi :: Amp -> Amp -> Cps -> SE Sig-randomi a1 a2 a3 = se $ opc3 "randomi" [-    (a, [k, k, x, i, i]),-    (k, [k, k, k, i, i])] a1 a2 a3---- | Generates random numbers with a user-defined limit and holds them for a period of time.------ > ares randomh kmin, kmax, xcps [,imode] [,ifirstval]--- > kres randomh kmin, kmax, kcps [,imode] [,ifirstval]------ doc: <http://www.csounds.com/manual/html/randomh.html> --randomh :: Amp -> Amp -> Cps -> SE Sig-randomh a1 a2 a3 = se $ opc3 "randomh" [-    (a, [k, k, x, i, i]),-    (k, [k, k, k, i, i])] a1 a2 a3---- | Generates approximate pink noise (-3dB/oct response) by one of two different methods:------ * a multirate noise generator after Moore, coded by Martin Gardner------ * a filter bank designed by Paul Kellet------ > ares pinkish xin [, imethod] [, inumbands] [, iseed] [, iskip]------ doc: <http://www.csounds.com/manual/html/pinkish.html> --pinkish :: Sig -> SE Sig -pinkish a1 = se $ opc1 "pinkish" [(a, x: replicate 4 i)] a1---- | Unsafe version of the 'pinkish' opcode. Unsafe means that there can be possible alias--- on the expression level. Two expressions with the same arguments can be unexpectedly--- rendered as the same expression within one instrument. --pinkish' :: Sig -> Sig-pinkish' = opc1 "pinkish" [(a, x: replicate 4 i)]---- | A white noise generator with an IIR lowpass filter. ------ > ares noise xamp, kbeta------ doc: <http://www.csounds.com/manual/html/noise.html>- -noise :: Amp -> Sig -> SE Sig-noise a1 a2 = se $ opc2 "noise" [(a, [x, k])] a1 a2---- | Unsafe version of the 'noise' opcode. Unsafe means that there can be possible alias--- on the expression level. Two expressions with the same arguments can be unexpectedly--- rendered as the same expression within one instrument. --noise' :: Amp -> Sig -> Sig-noise' = opc2 "noise" [(a, [x, k])]------------------------------------------------------- envelopes---- | Trace a series of line segments between specified points. ------ > ares linseg ia, idur1, ib [, idur2] [, ic] [...]--- > kres linseg ia, idur1, ib [, idur2] [, ic] [...]------ doc: <http://www.csounds.com/manual/html/linseg.html>-linseg :: [D] -> Ksig-linseg = kr . opcs "linseg" [-    (a, repeat i),-    (k, repeat i)]---- | Trace a series of line segments between specified points including a release segment. ------ > ares linsegr ia, idur1, ib [, idur2] [, ic] [...], irel, iz--- > kres linsegr ia, idur1, ib [, idur2] [, ic] [...], irel, iz------ doc: <http://www.csounds.com/manual/html/linsegr.html>--linsegr :: [D] -> D -> D -> Ksig-linsegr xs relDur relVal = kr $ opcs "linsegr" ([-    (a, repeat i),-    (k, repeat i)]) (xs ++ [relDur, relVal])----- | Trace a series of exponential segments between specified points.------ > ares expseg ia, idur1, ib [, idur2] [, ic] [...]--- > kres expseg ia, idur1, ib [, idur2] [, ic] [...]------ doc: <http://www.csounds.com/manual/html/expseg.html>--expseg :: [D] -> Ksig-expseg = kr . opcs "expseg" [-    (a, repeat i),-    (k, repeat i)]---- | Trace a series of exponential segments between specified points including a release segment. ------ > ares expsegr ia, idur1, ib [, idur2] [, ic] [...], irel, iz--- > kres expsegr ia, idur1, ib [, idur2] [, ic] [...], irel, iz------ doc: <http://www.csounds.com/manual/html/expsegr.html>--expsegr :: [D] -> D -> D -> Ksig-expsegr xs relDur relVal = kr $ opcs "expsegr" ([-    (a, repeat i),-    (k, repeat i)]) (xs ++ [relDur, relVal])---- | Generate control signal consisting of held segments delimited by two or more specified points. The entire envelope is looped at kfreq rate. Each parameter can be varied at k-rate. ------ > ksig lpshold kfreq, ktrig, ktime0, kvalue0  [, ktime1] [, kvalue1] \--- >       [, ktime2] [, kvalue2] [...]------ doc: <http://www.csounds.com/manual/html/lpshold.html>--lpshold :: Sig -> Sig -> [Sig] -> Ksig-lpshold = mkLps "lpshold"---- | Generate control signal consisting of linear segments delimited by two or more specified points. The entire envelope is looped at kfreq rate. Each parameter can be varied at k-rate. ------ > ksig loopseg kfreq, ktrig, iphase, ktime0, kvalue0 [, ktime1] [, kvalue1] \--- >       [, ktime2] [, kvalue2] [...]------ doc: <http://www.csounds.com/manual/html/loopseg.html>--loopseg :: Sig -> Sig -> [Sig] -> Ksig-loopseg = mkLps "loopseg"---- | Generate control signal consisting of controllable exponential segments or linear segments delimited by two or more specified points. --- The entire envelope is looped at kfreq rate. Each parameter can be varied at k-rate. ------ > ksig looptseg kfreq, ktrig, ktime0, kvalue0, ktype0, [, ktime1] [, kvalue1] [,ktype1] \--- >       [, ktime2] [, kvalue2] [,ktype2] [...][, ktimeN] [, kvalueN]------ doc: <http://www.csounds.com/manual/html/looptseg.html>--looptseg :: Sig -> Sig -> [Sig] -> Ksig-looptseg = mkLps "looptseg"--mkLps :: Name -> Sig -> Sig -> [Sig] -> Ksig-mkLps name kfreq ktrig kvals = kr $ opcs name signature $ kfreq:ktrig:kvals-    where signature = [(k, repeat k)]---- | Apply a stright line rise and decay pattern to an imput amp signal.------ > kr linen kamp, iris, idur, idec--- > ar linen xamp, iris, idur, idec------ doc: <http://www.csounds.com/manual/html/linen.html>-linen :: Amp -> D -> D -> D -> Sig-linen a1 a2 a3 a4 = opc4 "linen" [-    (k, k:is 3),-    (a, x:is 3)] a1 a2 a3 a4-    --- | Apply a stright line rise then an exponential decay decay while the note is extended in time.------ > kr linenr kamp, iris, idur, iatdec--- > ar linenr xamp, iris, idur, iatdec------ doc: <http://www.csounds.com/manual/html/linenr.html>-linenr :: Amp -> D -> D -> D -> Sig-linenr a1 a2 a3 a4 = opc4 "linenr" [-    (k, k:is 3),-    (a, x:is 3)] a1 a2 a3 a4---- | Apply an envelope consisting of 3 segments:------ * stored function rise shape------ * modified exponential \"pseudo steady state\" ------ * exponential decay------ > kr envlpx kamp, irise, idur, idec, ifn, iatss, iatdec, [ixmod]--- > ar envlpx xamp, irise, idur, idec, ifn, iatss, iatdec, [ixmod]------ doc: <http://www.csounds.com/manual/html/envlpx.html>-envlpx :: Amp -> D -> D -> D -> Tab -> D -> D -> Sig-envlpx a1 a2 a3 a4 a5 a6 a7 = opc7 "envlpx" [-    (k, k:is 8),-    (a, x:is 8)] a1 a2 a3 a4 a5 a6 a7--------------------------------------------------------- audio delays---- | This is an interpolating variable time delay, it is not very different from the existing implementation (deltapi), it is only easier to use. ------ > ares vdelay asig, adel, imaxdel [, iskip]------ doc: <http://www.csounds.com/manual/html/vdelay.html>-vdelay :: Sig -> Sig -> D -> Sig-vdelay = opc3 "vdelay" [(a, [a, a, i, i])]---- | A variable delay opcode with high quality interpolation. ------ > aout vdelayx ain, adl, imd, iws [, ist]------ doc: <http://www.csounds.com/manual/html/vdelayx.html>-vdelayx :: Sig -> Sig -> D -> D -> Sig-vdelayx = opc4 "vdelayx" [(a, [a, a, i, i, i])]---- | Variable delay opcodes with high quality interpolation. ------ aout vdelayxw ain, adl, imd, iws [, ist]------ doc: <http://www.csounds.com/manual/html/vdelayxw.html>-vdelayxw :: Sig -> Sig -> D -> D -> Sig-vdelayxw = opc4 "vdelayxw" [(a, [a, a, i, i, i])]--------------------------------------------------------- delay lines---- | Reads from an automatically established digital delay line. ------ > ares delayr idlt [, iskip]------ doc: <http://www.csounds.com/manual/html/delayr.html>-delayr :: D -> SE Sig-delayr a1 = se $ opc1 "delayr" [(a, [i])] a1---- | Writes the audio signal to a digital delay line. ------ > delayw asig------ doc: <http://www.csounds.com/manual/html/delayw.html>-delayw :: Sig -> SE ()-delayw a1 = se_ $ opc1 "delayw" [(x, [a])] a1---- | Tap a delay line at variable offset times. ------ > ares deltap kdlt--- --- doc: <http://www.csounds.com/manual/html/deltap.html>-deltap :: Sig -> SE Sig-deltap a1 = se $ opc1 "deltap" [(a, [k])] a1---- | Taps a delay line at variable offset times, uses interpolation. ------ > ares deltapi xdlt------ doc: <http://www.csounds.com/manual/html/deltapi.html>-deltapi :: Sig -> SE Sig-deltapi a1 = se $ opc1 "deltapi" [(a, [x])] a1---- | Taps a delay line at variable offset times, uses cubic interpolation. ------ > ares deltap3 xdlt------ doc: <http://www.csounds.com/manual/html/deltap3.html>-deltap3 :: Sig -> SE Sig-deltap3 a1 = se $ opc1 "deltap3" [(a, [x])] a1---- | deltapx is similar to deltapi or deltap3. However, it allows higher quality interpolation. This opcode can read from and write to a delayr/delayw delay line with interpolation. ------ > aout deltapx adel, iwsize------ doc: <http://www.csounds.com/manual/html/deltapx.html>-deltapx :: Sig -> D -> SE Sig-deltapx a1 a2 = se $ opc2 "deltapx" [(a, [a, i])] a1 a2---- | deltapxw mixes the input signal to a delay line. This opcode can be mixed with reading units --- (deltap, deltapn, deltapi, deltap3, and deltapx) in any order; the actual delay time is the difference of--- the read and write time. This opcode can read from and write to a delayr/delayw delay line with interpolation. ------ > deltapxw ain, adel, iwsize------ doc: <http://www.csounds.com/manual/html/deltapxw.html>-deltapxw :: Sig -> Sig -> D -> SE ()-deltapxw a1 a2 a3 = se_ $ opc3 "deltapxw" [(x, [a, a, i])] a1 a2 a3-------------------------------------------------------- filters--filterSignature1 :: [(Rate, [Rate])]-filterSignature1 = [(a, [a, k, i])]--mkFilter1 :: (Val a1, Val a2, Val b) => Name -> a1 -> a2 -> b-mkFilter1 name = opc2 name filterSignature1--filterSignature2 :: [(Rate, [Rate])]-filterSignature2 = [(a, [a, k, k, i])]--mkFilter2 :: (Val a1, Val a2, Val a3, Val b) => Name -> a1 -> a2 -> a3 -> b-mkFilter2 name = opc3 name filterSignature2----- | A first-order recursive low-pass filter with variable frequency response.------ tone is a 1 term IIR filter. Its formula is:------ > yn = c1 * xn + c2 * yn-1------ where------  * b = 2 - cos(2 π hp/sr);------  * c2 = b - sqrt(b2 - 1.0)------  * c1 = 1 - c2------ > ares tone asig, khp [, iskip]------ doc: <http://www.csounds.com/manual/html/tone.html>--tone :: Sig -> Sig -> Sig---- | A hi-pass filter whose transfer functions are the complements of the tone opcode. ------ > ares atone asig, khp [, iskip]------ doc: <http://www.csounds.com/manual/html/atone.html>-atone :: Sig -> Sig -> Sig---- | Implementation of a second-order low-pass Butterworth filter. ------ > ares butlp asig, kfreq [, iskip]------ doc: <http://www.csounds.com/manual/html/butterlp.html>-butlp :: Sig -> Sig -> Sig---- | Implementation of second-order high-pass Butterworth filter.------ > ares buthp asig, kfreq [, iskip]------ doc: <http://www.csounds.com/manual/html/butterhp.html>--buthp :: Sig -> Sig -> Sig---- | A second-order resonant filter.------ > ares reson asig, kcf, kbw [, iscl] [, iskip]------ doc: <http://www.csounds.com/manual/html/reson.html>- -reson :: Sig -> Sig -> Sig -> Sig---- |  A notch filter whose transfer functions are the complements of the reson opcode. ------ > ares areson asig, kcf, kbw [, iscl] [, iskip]------ doc: <http://www.csounds.com/manual/html/areson.html>--areson :: Sig -> Sig -> Sig -> Sig---- | Implementation of a second-order band-pass Butterworth filter. ------ > ares butbp asig, kfreq, kband [, iskip]------ doc: <http://www.csounds.com/manual/html/butterbp.html>-butbp :: Sig -> Sig -> Sig -> Sig---- | Implementation of a second-order band-reject Butterworth filter. ------ > ares butbr asig, kfreq, kband [, iskip]------ doc: <http://www.csounds.com/manual/html/butterbr.html>-butbr :: Sig -> Sig -> Sig -> Sig---- | Moogladder is an new digital implementation of the Moog ladder filter based on the work of --- Antti Huovilainen, described in the paper "Non-Linear Digital Implementation of the Moog Ladder Filter" (Proceedings of DaFX04, Univ of Napoli). --- This implementation is probably a more accurate digital representation of the original analogue filter.------ > asig moogladder ain, kcf, kres[, istor]------ doc: <http://www.csounds.com/manual/html/moogladder.html>-moogladder :: Sig -> Sig -> Sig -> Sig--tone  = mkFilter1 "tone"-atone = mkFilter1 "atone"-butlp = mkFilter1 "butlp"-buthp = mkFilter1 "buthp"--reson  = mkFilter2 "reson"-areson = mkFilter2 "areson"-butbp  = mkFilter2 "butbp"-butbr  = mkFilter2 "butbr"-moogladder = mkFilter2 "moogladder"---- | Variably reverberates an input signal with a “colored” frequency response. ------ > ares vcomb asig, krvt, xlpt, imaxlpt [, iskip] [, insmps]------ doc: <http://www.csounds.com/manual/html/vcomb.html>-vcomb :: Sig -> Sig -> Sig -> D -> Sig-vcomb = opc4 "vcomb" [(a, [a, k, x, i, i, i])]---- | A second-order multi-mode filter. ------ > ares bqrez asig, xfco, xres [, imode] [, iskip]------ doc: <http://www.csounds.com/manual/html/bqrez.html>-bqrez :: Sig -> Sig -> Sig -> Sig-bqrez = opc3 "bqrez" [(a, [a, x, x, i, i])]---- | Reverberates an input signal with a “colored” frequency response. ------ > ares comb asig, krvt, ilpt [, iskip] [, insmps]------ doc: <http://www.csounds.com/manual/html/comb.html>-comb :: Sig -> Sig -> D -> Sig-comb = opc3 "comb" [(a, [a, k, i, i, i])]---- | Applies portamento to a step-valued control signal. ------ > kres port ksig, ihtim [, isig]------ doc: <http://www.csounds.com/manual/html/port.html>-port :: Sig -> D -> Sig-port = opc2 "port" [(k, [k, i, i])]---- | Applies portamento to a step-valued control signal. ------ > kres portk ksig, khtim [, isig]------ doc: <http://www.csounds.com/manual/html/portk.html>-portk :: Sig -> Sig -> Sig-portk = opc2 "portk" [(k, [k, k, i])]-------------------------------------------------------- reverberation---- | freeverb is a stereo reverb unit based on Jezar's public domain C++ sources, composed of eight parallel --- comb filters on both channels, followed by four allpass units in series. The filters on the right channel --- are slightly detuned compared to the left channel in order to create a stereo effect.------ > aoutL, aoutR freeverb ainL, ainR, kRoomSize, kHFDamp[, iSRate[, iSkip]] ------ doc: <http://www.csounds.com/manual/html/freeverb.html>-freeverb :: Sig -> Sig -> Sig -> Sig -> (Sig, Sig)-freeverb = mopc4 "freeverb" ([a, a], [a, a, k, k, i, i])---- | 8 delay line stereo FDN reverb, with feedback matrix based upon physical modeling scattering junction of 8 --- lossless waveguides of equal characteristic impedance. Based on Csound orchestra version by Sean Costello. ------ > aoutL, aoutR reverbsc ainL, ainR, kfblvl, kfco[, israte[, ipitchm[, iskip]]] ------ doc: <http://www.csounds.com/manual/html/reverbsc.html>-reverbsc :: Sig -> Sig -> Sig -> Sig -> (Sig, Sig)-reverbsc = mopc4 "reverbsc" ([a, a], [a, a, k, k, i, i, i])---- | Reverberates an input signal with a “natural room” frequency response. ------ > ares reverb asig, krvt [, iskip]------ doc: <http://www.csounds.com/manual/html/reverb.html>-reverb :: Sig -> Sig -> Sig-reverb = opc2 "reverb" [(a, [a, k, i])]---- | This is a reverberator consisting of 6 parallel comb-lowpass filters--- being fed into series of 5 allpass filters.------ > ares reverb2 asig, ktime, khdif------ doc: <http://www.csounds.com/manual/html/reverb2.html>-reverb2 :: Sig -> Sig -> Sig -> Sig-reverb2 = opc3 "reverb2" [(a, [a, k, k])]---- | This is a reverberator consisting of 6 parallel comb-lowpass filters being fed into a series --- of 5 allpass filters. nreverb replaces reverb2 (version 3.48) and so both opcodes are identical. ------ > ares nreverb asig, ktime, khdif [, iskip] [,inumCombs] [, ifnCombs] \--- >       [, inumAlpas] [, ifnAlpas]------ doc: <http://www.csounds.com/manual/html/nreverb.html>-nreverb :: Sig -> Sig -> Sig -> Sig-nreverb = opc3 "nreverb" [(a, [a, k, k] ++ is 5)]---- | babo stands for ball-within-the-box. It is a physical model reverberator based on the paper--- by Davide Rocchesso "The Ball within the Box: a sound-processing metaphor", Computer Music Journal, Vol 19, N.4, pp.45-47, Winter 1995.------ The resonator geometry can be defined, along with some response characteristics, the position of the listener within the resonator, and the position of the sound source. ------ > a1, a2 babo asig, ksrcx, ksrcy, ksrcz, irx, iry, irz [, idiff] [, ifno]------ doc: <http://www.csounds.com/manual/html/babo.html>-babo :: Sig -> Sig -> Sig -> Sig -> D -> D -> D -> (Sig, Sig)-babo = mopc7 "babo" ([a, a], [a, k, k, k] ++ is 5)-------------------------------------------------------- Amplitude Measurement And Following---- | Determines the root-mean-square amplitude of an audio signal. It low-pass filters the actual value, to average in the manner of a VU meter. ------ > kres rms asig [, ihp] [, iskip]------ doc: <http://www.csounds.com/manual/html/rms.html>-rms :: Sig -> Sig-rms = opc1 "rms" [(k, [a, i, i])]---- | The rms power of asig can be interrogated, set, or adjusted to match that of a comparator signal. ------ > ares balance asig, acomp [, ihp] [, iskip]------ doc: <http://www.csounds.com/manual/html/balance.html>-balance :: Sig -> Sig -> Sig-balance = opc2 "balance" [(a, [a, a, i, i])]---- | Envelope follower unit generator. ------ > ares follow asig, idt------ doc: <http://www.csounds.com/manual/html/follow.html>-follow :: Sig -> D -> Sig-follow = opc2 "follow" [(a, [a, i])]---- | A controllable envelope extractor using the algorithm attributed to Jean-Marc Jot. ------ > ares follow2 asig, katt, krel------ doc: <http://www.csounds.com/manual/html/follow2.html>-follow2 :: Sig -> Sig -> Sig -> Sig-follow2 = opc3 "follow2" [(a, [a, k, k])]---- | These opcodes maintain the output k-rate variable as the peak absolute level so far received. ------ > kres peak asig--- > kres peak ksig------ doc: <http://www.csounds.com/manual/html/peak.html>-peak :: Sig -> Sig-peak = opc1 "peak" [(k, [x])]---- | max_k outputs the local maximum (or minimum) value of the incoming asig signal, checked in the time interval between ktrig has become true twice. ------ > knumkout max_k asig, ktrig, itype------ doc: <http://www.csounds.com/manual/html/max_k.html>-max_k :: Sig -> Sig -> D -> Sig-max_k = opc3 "max_k" [(k, [a, k, i])]------------------------------------------------------ Pitch Estimation---- | ptrack takes an input signal, splits it into ihopsize blocks and using a STFT method, extracts an estimated --- pitch for its fundamental frequency as well as estimating the total amplitude of the signal in dB, relative to--- full-scale (0dB). The method implies an analysis window size of 2*ihopsize samples (overlaping by 1/2 window), which--- has to be a power-of-two, between 128 and 8192 (hopsizes between 64 and 4096). Smaller windows will give better time--- precision, but worse frequency accuracy (esp. in low fundamentals).This opcode is based on an original algorithm by M. Puckette. ------ > kcps, kamp ptrack asig, ihopsize[,ipeaks]------ doc: <http://www.csounds.com/manual/html/ptrack.html>-ptrack :: Sig -> D -> (Sig, Sig)-ptrack = mopc2 "ptrack" ([k, k], [a, i, i])---- | Using the same techniques as spectrum and specptrk, pitch tracks the pitch of the signal in octave point decimal form, and amplitude in dB. ------ > koct, kamp pitch asig, iupdte, ilo, ihi, idbthresh [, ifrqs] [, iconf] \--- >       [, istrt] [, iocts] [, iq] [, inptls] [, irolloff] [, iskip]------ doc: <http://www.csounds.com/manual/html/pitch.html>-pitch :: Sig -> D -> D -> D -> D -> (Sig, Sig) -pitch = mopc5 "pitch" ([k, k], a:is 12)---- | Follows the pitch of a signal based on the AMDF method (Average Magnitude Difference Function). Outputs pitch and amplitude --- tracking signals. The method is quite fast and should run in realtime. This technique usually works best for monophonic signals. ------ > kcps, krms pitchamdf asig, imincps, imaxcps [, icps] [, imedi] \--- >       [, idowns] [, iexcps] [, irmsmedi]------ doc: <http://www.csounds.com/manual/html/pitchamdf.html>-pitchamdf :: Sig -> D -> D -> (Sig, Sig)-pitchamdf = mopc3 "pitchamdf" ([k, k], a:is 8)---- | Estimate the tempo of beat patterns in a control signal. ------ > ktemp tempest kin, iprd, imindur, imemdur, ihp, ithresh, ihtim, ixfdbak, \--- >       istartempo, ifn [, idisprd] [, itweek]------ doc: <http://www.csounds.com/manual/html/tempest.html>-tempest :: Sig -> D -> D -> D -> D -> D -> D -> D -> D -> Tab -> Sig-tempest = opc10 "tempest" [(k, k:is 11)]------------------------------------------------------ Dynamic Processing---- | This unit functions as an audio compressor, limiter, expander, or noise gate, using either soft-knee or hard-knee --- mapping, and with dynamically variable performance characteristics. It takes two audio input signals, aasig and acsig,--- the first of which is modified by a running analysis of the second. Both signals can be the same, or the first can be --- modified by a different controlling signal.------ compress first examines the controlling acsig by performing envelope detection. This is directed by two control--- values katt and krel, defining the attack and release time constants (in seconds) of the detector. The detector --- rides the peaks (not the RMS) of the control signal. Typical values are .01 and .1, the latter usually being similar--- to ilook.--- --- The running envelope is next converted to decibels, then passed through a mapping function to determine what compresser--- action (if any) should be taken. The mapping function is defined by four decibel control values. These are given as --- positive values, where 0 db corresponds to an amplitude of 1, and 90 db corresponds to an amplitude of 32768. ------ > ar compress aasig, acsig, kthresh, kloknee, khiknee, kratio, katt, krel, ilook------ doc: <http://www.csounds.com/manual/html/compress.html>-compress :: Sig -> Sig -> Sig -> Sig -> Sig -> Sig -> Sig -> Sig -> D -> Sig-compress = opc9 "compress" [(a, [a, a, k, k, k, k, k, k, i])]---- | This opcode dynamically modifies a gain value applied to the input sound ain by comparing its power level to a given --- threshold level. The signal will be compressed/expanded with different factors regarding that it is over or under the threshold. ------ > ares dam asig, kthreshold, icomp1, icomp2, irtime, iftime------ doc: <http://www.csounds.com/manual/html/dam.html>-dam :: Sig -> Sig -> D -> D -> D -> D -> Sig-dam = opc6 "dam" [(a, a:k:is 4)]---- | Clips an a-rate signal to a predefined limit, in a “soft” manner, using one of three methods. ------ > ares clip asig, imeth, ilimit [, iarg]------ doc: <http://www.csounds.com/manual/html/clip.html>-clip :: Sig -> D -> D -> Sig-clip = opc3 "clip" [(a, [a, i, i])]------------------------------------------------------ Sample Level Operations---- | Sets the lower and upper limits of the value it processes. ------ > ares limit asig, klow, khigh--- > ires limit isig, ilow, ihigh--- > kres limit ksig, klow, khigh------ doc: <http://www.csounds.com/manual/html/limit.html>-limit :: Sig -> Sig -> Sig -> Sig-limit = opc3 "limit" [-    (a, [a, k, k]),-    (k, [k, k, k]),-    (i, [i, i, i])]---- | Performs a sample-and-hold operation on its input. ------ > ares samphold asig, agate [, ival] [, ivstor]--- > kres samphold ksig, kgate [, ival] [, ivstor]------ doc: <http://www.csounds.com/manual/html/samphold.html>-samphold :: Sig -> Sig -> Sig-samphold = opc2 "samphold" [-    (a, [a, a, i, i]),-    (k, [k, k, i, i])]---- | Access values of the current buffer of an a-rate variable by indexing. Useful for doing sample-by-sample manipulation at k-rate without using setksmps 1. ------ > kval vaget kndx, avar------ doc: <http://www.csounds.com/manual/html/vaget.html>-vaget :: Sig -> Sig -> Sig-vaget = opc2 "vaget" [(k, [k, a])]---- | Write values into the current buffer of an a-rate variable at the given index. Useful for doing sample-by-sample manipulation at k-rate without using setksmps 1. ------ > vaset kval, kndx, avar------ doc: <http://www.csounds.com/manual/html/vaset.html>-vaset :: Sig -> Sig -> Sig -> SE ()-vaset a1 a2 a3 = se_ $ opc3 "vaset" [(x, [k, k, a])] a1 a2 a3-------------------------------------------------------- panning---- | Distribute an audio signal amongst four channels with localization control.    ------ > a1, a2, a3, a4 pan asig, kx, ky, ifn [, imode] [, ioffset]------ doc: <http://www.csounds.com/manual/html/pan.html>-pan :: Sig -> Sig -> Sig -> Tab -> (Sig, Sig, Sig, Sig)-pan = mopc4 "pan" ([a, a, a, a], [a, k, k, i, i, i])---- | Distribute an audio signal across two channels with a choice of methods. ------ > a1, a2 pan2 asig, xp [, imode]------ doc: <http://www.csounds.com/manual/html/pan2.html>-pan2 :: Sig -> Sig -> (Sig, Sig)-pan2 = mopc2 "pan2" ([a, a], [a, x, i])----- HRTF---- | This opcode takes a source signal and spatialises it in the 3 dimensional space around a listener using head related --- transfer function (HRTF) based filters. It produces a static output (azimuth and elevation parameters are i-rate), --- because a static source allows much more efficient processing than hrtfmove and hrtfmove2,. ------ > aleft, aright hrtfstat asrc, iAz, iElev, ifilel, ifiler [,iradius, isr]------ doc: <http://www.csounds.com/manual/html/hrtfstat.html>-hrtfstat :: Sig -> D -> D -> Str -> Str -> (Sig, Sig)-hrtfstat = mopc5 "hrtfstat" ([a, a], a:s:i:i:s:is 2)---- | This opcode takes a source signal and spatialises it in the 3 dimensional space around a listener by convolving the source with stored head related transfer function (HRTF) based filters. ------ > aleft, aright hrtfmove asrc, kAz, kElev, ifilel, ifiler [, imode, ifade, isr]------ doc: <http://www.csounds.com/manual/html/hrtfmove.html>-hrtfmove :: Sig -> Sig -> Sig -> Str -> Str -> (Sig, Sig)-hrtfmove = mopc5 "hrtfmove" ([a, a], a:k:k:s:s:is 3)---- | This opcode takes a source signal and spatialises it in the 3 dimensional space around a listener using head related transfer function (HRTF) based filters. ------ > aleft, aright hrtfmove2 asrc, kAz, kElev, ifilel, ifiler [,ioverlap, iradius, isr]------ doc: <http://www.csounds.com/manual/html/hrtfmove2.html>-hrtfmove2 :: Sig -> Sig -> Sig -> Str -> Str -> (Sig, Sig)-hrtfmove2 = mopc5 "hrtfmove2" ([a, a], a:k:k:s:s:is 3)------------------------------------------------------------------------------- Other opcodes---- | Extend the duration of real-time generated events and handle their extra life (Usually for usage along with release instead of linenr, linsegr, etc). ------ > xtratim iextradur------ doc: <http://www.csounds.com/manual/html/xtratim.html>-xtratim :: D -> SE ()-xtratim a1 = se_ $ opc1 "xtratim" [(x, [i])] a1-
− src/Csound/Opcode/Data.hs 
@@ -1,631 +0,0 @@--- | Data-module Csound.Opcode.Data (--    ------------------------------------------------------    -- * Buffer and Function tables--    {--    -- ** Writing To Tables-    tableiw, tablew, tabw_i, tabw, -    -}--    -- ** Reading From Tables-    table, tablei, table3, tableD, tableiD, table3D, tab_i, tab, --    ------------------------------------------------------    -- * Signal Input and Output,  Sample and Loop Playback, Soundfonts--    -- ** Signal Input And Output-    inch, outch,--    -- ** Sample Playback With Optional Looping-    flooper2, sndloop,--    ------------------------------------------------------    -- *  File Input and Output--    -- ** Sound File Input-    soundin, diskin2, mp3in,--    -- ** Sound File Queries-    filelen, filesr, filenchnls, filepeak, filebit,--    -- ** Sound File Output-    fout,--    -- ** Non-Soundfile Input And Output--    ------------------------------------------------------    -- * Converters of Data Types-    Nums,-    -    -- ** Rate conversions-    downsamp, upsamp, interp,-    -    -- ** Amplitude conversions-    ampdb, ampdbfs, dbamp, dbfsamp,--    -- ** Pitch conversions-    cent, cpsmidinn, cpsoct, cpspch, octave, octcps, octmidinn, octpch, pchmidinn, pchoct, semitone,--    -- ** Integer and fractional parts-    fracD, floorD, ceilD, intD, roundD,-    fracSig, floorSig, ceilSig, intSig, roundSig,-        -    ------------------------------------------------------    -- * Printing and Strings--    -- ** Simple Printing-    printi, printk,--    -- ** Formatted Printing--    -- ** String Variables-    sprintf, sprintfk,--    -- ** String Manipulation And Conversion-    strcat, strcatk--) where--import Csound.Exp-import Csound.Exp.Wrapper-import Csound.Exp.SE-import Csound.Exp.Tuple-import Csound.LowLevel-import Csound.Exp.Numeric---------------------------------------------------------- * Buffer and Function tables---{---- ** Writing To Tables---- | This opcode operates on existing function tables, changing their contents. tablew is for writing --- at k- or at a-rates, with the table number being specified at init time. Using tablew with i-rate signal --- and index values is allowed, but the specified data will always be written to the function table at k-rate, --- not during the initialization pass. The valid combinations of variable types are shown by the first letter of the variable names. ------ > tablew asig, andx, ifn [, ixmode] [, ixoff] [, iwgmode]--- > tablew isig, indx, ifn [, ixmode] [, ixoff] [, iwgmode]--- > tablew ksig, kndx, ifn [, ixmode] [, ixoff] [, iwgmode]------ doc: <http://www.csounds.com/manual/html/tablew.html>-tablew :: Sig -> Sig -> Tab -> SE ()-tablew a1 a2 a3 = se_ $ opc3 "tablew" (map sign [a, k, i]) a1 a2 a3-    where sign t = (x, t:t:is 4)---- | This opcode operates on existing function tables, changing their contents. tableiw is --- used when all inputs are init time variables or constants and you only want to run it at --- the initialization of the instrument. The valid combinations of variable types are shown by the first letter of the variable names.------ > tableiw isig, indx, ifn [, ixmode] [, ixoff] [, iwgmode]------ doc: <http://www.csounds.com/manual/html/tableiw.html>-tableiw :: D -> D -> Tab -> SE ()-tableiw a1 a2 a3 = se_ $ opc3 "tableiw" [(i, is 6)] a1 a2 a3---- | 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]------ doc: <http://www.csounds.com/manual/html/tab.html>-tabw :: Sig -> Sig -> Tab -> SE ()-tabw a1 a2 a3 = se_ $ opc3 "tabw" (map sign [a, k]) a1 a2 a3-    where sign t = (x, t:t:is 2)---- | 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_i isig, indx, ifn [,ixmode]------ doc: <http://www.csounds.com/manual/html/tab.html>-tabw_i :: D -> D -> Tab -> SE ()-tabw_i a1 a2 a3 = se_ $ opc3 "tabw_i" [(x, is 4)] a1 a2 a3--}---- ** Reading From Tables---- | Accesses table values by direct indexing. ------ > ares table andx, ifn [, ixmode] [, ixoff] [, iwrap]--- > ires table indx, ifn [, ixmode] [, ixoff] [, iwrap]--- > kres table kndx, ifn [, ixmode] [, ixoff] [, iwrap]------ doc: <http://www.csounds.com/manual/html/table.html>-table :: Sig -> Tab -> Sig---- | Accesses table values by direct indexing with linear interpolation. ------ > ares tablei andx, ifn [, ixmode] [, ixoff] [, iwrap]--- > ires tablei indx, ifn [, ixmode] [, ixoff] [, iwrap]--- > kres tablei kndx, ifn [, ixmode] [, ixoff] [, iwrap]------ doc: <http://www.csounds.com/manual/html/tablei.html>-tablei :: Sig -> Tab -> Sig----- | Accesses table values by direct indexing with cubic interpolation. ------ > ares table3 andx, ifn [, ixmode] [, ixoff] [, iwrap]--- > ires table3 indx, ifn [, ixmode] [, ixoff] [, iwrap]--- > kres table3 kndx, ifn [, ixmode] [, ixoff] [, iwrap]------ doc: <http://www.csounds.com/manual/html/table3.html>-table3 :: Sig -> Tab -> Sig----- | Accesses table values by direct indexing. ------ > ires table indx, ifn [, ixmode] [, ixoff] [, iwrap]------ doc: <http://www.csounds.com/manual/html/table.html>-tableD :: D -> Tab -> D---- | Accesses table values by direct indexing with linear interpolation. ------ > ires tablei indx, ifn [, ixmode] [, ixoff] [, iwrap]------ doc: <http://www.csounds.com/manual/html/tablei.html>--tableiD :: D -> Tab -> D---- | Accesses table values by direct indexing with cubic interpolation. ------ > ires table3 indx, ifn [, ixmode] [, ixoff] [, iwrap]------ doc: <http://www.csounds.com/manual/html/table3.html>-table3D :: D -> Tab -> D--table = mkTable "table"-tablei = mkTable "tablei"-table3 = mkTable "table3"--tableD = mkTableD "table"-tableiD = mkTableD "tablei"-table3D = mkTableD "table3"--mkTable :: Name -> Sig -> Tab -> Sig-mkTable name = opc2 name [-    (a, a:rest),-    (k, k:rest),-    (i, i:rest)]-    where rest = [i, i, i]--mkTableD :: Name -> D -> Tab -> D-mkTableD name = opc2 name [-    (a, a:rest),-    (k, k:rest),-    (i, i:rest)]-    where rest = [i, i, i]---- | 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]------ doc: <http://www.csounds.com/manual/html/tab.html>-tab :: Sig -> Tab -> Sig-tab = opc2 "tab" [-    (a, [x,i,i]),-    (k, [k,i,i])]---- | 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).------ > ir tab_i indx, ifn[, ixmode]------ doc: <http://www.csounds.com/manual/html/tab.html>-tab_i :: D -> Tab -> D-tab_i = opc2 "tab_i" [(i, [i,i,i])]---- ** Saving Tables To Files--{---- ftsave "filename", iflag, ifn1 [, ifn2] [...]-ftsave :: S -> I -> [Tab] -> SE ()-ftsave a1 a2 a3 = opcs "ftsave" [(x, repeat i)] (phi a1 : phi a2 : map phi a3)-    where phi :: Val a => a -> E-          phi = Fix . unwrap  ---- ftsavek "filename", ktrig, iflag, ifn1 [, ifn2] [...]-ftsavek :: S -> Sig -> I -> [Tab] -> SE ()-ftsavek a1 a2 a3 a4 = opcs "ftsavek" [(x, repeat i)] (phi a1 : phi a2 : phi a3 : map phi a4)-    where phi :: Val a => a -> E-          phi = Fix . unwrap  --}---- ** Reading Tables From Files---------------------------------------------------------- * Signal Input and Output,  Sample and Loop Playback, Soundfonts---- ** Signal Input And Output---- | Reads from numbered channels in an external audio signal or stream. ------ > ain1[, ...] inch kchan1[,...]------ doc: <http://www.csounds.com/manual/html/inch.html>-inch :: CsdTuple a => [Sig] -> a-inch = mopcs "inch" (repeat a, repeat k)---- | Writes multi-channel audio data, with user-controllable channels, to an external device or stream. ------ > outch kchan1, asig1 [, kchan2] [, asig2] [...]------ doc: <http://www.csounds.com/manual/html/outch.html>-outch :: [(Sig, Sig)] -> SE ()-outch ts = se_ $ opcs "outch" [(x, cycle [a,k])] $ (\(a1, a2) -> [a1, a2]) =<< ts---- ** Sample Playback With Optional Looping---- | This opcode implements a crossfading looper with variable loop parameters and three --- looping modes, optionally using a table for its crossfade shape. It accepts non-power-of-two tables --- for its source sounds, such as deferred-allocation GEN01 tables.------ > asig flooper2 kamp, kpitch, kloopstart, kloopend, kcrossfade, ifn \--- >       [, istart, imode, ifenv, iskip]------ doc: <http://www.csounds.com/manual/html/flooper2.html>-flooper2 :: Sig -> Sig -> Sig -> Sig -> Sig -> Tab -> Sig  -flooper2 = opc6 "flooper2" [(a, ks 5 ++ is 5)]---- | This opcode records input audio and plays it back in a loop with user-defined duration and --- crossfade time. It also allows the pitch of the loop to be controlled, including reversed playback. ------ > asig, krec sndloop ain, kpitch, ktrig, idur, ifad------ doc: <http://www.csounds.com/manual/html/sndloop.html>-sndloop :: Sig -> Sig -> Sig -> D -> D -> (Sig, Sig)-sndloop = mopc5 "sndloop" ([a, k], [a,k,k,i,i])---- ** Soundfonts And Fluid Opcodes---------------------------------------------------------- *  File Input and Output---- ** Sound File Input---- | Reads audio data from an external device or stream. Up to 24 channels may be read before v5.14, extended to 40 in later versions. ------ > ar1[, ar2[, ar3[, ... a24]]] soundin ifilcod [, iskptim] [, iformat] \--- >      [, iskipinit] [, ibufsize]------ doc: <http://www.csounds.com/manual/html/soundin.html>-soundin :: CsdTuple a => Str -> a-soundin = mopc1 "soundin" (repeat a, s:is 4)---- | Reads audio data from a file, and can alter its pitch using one of several available interpolation --- types, as well as convert the sample rate to match the orchestra sr setting. diskin2 can also read --- multichannel files with any number of channels in the range 1 to 24 in versions before 5.14, and --- 40 after. . diskin2 allows more control and higher sound quality than diskin, but there is also the disadvantage of higher CPU usage.------ > a1[, a2[, ... aN]] diskin2 ifilcod, kpitch[, iskiptim \--- >       [, iwrap[, iformat [, iwsize[, ibufsize[, iskipinit]]]]]]------ doc: <http://www.csounds.com/manual/html/diskin2.html>-diskin2 :: CsdTuple a => Str -> Cps -> a-diskin2 = mopc2 "diskin2" (repeat a, s:k:is 6)---- | Reads stereo audio data from an external MP3 file. ------ > ar1, ar2 mp3in ifilcod[, iskptim, iformat, iskipinit, ibufsize]------ doc: <http://www.csounds.com/manual/html/mp3in.html>-mp3in :: Str -> (Sig, Sig)-mp3in = mopc1 "mp3in" ([a,a], s:is 4)----- ** Sound File Queries---- | Returns the length of a sound file. ------ > ir filelen ifilcod, [iallowraw]------ doc: <http://www.csounds.com/manual/html/filelen.html>-filelen :: Str -> D-filelen = opc1 "filelen" [(i, [i,i])]---- | Returns the sample rate of a sound file. ------ > ir filesr ifilcod [, iallowraw]------ doc: <http://www.csounds.com/manual/html/filesr.html>-filesr :: Str -> D-filesr = opc1 "filesr" [(i, [i,i])]---- | Returns the number of channels in a sound file.------ > ir filenchnls ifilcod [, iallowraw]------ doc: <http://www.csounds.com/manual/html/filechnls.html>-filenchnls :: Str -> D-filenchnls = opc1 "filenchnls" [(i, [i,i])]---- | Returns the peak absolute value of a sound file. ------ > ir filepeak ifilcod [, ichnl]------ doc: <http://www.csounds.com/manual/html/filepeak.html>-filepeak :: Str -> D-filepeak = opc1 "filepeak" [(i, [i,i])]---- | Returns the number of bits in each sample in a sound file.------ > ir filebit ifilcod [, iallowraw]------ doc: <http://www.csounds.com/manual/html/filebit.html>-filebit :: Str -> D-filebit = opc1 "filebit" [(i, [i,i])] ---- ** Sound File Output---- | fout outputs N a-rate signals to a specified file of N channels. ------ > fout ifilename, iformat, aout1 [, aout2, aout3,...,aoutN]------ doc: <http://www.csounds.com/manual/html/fout.html>-fout :: [Sig] -> SE ()-fout sigs = se_ $ opcs "fout" [(x, repeat a)] sigs---- ** Non-Soundfile Input And Output---------------------------------------------------------- * Converters of Data Types---- | Modify a signal by down-sampling. ------ > kres downsamp asig [, iwlen]------ doc: <http://www.csounds.com/manual/html/downsamp.html>-downsamp :: Sig -> Sig -downsamp = opc1 "downsamp" [(k, [a,i])]---- | Modify a signal by up-sampling. ------ > ares upsamp ksig------ doc: <http://www.csounds.com/manual/html/upsamp.html>-upsamp :: Sig -> Sig-upsamp = opc1 "upsamp" [(a, [k])]---- | Converts a control signal to an audio signal using linear interpolation. ------ > ares interp ksig [, iskip] [, imode]------ doc: <http://www.csounds.com/manual/html/interp.html>-interp :: Sig -> Sig-interp = opc1 "interp" [(a, [k,i,i])]----------------------------------------------------------------------------------------------- amplitude conversions---- | Floating number types: 'Sig' or 'D'.-class Val a => Nums a where-    isSig :: a -> Bool -    -instance Nums Sig where isSig = const True-instance Nums D   where isSig = const False--conv :: Nums a => NumOp -> a -> a-conv op arg = noRate $ ExpNum $ PreInline op [toPrimOr $ toE arg]--convKr :: Nums a => NumOp -> a -> a-convKr op arg = conv op $ phi arg-    where phi-            | isSig arg = setRate Kr -            | otherwise = id----- | Returns the amplitude equivalent of the decibel value x. Thus:------ *    60 dB = 1000------ *    66 dB = 1995.262------ *    72 dB = 3891.07------ *    78 dB = 7943.279------ *    84 dB = 15848.926------ *    90 dB = 31622.764------ > ampdb(x)  (no rate restriction)------ doc: <http://www.csounds.com/manual/html/ampdb.html>--ampdb :: Nums a => a -> a-ampdb = conv Ampdb ---- | Returns the amplitude equivalent of the full scale decibel (dB FS) value x. --- The logarithmic full scale decibel values will be converted to linear 16-bit signed integer values from −32,768 to +32,767. ------ > ampdbfs(x)  (no rate restriction)------ doc: <http://www.csounds.com/manual/html/ampdbfs.html>--ampdbfs :: Nums a => a -> a-ampdbfs = conv Ampdbfs---- | Returns the decibel equivalent of the raw amplitude x. ------ > dbamp(x)  (init-rate or control-rate args only)------ doc: <http://www.csounds.com/manual/html/dbamp.html>--dbamp :: Nums a => a -> a-dbamp = convKr Dbamp---- | Returns the decibel equivalent of the raw amplitude x, relative to full scale amplitude. Full scale is assumed to be 16 bit. New is Csound version 4.10. ------ > dbfsamp(x)  (init-rate or control-rate args only)------ doc: <http://www.csounds.com/manual/html/dbfsamp.html>-dbfsamp :: Nums a => a -> a -dbfsamp = convKr Dbfsamp ----------------------------------------------------------------------------------------------- pitch conversions---- | Calculates a factor to raise/lower a frequency by a given amount of cents. ------ > cent(x) (no rate restriction)------ doc: <http://www.csounds.com/manual/html/cent.html>-cent :: Nums a => a -> a-cent = conv Cent---- | Converts a Midi note number value to cycles-per-second. ------ > cpsmidinn (MidiNoteNumber)  (init- or control-rate args only)------ doc: <http://www.csounds.com/manual/html/cpsmidinn.html>-cpsmidinn :: Nums a => a -> a-cpsmidinn = convKr Cpsmidinn---- | Converts an octave-point-decimal value to cycles-per-second. ------ > cpsoct(oct) (no rate restriction)------ doc: <http://www.csounds.com/manual/html/cpsoct.html>-cpsoct :: Nums a => a -> a-cpsoct = conv Cpsoct---- | Converts a pitch-class value to cycles-per-second. ------ > cpspch (pch)  (init- or control-rate args only)------ doc: <http://www.csounds.com/manual/html/cpspch.html>-cpspch :: Nums a => a -> a-cpspch = convKr Cpspch----- | Calculates a factor to raise/lower a frequency by a given amount of octaves. ------ > octave(x) (no rate restriction)------ doc: <http://www.csounds.com/manual/html/octave.html>-octave :: Nums a => a -> a-octave = conv Octave---- | Converts a cycles-per-second value to octave-point-decimal. ------ > octcps (cps)  (init- or control-rate args only)------ doc: <http://www.csounds.com/manual/html/octcps.html>-octcps :: Nums a => a -> a-octcps = convKr Octcps---- | Converts a Midi note number value to octave-point-decimal. ------ > octmidinn (MidiNoteNumber)  (init- or control-rate args only)------ doc: <http://www.csounds.com/manual/html/octmidinn.html>-octmidinn :: Nums a => a -> a-octmidinn = convKr Octmidinn----- | Converts a pitch-class value to octave-point-decimal. ------ > octpch (pch)  (init- or control-rate args only)------ doc: <http://www.csounds.com/manual/html/octpch.html>-octpch :: Nums a => a -> a-octpch = convKr Octpch---- | Converts a Midi note number value to octave point pitch-class units. ------ > pchmidinn (MidiNoteNumber)  (init- or control-rate args only)------ doc: <http://www.csounds.com/manual/html/pchmidinn.html>-pchmidinn :: Nums a => a -> a-pchmidinn = convKr Pchmidinn---- | Converts an octave-point-decimal value to pitch-class. ------ > pchoct (oct)  (init- or control-rate args only)------ doc: <http://www.csounds.com/manual/html/pchoct.html>-pchoct :: Nums a => a -> a-pchoct = convKr Pchoct---- | Calculates a factor to raise/lower a frequency by a given amount of semitones. ------ > semitone(x) (no rate restriction)------ doc: <http://www.csounds.com/manual/html/semitone.html>-semitone :: Nums a => a -> a-semitone = conv Semitone---------------------------------------------------------- * Printing and Strings---- ** Simple Printing---- | These units will print orchestra init-values. ------ > print iarg [, iarg1] [, iarg2] [...]------ doc: <http://www.csounds.com/manual/html/print.html>-printi :: [D] -> SE ()-printi a1 = se_ $ opcs "print" [(x, repeat i)] a1---- | Prints one k-rate value at specified intervals. ------ > printk itime, kval [, ispace]------ doc: <http://www.csounds.com/manual/html/printk.html>-printk :: D -> Sig -> SE ()-printk a1 a2 = se_ $ opc2 "printk" [(x, [i,k,i])] a1 a2----- ** Formatted Printing---- ** String Variables---- | sprintf write printf-style formatted output to a string variable, similarly to the C function sprintf(). sprintf runs at i-time only. ------ > Sdst sprintf Sfmt, xarg1[, xarg2[, ... ]]------ doc: <http://www.csounds.com/manual/html/sprintf.html>-sprintf :: Str -> [D] -> Str-sprintf a1 a2 = opcs "sprintf" [(s, s:repeat i)] (toE a1 : map toE a2)---- | sprintfk writes printf-style formatted output to a string variable, similarly to the C function sprintf(). sprintfk runs both at initialization and performance time. ------ > Sdst sprintfk Sfmt, xarg1[, xarg2[, ... ]]------ doc: <http://www.csounds.com/manual/html/sprintfk.html>-sprintfk :: Str -> [Sig] -> Str-sprintfk a1 a2 = opcs "sprintfk" [(s, s:repeat k)] (toE a1 : map toE a2)---- ** String Manipulation And Conversion---- | Concatenate two strings and store the result in a variable. strcat runs at i-time only. It is allowed for any of the input arguments to be the same as the output variable. ------ > Sdst strcat Ssrc1, Ssrc2------ doc: <http://www.csounds.com/manual/html/strcat.html>-strcat :: Str -> Str -> Str-strcat = opc2 "strcat" [(s, [s,s])]---- |  Concatenate two strings and store the result in a variable. strcatk does the --- concatenation both at initialization and performance time. It is allowed for any of the input arguments to be the same as the output variable. ------ > Sdst strcatk Ssrc1, Ssrc2------ doc: <http://www.csounds.com/manual/html/strcatk.html>-strcatk :: Str -> Str -> Str-strcatk = opc2 "strcatk" [(s, [s,s])]--
− src/Csound/Opcode/Interaction.hs 
@@ -1,126 +0,0 @@--- | Realtime Interaction-module Csound.Opcode.Interaction (--    ------------------------------------------------------    -- * MIDI--    -- ** Opcodes For Use In MIDI-Triggered Instruments-    cpsmidi, ampmidi, pchbend, aftouch,--    -- ** Opcodes For Use In All Instruments-    ctrl7,--    ------------------------------------------------------    -- * Human Interfaces--    -- ** Keys-    sensekey,--    -- ** Mouse-    xyin    -) where--import Csound.Exp(Msg)-import Csound.Exp.Wrapper-import Csound.LowLevel---------------------------------------------------------- * MIDI---- ** Opcodes For Use In MIDI-Triggered Instruments---- | Get the note number of the current MIDI event, expressed in cycles-per-second. ------ > icps cpsmidi------ doc: <http://www.csounds.com/manual/html/cpsmidi.html>--cpsmidi :: Msg -> D-cpsmidi = const $ constOpc "cpsmidi"---- | Get the velocity of the current MIDI event. ------ > iamp ampmidi iscal [, ifn]------ doc: <http://www.csounds.com/manual/html/ampmidi.html>-ampmidi :: Msg -> D-ampmidi = const $ constOpc "ampmidi"---- | Get the current pitch-bend value for this channel. ------ > kbend pchbend [imin] [, imax]------ doc: <http://www.csounds.com/manual/html/pchbend.html>-pchbend :: Msg -> Sig -pchbend = const $ constDiap "pchbend"---- | Get the current after-touch value for this channel. ------ > kaft aftouch [imin] [, imax]------ doc: <http://www.csounds.com/manual/html/.html>-aftouch :: Msg -> Sig-aftouch = const $ constDiap "aftouch"---- ** Opcodes For Use In All Instruments---- | Allows a floating-point 7-bit MIDI signal scaled with a minimum and a maximum range. ------ > idest ctrl7 ichan, ictlno, imin, imax [, ifn]--- > kdest ctrl7 ichan, ictlno, kmin, kmax [, ifn]--- > adest ctrl7 ichan, ictlno, kmin, kmax [, ifn] [, icutoff]------ doc: <http://www.csounds.com/manual/html/ctrl7.html>-ctrl7 :: D -> D -> Sig -> Sig -> Sig-ctrl7 = opc4 "ctrl7" [-    (i, replicate 5 i),-    (k, [i, i, k, k, i]),-    (a, [i, i, k, k, i, i])]---constOpc :: Val a => Name -> a-constOpc name = opc0 name [(i, [])]--constDiap :: Val a => Name -> a-constDiap name = opc0 name [(k, [i, i])]---------------------------------------------------------- * Open Sound Control and Network---- ** Open Sound Control---- ** Remote Instruments---- ** Network Audio---------------------------------------------------------- * Human Interfaces---- ** Widgets---- ** Keys---- | Returns the ASCII code of a key that has been pressed, or -1 if no key has been pressed. ------ > kres[, kkeydown] sensekey------ doc: <http://www.csounds.com/manual/html/sensekey.html>-sensekey :: (Sig, Sig)-sensekey = mopc0 "sensekey" ([k,k], [])---- ** Mouse---- | Sense the cursor position in an output window. When xyin is called the position of the mouse within --- the output window is used to reply to the request. This simple mechanism does mean that only one xyin --- can be used accurately at once. The position of the mouse is reported in the output window. ------ > kx, ky xyin iprd, ixmin, ixmax, iymin, iymax [, ixinit] [, iyinit]------ doc: <http://www.csounds.com/manual/html/xyin.html>-xyin :: D -> D -> D -> D -> D -> (Sig, Sig)-xyin = mopc5 "xyin" ([k,k], is 7)---- ** WII---- ** P5 Glove-
+ src/Csound/Options.hs view
@@ -0,0 +1,87 @@+module Csound.Options(+    Options(..),++    -- * Shortcuts+    setRates, setBufs, setGain, setJack,+    setOutput, setInput, +    setDac, setAdc, setDacBy, setAdcBy, setThru,++    -- * Flags+    -- | Csound's command line flags. See original documentation for +    -- detailed overview: <http://www.csounds.com/manual/html/CommandFlagsCategory.html>+    Flags(..),++    -- * Audio file output+    AudioFileOutput(..),+    FormatHeader(..), FormatSamples(..), FormatType(..),+    Dither(..), IdTags(..),++    -- * Realtime Audio Input/Output+    Rtaudio(..), PulseAudio(..),+       +    -- * MIDI File Input/Ouput+    MidiIO(..),++    -- * MIDI Realtime Input/Ouput+    MidiRT(..), Rtmidi(..),++    -- * Display+    Displays(..), DisplayMode(..),++    -- * Performance Configuration and Control+    Config(..)+) where++import Data.Monoid+import Data.Default+import Csound.Typed++-- | Sets sample rate and block size+--+-- > setRates sampleRate blockSize+setRates :: Int -> Int -> Options+setRates sampleRate blockSize = def +    { csdSampleRate = Just sampleRate+    , csdBlockSize  = Just blockSize }++-- | Sets hardware and software buffers.+--+-- > setBufs hardwareBuf ioBuf+setBufs :: Int -> Int -> Options+setBufs hw io = def { csdFlags = def { config = def { hwBuf = Just hw, ioBuf = Just io } } }++setGain :: Double -> Options+setGain d = def { csdGain = Just d' }+    where d' = max 0 $ min 1 $ d++setJack :: String -> Options+setJack name = def { csdFlags = def { rtaudio = Just $ Jack name "input" "output" } }+++setDac :: Options+setDac = setDacBy ""++setAdc :: Options+setAdc = setAdcBy ""++setInput :: String -> Options+setInput a = def { csdFlags = def { audioFileOutput = def { input = Just a } } }++setOutput :: String -> Options+setOutput a = def { csdFlags = def { audioFileOutput = def { output = Just a } } }++setDacBy :: String -> Options+setDacBy port = setOutput name+    where name +            | null port = "dac"+            | otherwise = "dac:" ++ port+ +setAdcBy :: String -> Options+setAdcBy port = setInput name+    where name +            | null port = "adc"+            | otherwise = "adc:" ++ port++setThru :: Options+setThru = mappend setDac setAdc+
− src/Csound/Render.hs 
@@ -1,85 +0,0 @@-{-# Language TupleSections #-}-module Csound.Render(-    render    -) where--import Data.Traversable-import Control.Monad.Trans.Writer-import qualified Data.IntMap as IM--import Csound.Exp-import Csound.Exp.Instr(effectExp)-import Csound.Exp.SE-import Csound.Exp.Options-import Csound.Render.Pretty-import Csound.Render.Instr-import Csound.Render.Options-import Csound.Render.Channel--import Csound.Exp.Tuple(Out)-import Csound.Exp.Mix-import Csound.Exp.GE-import Csound.Exp.EventList--render :: (Out a, CsdSco f) => CsdOptions -> f (Mix a) -> IO String-render opt sigs = fmap (show . renderHistory (nchnls sigs) (csdEventListDur events) opt) -    $ flip execGE opt $ do-        notes <- traverse unMix events-        instrId <- saveMixerInstr =<< effectExp (proxy masterOuts sigs)-        let notes' = rescaleCsdEventListM $ toCsdEventList notes -        saveMixerNotes $ toLowLevelNotesMap $ Eff instrId notes'-        saveAlwaysOnNote instrId-    where events = toCsdEventList sigs-          proxy :: (Out a) => (a -> SE ()) -> f (Mix a) -> (a -> SE ()) -          proxy = const--toLowLevelNotesMap :: M -> IM.IntMap LowLevelSco-toLowLevelNotesMap mixNotes = IM.fromList $ execWriter $ phi mixNotes-    where    -        phi :: M -> Writer [(Int, LowLevelSco)] ()-        phi x = case x of-            Eff instrId notes -> -                let (instrNotes, rest) = onEff notes-                in  tell [(instrIdCeil instrId, instrNotes)] >> mapM_ phi rest-            Snd _ _ -> error "Render.hs:toLowLevelNotesMap no effect instrument, end up in Snd case"--onEff :: CsdEventList M -> (LowLevelSco, [M])-onEff (CsdEventList _ events) = execWriter $ mapM_ phi events-    where phi :: CsdEvent M -> Writer (LowLevelSco, [M]) ()-          phi (start, dur, content) = case content of-            Snd instrId notes -> tellFst $ fmap (instrId, ) $ csdEventListNotes $ delayCsdEventList start notes-            Eff instrId _     -> tell ([(instrId, (start, dur, []))], [content])-          tellFst x = tell (x, [])--renderHistory :: Int -> Double -> CsdOptions -> History -> Doc-renderHistory numOfChnls totalDur options history = ppCsdFile -    -- flags-    (renderFlags options) -    -- instr 0-    (renderInstr0 numOfChnls (midis history) options)-    -- orchestra-    (renderOrc $ instrs history)-    -- scores-    (renderSco $ scos history)-    -- strings-    (ppMapTable ppStrset $ strIndex history)-    -- ftables-    (ppTotalDur totalDur $$ (ppMapTable ppTabDef $ tabIndex history))    --    -renderSco :: Scos -> Doc-renderSco x = vcat $ fmap ppAlwayson $ alwaysOnInstrs x--renderOrc :: Instrs -> Doc-renderOrc x = (vcatMap renderSource $ instrSources x) $$ (vcatMap renderMixer $ instrMixers x)-    where getMixerNotes instrId = (fmap renderNotes $ mixerNotes x) IM.! (instrIdCeil instrId)-          -          renderSource = uncurry renderInstr    -          renderMixer  (instrId, expr) = ppInstr instrId $-               ppFreeChnStmt-            $$ getMixerNotes instrId-            $$ renderInstrBody expr--renderNotes :: LowLevelSco -> Doc-renderNotes notes = vcat $ fmap (\(instrId, evt) -> ppEvent instrId evt chnVar) notes-
− src/Csound/Render/Channel.hs 
@@ -1,88 +0,0 @@--- | Opcodes for routing the signals-module Csound.Render.Channel (-    masterOuts,-    -- * channel opcodes-    chnVar, chnName, -    chnmix, chnget, chnclear,-    chnUpdateStmt, chnUpdateOpcodeName, ppFreeChnStmt,-    freeChn, -    -- * trigger an instrument-    event, eventWithChannel, instrOn, instrOff-) where--import Csound.Exp-import Csound.Exp.Wrapper-import Csound.Exp.SE-import Csound.Exp.Arg(Arg, toNote)-import Csound.Exp.Tuple(Out(..))-import Csound.Exp.Cons(opc0, opc1, opc2, opcs)-import Csound.Opcode(clip, zeroDbfs, sprintf)-import Csound.Render.Pretty(Doc, verbatimLines, ppOpc, ppVar)   -------------------------------------------------------------- master instrument output--masterOuts :: (Out a) => a -> SE ()-masterOuts outSigs = outs . clipByMax =<< toOut outSigs-    where outs xs = se_ $ case xs of-              a:[] -> opc1 "out" [(Xr, [Ar])] a-              _    -> opcs "outs" [(Xr, repeat Ar)] xs    --clipByMax :: [Sig] -> [Sig]-clipByMax = fmap clip'-    where clip' x = clip x 0 zeroDbfs--------------------------------------------------------------- channels  --chnVar :: Var-chnVar = Var LocalVar Ir "Port"--chnName :: Int -> D -> Str-chnName name = sprintf formatString . return-    where formatString = str $ 'p' : show name ++ "_" ++ "%d"--chnmix :: Sig -> Str -> SE ()-chnmix a b = se_ $ opc2 "chnmix" [(Xr, [Ar, Sr])] a b--chnget :: Str -> SE Sig-chnget a = se $ opc1 "chnget" [(Ar, [Sr])] a--chnclear :: Str -> SE ()-chnclear a = se_ $ opc1 "chnclear" [(Xr, [Sr])] a--chnUpdateStmt :: Doc-chnUpdateStmt = verbatimLines [-    "giPort init 1",-    "opcode " ++ chnUpdateOpcodeName ++ ", i, 0",-    "xout giPort",-    "giPort = giPort + 1",-    "endop"]--ppFreeChnStmt :: Doc-ppFreeChnStmt = ppOpc (ppVar chnVar) chnUpdateOpcodeName []--chnUpdateOpcodeName :: String-chnUpdateOpcodeName = "FreePort"--freeChn :: SE D-freeChn = se $ opc0 "FreePort" [(Ir, [])]------------------------------------------------------------------ notes--event :: Arg a => InstrId -> D -> D -> a -> SE ()-event instrId start dur arg = se_ $ opcs "event" [(Xr, repeat Ir)] argExp-    where argExp :: [E]-          argExp = fmap prim $ toNote (str "i", instrId, start, dur, arg) --eventWithChannel :: Arg a => InstrId -> D -> D -> a -> D -> SE ()-eventWithChannel instrId start dur arg chn = event instrId start dur (arg, chn)--instrOn :: Arg a => InstrId -> a -> D -> SE ()-instrOn instrId arg chn = eventWithChannel instrId 0 (-1) arg chn--instrOff :: InstrId -> SE ()-instrOff instrId = event (toNegative instrId) 0 (-1) ()-    where toNegative a = a { instrIdCeil = negate $ abs $ instrIdCeil a }-
− src/Csound/Render/Instr.hs 
@@ -1,142 +0,0 @@-module Csound.Render.Instr(-    renderInstr, renderInstrBody-) where--import Control.Arrow(second)-import Data.List(sort, find)-import qualified Data.Map as M--import Data.Maybe(fromJust)-import Data.Default-import Data.Fix(Fix(..), cata)-import Data.Fix.Cse(fromDag, cse)--import Csound.Exp hiding (Var)-import Csound.Exp.Wrapper(getRates, isMultiOutSignature)--import Csound.Tfm.DeduceTypes-import Csound.Tfm.UnfoldMultiOuts-import Csound.Render.Pretty(ppStmt, ppInstr, vcat, Doc)--type Dag f = [(Int, f Int)]--renderInstr :: InstrId -> E -> Doc-renderInstr instrId expr = ppInstr instrId $ renderInstrBody expr--renderInstrBody :: E -> Doc-renderInstrBody sig = vcat $ map (uncurry ppStmt . clearEmptyResults) $ collectRates $ toDag sig------------------------------------------------------------------ E -> Dag--toDag :: E -> Dag RatedExp -toDag expr = fromDag $ cse $ trimByArgLength expr--trimByArgLength :: E -> E-trimByArgLength = cata $ \x -> Fix x{ ratedExpExp = phi $ ratedExpExp x }-    where phi x = case x of-            Tfm info xs -> Tfm (info{infoSignature = trimInfo (infoSignature info) xs}) xs-            _ -> x-          trimInfo signature args = case signature of-            SingleRate tab -> SingleRate $ fmap trim tab-            MultiRate outs ins -> MultiRate outs (trim ins)        -            where trim = take (length args)    -                  -clearEmptyResults :: ([RatedVar], Exp RatedVar) -> ([RatedVar], Exp RatedVar)-clearEmptyResults (res, expr) = (filter ((/= Xr) . ratedVarRate) res, expr)-        -collectRates :: Dag RatedExp -> [([RatedVar], Exp RatedVar)]-collectRates dag = fmap (second ratedExpExp) res-    where res = unfoldMultiOuts unfoldSpec lastFreshId dag1  -          (dag1, lastFreshId) = rateGraph dag---------------------------------------------------------------- Dag -> Dag---------------------------------------------------------------- deduces types--rateGraph :: [Stmt RatedExp Int] -> ([Stmt RatedExp (Var Rate)], Int)-rateGraph dag = (stmts, lastId)-     where (stmts, lastId) = deduceTypes algSpec dag-           algSpec = TypeGraph mkConvert' defineType'--           mkConvert' a = (to, RatedExp def def $ -                   ConvertRate (ratedVarRate to) (ratedVarRate from) $ PrimOr $ Right from)-               where from = convertFrom a-                     to   = convertTo   a--           defineType' (outVar, expr) desiredRates = (ratesForConversion, (outVar', expr'))-               where possibleRate = deduceRate desiredRates expr -                     ratesForConversion = filter (not . flip coherentRates possibleRate) desiredRates-                     expr' = RatedExp def def $ rateExp possibleRate $ ratedExpExp expr-                     outVar' = ratedVar possibleRate outVar--------------------------------------------------------------- unfolds multiple rates--unfoldSpec :: UnfoldMultiOuts RatedExp Rate -unfoldSpec = UnfoldMultiOuts getSelector' getParentTypes'-    where getSelector' x = case ratedExpExp x of-                Select _ order (PrimOr (Right parent)) -> Just $ Selector parent order -                _ -> Nothing-          getParentTypes' x = case ratedExpExp x of-                Tfm i _ -> if (isMultiOutSignature $ infoSignature i) -                           then Just (getRates $ ratedExpExp x) -                           else Nothing -                _ -> Nothing--coherentRates :: Rate -> Rate -> Bool-coherentRates to from = case (to, from) of-    (a, b)  | a == b    -> True-    (Xr, _)             -> True             -    (Kr, Ir)            -> True-    _                   -> False--deduceRate :: [Rate] -> RatedExp Int -> Rate-deduceRate desiredRates expr = case ratedExpExp expr of-    ExpPrim _ -> case desiredRates of-        [Sr] -> Sr-        _ -> Ir-       -    Tfm info _ | isProcedure info -> Xr-    Tfm info _ -> case infoSignature info of-        MultiRate _ _ -> Xr-        SingleRate tab -> -            let r1 = tfmNoRate (infoName info) desiredRates tab-            in  case ratedExpRate expr of-                    Just r | M.member r tab -> r-                    Just _ -> r1-                    Nothing -> r1-    -    ExpNum _ -> case maximum desiredRates of-        Xr -> Ar-        r -> r-    -    Select rate _ _ -> rate-    If _ _ _ -> head $ filter (/= Xr) $ sort desiredRates   -    ReadVar v -> varRate v-    WriteVar _ _ -> Xr    -    where tfmNoRate name rates tab = case sort rates of-              [Xr]  -> tfmNoRate name [Ar] tab                -              Xr:as -> tfmNoRate name as tab-              as -> fromJust $ find (flip M.member tab) (as ++ [minBound .. maxBound])         --rateExp :: Rate -> Exp Int -> Exp RatedVar -rateExp curRate expr = case expr of-    ExpPrim (P n) | curRate == Sr -> ExpPrim (PString n)-    Tfm i xs -> Tfm i $ mergeWithPrimOrBy (flip ratedVar) xs (ratesFromSignature curRate (infoSignature i))-    Select rate pid a -> Select rate pid (fmap (ratedVar Xr) a)    -    If _ _ _ -> let curRate' = max curRate Kr-                in  fmap (fmap (ratedVar curRate')) expr-    ExpNum _ -> fmap (fmap (ratedVar curRate)) expr    -    ReadVar v -> ReadVar v-    WriteVar v a -> WriteVar v $ fmap (ratedVar (varRate v)) a-    ExpPrim p -> ExpPrim p-    where ratesFromSignature rate signature = case signature of-              SingleRate table -> table M.! rate-              MultiRate _ rs   -> rs--mergeWithPrimOrBy :: (a -> b -> c) -> [PrimOr a] -> [b] -> [PrimOr c]-mergeWithPrimOrBy cons = zipWith (\primOr b -> fmap (flip cons b) primOr)-
− src/Csound/Render/Options.hs 
@@ -1,36 +0,0 @@-module Csound.Render.Options(-    renderInstr0, renderFlags-) where--import Csound.Exp.Options-import Csound.Render.Pretty-import Csound.Render.Channel(chnUpdateStmt)--renderFlags :: CsdOptions -> Doc-renderFlags = text . flags--type Nchnls = Int--renderInstr0 :: Nchnls -> [MidiAssign] -> CsdOptions -> Doc-renderInstr0 nchnls massignTable opt = ($$ chnUpdateStmt) $ ppInstr0 $ [-    stmt "sr"    $ sampleRate opt,-    stmt "ksmps" $ blockSize opt,-    stmt "nchnls" nchnls,   -    stmt "0dbfs" 1,-    maybe empty stmtSeed $ seed opt] -    ++ map stmtInitc7 (initc7 opt)-    ++ fmap renderMidiAssign massignTable        -    where stmt a b = text a $= int b-          stmtSeed n = ppProc "seed" [int n]-          stmtInitc7 (chn, ctl, val) = ppProc "initc7" [int chn, int ctl, double val]-            -  -renderMidiAssign :: MidiAssign -> Doc-renderMidiAssign a = ppProc opcode $ [int $ midiAssignChannel a, int $ midiAssignInstr a] ++ auxParams-    where opcode = case midiAssignType a of-              Massign     -> "massign"-              Pgmassign _ -> "pgmassign"-          auxParams = case midiAssignType a of -              Pgmassign (Just n) -> [int n]-              _ -> []  -
− src/Csound/Render/Pretty.hs 
@@ -1,257 +0,0 @@-module Csound.Render.Pretty (-    Doc, int, double, text, empty, ($$), vcat, vcatMap,-    verbatimLines,--    binaries, unaries, funcs,-    binary, unary, func,-    ppMapTable,-    ppStmt,-    ($=), ppOpc, ppProc, ppVar,-    ppPrim, ppTab, ppStrget, ppStrset, ppTabDef, ppConvertRate, ppIf,-    ppCsdFile, ppInstr, ppInstr0, ppScore, ppNote, ppTotalDur, ppOrc, ppSco, -    ppInline, ppCondOp, ppNumOp,-    ppEvent, ppMasterNote, ppAlwayson-) where--import Data.Char(toLower)-import qualified Data.Map as M-import qualified Data.IntMap as IM-import Text.PrettyPrint.Leijen--import Csound.Tfm.Tab-import Csound.Exp -import Csound.Exp.EventList--vcatMap :: (a -> Doc) -> [a] -> Doc-vcatMap f = vcat . fmap f--verbatimLines :: [String] -> Doc-verbatimLines = vcat . fmap text--($$) :: Doc -> Doc -> Doc-($$) = (<$$>)--binaries, unaries, funcs :: String -> [Doc] -> Doc--binaries op as = binary op (as !! 0) (as !! 1)-unaries  op as = unary  op (as !! 0)-funcs    op as = func   op (as !! 0)--binary :: String -> Doc -> Doc -> Doc-binary op a b = parens $ a <+> text op <+> b--unary :: String -> Doc -> Doc-unary op a = parens $ text op <> a--func :: String -> Doc -> Doc-func op a = text op <> parens a--ppMapTable :: (a -> Int -> Doc) -> Index a -> Doc-ppMapTable phi = vcat . map (uncurry phi) . M.toList . indexElems---ppRate :: Rate -> Doc-ppRate x = case x of-    Sr -> char 'S'-    _  -> phi x-    where phi = text . map toLower . show --ppPrimOrVar :: PrimOr RatedVar -> Doc-ppPrimOrVar x = either ppPrim ppRatedVar $ unPrimOr x--ppRatedVar :: RatedVar -> Doc-ppRatedVar v = ppRate (ratedVarRate v) <> int (ratedVarId v)--ppOuts :: [RatedVar] -> Doc-ppOuts xs = hsep $ punctuate comma $ map ppRatedVar xs--($=) :: Doc -> Doc -> Doc-($=) a b = a <+> equals <+> b--ppOpc :: Doc -> String -> [Doc] -> Doc-ppOpc out name xs = out <+> ppProc name xs--ppProc :: String -> [Doc] -> Doc-ppProc name xs = text name <+> (hsep $ punctuate comma xs)--ppVar :: Var -> Doc-ppVar v = case v of-    Var ty rate name -> ppVarType ty <> ppRate rate <> text name-    VarVerbatim _ name -> text name--ppVarType :: VarType -> Doc-ppVarType x = case x of-    LocalVar -> empty-    GlobalVar -> char 'g'--ppPrim :: Prim -> Doc-ppPrim x = case x of-    P n -> char 'p' <> int n-    PrimInstrId a -> ppInstrId a-    PString a -> int a    -    PrimInt n -> int n-    PrimDouble d -> double d-    PrimString s -> dquotes $ text s-    PrimTab f -> error $ "i'm lost table, please substitute me (" ++ (show f) ++ ")" -    -ppTab :: LowTab -> Doc-ppTab (LowTab size n xs) = text "gen" <> int n <+> int size <+> (hsep $ map double xs)- -ppIf :: Doc -> Doc -> Doc -> Doc-ppIf p t e = p <+> char '?' <+> t <+> char ':' <+> e--ppStrget :: Doc -> Int -> Doc-ppStrget out n = ppOpc out "strget" [char 'p' <> int n]--ppConvertRate :: Doc -> Rate -> Rate -> Doc -> Doc-ppConvertRate out to from var = case (to, from) of-    (Ar, Kr) -> upsamp var -    (Ar, Ir) -> upsamp $ k var-    (Kr, Ar) -> downsamp var-    (Kr, Ir) -> out $= k var-    (Ir, Ar) -> downsamp var-    (Ir, Kr) -> out $= i var-    (a, b)   -> error $ "bug: no rate conversion from " ++ show b ++ " to " ++ show a ++ "."-    where upsamp x = ppOpc out "upsamp" [x]-          downsamp x = ppOpc out "downsamp" [x]-          k = func "k"-          i = func "i"--ppTabDef :: LowTab -> Int -> Doc-ppTabDef ft tabId = char 'f' -    <>  int tabId -    <+> int 0 -    <+> (int $ lowTabSize ft)-    <+> (int $ lowTabGen ft) -    <+> (hsep $ map double $ lowTabArgs ft)--ppStrset :: String -> Int -> Doc-ppStrset str strId = text "strset" <+> int strId <> comma <+> (dquotes $ text str)---- file--newline :: Doc-newline = line--ppCsdFile :: Doc -> Doc -> Doc -> Doc -> Doc -> Doc -> Doc-ppCsdFile flags instr0 instrs scores strTable tabs = -    tag "CsoundSynthesizer" [-        tag "CsOptions" [flags],-        tag "CsInstruments" [-            instr0, strTable, instrs],-        tag "CsScore" [-            tabs, scores]]    --tag :: String -> [Doc] -> Doc-tag name content = vcat $ punctuate newline [-    char '<' <> text name <> char '>', -    vcat $ punctuate newline content, -    text "</" <> text name <> char '>']  ---- instrument--ppInstr :: InstrId -> Doc -> Doc-ppInstr instrId body = vcat [-    text "instr" <+> ppInstrId instrId,-    body,-    text "endin"]--ppInstr0 :: [Doc] -> Doc-ppInstr0 = vcat--ppOrc :: [Doc] -> Doc-ppOrc = vcat . punctuate newline--ppInstrId :: InstrId -> Doc-ppInstrId (InstrId den nom) = int nom <> maybe empty ppAfterDot den -    where ppAfterDot x = text $ ('.': ) $ reverse $ show x---- score--ppSco :: [Doc] -> Doc-ppSco = vcat--ppScore :: [Doc] -> Doc-ppScore = vcat--ppNote :: InstrId -> Double -> Double -> [Doc] -> Doc-ppNote instrId time dur args = char 'i' <> ppInstrId instrId <+> double time <+> double dur <+> hsep args--ppMasterNote :: InstrId -> CsdEvent [Prim] -> Doc-ppMasterNote instrId evt = ppNote instrId (csdEventStart evt) (csdEventDur evt) (fmap ppPrim $ csdEventContent evt) <+> int 0--ppEvent :: InstrId -> CsdEvent [Prim] -> Var -> Doc-ppEvent instrId evt var = pre <> comma <+> ppVar var-    where pre = ppProc "event_i" $ dquotes (char 'i') : ppInstrId instrId -                : (double $ csdEventStart evt) : (double $ csdEventDur evt) : (fmap ppPrim $ csdEventContent evt)--ppTotalDur :: Double -> Doc-ppTotalDur d = text "f0" <+> double d--ppAlwayson :: InstrId -> Doc-ppAlwayson instrId = char 'i' <> ppInstrId instrId <+> int 0  <+> int (-1)---- expressions--ppInline :: (a -> [Doc] -> Doc) -> Inline a Doc -> Doc-ppInline ppNode a = iter $ inlineExp a    -    where iter x = case x of-              InlinePrim n        -> inlineEnv a IM.! n-              InlineExp op args   -> ppNode op $ fmap iter args  ---- booleans--ppCondOp :: CondOp -> [Doc] -> Doc  -ppCondOp op = case op of-    TrueOp            -> const $ text "(1 == 1)"                -    FalseOp           -> const $ text "(0 == 1)"-    And               -> bi "&&"-    Or                -> bi "||"-    Equals            -> bi "=="-    NotEquals         -> bi "!="-    Less              -> bi "<"-    Greater           -> bi ">"-    LessEquals        -> bi "<="    -    GreaterEquals     -> bi ">="                         -    where bi  = binaries -          --- numeric--ppNumOp :: NumOp -> [Doc] -> Doc-ppNumOp op = case  op of-    Add -> bi "+"-    Sub -> bi "-"-    Mul -> bi "*"-    Div -> bi "/"-    Neg -> uno "-"    -    Pow -> bi "^"    -    Mod -> bi "%"-    -    ExpOp -> fun "exp"-    IntOp -> fun "int" -    -    x -> fun (firstLetterToLower $ show x)        -    where bi  = binaries-          uno = unaries-          fun = funcs-          firstLetterToLower xs = case xs of-            a:as -> toLower a : as-            [] -> error "ppNumOp firstLetterToLower: empty identifier"---ppStmt :: [RatedVar] -> Exp RatedVar -> Doc-ppStmt outs expr = ppExp (ppOuts outs) expr--ppExp :: Doc -> Exp RatedVar -> Doc-ppExp res expr = case fmap ppPrimOrVar expr of-    ExpPrim (PString n) -> ppStrget res n-    ExpPrim p -> res $= ppPrim p-    Tfm info [a, b] | isInfix  info -> res $= binary (infoName info) a b-    Tfm info xs -> ppOpc res (infoName info) xs-    ConvertRate to from x -> ppConvertRate res to from x-    If info t e -> res $= ppIf (ppInline ppCondOp info) t e-    ExpNum (PreInline op as) -> res $= ppNumOp op as-    WriteVar v a -> ppVar v $= a-    ReadVar v -> res $= ppVar v-    x -> error $ "unknown expression: " ++ show x-
+ src/Csound/SigSpace.hs view
@@ -0,0 +1,290 @@+{-# OPTIONS_GHC -fno-warn-orphans #-}+{-# Language FlexibleInstances #-}+module Csound.SigSpace(+    SigSpace(..), mul, +    cfd, cfds, cfdSpec, cfdsSpec, +    wsum        +) where++import Control.Applicative++import Csound.Typed+import Csound.Typed.Opcode(pvscross)++-- | A class for easy way to process the outputs of the instruments.+class Num a => SigSpace a where+    mapSig  :: (Sig -> Sig)    -> a -> a+    bindSig :: (Sig -> SE Sig) -> a -> SE a++-- | Scaling the sound.+mul :: SigSpace a => Sig -> a -> a+mul k = mapSig (k * )++-- | Crossfade.+--+-- > cfd coeff sig1 sig2+--+-- If coeff equals 0 then we get the first signal and if it equals 1 we get the second signal.+cfd :: 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 +    where mix' c a b = mixFun c b a+  +-- | Generic crossfade for n coefficients and n+1 signals.+--+-- > cfds coeffs sigs+cfds :: SigSpace a => [Sig] -> [a] -> a+cfds = genCfds 0 cfd++-- | Spectral crossfade.+cfdSpec :: Sig -> Spec -> Spec -> Spec+cfdSpec coeff a b = pvscross a b (1 - coeff) coeff++-- | Generic spectral crossfade.+cfdsSpec :: [Sig] -> [Spec] -> Spec+cfdsSpec = genCfds undefined cfdSpec++-- | Weighted sum.+wsum :: SigSpace a => [(Sig, a)] -> a+wsum = sum . fmap (uncurry mul)++instance SigSpace Sig where+    mapSig = id+    bindSig = id++instance SigSpace (Sig, Sig) where+    mapSig  f (a1, a2) = (f a1, f a2)+    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)+    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)+    bindSig f (a1, a2, a3, a4) = (,,,) <$> f a1 <*> f a2 <*> f a3 <*> f a4++instance SigSpace (SE Sig) where+    mapSig  f = fmap (mapSig f)+    bindSig f = fmap (bindSig f)++instance SigSpace (SE (Sig, Sig)) where+    mapSig  f = fmap (mapSig f)+    bindSig f = fmap (bindSig f)++instance SigSpace (SE (Sig, Sig, Sig)) where+    mapSig  f = fmap (mapSig f)+    bindSig f = fmap (bindSig f)++instance SigSpace (SE (Sig, Sig, Sig, Sig)) where+    mapSig  f = fmap (mapSig f)+    bindSig f = fmap (bindSig f)++-----------------------------------------------------+-- numeric instances++-- Num++instance Num (Sig, Sig) 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 Num (Sig, Sig, Sig) 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 Num (Sig, Sig, Sig, Sig) 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 Num (SE Sig) where+    (+) = liftA2 (+)+    (*) = liftA2 (*)+    negate = fmap negate++    fromInteger = return . fromInteger+    signum = fmap signum+    abs = fmap abs++instance Num (SE (Sig, Sig)) where+    (+) = liftA2 (+)+    (*) = liftA2 (*)+    negate = fmap negate++    fromInteger = return . fromInteger+    signum = fmap signum+    abs = fmap abs++instance Num (SE (Sig, Sig, Sig)) where+    (+) = liftA2 (+)+    (*) = liftA2 (*)+    negate = fmap negate++    fromInteger = return . fromInteger+    signum = fmap signum+    abs = fmap abs++instance Num (SE (Sig, Sig, Sig, Sig)) where+    (+) = liftA2 (+)+    (*) = liftA2 (*)+    negate = fmap negate++    fromInteger = return . fromInteger+    signum = fmap signum+    abs = fmap abs++instance Num (a -> Sig) where+    (+) = liftA2 (+)+    (*) = liftA2 (*)+    negate = fmap negate++    fromInteger = return . fromInteger+    signum = fmap signum+    abs = fmap abs++instance Num (a -> (Sig, Sig)) where+    (+) = liftA2 (+)+    (*) = liftA2 (*)+    negate = fmap negate++    fromInteger = return . fromInteger+    signum = fmap signum+    abs = fmap abs++instance Num (a -> (Sig, Sig, Sig)) where+    (+) = liftA2 (+)+    (*) = liftA2 (*)+    negate = fmap negate++    fromInteger = return . fromInteger+    signum = fmap signum+    abs = fmap abs++instance Num (a -> (Sig, Sig, Sig, Sig)) where+    (+) = liftA2 (+)+    (*) = liftA2 (*)+    negate = fmap negate++    fromInteger = return . fromInteger+    signum = fmap signum+    abs = fmap abs+++instance Num (a -> SE Sig) where+    (+) = liftA2 (+)+    (*) = liftA2 (*)+    negate = fmap negate++    fromInteger = return . fromInteger+    signum = fmap signum+    abs = fmap abs++instance Num (a -> SE (Sig, Sig)) where+    (+) = liftA2 (+)+    (*) = liftA2 (*)+    negate = fmap negate++    fromInteger = return . fromInteger+    signum = fmap signum+    abs = fmap abs++instance Num (a -> SE (Sig, Sig, Sig)) where+    (+) = liftA2 (+)+    (*) = liftA2 (*)+    negate = fmap negate++    fromInteger = return . fromInteger+    signum = fmap signum+    abs = fmap abs++instance Num (a -> SE (Sig, Sig, Sig, Sig)) where+    (+) = liftA2 (+)+    (*) = liftA2 (*)+    negate = fmap negate++    fromInteger = return . fromInteger+    signum = fmap signum+    abs = fmap abs++-- Fractional++instance Fractional (Sig, Sig) where+    (a1, a2) / (b1, b2) = (a1 / b1, a2 / b2)+    fromRational a = (fromRational a, fromRational a)++instance Fractional (Sig, Sig, Sig) where+    (a1, a2, a3) / (b1, b2, b3) = (a1 / b1, a2 / b2, a3 / b3)+    fromRational a = (fromRational a, fromRational a, fromRational a)++instance Fractional (Sig, Sig, Sig, Sig) where+    (a1, a2, a3, a4) / (b1, b2, b3, b4) = (a1 / b1, a2 / b2, a3 / b3, a4 / b4)+    fromRational a = (fromRational a, fromRational a, fromRational a, fromRational a)++instance Fractional (SE Sig) where+    (/) = liftA2 (/)+    fromRational = return . fromRational++instance Fractional (SE (Sig, Sig)) where+    (/) = liftA2 (/)+    fromRational = return . fromRational++instance Fractional (SE (Sig, Sig, Sig)) where+    (/) = liftA2 (/)+    fromRational = return . fromRational++instance Fractional (SE (Sig, Sig, Sig, Sig)) where+    (/) = liftA2 (/)+    fromRational = return . fromRational++instance Fractional (a -> SE Sig) where+    (/) = liftA2 (/)+    fromRational = return . fromRational++instance Fractional (a -> SE (Sig, Sig)) where+    (/) = liftA2 (/)+    fromRational = return . fromRational++instance Fractional (a -> SE (Sig, Sig, Sig)) where+    (/) = liftA2 (/)+    fromRational = return . fromRational++instance Fractional (a -> SE (Sig, Sig, Sig, Sig)) where+    (/) = liftA2 (/)+    fromRational = return . fromRational++instance Fractional (a -> Sig) where+    (/) = liftA2 (/)+    fromRational = return . fromRational++instance Fractional (a -> (Sig, Sig)) where+    (/) = liftA2 (/)+    fromRational = return . fromRational++instance Fractional (a -> (Sig, Sig, Sig)) where+    (/) = liftA2 (/)+    fromRational = return . fromRational++instance Fractional (a -> (Sig, Sig, Sig, Sig)) where+    (/) = liftA2 (/)+    fromRational = return . fromRational++
src/Csound/Tab.hs view
@@ -11,10 +11,15 @@      -- * Fill table with numbers     doubles,-    +   +    -- * Read from files+    wavs, mp3s,+     -- * (In)Harmonic series     PartialStrength, PartialNumber, PartialPhase, PartialDC,-    sines, sines3, sines2, partials, sines4, buzzes,+    sines, sines3, sines2, sines1, sines4, buzzes,+    -- ** Special cases+    sine, cosine, sigmoid,      -- * Interpolants         -- | All funtions have the same shape of arguments:@@ -43,20 +48,22 @@     -- > lins [0, 1, 1, 3, 0]     --     -- all these expressions are equivalent. -    consts, lins, cubes, exps, splines,    +    consts, lins, cubes, exps, splines, startEnds,     -- ** Equally spaced interpolants-    econsts, elins, ecubes, eexps, esplines,+    econsts, elins, ecubes, eexps, esplines, estartEnds,      -- * Polynomials         polys, chebs1, chebs2, bessels,     -    -- +    -- * Windows  +    winHamming, winHanning,  winBartlett, winBlackman,+    winHarris, winGaussian, winKaiser, winRectangle, winSync,      -- * Low level Csound definition.     gen,          -- * Modify tables-    skipNorm, setSize, setDegree, guardPoint, gp,+    skipNorm, forceNorm, setSize, setDegree, guardPoint, gp,          -- ** Handy shortcuts             -- | handy shortcuts for the function 'setDegree'.@@ -65,43 +72,29 @@     -- * Identifiers for GEN-routines          -- | Low level Csound integer identifiers for tables. These names can be used in the function 'Csound.Base.fineFi'-    idDoubles, idSines, idSines3, idSines2, idPartials, idSines4, idBuzzes, idConsts, idSegs, idCubes, idExps, idSplines,  idPolys, idChebs1, idChebs2, idBessels+    idWavs, idMp3s, idDoubles, idSines, idSines3, idSines2+    , idPartials, idSines4, idBuzzes, idConsts, idLins, idCubes+    , idExps, idSplines, idStartEnds,  idPolys, idChebs1, idChebs2, idBessels, idWins ) where  import Data.Default-import Csound.Exp-import Csound.Tfm.Tab(updateTabSize)--import qualified Data.IntMap as IM+import Csound.Typed --- | Sets different table size for different GEN-routines. ------ > fineFi n ps ------ where --- --- * @n@ is the default value for table size (size is a @n@ power of 2) for all gen routines that are not listed in the next argument @ps@.------ * @ps@ is a list of pairs @(genRoutineId, tableSizeDegreeOf2)@ that sets the given table size for a ---   given GEN-routine.------ with this function we can set lower table sizes for tables that are usually used in the envelopes.-fineFi :: Int -> [(Int, Int)] -> TabFi-fineFi n xs = TabFi n (IM.fromList xs)+wavs :: String -> Double -> Int -> Tab+wavs filename skiptime channel = preTab (SizePlain 0) idWavs +    (FileAccess filename [skiptime, format, fromIntegral $ channel])+    where format = 0 --- | Sets the same table size for all tables. ------ > coarseFi n------ where @n@  is a degree of 2. For example, @n = 10@ sets size to 1024 points for all tables by default.-coarseFi :: Int -> TabFi-coarseFi n = TabFi n IM.empty+mp3s :: String -> Double -> Tab+mp3s filename skiptime = preTab (SizePlain 0) idMp3s +    (FileAccess filename [skiptime, format])+    where format = 0  interp :: Int -> [Double] -> Tab-interp genId as = Tab def genId (ArgsRelative as)+interp genId as = preTab def genId (ArgsRelative as)  plains :: Int -> [Double] -> Tab-plains genId as = Tab def genId (ArgsPlain as)+plains genId as = preTab def genId (ArgsPlain as)  insertOnes :: [Double] -> [Double] insertOnes xs = case xs of@@ -109,21 +102,25 @@     a:[] -> [a]     a:as -> a : 1 : insertOnes as --tableSizes :: [Int]-tableSizes = [res | a <- twos, b <- twos1, res <- [a, b]]-    where twos  = fmap (2 ^) [(0::Int) .. ]-          twos1 = fmap ( +1) twos  - findTableSize :: Int -> Int-findTableSize n = head $ dropWhile (< n) tableSizes+findTableSize n+    | isPowerOfTwo n        = n+    | isPowerOfTwo (n - 1)  = n+    | otherwise             = -n+    +isPowerOfTwo :: Int -> Bool+isPowerOfTwo a +    | null zeroes   = False+    | otherwise     = all ( == 0) zeroes+    where zeroes = fmap (flip mod 2) $ takeWhile (> 1) $ iterate (\x -> div x 2) a  -- loadFile :: Int -> String -> Double -> Tab  -- | Table contains all provided values  -- (table is extended to contain all values and to be of the power of 2 or the power of two plus one).+-- (by default it skips normalization). doubles :: [Double] -> Tab-doubles as = setSize (findTableSize n) $ plains idDoubles as+doubles as = skipNorm $ setSize (findTableSize n) $ plains idDoubles as     where n = length as  -- | Segments of the exponential curves.@@ -180,7 +177,7 @@ -- -- * @n1, n2, ...@  are lengths of the segments relative to the total number of the points in the table lins :: [Double] -> Tab-lins = interp idSegs+lins = interp idLins  -- | Equally spaced segments of straight lines. --@@ -235,12 +232,43 @@ -- > consts [a, 1, b, 1, c, ...] econsts :: [Double] -> Tab econsts = consts . insertOnes-    +   +-- | Creates a table from a starting value to an ending value.+--+-- > startEnds [val1, dur1, type1, val2, dur2, type2, val3, ... typeX, valN]+--+-- * val1, val2 ... -- end points of the segments+--+-- * dur1, dur2 ... -- durations of the segments+--+-- * type1, type2 ... -- if 0, a straight line is produced. If non-zero, then it creates the following curve, for dur steps:+--+-- > beg + (end - beg) * (1 - exp( i*type)) / (1 - exp(type * dur))+-- +-- * beg, end - end points of the segment+--+-- * dur - duration of the segment+startEnds :: [Double] -> Tab+startEnds as = preTab def idStartEnds (ArgsGen16 as)++-- | Equally spaced interpolation for the function @startEnds@+--+-- > estartEnds [val1, type1, val2, typ2, ...]+--+-- is the same as+--+-- > estartEnds [val1, 1, type1, val2, 1, type2, ...]+estartEnds :: [Double] -> Tab+estartEnds = startEnds . insertOnes16+    where +        insertOnes16 xs = case xs of+            a:b:as  -> a : 1 : b : insertOnes16 as+            _       -> xs+ type PartialNumber = Double type PartialStrength = Double type PartialPhase = Double type PartialDC = Double-      -- | Series of harmonic partials: --@@ -255,21 +283,33 @@ sines = plains idSines  -- | Just like 'Csound.Tab.sines2' but partial strength is set to one.-partials :: [PartialNumber] -> Tab-partials xs = sines2 $ zip xs (repeat 1)+sines1 :: [PartialNumber] -> Tab+sines1 xs = sines2 $ zip xs (repeat 1)  -- | Just like 'Csound.Tab.sines3' but phases are set to zero. sines2 :: [(PartialNumber, PartialStrength)] -> Tab-sines2 xs = sines3 [(num, str, 0) | (num, str) <- xs]+sines2 xs = sines3 [(num, strength, 0) | (num, strength) <- xs]  -- | Specifies series of possibly inharmonic partials. sines3 :: [(PartialNumber, PartialStrength, PartialPhase)] -> Tab-sines3 xs = plains idSines3 [a | (pn, str, phs) <- xs, a <- [pn, str, phs]]+sines3 xs = plains idSines3 [a | (pn, strength, phs) <- xs, a <- [pn, strength, phs]]  -- | Specifies series of possibly inharmonic partials with direct current. sines4 :: [(PartialNumber, PartialStrength, PartialPhase, PartialDC)] -> Tab-sines4 xs = plains idSines4 [a | (pn, str, phs, dc) <- xs, a <- [pn, str, phs, dc]]+sines4 xs = plains idSines4 [a | (pn, strength, phs, dc) <- xs, a <- [pn, strength, phs, dc]] +-- | Table for pure sine wave.+sine :: Tab+sine = sines [1]++-- | Table for pure cosine wave.+cosine :: Tab+cosine = buzzes 1 []++-- | Table for sigmoid wave.+sigmoid :: Tab+sigmoid = sines4 [(0.5, 0.5, 270, 0.5)]+ -- | Generates values similar to the opcode 'Csound.Opcode.Basic.buzz'.  -- -- > buzzes numberOfHarmonics [lowestHarmonic, coefficientOfAttenuation]@@ -325,7 +365,39 @@ chebs2 :: Double -> Double -> [Double] -> Tab chebs2 xint xamp hs = plains idChebs2 (xint : xamp : hs) +winHamming, winHanning, winBartlett, winBlackman,+    winHarris, winGaussian, winKaiser, winRectangle, winSync :: [Double] -> Tab ++winHamming      = wins Hamming+winHanning      = wins Hanning+winBartlett     = wins Bartlett+winBlackman     = wins Blackman+winHarris       = wins Harris+winRectangle    = wins Rectangle+winSync         = wins Sync+winGaussian     = wins Gaussian+winKaiser       = wins Kaiser++data WinType +    = Hamming | Hanning | Bartlett | Blackman+    | Harris | Gaussian | Kaiser | Rectangle | Sync++winTypeId :: WinType -> Double+winTypeId x = case x of+    Hamming     -> 1+    Hanning     -> 2+    Bartlett    -> 3+    Blackman    -> 4+    Harris      -> 5+    Gaussian    -> 6+    Kaiser      -> 7+    Rectangle   -> 8+    Sync        -> 9++wins :: WinType -> [Double] -> Tab+wins ty params = gen idWins (winTypeId ty : params)+ -- | Creates a table of doubles (It's f-table in Csound). -- Arguments are: --@@ -335,7 +407,7 @@ -- -- All tables are created at 0 and memory is never released. gen :: Int -> [Double] -> Tab-gen genId args = Tab def genId (ArgsPlain args)+gen genId args = preTab def genId (ArgsPlain args)  -- | Adds guard point to the table size (details of the interpolation schemes: you do need guard point if your intention is to read the  -- table once but you don't need the guard point if you read table in many cycles, the guard point is the the first point of your table).  @@ -374,33 +446,4 @@ hifi    = setDegree 1 hhifi   = setDegree 2 hhhifi  = setDegree 3 ---- | Skips normalization (sets table size to negative value)-skipNorm :: Tab -> Tab-skipNorm x = case x of-    TabExp _ -> error "you can skip normalization only for primitive tables (made with gen-routines)"-    primTab  -> primTab{ tabGen = negate $ abs $ tabGen primTab }----idDoubles, idSines, idSines3, idSines2, idPartials, idSines4, idBuzzes, idConsts, idSegs, idCubes, idExps, idSplines,  idPolys, idChebs1, idChebs2, idBessels :: Int---- Human readable Csound identifiers for GEN-routines--idDoubles = 2-idSines = 10-idSines3 = 9-idSines2 = 9-idPartials = 9-idSines4 = 19-idBuzzes = 11-idConsts = 17-idSegs = 7-idCubes = 6-idExps = 5-idSplines = 8 -idPolys = 3-idChebs1 = 13-idChebs2 = 14-idBessels = 12
− src/Csound/Tfm/DeduceTypes.hs 
@@ -1,124 +0,0 @@-module Csound.Tfm.DeduceTypes(-    Var(..), TypeGraph(..), Convert(..), Stmt, deduceTypes    -) where--import Data.List(nub)-import qualified Data.Map as M-import qualified Data.IntMap as IM-import qualified Data.Traversable as T--import Data.STRef-import Control.Monad.ST-import Data.Array.ST--type TypeRequests s ty = STArray s Int [ty]--initTypeRequests :: Int -> ST s (TypeRequests s ty)-initTypeRequests size = newArray (0, size - 1) []--requestType :: Var ty -> TypeRequests s ty -> ST s ()-requestType v arr = modifyArray arr (varId v) (varType v :)--modifyArray :: Ix i => STArray s i a -> i -> (a -> a) -> ST s ()-modifyArray arr i f = writeArray arr i . f =<< readArray arr i--getTypes :: Int -> TypeRequests s ty -> ST s [ty]-getTypes n arr = readArray arr n---- | Typed variable.-data Var a = Var -    { varId   :: Int-    , varType :: a -    } deriving (Show, Eq, Ord)--data GetType ty     -    = NoConversion ty -    -- If there is a conversion we look for a fresh identifier by map -    -- (map converts mismatched type to fresh identifier)-    | ConversionLookup (M.Map ty Int)--type TypeMap ty = IM.IntMap (GetType ty)--lookupVar :: Ord a => TypeMap a -> Var a -> Var a-lookupVar m (Var i r) = case m IM.! i of-    NoConversion     ty -> Var i ty-    ConversionLookup f  -> Var (f M.! r) r---- Statement: assignment, like---    leftHandSide = RightHandSide( arguments )-type Stmt f a = (a, f a)---- When we haave type collisions we have to insert converters:-data Convert a = Convert-    { convertFrom   :: Var a-    , convertTo     :: Var a }--data Line f a = Line -    { lineType      :: (Int, GetType a) -    , lineStmt      :: Stmt f (Var a) -    , lineConverts  :: [Convert a] }---- Algorithm specification for the given functor 'f' and type labels of 'a'.-data TypeGraph f a = TypeGraph -    -- create a type conversion statement-    { mkConvert   :: Convert a -> Stmt f (Var a)-    -- for a given statement and a list of requested types for the output produces a pair of-    -- (nonConvertibleTypes, statementWithDeducedTypes)-    -- nonConvertibleTypes is used for insertion of converters.-    , defineType  :: Stmt f Int -> [a] -> ([a], Stmt f (Var a)) }---- | Deduces types for a dag:------ deduceTypes (functorSpecificFuns) (dag) = (dagWithTypes, lastFreshIdentifier)------ Assumption -- dag is labeled with integers. Labels are unique--- and a list of labels is a range (0, n) (It's just what we get with CSE algorithm). --- --- Algorithm proceeds as follows. We init an array of type requests and a reference for fresh identifiers. --- Type request comes from right hand side of the statement. We need fresh identifiers for converters.--- If we are going to use a new statement for conversion we need new variables.--- --- (discussLine)--- Then we process lines in reverse order and collect type requests by looking at right hand sides--- and writing type requests for all arguments. ------ (processLine)--- In the second run we substitute all identifiers with typed variables. It's no so strightforward--- due to converters. If there are converters we have to insert new statements and substitute identifiers--- with new ones. That's why we convert variables to variables in the processLine. ----deduceTypes :: (Ord a, T.Traversable f) => TypeGraph f a -> [Stmt f Int] -> ([Stmt f (Var a)], Int)-deduceTypes spec as = runST $ do-    freshIds <- newSTRef n-    typeRequests <- initTypeRequests n-    lines' <- mapM (discussLine spec typeRequests freshIds) $ reverse as-    let typeMap = IM.fromList $ fmap lineType lines'-    lastId <- readSTRef freshIds-    return (reverse $ processLine typeMap =<< lines', lastId)-    where n = length as-          processLine typeMap line = fmap (mkConvert spec) (lineConverts line) ++ [(a, fmap (lookupVar typeMap) b)]-              where (a, b) = lineStmt line            --discussLine :: (Ord a, T.Traversable f) => TypeGraph f a -> TypeRequests s a -> STRef s Int -> Stmt f Int -> ST s (Line f a)-discussLine spec typeRequests freshIds stmt@(pid, _) = do-    (conv, expr') <- fmap (defineType spec stmt . nub) $ getTypes pid typeRequests-    _ <- T.traverse (flip requestType typeRequests) (snd expr')-    let curType = fst expr'-    (getType, convs) <- mkGetType conv curType freshIds-    return $ Line (pid, getType) expr' convs--mkGetType :: Ord a => [a] -> Var a -> STRef s Int -> ST s (GetType a, [Convert a])-mkGetType typesToConvert curVar freshIds -    | null typesToConvert = return (NoConversion $ varType curVar, [])-    | otherwise = do-        ids <- nextIds n freshIds-        return (ConversionLookup $ M.fromList $ (varType curVar, varId curVar) : (zip typesToConvert ids), -                zipWith (\i t -> Convert curVar (Var i t)) ids typesToConvert)-    where n = length typesToConvert    --nextIds :: Int -> STRef s Int -> ST s [Int]-nextIds n ref = do-    curId <- readSTRef ref-    writeSTRef ref (curId + n)    -    return [curId .. n + curId]-
− src/Csound/Tfm/Tab.hs 
@@ -1,179 +0,0 @@-module Csound.Tfm.Tab(-    -- * index table-    Index(..), indexInsert,-    -- * strings-    getStrings, substNoteStrs,        -    -- * f-tables-    getInstrTabs, getPrimTabs,-    substInstrTabs, substNoteTabs, -    defineInstrTabs, defineNoteTabs,-    updateTabSize-) where--import Data.Default-import qualified Data.Map as M(Map, lookup, insert, fromList, (!))-import qualified Data.IntMap as IM(findWithDefault)--import Data.Fix(Fix(..), cata)-import Data.Foldable(foldMap)--import Csound.Exp--------------------------------------------------------------------------  --data Index a = Index -    { indexElems  :: M.Map a Int-    , indexLength :: Int }--indexInsert :: Ord a => a -> Index a -> (Int, Index a)-indexInsert a m = case M.lookup a (indexElems m) of-    Just n  -> (n, m)-    Nothing -> (len, m{ indexElems = M.insert a len (indexElems m), indexLength = succ len })-    where len = indexLength m--instance Ord a => Default (Index a) where-    def = Index (M.fromList []) 1--------------------------------------------------------------------------  strings--getStrings :: [Prim] -> [String]-getStrings xs = primStrings =<< xs--primStrings :: Prim -> [String]-primStrings x = case x of-    PrimString s -> [s]-    _ -> []--substNoteStrs :: StringMap -> Note -> Note-substNoteStrs m = fmap (substPrimStrs m)--substPrimStrs :: StringMap -> Prim -> Prim-substPrimStrs strs x = case x of-    PrimString s -> PrimInt (strs M.! s)-    _ -> x--------------------------------------------------------------------------------- Collects all tables from instruments [E] and notes [Prim]----    -getInstrTabs :: E -> [LowTab]-getInstrTabs = cata $ \re -> (maybe [] id $ ratedExpDepends re) ++ case fmap fromPrimOr $ ratedExpExp re of    -    ExpPrim p -> getPrimTabs p-    Tfm _ as -> concat as-    ConvertRate _ _ a -> a-    ExpNum a -> foldMap id a-    Select _ _ a -> a-    If info a b -> foldMap id info ++ a ++ b-    ReadVar _ -> []-    WriteVar _ a -> a-    InitVar _ _ -> []-    IfBegin _ -> []-    ExpBool _ -> []-    ElseIfBegin _ -> []-    ElseBegin -> []-    IfEnd -> []-    where fromPrimOr x = case unPrimOr x of-            Left  p -> getPrimTabs p-            Right a -> a--getPrimTabs :: Prim -> [LowTab]-getPrimTabs x = case x of-    PrimTab (Right t) -> [t]-    _ -> []--------------------------------------------------------------------------------- We substitute tables with their unique identifiers. TabMap defines the identifiers.---- substitutes tables in the instruments (orchestra)-substInstrTabs :: TabMap -> E -> E-substInstrTabs m = cata $ \re -> Fix $ re { ratedExpExp = fmap phi $ ratedExpExp re }-    where phi x = case unPrimOr x of-            Left p -> PrimOr $ Left $ substPrimTab m p-            _ -> x ---- substitutes tables in the notes (score)-substNoteTabs :: TabMap -> Note -> Note-substNoteTabs m = fmap (substPrimTab m)---- substitute table in the primitive value.-substPrimTab :: TabMap -> Prim -> Prim-substPrimTab m x = case x of -    PrimTab (Right tab) -> PrimInt (m M.! tab)-    _ -> x--------------------------------------------------------------------------------- Defining tables------ To define table means to transform all relative parameters to absolute.--- Relative parameters (size or points in the case of tables for interpolation)--- are set from renderer settings. User can change them globally.------- defines tables for an instrument-defineInstrTabs :: TabFi -> E -> E-defineInstrTabs n = cata $ \re -> Fix $ re { ratedExpExp = fmap phi $ ratedExpExp re }-    where phi x = case unPrimOr x of-            Left p -> PrimOr $ Left $ definePrimTab n p-            _ -> x ---- define tables for a note-defineNoteTabs :: TabFi -> Note -> Note-defineNoteTabs n = fmap (definePrimTab n)---- define table for a primitive value-definePrimTab :: TabFi -> Prim -> Prim-definePrimTab n x = case x of-    PrimTab (Left tab) -> PrimTab (Right $ defineTab n tab)-    _ -> x---- set all relative parameters to absolute. -defineTab :: TabFi -> Tab -> LowTab-defineTab tabFi tab = LowTab size (tabGen tab) args-    where size = defineTabSize (getTabSizeBase tabFi tab) (tabSize tab)-          args = defineTabArgs size (tabArgs tab)--getTabSizeBase :: TabFi -> Tab -> Int-getTabSizeBase tf tab = IM.findWithDefault (tabFiBase tf) (tabGen tab) (tabFiGens tf)--defineTabArgs :: Int -> TabArgs -> [Double] -defineTabArgs size args = case args of-    ArgsPlain as -> as -    ArgsRelative as -> fromRelative size as-    where fromRelative n as = substEvens (mkRelative n $ getEvens as) as-          getEvens xs = case xs of-            [] -> []-            _:[] -> []-            _:b:as -> b : getEvens as-            -          substEvens evens xs = case (evens, xs) of-            ([], as) -> as-            (_, []) -> []-            (e:es, a:_:as) -> a : e : substEvens es as-            _ -> error "table argument list should contain even number of elements"-            -          mkRelative n as = fmap ((fromIntegral :: (Int -> Double)) . round . (s * )) as-            where s = fromIntegral n / sum as-            --defineTabSize :: Int -> TabSize -> Int-defineTabSize base x = case x of-       SizePlain n -> n-       SizeDegree guardPoint degree ->          -                byGuardPoint guardPoint $-                byDegree base degree-    where byGuardPoint guardPoint -            | guardPoint = (+ 1)-            | otherwise  = id-            -          byDegree zero n = 2 ^ max 0 (zero + n) --------------------------------------------------------------------------------- change table size--updateTabSize :: (TabSize -> TabSize) -> Tab -> Tab-updateTabSize phi x = case x of-    TabExp _ -> error "you can change size only for primitive tables (made with gen-routines)"-    primTab  -> primTab{ tabSize = phi $ tabSize primTab }-
− src/Csound/Tfm/UnfoldMultiOuts.hs 
@@ -1,70 +0,0 @@-{-# Language TupleSections #-}-module Csound.Tfm.UnfoldMultiOuts(-    unfoldMultiOuts, UnfoldMultiOuts(..), Selector(..)-) where--import Data.List(sortBy)-import Data.Ord(comparing)-import Data.Maybe(mapMaybe, isNothing)-import Control.Monad.Trans.State.Strict-import qualified Data.IntMap as IM--import Csound.Tfm.DeduceTypes(Var(..))--type ChildrenMap = IM.IntMap [Port]--lookupChildren :: ChildrenMap -> Var a -> [Port]-lookupChildren m parentVar = m IM.! varId parentVar--mkChildrenMap :: [(Var a, Selector a)] -> ChildrenMap-mkChildrenMap = IM.fromListWith (++) . fmap extract -    where extract (var, sel) = (varId $ selectorParent sel, -                                return $ Port (varId var) (selectorOrder sel))--data Port = Port -    { portId    :: Int-    , portOrder :: Int } deriving (Show)--type SingleStmt f a = (Var a, f (Var a))-type MultiStmt  f a = ([Var a], f (Var a))--data Selector a = Selector -    { selectorParent  :: Var a-    , selectorOrder   :: Int }--data UnfoldMultiOuts f a = UnfoldMultiOuts {-    getSelector    :: f (Var a) -> Maybe (Selector a),-    getParentTypes :: f (Var a) -> Maybe [a] }--unfoldMultiOuts :: UnfoldMultiOuts f a -> Int -> [SingleStmt f a] -> [MultiStmt f a]-unfoldMultiOuts algSpec lastFreshId stmts = evalState st lastFreshId-    where selectors = mapMaybe (\(lhs, rhs) -> fmap (lhs,) $ getSelector algSpec rhs) stmts-          st = mapM (unfoldStmt algSpec $ mkChildrenMap selectors) $ dropSelectors stmts-          dropSelectors = filter (isNothing . getSelector algSpec . snd)--unfoldStmt :: UnfoldMultiOuts f a -> ChildrenMap -> SingleStmt f a -> State Int (MultiStmt f a)-unfoldStmt algSpec childrenMap (lhs, rhs) = case getParentTypes algSpec rhs of-    Nothing    -> return ([lhs], rhs)-    Just types -> fmap (,rhs) $ formLhs (lookupChildren childrenMap lhs) types--formLhs :: [Port] -> [a] -> State Int [Var a]-formLhs ports types = fmap (zipWith (flip Var) types) (getPorts ports)-    where getPorts ps = state $ \lastFreshId -> -            let ps' = sortBy (comparing portOrder) ps-                (ids, lastPortOrder) = runState (mapM (fillMissingPorts lastFreshId) ps') 0-                freshIdForTail = 1 + lastFreshId + inUsePortsSize-                tailIds = map (+ freshIdForTail) [0 .. outputArity - 1 - lastPortOrder]-            in  (concat ids ++ tailIds, lastFreshId + outputArity - inUsePortsSize)--          outputArity = length types    -          inUsePortsSize = length ports  -                                -          fillMissingPorts :: Int -> Port -> State Int [Int]-          fillMissingPorts lastFreshId port = state $ \s ->-                if s == order-                then ([e], next) -                else (fmap (+ lastFreshId) [s .. order - 1] ++ [e], next)-            where e = portId port-                  order = portOrder port                  -                  next = order + 1-
+ src/Csound/Types.hs view
@@ -0,0 +1,84 @@+-- | The Csound types.+--+-- There are several primitive types:+--+-- * @Sig@ - signals+--+-- * @D@ - numbers+--+-- * @Str@ - strings+--+-- * @Tab@ - 1-dimensional arrays+--+-- * @Spec@ and @Wspec@ - sound spectrums+--+--  A signal is a stream of numbers. Signals carry sound or time varied +--  control values. Numbers are constants. 1-dimensional arrays contain some useful+--  data which is calculated at the initial run of the program.+--+-- There is only one compound type. It's a tuple of Csound values. The empty tuple+-- is signified with special type called @Unit@. +--+module Csound.Types(+    -- * Primitive types    +    Sig, D, Tab, Str, Spec, Wspec,    +    BoolSig, BoolD, Val(..), SigOrD,++    -- ** Constructors+    double, int, text, +    +    -- ** Constants+    idur, getSampleRate, getControlRate, getBlockSize,++    -- ** Converters+    ar, kr, ir, sig,++    -- ** Init values+    withInits, withDs, withSigs, withTabs, +    withD, withSig, withTab, withSeed,++    -- ** Numeric functions+    quot', rem', div', mod', ceil', floor', round', int', frac',        +   +    -- ** Logic functions+    boolSig, when1, whens, ++    -- ** Aliases +    -- | Handy for functions that return tuples to specify the utput type+    --+    -- > (aleft, aright) = ar2 $ diskin2 "file.wav" 1+    -- +    -- or+    --+    -- > asig = ar1 $ diskin2 "file.wav" 1+    Sig2, Sig4, Sig6, Sig8,+    ar1, ar2, ar4, ar6, ar8,++    -- * Tuples+    Tuple(..), makeTupleMethods, Unit, unit,+    -- *** Logic functions+    ifTuple, guardedTuple, caseTuple, +    +    -- * Instruments    ++    -- | An instrument is a function that takes a tpule of csound values as an argument+    -- and returns a tuple of signals as an output. The type of the instrument is:+    --+    -- > (Arg a, Out b) => a -> b++    -- ** Arguments+    Arg,+    -- *** Logic functions+    ifArg, guardedArg, caseArg,++    -- ** Outputs+    Sigs+) where++import Csound.Typed.Types++type Sig2 = (Sig, Sig)+type Sig4 = (Sig, Sig, Sig, Sig)+type Sig6 = (Sig, Sig, Sig, Sig, Sig, Sig)+type Sig8 = (Sig, Sig, Sig, Sig, Sig, Sig, Sig, Sig)+