module Montage

The module Montage is an (unofficial) example of using the modules Allegory, Sndfile and Csound to create mini-language to describe montages of sounds, i.e. successions, crossfades, overlaps of some number of sounds.

module Montage where

import Allegory
import Csound
import Sndfile
import Hugs.Quote

From the "user's" standpoint, there are just two parts of the module that require attention. The first of these is the datetype Montage. Each 'Montage' represents an instruction in the Montage language. These instructions are the next element in the code, below. The second element to know is the function 'montage' which takes a list of Montage instructions and returns the resulting Sound (which can then be realized with the function 'make').

The remaining code is simply implementation of the above. The module's compact definition and implementation is something of an indication of the advantages of the functional programming paradigm.

type MontageElement = (FilePath,Double,Double,Double,Double)
{- path to sound, starttime, duration, attack, release -}

setRelease :: Double -> MontageElement -> MontageElement
setRelease r (f,s,d,a,_) = (f,s,d,a,r)

getStart :: MontageElement -> Double
getStart (_,s,_,_,_) = s

type MontageComposition = [MontageElement]

setLastRelease :: Double -> MontageComposition -> MontageComposition
setLastRelease r c = (init c) ++ [setRelease r (last c)]

type MontageState = (MontageComposition,(Double,Double))
{- composition, time pointer, attack -}

montageInterpreter :: MontageState -> Montage -> MontageState
montageInterpreter (c,(tp,a)) (Sound s) = (c ++ [(s,tp,sfDuration s,a,0.0)], (tp+(sfDuration s),0.0))
montageInterpreter (c,(tp,a)) (Crossfade t) = (setLastRelease t c, (tp-t,t))
montageInterpreter (c,(tp,a)) (Overlap t) = (c, (tp-t,a))
montageInterpreter (c,(tp,a)) (OverlapCrossfade to tcf) = (setLastRelease tcf c, (tp-to-tcf,tcf))
montageInterpreter (c,(tp,a)) (InsertSilence t) = (c, (tp+t,a))
montageInterpreter (c,(tp,a)) (AlignLeft) = (c, (getStart (last c),a))
montageInterpreter (c,(tp,a)) (AlignLeftPlus t) = (c, ((getStart (last c))+t,a))
montageInterpreter state (MontageList xs) = foldl (montageInterpreter) state xs
montageInterpreter (c,(tp,a)) (Insert s t) = (c ++ [(s,t,sfDuration s,0.0,0.0)], (tp,a))
montageInterpreter (c,(tp,a)) (NoInstruction) = (c,(tp,a))

montageComposer :: MontageComposition -> Sound
montageComposer x = csound (orchestra ++ score)
  where nchnls = sfChannels (g (x!!0))
        g (f,_,_,_,_) = f
        diskin
         | nchnls ==1 = "a1"
         | nchnls ==2 = "a1,a2"
         | nchnls ==4 = "a1,a2,a3,a4"
        out
         | nchnls ==1 = "out a1*aenv"
         | nchnls ==2 = "outs a1*aenv,a2*aenv"
         | nchnls ==4 = "outq a1*aenv,a2*aenv,a3*aenv,a4*aenv"
score = "\n<CsScore>\n" ++ (concat [i s d f a r | (f,s,d,a,r) <- x]) ++ "</CsScore>\n</CsoundSynthesizer>\n"
        i s d f 0.0 0.0 = "i1 "++(show s)++" "++(show d)++" \""++f++"\" \n"
        i s d f a 0.0 = "i2 "++(show s)++" "++(show d)++" \""++f++"\" "++(show a)++"\n"
        i s d f 0.0 r = "i3 "++(show s)++" "++(show d)++" \""++f++"\" "++(show r)++"\n"
        i s d f a r = "i4 "++(show s)++" "++(show d)++" \""++f++"\" "++(show a)++" "++(show r)++"\n"
        orchestra = ``<CsoundSynthesizer>
<CsInstruments>
sr=44100
kr=441
ksmps=100
nchnls=$(nchnls)
instr 1
; no fadein or fadeout
aenv = 1.0
          $(diskin) diskin p4,1
          $(out)
endin
instr 2
; fadein only
aenv linseg 0.0, p5, 1.0, p3-p5, 1.0
          $(diskin) diskin p4,1
          $(out)
endin
instr 3
; fadeout only
aenv linseg 1.0, p3-p5, 1.0, p5, 0.0
          $(diskin) diskin p4,1
          $(out)
endin
instr 4
; fadein and fadeout
aenv linseg 0.0, p5, 1.0, p3-p5-p6, 1.0, p6, 0.0
          $(diskin) diskin p4,1
          $(out)
endin
</CsInstruments>''