Skip to content

Instantly share code, notes, and snippets.

Embed
What would you like to do?
リスト処理で簡単な波形を作ってSarasvati(開発版:https://github.com/tokiwoousaka/Sarasvati/tree/develop/4 )に流し込むテスト。
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
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment
You can’t perform that action at this time.