リスト処理で簡単な波形を作ってSarasvati(開発版：https://github.com/tokiwoousaka/Sarasvati/tree/develop/4 )に流し込むテスト。

gistfile1.hs

module Main where
import Sound.Sarasvati
import Control.DeepSeq
import Control.Arrow

main :: IO ()
main = do
  putStrLn "music building..."
  sarasvatiOutput defaultConfig . vol 0.5 0.5 $!! concat [music, music, r 8]
  return ()

----------------
-- tools

type Waveform = [(Float, Float)]
type Note = Int -> Waveform

sinBase :: SarasvatiConfig -> Double -> [Float]
sinBase c d = let
  step = realToFrac $ (pi / confSampleRate c) * d
  in map sin [0, step.. ]

sinl :: Double -> [Float]
sinl = sinBase defaultConfig
 
zips :: [a] -> [(a, a)]
zips x = zip x x
 
mw :: Double -> Int -> Waveform
mw h l = take (l * 4800) $ zips (sinl h)
 
vol :: Float -> Float -> Waveform -> Waveform
vol x y = map ((*x)***(*y))

-- Actually, Waveform be Monoid by this operation.
mixing :: Waveform -> Waveform -> Waveform
mixing [] [] = []
mixing [] (x:xs) = x : mixing [] xs
mixing (x:xs) [] = x : mixing xs []
mixing (x:xs) (y:ys) = (fst x + fst y, snd x + snd y) : mixing xs ys

----------------
-- mix

music :: Waveform
music = foldl mixing [] 
  [ vol 0.6 0.6 $ concat 
    [ baseLine01, baseLine01, baseLine01, baseLine01
    , baseLine01, baseLine01
    ]
  , vol 0.7 0.35 $ concat 
    [ mainMero01, mainMero02, mainMero01, mainMero02'
    , mainMero03, mainMero04
    ]
  , vol 0.05 0.1 $ concat 
    [ subMero01, subMero02, subMero01, subMero02
    , subMero03, subMero04
    ]
  ]
  
----------------
-- main mero

mainMero01 :: Waveform
mainMero01 = concat
  [ a 14, a 1, b 1 
  , c' 8, b 4, g 4
  , a 1, r 2, e' 1, e' 12
  , d' 1, r 2, g 1, g 12
  ]

mainMero02 :: Waveform
mainMero02 = concat
  [ a 14, a 1, b 1 
  , c' 8, b 4, g' 2 , fs' 1, f' 1
  , e' 15, d' 1
  , e' 16
  ]

mainMero02' :: Waveform
mainMero02' = concat
  [ a 14, a 1, b 1 
  , c' 8, b 4, g' 2 , fs' 1, f' 1
  , e' 15, d' 1
  , e' 12, a 1, b 1, c' 1, e' 1
  ]

mainMero03 :: Waveform
mainMero03 = concat
  [ a' 16
  , g' 8, d' 8
  , e' 3, f' 3, e' 2, d' 3, e' 3, d' 2
  , c' 8, b 8
  ]

mainMero04 :: Waveform
mainMero04 = concat
  [ a 10, a 2, b 2, c' 2
  , a 10, a 2, b 2, c' 2
  , e' 15, d' 1
  , e' 16
  ]

----------------
-- sub mero

subMero01 :: Waveform
subMero01 = concat
  [ r 16
  , r 16
  , r 8, a' 1, r 2, e'' 1, e'' 3, d'' 1
  , e'' 7, d'' 1
  , e'' 1, d'' 1, e'' 1, d'' 1, e'' 1, d'' 1, e'' 1, d'' 1
  ]

subMero02 :: Waveform
subMero02 = concat
  [ e'' 16
  , r 16
  , r 8, a' 4, g'' 2 , fs'' 1, f'' 1
  , e'' 16
  ]

subMero03 :: Waveform
subMero03 = vol 0.5 0.5 $ concat
  [ c''' 16
  , b'' 8, g'' 8
  , g'' 3, a'' 3, g'' 2, f'' 3, g'' 3, f'' 2
  , e'' 8, d'' 8
  ]

subMero04 :: Waveform
subMero04 = vol 0.8 0.8 $ concat
  [ c'' 10, c'' 2, d'' 2, e'' 2
  , c'' 10, c'' 2, d'' 2, e'' 2
  , g'' 16
  , fs'' 16
  ]

----------------
-- base line

baseLineR1 :: Note -> Note -> Waveform
baseLineR1 n1 n2 = concat $ 
  [ n1 1, r  1, n1 1, r 1, r 2 , n1 1, n1 1
  , n2 1, r  1, n2 1, r 1, r 2 , n2 1, n2 1
  ]

baseLine01 :: Waveform
baseLine01 = concat $
  [ baseLineR1 a_ g_
  , baseLineR1 f_ e_
  , baseLineR1 a_ c
  , baseLineR1 g_ g_
  ]

----------------
-- notes

e_ = mw 329.63
f_ = mw 349.23
g_ = mw 392.00
a_ = mw 440.00
c = mw 523.25
d = mw 587.32
e = mw 659.25
f = mw 698.46
g = mw 783.99
a = mw 880.00
b = mw 987.77
c' = mw 1046.50
d' = mw 1174.66
e' = mw 1318.51
f' = mw 1396.91
fs' = mw 1479.98
g' = mw 1567.98
a' = mw 1760.00
b' = mw 1975.53
c'' = mw 2093.00
d'' = mw 2349.32
e'' = mw 2637.02
f'' = mw 2793.83
fs'' = mw 2959.96
g'' = mw 3135.96
a'' = mw 3520.00
b'' = mw 3951.07
c''' = mw 4186.01
d''' = mw 4698.64
e''' = mw 5274.04
r = vol 0 0 . mw 0