csound-expression-1.1.1: library to make electronic music

Safe HaskellNone

Csound.Base

Contents

Description

Basic types and functions.

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.

Synopsis

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 (D), strings (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 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 CsdSco. This library lets you use your own representation of scores. The default one is 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 (Sig or 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 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 mix:

 mix :: (Out a, Out b, CsdSco f) => (a -> b) -> f (Mix a) -> f (Mix (NoSE a))

Looks like the function 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 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 (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 linseg).

You can change this behaviour with functions ar and 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 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:

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 (Sig)
  • ksig -- control rate (Sig)
  • xsig -- audio or control rate (Sig)
  • inum -- constant number (D)
  • ifn -- table (Tab). They are called functional tables in Csound.
  • Sfile -- string, probably a file name (Str)
  • fsrc -- spectrum (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 withInits for this purpose.

Example (a concert A)

More examples

You can find many examples at:

References

Got interested in Csound? Csound is very well documented. There are good tutorials, read about it at:

Types

class Val a Source

arity :: Arg a => a -> IntSource

Constants

A constant value doesn't change while instrument is playing a note. Only constants can be passed as arguments to the instruments.

data D Source

Doubles.

data Str Source

Strings.

withInits :: (Val a, CsdTuple inits) => a -> inits -> SigSource

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)

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.

data Spec Source

Spectrum of the signal (see FFT and Spectral Processing at Csound.Opcode.Advanced).

Booleans

Use functions from the module Data.Boolean to make boolean expressions.

data BoolSig Source

Boolean signals.

data BoolD Source

Boolean constants.

Instances

Side effects

data SE a Source

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.

Instances

Tuples

class CsdTuple a Source

Describes tuples of Csound values. It's used for functions that can return several results (such as soundin or diskin2). Tuples can be nested.

Instances

CsdTuple () 
CsdTuple Tab 
CsdTuple Spec 
CsdTuple Str 
CsdTuple D 
CsdTuple Sig 
(CsdTuple a, CsdTuple b) => CsdTuple (a, b) 
(CsdTuple a, CsdTuple b, CsdTuple c) => CsdTuple (a, b, c) 
(CsdTuple a, CsdTuple b, CsdTuple c, CsdTuple d) => CsdTuple (a, b, c, d) 
(CsdTuple a, CsdTuple b, CsdTuple c, CsdTuple d, CsdTuple e) => CsdTuple (a, b, c, d, e) 
(CsdTuple a, CsdTuple b, CsdTuple c, CsdTuple d, CsdTuple e, CsdTuple f) => CsdTuple (a, b, c, d, e, f) 
(CsdTuple a, CsdTuple b, CsdTuple c, CsdTuple d, CsdTuple e, CsdTuple f, CsdTuple g) => CsdTuple (a, b, c, d, e, f, g) 
(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) 

Converters

class ToSig a whereSource

Values that can be converted to signals.

Methods

toSig :: a -> SigSource

ar :: Sig -> SigSource

Sets rate to audio rate.

kr :: Sig -> SigSource

Sets rate to control rate.

ir :: Sig -> DSource

Converts signal to double.

sig :: D -> SigSource

Converts numbers to signals. It creates constant signal.

double :: Double -> DSource

Converts Haskell's doubles to Csound's doubles

str :: String -> StrSource

Converts Haskell's strings to Csound's strings

Making a sound

Let's make some noise. Sound is build from list of tracks (SigOut).

class CsdTuple (NoSE a) => Out a Source

Output of the instrument.

Instances

Out () 
Out Sig 
(Out a, CsdTuple a) => Out (SE a) 
(CsdTuple a, CsdTuple b, Out a, Out b) => Out (a, b) 
(CsdTuple a, CsdTuple b, CsdTuple c, Out a, Out b, Out c) => Out (a, b, c) 
(CsdTuple a, CsdTuple b, CsdTuple c, CsdTuple d, Out a, Out b, Out c, Out d) => Out (a, b, c, d) 
(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) 
(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) 
(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) 
(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) 

Handy short-cuts

type Sig2 = (Sig, Sig)Source

type Sig3 = (Sig, Sig, Sig)Source

type Sig4 = (Sig, Sig, Sig, Sig)Source

type Ksig = SigSource

An alias for control rate signals (it's used only to clarify that kr was applied to the signal).

type Amp = SigSource

An alias for amplitude.

type Cps = SigSource

An alias for cycles per second.

type Iamp = DSource

An alias for amplitude as number.

type Icps = DSource

An alias for cycles per second as number.

Scores

We can define an instrument and tell it to play some notes.

class Arg a whereSource

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 = ...

Instances

Arg () 
Arg Tab 
Arg Str 
Arg D 
(Arg a, Arg b) => Arg (a, b) 
(Arg a, Arg b, Arg c) => Arg (a, b, c) 
(Arg a, Arg b, Arg c, Arg d) => Arg (a, b, c, d) 
(Arg a, Arg b, Arg c, Arg d, Arg e) => Arg (a, b, c, d, e) 
(Arg a, Arg b, Arg c, Arg d, Arg e, Arg f) => Arg (a, b, c, d, e, f) 
(Arg a, Arg b, Arg c, Arg d, Arg e, Arg f, Arg g) => Arg (a, b, c, d, e, f, g) 
(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) 

data ArgMethods a Source

The abstract type of methods for the class Arg.

makeArgMethods :: Arg a => (a -> b) -> (b -> a) -> ArgMethods bSource

Defines instance of type class Arg for a new type in terms of an already defined one.

data Mix a Source

sco :: (Arg a, Out b, CsdSco f) => (a -> b) -> f a -> f (Mix (NoSE b))Source

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 (Sig or 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 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.

mix :: (Out a, Out b, CsdSco f) => (a -> b) -> f (Mix a) -> f (Mix (NoSE b))Source

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 sco or mix or midi.

With the function 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!

class CsdSco f whereSource

Instances

Effects

effect :: (CsdTuple a, Out a) => (Sig -> Sig) -> a -> aSource

Constructs the effect that applies a given function on every channel.

effectS :: (CsdTuple a, Out a) => (Sig -> SE Sig) -> a -> SE aSource

Constructs the effect that applies a given function with side effect (it uses random opcodes or delays) on every channel.

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 :: (Out a, CsdSco sco) => sco (Mix a) -> IO StringSource

Renders Csound file.

writeCsd :: (Out a, CsdSco sco) => String -> sco (Mix a) -> IO ()Source

Render Csound file and save it to the give file.

playCsd :: (Out a, CsdSco sco) => String -> String -> sco (Mix a) -> IO ()Source

RenderCsound file save it to the given file, render with csound command and play it with the given program.

 playCsd program file sco 

Produces files file.csd (with renderCsd) and file.wav (with csound) and then invokes:

 program file.wav

Players (Linux)

Handy short-cuts for function playCsd.

mplayer :: (Out a, CsdSco sco) => sco (Mix a) -> IO ()Source

Renders to tmp.csd and tmp.wav and plays with mplayer.

totem :: (Out a, CsdSco sco) => sco (Mix a) -> IO ()Source

Renders to tmp.csd and tmp.wav and plays with totem player.

Players (Windows)

Handy short-cuts for function playCsd.

TODO (you can send me your definitions)

Players (OS X)

Handy short-cuts for function playCsd.

TODO (you can send me your definitions)

Opcodes

Some colors to paint our soundscapes.

Patterns

Frequently used combinations of opcodes.

module Csound.Air

Options

We can set some csound options.

data CsdOptions Source

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. 

Constructors

CsdOptions 

Instances

renderCsdBy :: (Out a, CsdSco sco) => CsdOptions -> sco (Mix a) -> IO StringSource

Renders Csound file with options.

writeCsdBy :: (Out a, CsdSco sco) => CsdOptions -> String -> sco (Mix a) -> IO ()Source

Render Csound file with options and save it to the give file.

playCsdBy :: (Out a, CsdSco sco) => CsdOptions -> String -> String -> sco (Mix a) -> IO ()Source

Works just like playCsd but you can supply csound options.

Players (Linux)

Handy short-cuts for function playCsdBy.

mplayerBy :: (Out a, CsdSco sco) => CsdOptions -> sco (Mix a) -> IO ()Source

Renders to tmp.csd and tmp.wav and plays with mplayer.

totemBy :: (Out a, CsdSco sco) => CsdOptions -> sco (Mix a) -> IO ()Source

Renders to tmp.csd and tmp.wav and plays with totem player.

Players (Windows)

Handy short-cuts for function playCsd.

TODO (you can send me your definitions)

Players (OS X)

Handy short-cuts for function playCsd.

TODO (you can send me your definitions)