January 22nd, 2008
As part of my effort to seek enlightenment through Haskell I’ve made some music. It’s actually sort of neat creating a waveform that when played through a DA resembles something other than white noise. This isn’t controlling a sequencer – it’s just composing functions to make make a sound representation. It’s a lot like naive ray tracing where all objects are considered for each pixel in that for each sample I sum the waveforms for all notes, many of which are zero since a note only plays for a short duration and is otherwise silent.
Notes are made by transforming a sound frequency Signal (Double -> Double) with pitch and amplitude Shifters (Signal -> Signal). For the note envelope I create a signal that represents amplitude and modulate the sound signal with the amp combinator, which is a Modulator (Signal -> Signal -> Signal).
One thing missing from this implementation is the ability to write (signal = signal1 + signal2). I now would write (signal t = signal1 t + signal2 t,) since a signal is a function over time. mauke in #haskell (irc.freenode.net) was helpful but I still don’t understand why some things work the way they do so I chose not to write a (+) instance for signals until I understand it better. The following will play a few measures of Mozart’s something something as I remember it. I forgot what it’s called but it’s in C and it’s popular.
Here’s an ogg vorbis of the output: mozart.ogg
And the illiterate Haskell.
-- Compile and listen as follows -- ghc -o mozart mozart.hs && ./mozart | mplayer -v -rawaudio rate=16000:channels=1:samplesize=1 -demuxer rawaudio - import System.IO import Data.Char type Signal = Double -> Double type Shifter = Signal -> Signal type Modulator = Signal -> Signal -> Signal main :: IO () main = putStr . toBytes . take 200000 . sample 16000 $ sound sound :: Signal sound = ampc 0.35 . shifterSum song . pitchc (440 * hstep ** 3 * 2 * pi) $ wave song :: [Shifter] song = zipWith (\e p -> amp e . pitchc p) (lhEnvs ++ rhEnvs) (lhPitches ++ rhPitches) wave :: Signal wave = flange (\x -> sin (x * 2)) sin lhPitches :: [Double] lhPitches = map (* (1/2)) $ [du,so,me,so,du,so,me,so,re,so,fa,so,du,so,me,so] ++ [du,la,fa,la,du,so,me,so,re,so,fa,so,du,so,me,so] lhBegins :: [Double] lhBegins = take 32 $ toTempo [1..] -- Applies 0.1 second duration to left hand begin times -- resulting in a list of complete amplitude envelopes -- for each note. lhEnvs :: [Signal] lhEnvs = map (pianoEnv 0.1) lhBegins rhPitches :: [Double] rhPitches = [du,me,so,ti/2,du,re,du, la,so,du*2,so,fa,me] rhBegins :: [Double] rhBegins = toTempo [1,5,7,9,12,12.5,13, 17,21,23,25,28,29] rhEnvs :: [Signal] rhEnvs = map (pianoEnv 0.5) rhBegins -- attack decay sustain release to resemble a piano -- apply duration and begin for complete envelope signal pianoEnv :: Double -> Double -> Signal pianoEnv = env 0.005 0.05 0.4 0.7 -- eigth note tempo tempo = 160 toTempo :: [Double] -> [Double] toTempo ts = map (\t -> 60 * t / tempo) ts -- Sums list of signal shifters and mutes the original signal shifterSum :: [Shifter] -> Shifter shifterSum xs = foldr (shifterAdd) (const . const 0) xs shifterAdd :: Shifter -> Shifter -> Shifter shifterAdd a b input t = a input t + b input t -- 1 b -- / \c_____d -- / \ -- 0 ___a/ \e___ Makes an amplitude envelope for a note -- -- Will div by zero in some cases. env :: Double -> Double -> Double -> Double -> Double -> Double -> Signal env attack decay sustain release duration begin t | t < a || t >= e = 0 | t < b = (t - a) / attack | t < c = 1 - (1 - sustain) * (t - b) / decay | t < d = sustain | t < e = sustain - sustain * (t - d) / release where a = begin b = a + attack c = b + decay d = c + duration e = d + release sample :: Double -> Signal -> [Double] sample rate signal = [signal (t / rate) | t <- [0..]] -- yuck toBytes :: [Double] -> [Char] toBytes = fmap $ chr . clamp 0 255 . (\n -> truncate $ (n + 1) * 127) clamp min max x | x < min = min | x > max = max | otherwise = x pitchc :: Double -> Signal -> Signal pitchc mult input t = input (t * mult) ampc :: Double -> Signal -> Signal ampc mult input t = mult * (input t) amp :: Modulator amp control input t = (control t) * (input t) -- only works for control where d/dt = 0 pitch :: Modulator pitch control input t = input (t * control t) flange :: Modulator flange ff w t = w (t + ff t) hstep = 2 ** (1/12) du = hstep ** 0 re = hstep ** 2 me = hstep ** 4 fa = hstep ** 5 so = hstep ** 7 la = hstep ** 9 ti = hstep ** 11