csound-expression 1.0.2 → 1.0.3

raw patch · 20 files changed

+1384/−403 lines, 20 filesPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

API changes (from Hackage documentation)

Files

• csound-expression.cabal +3/−4
• src/Csound/Air.hs +231/−0
• src/Csound/Base.hs +228/−26
• src/Csound/Exp.hs +63/−90
• src/Csound/Exp/Cons.hs +8/−1
• src/Csound/Exp/Logic.hs +41/−3
• src/Csound/Exp/Numeric.hs +146/−78
• src/Csound/Exp/Wrapper.hs +164/−54
• src/Csound/LowLevel.hs +1/−2
• src/Csound/Opcode.hs +3/−2
• src/Csound/Opcode/Advanced.hs +21/−5
• src/Csound/Opcode/Basic.hs +54/−5
• src/Csound/Opcode/Data.hs +5/−51
• src/Csound/Opcode/Interaction.hs +2/−2
• src/Csound/Render.hs +13/−20
• src/Csound/Render/Instr.hs +24/−12
• src/Csound/Render/Options.hs +9/−6
• src/Csound/Render/Pretty.hs +10/−10
• src/Csound/Render/Sco.hs +16/−32
• src/Csound/Tab.hs +342/−0

@@ -1,5 +1,5 @@ Name:          csound-expression-Version:       1.0.2+Version:       1.0.3 Cabal-Version: >= 1.6 License:       BSD3 License-file:  LICENSE@@ -38,9 +38,6 @@     * Make low level opcode definitions simple. Let user define his own opcodes (if they are missing).     .     * Make it independent from any Score-generation library. Let user choose his favorite library.-    By the way, my favorite is the package 'temporal-music-notation' (but i'm biased as an author). You can-    find it on hackage alongside with 'temporal-csound'. It brings 'csound-expression' and 'temporal-music-notation'-    together.      .     * 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@@ -74,6 +71,8 @@   Hs-Source-Dirs:      src/   Exposed-Modules:         Csound.Base+        Csound.Air+        Csound.Tab         Csound.LowLevel         Csound.Opcode         Csound.Opcode.Basic

@@ -0,0 +1,231 @@+-- | The vital tools.+module Csound.Air (+    -- * Oscillators+    +    -- ** Bipolar+    osc, saw, sq, tri, -- pulse, ramp,+    +    -- ** Unipolar+    unipolar, uosc, usaw, usq, utri, -- upulse, uramp,+    +    -- * Filters+    -- | Arguemnts are inversed to get most out of curruing. First come parameters and the last one is the signal.+    +    -- ** Simple filters+    lp, hp, bp, br,+    +    -- ** Butterworth filters+    blp, bhp, bbp, bbr,+    +    -- * Patterns+    once, mean,+    +    -- ** Series+    hase, whase,+    haseS, whaseS,+    +    -- ** Crossfade+    cfd, cfds, cfdSpec, cfdsSpec+) where++import Csound.Exp(Tab)+import Csound.Exp.Wrapper(Sig, Spec, SE, kr)+import Csound.Exp.Cons(withInits)+import Csound.Exp.Numeric+import Csound.Opcode(idur, oscil3, vco, pvscross, +    atone, tone, areson, reson,+    buthp, butbp, butlp, butbr)+import Csound.Tab(hifi, sines, guardPoint)++--------------------------------------------------------------------------+-- oscillators++-- | Pure tone.+osc :: Sig -> Sig+osc cps = oscil3 1 cps (sines [1])++resolution = 12++-- | Sawtooth.+saw :: Sig -> Sig+saw cps = oscil3 1 cps (sines $ take resolution $ fmap (1 / ) [1 .. ])+-- vco 1 cps 1 0.5 `withInits` (sines [1])+++-- | Square wave.+sq :: Sig -> Sig+sq cps = oscil3 1 cps (sines $ take resolution $ fmap f [1 .. ])+    where f x+            | even x    = 0+            | otherwise = 1 / fromIntegral x+-- vco 1 cps 2 0.5 `withInits` (sines [1])++-- | Triangle wave.+tri :: Sig -> Sig+tri cps = oscil3 1 cps (sines $ take resolution $ zipWith f (cycle [1, -1]) [1 ..])+    where f a x+            | even x    = 0+            | otherwise = a / fromIntegral (x ^ 2)+-- vco 1 cps 3 0.5 `withInits` (sines [1])++{-+-- | 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])++-- | 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])+-}++-- unipolar waves++-- | 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++-- | Unipolar pure tone.+uosc :: Sig -> Sig+uosc = unipolar . osc++-- | Unipolar sawtooth.+usaw :: Sig -> Sig+usaw = unipolar . saw++-- | Unipolar square wave.+usq :: Sig -> Sig+usq = unipolar . sq++-- | Unipolar triangle wave.+utri :: Sig -> Sig+utri = unipolar . tri++{-+-- | Unipolar pulse.+upulse :: Sig -> Sig -> Sig+upulse a = unipolar . pulse a++uramp :: Sig -> Sig -> Sig+uramp a = unipolar . ramp a+-}+--------------------------------------------------------------------------+-- filters++-- | High-pass filter.+--+-- > hp cutoff sig+hp :: Sig -> Sig -> Sig+hp = flip atone++-- | Low-pass filter.+--+-- > lp cutoff sig+lp :: Sig -> Sig -> Sig+lp = flip tone++-- | Band-pass filter.+--+-- > bp cutoff bandwidth sig+bp :: Sig -> Sig -> Sig -> Sig+bp freq band a = reson a freq band++-- | Band-regect filter.+--+-- > br cutoff bandwidth sig+br :: Sig -> Sig -> Sig -> Sig +br freq band a = areson a freq band++-- Butterworth filters++-- | High-pass filter.+--+-- > bhp cutoff sig+bhp :: Sig -> Sig -> Sig+bhp = flip buthp++-- | Low-pass filter.+--+-- > blp cutoff sig+blp :: Sig -> Sig -> Sig+blp = flip butlp++-- | Band-pass filter.+--+-- > bbp cutoff bandwidth sig+bbp :: Sig -> Sig -> Sig -> Sig+bbp freq band a = butbp a freq band++-- | Band-regect filter.+--+-- > bbr cutoff bandwidth sig+bbr :: Sig -> Sig -> Sig -> Sig +bbr freq band a = butbr a freq band+++--------------------------------------------------------------------------+-- patterns++-- | Reads table once during the note length. +once :: Tab -> Sig+once a = oscil3 1 (1 / kr idur) a++-- | 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++-- | 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++-- | 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+++-- | 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 :: 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.+--+-- > cfds coeffs sigs+cfds :: [Sig] -> [Sig] -> Sig+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++    

@@ -1,42 +1,234 @@ -- | Basic types and functions. ----- Example (a concert A)------ > module Main where--- > --- > import Csound.Base--- > --- > osc :: Sig -> Sig--- > osc phs = oscil1 1 phs (genHigh 10 [1])--- > --- > instr :: D -> Out--- > instr pch = out $ 0.5 * (osc $ kr pch)--- > --- > res = score instr [(0, 1, 440)]--- > --- > main :: IO ()--- > main = writeFile "tmp.csd" $ renderCsd [res]------ Now you can invoke Csound on tmp.csd and listen to the result with your favourite player.------ > csound tmp.csd -o a.wav+-- 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 music is divided in two parts:+    --+    -- 1. Orchestra. User defines instruments+    --+    -- 2. Scores. User triggers instruments with a list of notes+    --+    -- Ab 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. In 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 (list of signals).+    --+    -- Later when you are done with orchestra section you can trigger the instruments with the function 'Csound.Base.score'+    --+    -- > score :: (Arg a, Out b) => (a -> b) -> [(Double, Double, a)] -> SigOut+    --+    -- It takes an instrument and the list of notes for this instrument. I've said that in Csound note contains+    -- four elements. But here it has only three because we define all notes at the time for one instrument.+    -- No need to label instrument with names explicitly. arguments-like thing is something that can be converted+    -- to the tuple of primitive values. There are a lot of predefined instances.+    --+    -- This library doesn't help you with score section that much. Scores are the same as you would write them with Csound.+    -- It's a list of events. Haskell can help you with powerful functions for lists but it's not so convenient as it+    -- can be. It's so on purpose. Csound-expression stays clear from score-generation libraries. But you can use+    -- your favourite library to create complex scores. You can use temporal-music-notation or Haskore or Euterpea.+    -- Any library that can generate the list of events 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]+    --+    -- Constants are converted to signals with them also.+    +    -- *** 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.Adoptions').+    -- I've tried to hide the size definition to make sings easier.     +    +    -- ** How to read the Csound docs+    +    -- | I'm to lazy to rewrite the Csound docs for all opcodes so 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 kr 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 $ kr cps)+    -- > +    -- > -- Let's trigger the instrument from the score section.+    -- > -- It plays a single note that starts at 0 and lasts for 1 second and +    -- > -- triggers the instrument 'instr' with frequency of 440 (Hz).+    -- > res = score pureTone [(0, 1, 440)]+    -- > +    -- > -- Renders generated csd-file to the "tmp.csd".+    -- > main :: IO ()+    -- > main = writeFile "tmp.csd" $ renderCsd [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.+    +    -- ** 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 Csound catalog: <http://www.music.buffalo.edu/hiller/accci/>+    --+    -- * 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,          -- ** Constants          -- | A constant value doesn't change while instrument is playing a note.     -- Only constants can be passed as arguments to the instruments.-    D, I, Tab, Str,+    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.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, BoolSig, Spec,+    Sig, Spec,+   +    -- ** Booleans+    -- | Use functions from the module "Data.Boolean" to make boolean expressions.+    BoolSig, BoolD,       module Data.Boolean,      -- ** Side effects@@ -46,12 +238,15 @@     CsdTuple,          -- ** Converters-    ToSig(..), ir, int, double, str,          +    ToSig(..), ir, double, str,                        -- * Making a sound     -    -- | Let's make some noise. Sound is build from list of tracks ("SigOut").-    Out, SigOut, effect, out, outs,  +    -- | Let's make some noise. Sound is build from list of tracks ('SigOut').+    Out, SigOut, effect, +    +    -- ** Handy short-cuts+    Outs, Sig2, Sig3, Sig4,           -- ** Scores     -- | We can define an instrument and tell it to play some notes.@@ -62,7 +257,7 @@     Msg, massign, pgmassign,      -- ** Rendering-    -- | Now we are ready to create a csound-file. The function "renderCsd" creates a 'String' that+    -- | 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,@@ -70,6 +265,10 @@     -- ** Opcodes         -- | Some colors to paint our soundscapes.     module Csound.Opcode,+    +    -- ** Patterns+    -- | Frequently used combinations of opcodes.+    module Csound.Air,              -- ** Options     -- | We can set some csound options.@@ -80,9 +279,12 @@ import Data.Default import Data.Boolean +import Csound.Air + import Csound.Exp import Csound.Exp.Cons import Csound.Exp.Wrapper+import Csound.Tab import Csound.Opcode import Csound.Exp.Numeric import Csound.Exp.Logic

@@ -1,11 +1,12 @@+{-# Language DeriveFunctor, DeriveFoldable, DeriveTraversable #-} module Csound.Exp(     E, RatedExp(..), RatedVar(..), onExp, Exp, toPrimOr, PrimOr(..), MainExp(..), Name,     VarType(..), Var(..), Info(..), OpcType(..), Rate(..),      Signature(..), isProcedure, isInfix, isPrefix,    -    Prim(..), Tab(..), TabMap,+    Prim(..), LowTab(..), Tab(..), TabSize(..), TabArgs(..), TabMap,     Inline(..), InlineExp(..), PreInline(..),     BoolExp, CondInfo, CondOp(..), isTrue, isFalse,    -    NumExp, NumOp(..)    +    NumExp, NumOp(..), Msg(..), Note, Event(..), eventEnd,    ) where  import Control.Applicative@@ -13,6 +14,8 @@ 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@@ -27,7 +30,7 @@     { ratedExpRate      :: Maybe Rate     , ratedExpDepends   :: Maybe a     , ratedExpExp       :: Exp a-    } deriving (Show, Eq, Ord)+    } deriving (Show, Eq, Ord, Functor, Foldable, Traversable)  data RatedVar = RatedVar      { ratedVarRate :: Rate @@ -49,7 +52,7 @@     _         -> Right a  newtype PrimOr a = PrimOr { unPrimOr :: Either Prim a }-    deriving (Show, Eq, Ord)+    deriving (Show, Eq, Ord, Functor)  data MainExp a      = ExpPrim Prim@@ -61,7 +64,7 @@     | ExpNum (NumExp a)     | ReadVar Var     | WriteVar Var a    -    deriving (Show, Eq, Ord)  +    deriving (Show, Eq, Ord, Functor, Foldable, Traversable)    data Var      = Var@@ -106,26 +109,67 @@     | PString Int       -- >> p-string:      | PrimInt Int      | PrimDouble Double -    | PrimTab Tab +    | PrimTab (Either Tab LowTab)     | PrimString String      deriving (Show, Eq, Ord)    -type TabMap = M.Map Tab Int- --- | Csound f-tables. You can make a value of 'Tab' with the function 'gen'.-data Tab = Tab -    { tabSize    :: Int-    , tabGen     :: Int-    , tabArgs    :: [Double]+type TabMap = M.Map LowTab Int++data LowTab = LowTab +    { lowTabSize    :: Int+    , lowTabGen     :: Int+    , lowTabArgs    :: [Double]     } deriving (Show, Eq, Ord) +-- | 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 }++data TabSize +    = SizePlain Int+    | SizeDegree +    { hasGuardPoint :: Bool+    , sizeDegree    :: Int +    } deriving (Show, Eq, Ord)+    +data TabArgs +    = ArgsPlain [Double]+    | ArgsRelative [Double]+    deriving (Show, Eq, Ord)++-- | Midi messages.+data Msg = Msg++type Note = [Prim]++data Event a = Event +    { eventStart :: Double+    , eventDur   :: Double+    , eventContent :: a }+    +eventEnd e = eventStart e + eventDur e++instance Functor Event where+    fmap f a = a{ eventContent = f $ eventContent a }+ ------------------------------------------------------------ -- types for arithmetic and boolean expressions  data Inline a b = Inline      { inlineExp :: InlineExp a     , inlineEnv :: IM.IntMap b    -    } deriving (Show, Eq, Ord)+    } deriving (Show, Eq, Ord, Functor, Foldable, Traversable)  data InlineExp a     = InlinePrim Int@@ -133,7 +177,7 @@     deriving (Show, Eq, Ord)  data PreInline a b = PreInline a [b]-    deriving (Show, Eq, Ord)+    deriving (Show, Eq, Ord, Functor, Foldable, Traversable)  -- booleans @@ -165,92 +209,21 @@     = Add | Sub | Neg | Mul | Div     | Pow | Mod      | Sin | Cos | Sinh | Cosh | Tan | Tanh | Sininv | Cosinv | Taninv-    | Abs | Ceil | ExpOp | Floor | Frac| IntOp | Log | Log10 | Logbtwo | Round | Sqrt    +    | Ceil | Floor | Frac | Round | IntOp+    | Abs | ExpOp | Log | Log10 | Logbtwo | Sqrt         | Ampdb | Ampdbfs | Dbamp | Dbfsamp      | Cpspch     deriving (Show, Eq, Ord)  ---------------------------------------------------------- instances for cse--instance Functor RatedExp where-    fmap f (RatedExp r d a) = RatedExp r (fmap f d) (fmap (fmap f) a)--instance Foldable RatedExp where-    foldMap f (RatedExp _ d a) = foldMap f d <> foldMap (foldMap f) a-    -instance Traversable RatedExp where-    traverse f (RatedExp r d a) = RatedExp r <$> traverse f d <*> traverse (traverse f) a--instance Functor PrimOr where-    fmap f (PrimOr a) = PrimOr (fmap f a)+-- instances for cse that ghc was not able to derive for me -instance Foldable PrimOr where-    foldMap f x = case unPrimOr x of-        Left _  -> mempty-        Right a -> f a+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--instance Functor MainExp where-    fmap f x = case x of-        ExpPrim p -> ExpPrim p-        Tfm t xs -> Tfm t $ map f xs-        ConvertRate ra rb a -> ConvertRate ra rb $ f a-        Select r n a -> Select r n $ f a-        If info a b -> If (fmap f info) (f a) (f b)-        ExpBool a -> ExpBool $ fmap f a-        ExpNum  a -> ExpNum  $ fmap f a-        ReadVar v -> ReadVar v-        WriteVar v a -> WriteVar v (f a)        ---instance Foldable MainExp where-    foldMap f x = case x of-        ExpPrim p -> mempty-        Tfm t xs -> foldMap f xs-        ConvertRate ra rb a -> f a-        Select r n a -> f a-        If info a b -> foldMap f info <> f a <> f b-        ExpBool a -> foldMap f a-        ExpNum  a -> foldMap f a-        ReadVar v -> mempty-        WriteVar v a -> f a-        -instance Traversable MainExp where-    traverse f x = case x of-        ExpPrim p -> pure $ ExpPrim p-        Tfm t xs -> Tfm t <$> traverse f xs-        ConvertRate ra rb a -> ConvertRate ra rb <$> f a-        Select r n a -> Select r n <$> f a-        If info a b -> If <$> traverse f info <*> f a <*> f b-        ExpBool a -> ExpBool <$> traverse f a-        ExpNum  a -> ExpNum  <$> traverse f a-        ReadVar v -> pure $ ReadVar v-        WriteVar v a -> WriteVar v <$> f a--instance Functor (Inline a) where-    fmap f a = a{ inlineEnv = fmap f $ inlineEnv a }--instance Foldable (Inline a) where-    foldMap f a = foldMap f $ inlineEnv a--instance Traversable (Inline a) where-    traverse f (Inline a b) = Inline a <$> traverse f b--instance Functor (PreInline a) where-    fmap f (PreInline op as) = PreInline op $ fmap f as--instance Foldable (PreInline a) where-    foldMap f (PreInline _ as) = foldMap f as--instance Traversable (PreInline a) where-    traverse f (PreInline op as) = PreInline op <$> traverse f as--  -- comments -- 

@@ -3,7 +3,7 @@     toE, fromE,     withInits,     bi,-    opcs, opc0, opc1, opc2, opc3, opc4, opc5, opc6, opc7, opc8, opc9, opc10, opc11,+    opcs, opc0, opc1, opc2, opc3, opc4, opc5, opc6, opc7, opc8, opc9, opc10, opc11, opc12,     mopcs, mopc0, mopc1, mopc2, mopc3, mopc4, mopc5, mopc6, mopc7 ) where @@ -101,6 +101,9 @@ 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 [unwrap a1, unwrap a2, unwrap a3, unwrap a4, unwrap a5, unwrap a6, unwrap a7, unwrap a8, unwrap a9, unwrap a10, unwrap 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 [unwrap a1, unwrap a2, unwrap a3, unwrap a4, unwrap a5, unwrap a6, unwrap a7, unwrap a8, unwrap a9, unwrap a10, unwrap a11, unwrap a12]+ ------------------------------- -- single out @@ -147,6 +150,10 @@  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 outs

@@ -11,6 +11,8 @@ import Csound.Exp.Wrapper import Csound.Exp +-- booleans for signals+ instance Boolean BoolSig where     true = boolOp0 TrueOp     false = boolOp0 FalseOp@@ -33,12 +35,50 @@     (<=*) = boolOp2 LessEquals     (>=*) = boolOp2 GreaterEquals +-- booleans for inits++instance Boolean BoolD where+    true = boolOp0 TrueOp+    false = boolOp0 FalseOp+    notB = BoolD . notE . unBoolD+    (&&*) = boolOp2 And+    (||*) = boolOp2 Or++type instance BooleanOf D = BoolD++instance IfB D where+    ifB = cond'+    +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 = cond'++-- booleans for strings++type instance BooleanOf Str = BoolD++instance IfB Str where+    ifB = cond'+ -------------------------------------------- -- if-then-else  boolExp = PreInline -cond' :: BoolSig -> Sig -> Sig -> Sig+cond' :: (Val bool, Val a) => bool -> a -> a -> a cond' p t e = wrap $ mkCond (condInfo $ toPrimOr $ Fix $ unwrap p) (unwrap t) (unwrap e)     where mkCond :: CondInfo (PrimOr E) -> RatedExp E -> RatedExp E -> RatedExp E           mkCond p t e @@ -86,6 +126,4 @@             Greater           -> boolExp LessEquals     args             LessEquals        -> boolExp Greater        args             GreaterEquals     -> boolExp Less           args     --    

@@ -1,5 +1,8 @@ {-# Language TypeSynonymInstances, FlexibleInstances #-}-module Csound.Exp.Numeric() where+module Csound.Exp.Numeric(+    fracD, floorD, ceilD, intD, roundD,+    fracSig, floorSig, ceilSig, intSig, roundSig+) where  import Data.Maybe(fromJust) import Control.Applicative@@ -13,22 +16,15 @@ -- instances for numerical expressions  class NumOpt a where-    maybeInt    :: a -> Maybe Int     maybeDouble :: a -> Maybe Double-    fromInt     :: Int -> a     fromDouble  :: Double -> a     fromNum     :: NumExp a -> a  instance NumOpt E where-    maybeInt x = case ratedExpExp $ unFix x of-        ExpPrim (PrimInt n) -> Just n-        _ -> Nothing-          maybeDouble x = case ratedExpExp $ unFix x of         ExpPrim (PrimDouble d) -> Just d-        _ -> Nothing-    -    fromInt = prim . PrimInt+        _ -> Nothing   +     fromDouble = prim . PrimDouble     fromNum = noRate . ExpNum . fmap toPrimOr    @@ -39,28 +35,28 @@     (+) a b          | isZero a = b         | isZero b = a-        | otherwise = biOpt (+) (+) Add a b+        | otherwise = biOpt (+) Add a b              (*) a b -        | isZero a || isZero b = fromInt 0-        | otherwise = biOpt (*) (*) Mul 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    +        | otherwise = biOpt (-) Sub a b         -    negate = unOpt negate negate Neg+    negate = unOpt negate Neg     -    fromInteger = fromInt . fromInteger-    abs = unOpt abs abs Abs+    fromInteger = fromDouble . fromInteger+    abs = unOpt abs Abs     signum = undefined  instance Fractional E where     (/) a b -        | isZero a = fromInt 0+        | isZero a = fromDouble 0         | isZero b = error "csound (/): division by zero" -        | otherwise = biOptOnDouble (/) Div a b+        | otherwise = biOpt (/) Div a b      fromRational = fromDouble . fromRational     @@ -73,7 +69,7 @@         2 -> funOpt (flip logBase 2) Logbtwo a         10 -> funOpt (flip logBase 10) Log10 a         b -> log a / log b-    (**) = biOpt (^) (**) Pow+    (**) = biOpt (**) Pow     sin = funOpt sin Sin      tan = funOpt tan Tan     cos = funOpt cos Cos@@ -87,33 +83,37 @@     acosh a = log $ a + sqrt (a + 1) * sqrt (a - 1)     atanh a = 0.5 * log ((1 + a) / (1 - a)) -{-    +enumError name = error $ name ++ " -- is defined only for literals"+     instance Enum E where     succ = (+1)     pred = \x -> x - 1-    toEnum = fromInt+    toEnum = fromDouble . fromIntegral+    fromEnum = undefined     enumFrom a = a : enumFrom (a+1)-    enumFromThen a b = a : enumFromThen (a+b) b-    enumFromTo = undefined-    enumFromThenTo = undefined-        -instance Real E where-    toRational = undefined+    +    enumFromThen a b = a : enumFromThen (a + b) b+     +    enumFromTo a b = case (maybeDouble a, maybeDouble b) of+        (Just x, Just y) -> fmap fromDouble $ enumFromTo x y+        _ -> enumError "[a .. b]"+            +    enumFromThenTo a b c = case (maybeDouble a, maybeDouble b, maybeDouble c) of+        (Just x, Just y, Just z) -> fmap fromDouble $ enumFromThenTo x y z+        _ -> enumError "[a, b .. c]"+    +    +instance Real E where toRational = undefined          instance Integral E where-    quot a b = truncate $ (truncate a) / (truncate b)-    rem a b = (a `quot` b)*b - a+    quot a b = intE $ (intE a) / (intE b)+    rem a b = (a `quot` b) * b - a     mod = mod'-    div a b = truncate $ a - mod a b / b+    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    -    -instance RealFrac E where-    properFraction a = (floor' a, frac' a)-    truncate = truncate'-    floor = floor'-    ceiling = ceil'-    round = round' . kr    --}        + onE1 :: (Val a, Val b) => (E -> E) -> (a -> b) onE1 f = wrap . unFix . f . Fix . unwrap @@ -126,16 +126,97 @@ ------------------------------------------- -- wrappers -instance Num Sig where    -    (+) = onE2 (+)-    (*) = onE2 (*)-    (-) = onE2 (-)-    negate = onE1 negate-    fromInteger = onConst fromInteger-    abs = onE1 abs-    signum = onE1 signum+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 Num I where+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 (-)@@ -204,34 +285,22 @@ ------------------------------------------------------------  isZero :: NumOpt a => a -> Bool-isZero a = maybe False id $ liftA2 (||) ((== 0) <$> maybeInt a) ((==0) <$> maybeDouble a)--getDouble :: NumOpt a => a -> Maybe Double-getDouble a = maybe (fromIntegral <$> maybeInt a) Just $ maybeDouble a +isZero a = maybe False id $ ((==0) <$> maybeDouble a) -unOpt :: (NumOpt a) => (Int -> Int) -> (Double -> Double) -> NumOp -> a -> a-unOpt intOp doubleOp op a = fromJust $-        (fromInt . intOp <$> maybeInt a)-    <|> (fromDouble . doubleOp <$> maybeDouble a)+unOpt :: (NumOpt a) => (Double -> Double) -> NumOp -> a -> a+unOpt doubleOp op a = fromJust $+        (fromDouble . doubleOp <$> maybeDouble a)     <|> Just (noOpt1 op a) -biOpt :: (NumOpt a) => (Int -> Int -> Int) -> (Double -> Double -> Double) -> NumOp -> a -> a -> a-biOpt intOp doubleOp op a b = fromJust $-        intOpA (maybeInt a) (maybeInt b) -    <|> doubleOpA (getDouble a) (getDouble b)-    <|> Just (noOpt2 op a b)-    where intOpA a b = fromInt <$> liftA2 intOp a b-          doubleOpA a b = fromDouble <$> liftA2 doubleOp a b--biOptOnDouble :: (NumOpt a) => (Double -> Double -> Double) -> NumOp -> a -> a -> a-biOptOnDouble doubleOp op a b = fromJust $-        (fromDouble <$> liftA2 doubleOp (getDouble a) (getDouble b))+biOpt :: (NumOpt a) => (Double -> Double -> Double) -> NumOp -> a -> a -> a+biOpt doubleOp op a b = fromJust $+        (fromDouble <$> liftA2 doubleOp (maybeDouble a) (maybeDouble b))     <|> Just (noOpt2 op a b)            funOpt :: NumOpt a => (Double -> Double) -> NumOp -> a -> a funOpt doubleOp op a = fromJust $-        (fromDouble . doubleOp <$> getDouble a)+        (fromDouble . doubleOp <$> maybeDouble a)     <|> Just (noOpt1 op a)  noOpt1 :: NumOpt a => NumOp -> a -> a@@ -241,25 +310,24 @@ noOpt2 op a b = fromNum $ PreInline op [a, b]  doubleToInt :: NumOpt a => (Double -> Int) -> NumOp -> a -> a-doubleToInt fun op a = fromJust $-        (fromInt <$> maybeInt a)-    <|> (fromInt . fun <$> maybeDouble a)+doubleToInt fun op a = fromJust $        +        (fromDouble . fromIntegral . fun <$> maybeDouble a)     <|> Just (noOpt1 op a)  -- arithmetic  mod' :: NumOpt a => a -> a -> a-mod' = biOpt mod (\a b -> fromIntegral $ mod (floor a) (floor b)) Pow+mod' = biOpt (\a b -> fromIntegral $ mod (floor a) (floor b)) Pow   -- other functions -ceil', floor', frac', int', round' :: NumOpt a => a -> a+ceilE, floorE, fracE, intE, roundE :: E -> E -ceil'   = doubleToInt ceiling Ceil -floor'  = doubleToInt floor Floor-round'  = doubleToInt round Round-frac'   = unOpt (const 0) (snd . properFraction) Frac -int'    = doubleToInt truncate IntOp +ceilE   = doubleToInt ceiling Ceil +floorE  = doubleToInt floor Floor+roundE  = doubleToInt round Round+fracE   = unOpt (snd . properFraction) Frac +intE    = doubleToInt truncate IntOp        

@@ -2,22 +2,23 @@         TypeSynonymInstances,         FlexibleInstances #-} module Csound.Exp.Wrapper(-    Out, Sig, I, D, Str, BoolSig(..), Spec, ToSig(..),+    Out(..), Outs, Sig, D, Str, BoolSig(..), BoolD(..), Spec, ToSig(..),+    Sig2, Sig3, Sig4,     SE, se, se_, runSE, execSE,     Arg(..), ArgMethods(..), toArg, makeArgMethods,     CsdTuple(..), multiOuts,     Val(..),-    str, double, int, ir,+    str, double, ir,     tfm, pref, prim, p,     isMultiOutSignature,     noRate, setRate, -    getRates, tabMap,+    getRates, tabMap, updateTabSize, defineInstrTabs, defineScoreTabs, substInstrTabs, substScoreTabs,      readVar, writeVar, gOutVar,     Channel ) where  import Control.Applicative-import Control.Monad(ap)+import Control.Monad(ap, join) import Control.Monad.Trans.State  import Data.List(nub)@@ -31,26 +32,31 @@  type Channel = Int +type Outs = SE [Sig]+type Sig2 = (Sig, Sig)+type Sig3 = (Sig, Sig, Sig)+type Sig4 = (Sig, Sig, Sig, Sig)+ -- | Output of the instrument.-type Out = SE [Sig]+class Out a where+    toOut :: a -> SE [Sig]  -- | Audio or control rate signals.  newtype Sig = Sig { unSig :: E } --- | Integers.-newtype I = I { unI :: E }- -- | Doubles. newtype D = D { unD :: E }  -- | Strings. newtype Str = Str { unStr :: E } --- | Boolean signals. Use functions from the module "Data.Boolean" to make boolean signals--- out of simple signals.+-- | Boolean signals.  newtype BoolSig = BoolSig { unBoolSig :: E } --- | Spectrum of the signal (see "FFT and Spectral Processing" in the "Csound.Opcode.Advanced"). +-- | Boolean constants. +newtype BoolD = BoolD { unBoolD :: E }++-- | Spectrum of the signal (see FFT and Spectral Processing at "Csound.Opcode.Advanced").  newtype Spec = Spec { unSpec :: E }  ------------------------------------------------@@ -115,10 +121,6 @@ p :: Val a => Int -> a p = prim . P --- | Converts Haskell's integers to Csound's integers-int :: Int -> I-int = prim . PrimInt- -- | Converts Haskell's doubles to Csound's doubles double :: Double -> D double = prim . PrimDouble@@ -155,26 +157,103 @@ getPrimUnsafe a = case ratedExpExp $ unwrap a of     ExpPrim p -> p -tabMap :: [E] -> TabMap-tabMap es = M.fromList $ zip (nub $ getFtables =<< es) [1 ..]-    where -        getFtables :: E -> [Tab]-        getFtables = cata $ \re -> case fmap fromPrimOr $ ratedExpExp re of    -            ExpPrim p -> fromPrim 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-            where fromPrim x = case x of-                    PrimTab t -> [t]-                    _ -> []-                  fromPrimOr x = case unPrimOr x of-                    Left  p -> fromPrim p-                    Right a -> a+tabMap :: [E] -> [[Event Note]] -> TabMap+tabMap es ps = M.fromList $ zip (nub $ (concat $ mapM (getScoreTabs =<< ) ps) ++ (getInstrTabs =<< es)) [1 ..]+    +getInstrTabs :: E -> [LowTab]+getInstrTabs = cata $ \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+    where fromPrimOr x = case unPrimOr x of+            Left  p -> getPrimTabs p+            Right a -> a +getScoreTabs :: Event Note -> [LowTab]+getScoreTabs = (getPrimTabs =<< ) . eventContent++getPrimTabs :: Prim -> [LowTab]+getPrimTabs x = case x of+    PrimTab (Right t) -> [t]+    _ -> []++substPrimTab :: TabMap -> Prim -> Prim+substPrimTab m x = case x of +    PrimTab (Right tab) -> PrimInt (m M.! tab)+    _ -> x++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 ++substScoreTabs :: TabMap -> [Event Note] -> [Event Note]+substScoreTabs m = fmap (fmap (fmap (substPrimTab m)))++defineScoreTabs :: Int -> [Event Note] -> [Event Note]+defineScoreTabs n = fmap (fmap (fmap (definePrimTab n)))++defineInstrTabs :: Int -> 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 ++definePrimTab :: Int -> Prim -> Prim+definePrimTab n x = case x of+    PrimTab (Left tab) -> PrimTab (Right $ defineTab n tab)+    _ -> x++defineTab :: Int -> Tab -> LowTab+defineTab midSize tab = LowTab size (tabGen tab) args+    where size = defineTabSize midSize (tabSize tab)+          args = defineTabArgs size (tabArgs tab)++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+            [] -> []+            a:[] -> []+            a:b:as -> b : getEvens as+            +          substEvens evens xs = case (evens, xs) of+            ([], xs) -> xs+            (es, []) -> []+            (e:es, a:b:as) -> a : e : substEvens es as+            +          mkRelative n as = fmap (fromIntegral . 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 base n +            | n == 0 = base+            | n > 0  = base * (2 ^ n)+            | n < 0  = base `div` (2 ^ abs n)    ++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 }+ -------------------------------------------- -- signals from primitive types @@ -183,10 +262,6 @@     ar :: a -> Sig  -- ^ Forces signal to audio rate.      kr :: a -> Sig  -- ^ Forces signal to control rate.      -instance ToSig I where-    ar = setRate Ar-    kr = setRate Kr        - instance ToSig D where     ar = setRate Ar     kr = setRate Kr        @@ -196,8 +271,8 @@     kr = setRate Kr              instance ToSig Int where-    ar = ar . int-    kr = kr . int+    ar = ar . double . fromIntegral+    kr = kr . double . fromIntegral      instance ToSig Double where     ar = ar . double@@ -232,10 +307,6 @@     wrap = Sig . Fix     unwrap = unFix . unSig -instance Val I where-    wrap = I . Fix-    unwrap = unFix . unI- instance Val D where     wrap = D . Fix     unwrap = unFix . unD@@ -245,13 +316,19 @@     unwrap = unFix . unStr  instance Val Tab where-    wrap = undefined-    unwrap = prim . PrimTab+    wrap = TabExp . Fix+    unwrap x = case x of+        TabExp e -> unFix e+        primTab -> (prim . PrimTab . Left) primTab  instance Val BoolSig where     wrap = BoolSig . Fix     unwrap = unFix . unBoolSig  +instance Val BoolD where+    wrap = BoolD . Fix+    unwrap = unFix . unBoolD + instance Val Spec where     wrap = Spec . Fix     unwrap = unFix . unSpec@@ -308,12 +385,6 @@         , toNote = const []         , arity = const 0 } -instance Arg I where-    argMethods = ArgMethods {-        arg = p,-        toNote = pure . getPrimUnsafe,-        arity = const 1 }-          instance Arg D where     argMethods = ArgMethods {         arg = p,@@ -388,12 +459,12 @@     toCsdTuple = wrap . unFix . head     arityCsdTuple = const 1 -instance CsdTuple I where+instance CsdTuple D where     fromCsdTuple = return . Fix . unwrap     toCsdTuple = wrap . unFix . head     arityCsdTuple = const 1 -instance CsdTuple D where+instance CsdTuple Tab where     fromCsdTuple = return . Fix . unwrap     toCsdTuple = wrap . unFix . head     arityCsdTuple = const 1@@ -471,4 +542,43 @@ isMultiOutSignature x = case x of     MultiRate _ _ -> True     _ -> False++------------------------------------------------+-- instrument outs++instance Out Sig where+    toOut = return . return+    +instance Out a => Out [a] where+    toOut = fmap concat . mapM toOut ++instance Out a => Out (SE a) where+    toOut = join . fmap toOut++instance (Out a, Out b) => Out (a, b) where+    toOut (a, b) = liftA2 (++) (toOut a) (toOut b)+    +instance (Out a, Out b, Out c) => Out (a, b, c) where+    toOut (a, b, c) = toOut (a, (b, c))+    +instance (Out a, Out b, Out c, Out d) => Out (a, b, c, d) where+    toOut (a, b, c, d) = toOut (a, (b, c, d))+ +instance (Out a, Out b, Out c, Out d, Out e) => Out (a, b, c, d, e) where+    toOut (a, b, c, d, e) = toOut (a, (b, c, d, e))++instance (Out a, Out b, Out c, Out d, Out e, Out f) => Out (a, b, c, d, e, f) where+    toOut (a, b, c, d, e, f) = toOut (a, (b, c, d, e, f))++instance (Out a, Out b, Out c, Out d, Out e, Out f, Out g) => Out (a, b, c, d, e, f, g) where+    toOut (a, b, c, d, e, f, g) = toOut (a, (b, c, d, e, f, g))++instance (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+    toOut (a, b, c, d, e, f, g, h) = toOut (a, (b, c, d, e, f, g, h))+++       + ++ 

@@ -17,7 +17,7 @@     -- >     (k, [k, k, i, i])]      Spec1, -    opcs, opc0, opc1, opc2, opc3, opc4, opc5, opc6, opc7, opc8, opc9, opc10, opc11,+    opcs, opc0, opc1, opc2, opc3, opc4, opc5, opc6, opc7, opc8, opc9, opc10, opc11, opc12,      -- * Multiple outputs     -- | Examples:@@ -69,7 +69,6 @@ import Csound.Exp import Csound.Exp.Wrapper import Csound.Exp.Cons-import Csound.Render.Sco(Msg)  i = Ir k = Kr

@@ -1,8 +1,9 @@ -- | 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 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 'withInits'.+-- use the function 'Csound.Base.withInits'. module Csound.Opcode (     module Csound.Opcode.Basic,     module Csound.Opcode.Advanced,

@@ -16,7 +16,12 @@     -- ** Doppler Shift     doppler,     +     -----------------------------------------------------+    -- * Granular Synthesis+    fof,+    +    -----------------------------------------------------     -- * Convolution     pconvolve, convolve, ftconv, dconv,   @@ -254,6 +259,17 @@ ----------------------------------------------------- -- * 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 :: Sig -> Sig -> 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 @@ -301,7 +317,7 @@ -- > ares dconv asig, isize, ifn -- -- doc: <http://www.csounds.com/manual/html/dconv.html>-dconv :: Sig -> I -> Tab -> Sig+dconv :: Sig -> D -> Tab -> Sig dconv = opc3 "dconv" [(a, [a,i,i])]  -----------------------------------------------------@@ -315,7 +331,7 @@ -- > fsig pvsanal ain, ifftsize, ioverlap, iwinsize, iwintype [, iformat] [, iinit] -- -- doc: <http://www.csounds.com/manual/html/pvsanal.html>-pvsanal :: Sig -> I -> I -> I -> I -> Spec+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.@@ -344,7 +360,7 @@ -- > ares pvsadsyn fsrc, inoscs, kfmod [, ibinoffset] [, ibinincr] [, iinit] -- -- doc: <http://www.csounds.com/manual/html/pvsadsyn.html>-pvsadsyn :: Spec -> I -> Sig -> Sig+pvsadsyn :: Spec -> D -> Sig -> Sig pvsadsyn = opc3 "pvsadsyn" [(a, [f,i,k,i,i,i])]  -----------------------------------------------------@@ -387,7 +403,7 @@ -- > ioverlap, inumbins, iwinsize, iformat pvsinfo fsrc -- -- doc: <http://www.csounds.com/manual/html/pvsinfo.html>-pvsinfo :: Spec -> (I, I, I, I)+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. @@ -579,7 +595,7 @@ -- > ares pluck kamp, kcps, icps, ifn, imeth [, iparm1] [, iparm2]      -- -- doc: <http://www.csounds.com/manual/html/pluck.html>-pluck :: Sig -> Sig -> D -> Tab -> I -> Sig+pluck :: Sig -> Sig -> D -> 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, 

@@ -24,7 +24,8 @@     -- * Envelopes     linseg, expseg, linsegr, expsegr,     lpshold, loopseg, looptseg,    -+    linen, linenr, envlpx, +         -----------------------------------------------------     -- * Delays @@ -57,7 +58,7 @@      -----------------------------------------------------     -- * Reverb-    freeverb, reverbsc, reverb, nreverb, babo, +    freeverb, reverbsc, reverb, reverb2, nreverb, babo,       -----------------------------------------------------     -- * Signal Measurement, Dynamic Processing, Sample Level Operations@@ -214,7 +215,7 @@ -- -- doc: <http://www.csounds.com/manual/html/vco.html>  -vco :: Sig -> Sig -> I -> Sig -> Sig+vco :: Sig -> Sig -> 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) @@ -472,6 +473,45 @@ mkLps name kfreq ktrig kvals = 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 :: Sig -> D -> D -> D -> Sig+linen = opc4 "linen" [+    (k, k:is 3),+    (a, x:is 3)]+    +-- | 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 :: Sig -> D -> D -> D -> Sig+linenr = opc4 "linenr" [+    (k, k:is 3),+    (a, x:is 3)]++-- | 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 :: Sig -> D -> D -> D -> Tab -> D -> D -> Sig+envlpx = opc7 "envlpx" [+    (k, k:is 8),+    (a, x:is 8)]+ ---------------------------------------------------- -- audio delays @@ -732,6 +772,15 @@ 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.  --@@ -802,7 +851,7 @@ -- > knumkout max_k asig, ktrig, itype -- -- doc: <http://www.csounds.com/manual/html/max_k.html>-max_k :: Sig -> Sig -> I -> Sig+max_k :: Sig -> Sig -> D -> Sig max_k = opc3 "max_k" [(k, [a, k, i])]  -------------------------------------------------@@ -885,7 +934,7 @@ -- > ares clip asig, imeth, ilimit [, iarg] -- -- doc: <http://www.csounds.com/manual/html/clip.html>-clip :: Sig -> I -> D -> Sig+clip :: Sig -> D -> D -> Sig clip = opc3 "clip" [(a, [a, i, i])]  -------------------------------------------------

@@ -4,22 +4,6 @@     -----------------------------------------------------     -- * Buffer and Function tables -    -- ** Creating Function Tables (Buffers)-    gen, skipNorm,-    -    -- ** Handy shortcuts-    -    -- | The table size is set to:-    ---    -- > low = 4096-    -- > mid = 8192-    -- > high = 16384-    -- > higher = 65536-    ---    -- genXxx1 means that the size is set to @Xxx + 1@.-    genLow, genMid, genHigh, genHigher,-    genLow1, genMid1, genHigh1, genHigher1,-     {-     -- ** Writing To Tables     tableiw, tablew, tabw_i, tabw, @@ -63,6 +47,10 @@      -- ** Pitch conversions     cpspch,++    -- ** Integer and fractional parts+    fracD, floorD, ceilD, intD, roundD,+    fracSig, floorSig, ceilSig, intSig, roundSig,              -----------------------------------------------------     -- * Printing and Strings@@ -83,45 +71,11 @@ import Csound.Exp import Csound.Exp.Wrapper import Csound.LowLevel+import Csound.Exp.Numeric  ----------------------------------------------------- -- * Buffer and Function tables --- ** Creating Function Tables (Buffers)---- | Creates a table of doubles (It's f-table in Csound).--- Arguments are:------ * table size------ * identificator of the GEN routine------ * GEN routine arguments------ All tables are created at 0 and memory is never released.-gen :: Int -> Int -> [Double] -> Tab-gen = Tab --low = 4096-mid = 8192-high = 16384-higher = 65536--genLow, genMid, genHigh, genHigher, genLow1, genMid1, genHigh1, genHigher1 :: Int -> [Double] -> Tab--genLow = gen low-genMid = gen mid-genHigh = gen high-genHigher = gen higher--genLow1 = gen (low + 1)-genMid1 = gen (mid + 1)-genHigh1 = gen (high + 1)-genHigher1 = gen (higher + 1)---- | Skips normalization (sets table size to negative value)-skipNorm :: Tab -> Tab-skipNorm (Tab size name args) = Tab (negate $ abs size) name args  {- -- ** Writing To Tables

@@ -20,7 +20,7 @@     xyin     ) where -import Csound.Render.Sco(Msg)+import Csound.Exp(Msg) import Csound.Exp.Wrapper import Csound.LowLevel @@ -71,7 +71,7 @@ -- > adest ctrl7 ichan, ictlno, kmin, kmax [, ifn] [, icutoff] -- -- doc: <http://www.csounds.com/manual/html/ctrl7.html>-ctrl7 :: I -> I -> Sig -> Sig -> Sig+ctrl7 :: D -> D -> Sig -> Sig -> Sig ctrl7 = opc4 "ctrl7" [     (i, replicate 5 i),     (k, [i, i, k, k, i]),

@@ -1,5 +1,5 @@ module Csound.Render(-    renderCsd, renderCsdBy, out, outs+    renderCsd, renderCsdBy ) where  import Data.Default@@ -11,7 +11,7 @@ import Data.Fix  import Csound.Exp-import Csound.Exp.Wrapper hiding (double, int)+import Csound.Exp.Wrapper hiding (double) import Csound.Render.Sco import Csound.Render.Instr import Csound.Render.Options@@ -21,14 +21,6 @@  import Csound.Opcode(clip, zeroDbfs) --- | Synonym for @return . return@.-out :: Sig -> Out-out = return . return---- | Synonym for @return@.-outs :: [Sig] -> Out-outs = return- -- | Renders Csound file. renderCsd :: [SigOut] -> String renderCsd = renderCsdBy def@@ -37,28 +29,29 @@ renderCsdBy :: CsdOptions -> [SigOut] -> String renderCsdBy opt as = show $ ppCsdFile      (renderFlags opt)-    (renderInstr0 (nchnls lastInstrExp) (midiAssignTable ids as) opt)-    (ppOrc $ firstInstr : lastInstr : zipWith (renderInstr krateSet fts) ids instrs)-    (ppSco $ firstInstrNote : lastInstrNote : zipWith (renderScores strs fts) ids scos)+    (renderInstr0 (nchnls lastInstr) (midiAssignTable ids as) opt)+    (ppOrc $ zipWith (renderInstr krateSet) allIds (fmap (substInstrTabs fts) allInstrs))+    (ppSco $ firstInstrNote : lastInstrNote : zipWith (renderScores strs) ids (fmap (substScoreTabs fts) $ scos))     (renderStringTable strs)     (renderTotalDur $$ renderTabs fts)-    where scos   = map (scoSigOut' . sigOutContent) as          +    where scos   = fmap (scoSigOut' . sigOutContent) as                     (instrs, effects, initOuts) = unzip3 $ zipWith runExpReader as ids    -          fts    = tabMap $ lastInstrExp : instrs+          fts    = tabMap allInstrs scos           strs   = stringMap $ concat scos           ids    = take nInstr [2 .. ]           +          allInstrs = fmap (defineInstrTabs (tabResolution opt)) $ firstInstr : lastInstr : instrs+          allIds    = firstInstrId : lastInstrId : ids+                     nInstr = length as           firstInstrId = 1           lastInstrId  = nInstr + 2                   -          firstInstr = renderInstr krateSet fts firstInstrId $ execSE $ sequence_ initOuts-          lastInstr  = renderInstr krateSet fts lastInstrId lastInstrExp-          -          lastInstrExp = mixingInstrExp globalEffect effects+          firstInstr = execSE $ sequence_ initOuts+          lastInstr  = mixingInstrExp globalEffect effects                       scoSigOut' x = case x of-              PlainSigOut _ _ -> scoSigOut x+              PlainSigOut _ _ -> defineScoreTabs (tabResolution opt) $ scoSigOut x               _ -> []                        dur = maybe 64000000 id $ totalDur as

@@ -11,10 +11,11 @@ import Data.Ord(comparing) import Data.Maybe(fromJust) +import Data.Fix(Fix(..), cata) import Data.Fix.Cse(fromDag, cse)  import Csound.Exp-import Csound.Exp.Wrapper hiding (double, int)+import Csound.Exp.Wrapper hiding (double)  import Csound.Tfm.RateGraph import Csound.Render.Pretty@@ -22,16 +23,16 @@ type InstrId = Int type Dag f = [(Int, f Int)] -renderInstr :: KrateSet -> TabMap -> InstrId -> E -> Doc-renderInstr krateSet ft instrId exp = ppInstr instrId $ renderInstrBody krateSet ft exp+renderInstr :: KrateSet -> InstrId -> E -> Doc+renderInstr krateSet instrId exp = ppInstr instrId $ renderInstrBody krateSet exp -renderInstrBody :: KrateSet -> TabMap -> E -> [Doc]-renderInstrBody krateSet ft sig = map (stmt . clearEmptyResults) $ collectRates krateSet st g+renderInstrBody :: KrateSet -> E -> [Doc]+renderInstrBody krateSet sig = map (stmt . clearEmptyResults) $ collectRates krateSet st g     where stmt :: ([RatedVar], Exp RatedVar) -> Doc-          stmt (res, exp) = renderExp ft (ppOuts res) exp+          stmt (res, exp) = renderExp (ppOuts res) exp                      st = getRenderState g-          g  = toDag ft sig+          g  = toDag sig   data RenderState = RenderState @@ -62,10 +63,21 @@     _ -> False  -toDag :: TabMap -> E -> Dag RatedExp -toDag ft exp = fromDag $ cse exp+toDag :: E -> Dag RatedExp +toDag exp = fromDag $ cse $ trimByArgLength exp  +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, exp) = (filter ((/= Xr) . ratedVarRate) res, exp)         @@ -110,10 +122,10 @@ getRate :: RatedExp a -> Rate getRate = fromJust . ratedExpRate -renderExp :: TabMap -> Doc -> Exp RatedVar -> Doc-renderExp m res exp = case fmap (ppPrimOrVar m) exp of+renderExp :: Doc -> Exp RatedVar -> Doc+renderExp res exp = case fmap ppPrimOrVar exp of     ExpPrim (PString n) -> ppStrget res n-    ExpPrim p -> res $= ppPrim m p+    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

@@ -6,18 +6,18 @@ import Data.List(transpose) import Data.Default -import Csound.Exp.Wrapper(Channel, Sig, SE, Out)+import Csound.Exp.Wrapper(Channel, Sig, SE, Out, Outs) import Csound.Render.Sco import Csound.Render.Pretty  type CtrlId = Int  -- | Sums signals for every channel.-mixing :: [[Sig]] -> Out+mixing :: [[Sig]] -> Outs mixing = return . fmap sum . transpose  -- | Sums signals for every channel and the processes the output with the given function.-mixingBy :: ([Sig] -> Out) -> ([[Sig]] -> Out)+mixingBy :: ([Sig] -> Outs) -> ([[Sig]] -> Outs) mixingBy f = (f =<<) . mixing   -- | Csound options. The default value is@@ -30,7 +30,8 @@ -- >             , csdSeed = Nothing -- >             , csdInitc7 = [] -- >             , csdEffect = mixing--- >             , csdKrate  = ["linseg", "expseg", "linsegr", "expsegr"] }+-- >             , csdKrate  = ["linseg", "expseg", "linsegr", "expsegr", "linen", "linenr", "envlpx"],+-- >             , tabResolution = 8192 }  -- should be power of 2  data CsdOptions = CsdOptions      { csdFlags      :: String       @@ -38,8 +39,9 @@     , csdBlockSize  :: Int               , csdSeed       :: Maybe Int         , csdInitc7     :: [(Channel, CtrlId, Double)]-    , csdEffect     :: [[Sig]] -> SE [Sig]+    , csdEffect     :: [[Sig]] -> Outs     , csdKrate      :: [String]+    , tabResolution :: Int     }  instance Default CsdOptions where@@ -50,7 +52,8 @@             , csdSeed = Nothing             , csdInitc7 = []             , csdEffect = mixing-            , csdKrate  = ["linseg", "expseg", "linsegr", "expsegr"] }+            , csdKrate  = ["linseg", "expseg", "linsegr", "expsegr", "linen", "linenr", "envlpx"]+            , tabResolution = 8192 }  renderFlags = text . csdFlags 

@@ -44,8 +44,8 @@     _  -> phi x     where phi = text . map toLower . show  -ppPrimOrVar :: TabMap -> PrimOr RatedVar -> Doc-ppPrimOrVar m x = either (ppPrim m) ppRatedVar $ unPrimOr x+ppPrimOrVar :: PrimOr RatedVar -> Doc+ppPrimOrVar x = either ppPrim ppRatedVar $ unPrimOr x  ppRatedVar :: RatedVar -> Doc ppRatedVar (RatedVar r x) = ppRate r <> int x@@ -72,16 +72,16 @@     LocalVar -> empty     GlobalVar -> char 'g' -ppPrim :: TabMap -> Prim -> Doc-ppPrim m x = case x of+ppPrim :: Prim -> Doc+ppPrim x = case x of     P n -> char 'p' <> int n     PrimInt n -> int n     PrimDouble d -> double d     PrimString s -> dquotes $ text s-    PrimTab f -> int $ m M.! f+    PrimTab f -> error $ "i'm lost table, please substitute me (" ++ (show f) ++ ")"      -ppTab :: Tab -> Doc-ppTab (Tab size n xs) = text "gen" <> int n <+> int size <+> (hsep $ map double xs)+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@@ -105,9 +105,9 @@ ppTabDef ft id = char 'f'      <>  int id      <+> int 0 -    <+> (int $ tabSize ft)-    <+> (int $ tabGen ft) -    <+> (hsep $ map double $ tabArgs ft)+    <+> (int $ lowTabSize ft)+    <+> (int $ lowTabGen ft) +    <+> (hsep $ map double $ lowTabArgs ft)  ppStrset str id = text "strset" <+> int id <> comma <+> (dquotes $ text str) 

@@ -1,8 +1,7 @@ module Csound.Render.Sco(     score, SigOut(..), effect, -    Msg, massign , pgmassign, MidiType(..),--    Event(..), eventEnd, PlainSigOut(..), renderScores,+    massign , pgmassign, MidiType(..),+    eventEnd, PlainSigOut(..), renderScores,     runExpReader, nchnls, stringMap, outs' ) where @@ -14,7 +13,7 @@ import Data.Fix  import Csound.Exp-import Csound.Exp.Wrapper hiding (int, double)+import Csound.Exp.Wrapper hiding (double) import Csound.Exp.Cons(opcs) import Csound.Exp.Numeric @@ -27,24 +26,9 @@ ------------------------------------------------------- -- scores -type Note = [Prim]---- | Midi messages.-data Msg = Msg--data Event a = Event -    { eventStart :: Double-    , eventDur   :: Double-    , eventContent :: a }-    -eventEnd e = eventStart e + eventDur e--instance Functor Event where-    fmap f a = a{ eventContent = f $ eventContent a }- -- | Applies a global effect function to the signal. With this function we can add reverb or panning to the mixed signal. -- The argument function takes a list of signals. Each cell of the list contains a signal on the given channel.-effect :: ([Sig] -> Out) -> SigOut -> SigOut+effect :: ([Sig] -> SE [Sig]) -> SigOut -> SigOut effect f a = a{ sigOutEffect = f <=< sigOutEffect a }  -- | The abstract type of musical tracks. @@ -79,9 +63,9 @@             | otherwise      = "outs"  -score :: (Arg a) => (a -> Out) -> [(Double, Double, a)] -> SigOut+score :: (Arg a, Out b) => (a -> b) -> [(Double, Double, a)] -> SigOut score instr scores = SigOut return $ -    PlainSigOut (expReader $ instr toArg) (fmap (\(a, b, c) -> Event a b (toNote argMethods c)) scores)+    PlainSigOut (expReader $  (toOut . instr) toArg) (fmap (\(a, b, c) -> Event a b (toNote argMethods c)) scores)   expReader :: SE [Sig] -> ExpReader@@ -100,28 +84,28 @@ nchnls x = case ratedExpExp $ unFix x of     Tfm _ as -> length as -massign :: Channel -> (Msg -> Out) -> SigOut +massign :: (Out a) => Channel -> (Msg -> a) -> SigOut  massign = midiAssign Massign -pgmassign :: Maybe Channel -> Int -> (Msg -> Out) -> SigOut +pgmassign :: (Out a) => Maybe Channel -> Int -> (Msg -> a) -> SigOut  pgmassign chn = midiAssign (Pgmassign chn) -midiAssign :: MidiType -> Channel -> (Msg -> SE [Sig]) -> SigOut-midiAssign ty n = SigOut return . Midi ty n . expReader . ($ Msg)+midiAssign :: (Out a) => MidiType -> Channel -> (Msg -> a) -> SigOut+midiAssign ty n = SigOut return . Midi ty n . expReader . toOut . ($ Msg)  ----------------------------------------------------------------- -- render -renderScores :: StringMap -> TabMap -> InstrId -> [Event Note] -> Doc-renderScores strs fts instrId as = ppScore $ map (renderNote strs fts instrId) as+renderScores :: StringMap -> InstrId -> [Event Note] -> Doc+renderScores strs instrId as = ppScore $ map (renderNote strs instrId) as -renderNote :: StringMap -> TabMap -> InstrId -> Event Note -> Doc-renderNote strs fts instrId e = ppNote instrId (eventStart e) (eventDur e) (map prim $ eventContent e)+renderNote :: StringMap -> InstrId -> Event Note -> Doc+renderNote strs instrId e = ppNote instrId (eventStart e) (eventDur e) (map prim $ eventContent e)     where prim x = case x of               PrimInt n -> int n-              PrimDouble d -> double d-              PrimTab f -> int $ fts M.! f+              PrimDouble d -> double d                             PrimString s -> int $ strs M.! s+              PrimTab f -> error $ "i'm lost in the scores, substitute me (" ++ show f ++ ")"                 stringMap :: [Event Note] -> StringMap

@@ -0,0 +1,342 @@+-- | Creating Function Tables (Buffers)+module Csound.Tab (+    -- | If you are not familliar with Csound's conventions+    -- you are pobably not aware of the fact that for efficiency reasons Csound requires that table size is equal+    -- to power of 2 or power of two plus one which stands for guard point (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 the table in many cycles, then the guard point is the the first point of your table).  +    Tab,+    +    -- * Fill table with numbers+    doubles,+    +    -- * (In)Harmonic series+    PartialStrength, PartialNumber, PartialPhase, PartialDC,+    sines, sines3, sines4, buzzes,++    -- * Interpolants    +    -- | All funtions have the same shape of arguments:+    --+    -- > fun [a, n1, b, n2, c, ...]+    --+    -- where+    --+    -- * a, b, c .. - are ordinate values+    --+    -- * n1, n2 .. - are lengths of the segments relative to the total number of the points in the table   +    --    +    -- Csounders, Heads up! all segment lengths are relative to the total sum of the segments.+    -- You don't need to make the sum equal to the number of points in the table. Segment's lengths will be resized +    -- automatically. For example if we want to define a curve that rises to 1 over 25\% of the table and then falls down to zero+    -- we can define it like this:+    --+    -- > segs [0, 0.25, 1, 0.75, 0] +    --+    -- or+    --+    -- > segs [0, 25, 1, 75, 0]+    --+    -- or+    --+    -- > segs [0, 1, 1, 3, 0]+    --+    -- all these expressions are equivalent. +    consts, segs, cubes, exps, splines,    +    -- ** Equally spaced interpolants+    econsts, esegs, ecubes, eexps, esplines,++    -- * Polynomials    +    polys, chebs1, chebs2,+    +    -- ++    -- * Low level Csound definition.+    gen,+    +    -- * Modify tables+    skipNorm, setSize, setDegree, guardPoint, gp,+    +    -- ** Handy shortcuts        +    -- | handy shortcuts for the function 'setDegree'.+    lllofi, llofi, lofi, midfi, hifi, hhifi, hhhifi+) where++import Data.Default+import Csound.Exp+import Csound.Exp.Wrapper(updateTabSize)++interp id as = Tab def id (ArgsRelative as)+plains id as = Tab def id (ArgsPlain as)++insertOnes :: [Double] -> [Double]+insertOnes as = case as of+    [] -> []+    a:[] -> [a]+    a:as -> a : 1 : insertOnes as+++tableSizes :: [Int]+tableSizes = [res | a <- twos, b <- twos1, res <- [a, b]]+    where twos  = fmap (2 ^) [0 .. ]+          twos1 = fmap ( +1) twos  ++findTableSize :: Int -> Int+findTableSize n = head $ dropWhile (< n) tableSizes++-- 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).+doubles :: [Double] -> Tab+doubles as = setSize (findTableSize n) $ plains 2 as+    where n = length as++-- | Segments of the exponential curves.+--+-- > exps [a, n1, b, n2, c, ...]+--+-- where +-- +-- * @a, b, c, ...@ are ordinate values+--+-- * @n1, n2, ...@  are lengths of the segments relative to the total number of the points in the table+exps :: [Double] -> Tab+exps = interp 5++-- | Equally spaced segments of exponential curves.+--+-- > eexps [a, b, c, ...] +--+-- is the same as+--+-- > exps [a, 1, b, 1, c, ...]+eexps :: [Double] -> Tab+eexps = exps . insertOnes++-- | Segments of cubic polynomials. +--+-- > cubes [a, n1, b, n2, c, ...]+--+-- where+--+-- * a, b, c .. - are ordinate values+--+-- * @n1, n2, ...@  are lengths of the segments relative to the total number of the points in the table+cubes :: [Double] -> Tab+cubes = interp 6++-- | Equally spaced segments of cubic polynomials.+--+-- > ecubes [a, b, c, ...] +--+-- is the same as+--+-- > cubes [a, 1, b, 1, c, ...]+ecubes :: [Double] -> Tab+ecubes = cubes . insertOnes++-- | Segments of straight lines. +--+-- > segs [a, n1, b, n2, c, ...]+--+-- where+--+-- * a, b, c .. - are ordinate values+--+-- * @n1, n2, ...@  are lengths of the segments relative to the total number of the points in the table+segs :: [Double] -> Tab+segs = interp 7++-- | Equally spaced segments of straight lines.+--+-- > esegs [a, b, c, ...] +--+-- is the same as+--+-- > segs [a, 1, b, 1, c, ...]+esegs :: [Double] -> Tab+esegs = segs . insertOnes++-- | Cubic spline curve.+--+-- > splines [a, n1, b, n2, c, ...]+--+-- where+--+-- * a, b, c .. - are ordinate values+--+-- * @n1, n2, ...@  are lengths of the segments relative to the total number of the points in the table+splines :: [Double] -> Tab+splines = interp 8++-- | Equally spaced spline curve.+--+-- > esplines [a, b, c, ...] +--+-- is the same as+--+-- > splines [a, 1, b, 1, c, ...]+esplines :: [Double] -> Tab+esplines = splines . insertOnes++-- | Constant segments (sample and hold).+--+-- > consts [a, n1, b, n2, c, ...]+--+-- where+--+-- * a, b, c .. - are ordinate values+--+-- * @n1, n2, ...@  are lengths of the segments relative to the total number of the points in the table+consts :: [Double] -> Tab+consts = interp 17++-- | Equally spaced constant segments.+--+-- > econsts [a, b, c, ...] +--+-- is the same as+--+-- > consts [a, 1, b, 1, c, ...]+econsts :: [Double] -> Tab+econsts = consts . insertOnes+    +type PartialNumber = Double+type PartialStrength = Double+type PartialPhase = Double+type PartialDC = Double+    ++-- | Series of harmonic partials:+--+-- > sine = sines [1]+--+-- > saw = sines $ fmap (1 / ) [1 .. 10]+--+-- > square = sines $ fmap (1 / ) [1, 3 .. 11]+--+-- > triangle = sines $ zipWith (\a b -> a / (b ** 2)) (cycle [1, -1]) [1, 3 .. 11]+sines :: [PartialStrength] -> Tab+sines = plains 10++-- | Specifies series of possibly inharmonic partials.+sines3 :: [(PartialNumber, PartialStrength, PartialPhase)] -> Tab+sines3 xs = plains 9 [a | (pn, str, phs) <- xs, a <- [pn, str, phs]]++-- | Specifies series of possibly inharmonic partials with direct current.+sines4 :: [(PartialNumber, PartialStrength, PartialPhase, PartialDC)] -> Tab+sines4 xs = plains 19 [a | (pn, str, phs, dc) <- xs, a <- [pn, str, phs, dc]]++-- | Generates values similar to the opcode 'Csound.Opcode.Basic.buzz'. +--+-- > buzzes numberOfHarmonics [lowestHarmonic, coefficientOfAttenuation]+--+-- With @buzzes n [l, r]@ you get @n@ harmonics from @l@ that are attenuated by the factor of @r@+-- on each step.+buzzes :: Double -> [Double] -> Tab+buzzes nh opts = plains 11 (nh : take 2 opts)++-- | Modified Bessel function of the second kind, order 0 (for amplitude modulated FM). +--+-- > bessels xint+--+-- the function is defined within the interval @[0, xint]@.+bessels :: Double -> Tab+bessels xint = plains 12 [xint]++-- | Polynomials.+--+-- > polys xl xr [c0, c1, c2, ..]+--+-- where+--+-- * xl, xr - left and right values of the interval over wich polynomial is defined+--+-- * [c0, c1, c2, ...] -- coefficients of the polynomial+--+-- > c0 + c1 * x + c2 * x * x + ...+polys :: Double -> Double -> [Double] -> Tab+polys x0 x1 cs = plains 3 (x0:x1:cs)++-- | Chebyshev polynomials of the first kind.+--+-- > polys xl xr [h0, h1, h2, ..]+--+-- where+--+-- * xl, xr - left and right values of the interval over wich polynomial is defined+--+-- * [h0, h1, h2, ...] -- relative strength of the partials+chebs1 :: Double -> Double -> [Double] -> Tab+chebs1 xint xamp hs = plains 13 (xint : xamp : hs)++-- | Chebyshev polynomials of the second kind.+--+-- > polys xl xr [h0, h1, h2, ..]+--+-- where+--+-- * xl, xr - left and right values of the interval over wich polynomial is defined+--+-- * [h0, h1, h2, ...] -- relative strength of the partials+chebs2 :: Double -> Double -> [Double] -> Tab+chebs2 xint xamp hs = plains 14 (xint : xamp : hs)+++-- | Creates a table of doubles (It's f-table in Csound).+-- Arguments are:+--+-- * identificator of the GEN routine+--+-- * GEN routine arguments+--+-- All tables are created at 0 and memory is never released.+gen :: Int -> [Double] -> Tab+gen id args = Tab def id (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).  +guardPoint :: Tab -> Tab+guardPoint = updateTabSize $ \x -> case x of+    SizePlain n -> SizePlain $ plainGuardPoint n+    a -> a{ hasGuardPoint = True }    +    where plainGuardPoint n+            | even n    = n + 1+            | otherwise = n++-- | Shortcut for 'Csound.Tab.guardPoint'.+gp :: Tab -> Tab+gp = guardPoint++-- | Sets an absolute size value. As you can do it in the Csound files.+setSize :: Int -> Tab -> Tab+setSize n = updateTabSize $ const (SizePlain n)++-- | Sets the relative size value. You can set the base value in the options +-- (see 'Csound.Base.tabResolution' at 'Csound.Base.CsdOptions', with tabResolution you can easily change table sizes for all your tables).+-- Here zero means the base value. 1 is the base value multiplied by 2, 2 is the base value multiplied by 4+-- and so on. Negative values mean division by the specified degree. +setDegree :: Int -> Tab -> Tab+setDegree degree = updateTabSize $ \x -> case x of+    SizePlain n -> SizePlain n+    a -> a{ sizeDegree = degree }++-- | Sets degrees from -3 to 3.+lllofi, llofi, lofi, midfi, hifi, hhifi, hhhifi :: Tab -> Tab ++lllofi  = setDegree (-3)+llofi   = setDegree (-2)+lofi    = setDegree (-1)+midfi   = setDegree 0+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 }++++