Project hosted by:
module Allegory

The core module Allegory defines the type 'Sound' as an abstraction of a computation that can produce a sound file on disk, and then defines operations that combine compose and relate multiple such computations.

The module begins with the usual preamble...


by David Ogborn,
(c) David Ogborn, 2000-2005

This software is distributed under the terms of the GNU General Public License.
...for details.


module Allegory where
import System
import IO
import IOExts
import Time
import Directory
import Sndfile

allegoryVersion = "0.60"

Allegory expects there to be three subdirectories in its working environment. The sources directory is where sounds to be worked on, from wherever they may have come, are expected to be. The temps directory is used to store various temporary files, including sound files that are only intermediate results on the way to some desired result. The results directory is where such desired results will be placed. Naturally these can be changed if so desired.

-- Paths and settings (edit as required for your project):
resultsDir = "results"
tempsDir = "temps"
sourcesDir = "sources"

Below is the definition of the core type Sound. The important thing to know is that a Sound is a computation that leads to a soundfile being written to disk. It may be as simple as the creation of a 10-second sine wave, or it may be something that coordinates hundreds of source files, applying various types of signal processing and then arranging them in time and/or space.

In technical terms, a Monad M is defined such that the type (M a) represents a computation leading to type a, with side effects including IO, the automatic generation of temporary file names for sound output, and the possibility of overriding such automatic file names.

data M a = M (Int -> (Int, a -> IO (), a))

type Sound = M FilePath

instance Monad M where
  return x = M (\s -> (s, \_ -> do return (), x))
  (M x1) >>= f = M (\s0 -> let
                            (s1, p1, a) = x1 s0
                            M x2 = f a
                            (s2, p2, b) = x2 s1
                            p = \n -> (p1 a) >> (p2 n)
                            (s2, p, b))

The operator @@ is used to name a Sound as a result to be directed to the results directory, not a mere temporary file. For instance, if (convolve fileX fileY) is a computation that convolves the sounds fileX and fileY, then (convolve fileX fileY @@ "interestingSound.wav") will be a related computation that stores the result as "interestingSound.wav".

(@@) :: M FilePath -> FilePath -> M FilePath
(M m) @@ n = M (\s0 -> let (s1, p, a) = m s0
                       in (s1, p, "results/" ++ n))

source :: FilePath -> Sound
source = return . ("sources/" ++)

The function 'make' takes a Sound and makes the computation happen. So, continuing our example above: make (convolve fileX fileY @@ "interestingSound.wav"), entered at the interpreter's prompt, will lead to this computation being carried out, and the file "interestingSound.wav" appearing in the results directory.

The function 'makeL' does the same thing for a list of Sound(s).

make :: Sound -> IO FilePath
make (M m) = (p n) >> return n
 where (_, p, n) = m 0

makeL :: [Sound] -> IO [FilePath]
makeL = mapM make

The type SoundList is a computation that leads to a number of sounds being created and returns their pathnames on disk, be they named results or temporary files.

type SoundList = M [FilePath]

The type Filter models something that given an existing sound, produces a new sound (i.e. given the FilePath of an existing sound, produces a computation that will produce a new sound). A number of higher-level functions to combine filters in various ways to produce new filters are also defined.

One feature of the Haskell language is its support for what is known as partial application. The utility of this feature can be illustrated in connection with the idea of Filter(s). Suppose that butterlp is of type (Double -> FilePath -> Sound), where the Double argument is the cutoff frequency of a Butterworth low pass filter (and the FilePath argument is the soundfile that will be the input to the filter). The expression (butterlp 40.0) is a partial-application of this function and has type (FilePath -> Sound) i.e. Filter. Then (given another function butterhp) the expression (composeFilters (butterlp 400.0) (butterhp 1600.0)) would represent a function that passes its input sound first through a low pass filter and then through a highpass filter. The operator # is defined to make this idiom easier, hence (butterlp 400.0) # (butterhp 1600.0) achieves the same result.

type Filter = FilePath -> Sound

composeFilters :: Filter -> Filter -> Filter
composeFilters f1 f2 x = (f1 x) >>= (\y -> f2 y)

(#) :: Filter -> Filter -> Filter
(#) = composeFilters

chainFilters :: [Filter] -> Filter
chainFilters = foldl1 (composeFilters)

filterSeries :: FilePath -> [Filter] -> SoundList
filterSeries x (f:fs)
 = do y <- f x
      z <- filterSeries y fs
      return (y:z)
filterSeries _ _ = return []

Then there are a few functions useful for getting information about sound files. Basically they are 'casts' to functions from the Sndfile module.

sfSampleCount :: String -> Int
sfSampleCount path = fromIntegral(sfFrames path)::Int

sfDuration :: String -> Double
sfDuration path = (fromIntegral(sfFrames path)::Double)
    / (fromIntegral(sfSampleRate path)::Double)

Finally, some general utility functions complete the module.

repeatListToLength :: [a] -> Int -> [a]
repeatListToLength _ 0 = []
repeatListToLength (x:xs) l = x : (repeatListToLength (xs ++ [x]) (l-1))

pchChgToSpeed :: Double -> Double
pchChgToSpeed x = ((exp ((log 2.0) / 12.0)) ** x)

runningTotal :: Num a => a -> [a] -> [a]
runningTotal s [] = [s]
runningTotal s (x:xs) = (s : (runningTotal (x+s) xs))

trans :: Int -> Double -> Double -> [Double]
trans l x1 x2 = [ x1+((fromIntegral(x)::Double)*i) | x <- [0 .. (l-1)]]
 where i = (x2-x1)/(fromIntegral(l-1)::Double)

average :: [Double] -> Double
average xs = (sum xs) / (fromIntegral(length xs)::Double)

showResult :: Show a => IO a -> IO ()
showResult p =
  do a <- p
     let b = (show a) ++ "\n"
     putStr b