Haskell Advent Calendar 13日目の記事です。
ごきげんよう。
今年も音楽の冬がやってまいりました。Haskellより音楽のほうに力を注いでいる気がするこの頃ですが、ふとこう思いました――「Haskellでシンセサイザーを作たらとても楽しいのではないか？」
シンセサイザーの仕組みは、たとえばFM・減算式ならこうなります:
しかし、これが実装出来てもあまり嬉しくない、というのはわかっていただけるのではないでしょうか――そう、ただのシンセサイザーではなくどんなシンセサイザーでも作れるフレームワークが欲しいのです。
部品を作る部品 -Artery-
まず、私は、部品同士を「配線」できるようにするため、arteryというパッケージを作りました。
ArteryはArrowとしてのインターフェイスを持っています。Arrowはごく簡単に表現すると、以下のようなクラスで表現されます(実際とは少し異なります)。
class Arrow a where
arr :: (b -> c) -> a b c
(>>>) :: a b c -> a c d -> a b d
(***) :: a b c -> a b' c' -> a (b,b') (c,c')
このクラスが意味するのは、「普通の関数を任意のアローに埋め込むことができる」「アロー同士は合成できる」「二つのアローを同時に動かすことができる」ということで、「Arrow」=「配線のできる型」といった理解でも問題ないでしょう。
Arrow記法を使うことで、非常に直感的にアローの組み合わせを記述することができます。
{-# LANGUAGE Arrows #-} hoge :: Artery m (Float, Float) Float hoge = proc (freq, phase) -> do x <- f -< (freq, phase) y <- g -< (freq * 2, phase) returnA -< x * y
出力が代入される変数、アロー、入力を<-と-<でつなげて書きます。do記法と同じ構文糖衣で、コンパイル時にarr、(>>>)、(***)の組み合わせに還元されます。
部品
Arteryで実装した部品を紹介します。電子回路と違って中身を見てもあまり面白くないので、実装は基本的に飛ばします。
発振器
dsp-arteryパッケージ(https://github.com/fumieval/dsp-artery)で、鋸波と正弦波を発生させるArteryが定義されています。周波数と位相の対を入力として取ります。
sineWave :: (Floating a, Ord a, Given SampleRate) => Artery m (a, a) a sawWave :: (Given SampleRate, Fractional a) => Artery m (Float, Float) a
フィルタ
http://musicdsp.org/archive.php?classid=3#26をHaskellに移植しただけです。信号、カットオフ、レゾナンスをそれぞれ入力として取ります。
lowpass :: Fractional a => Artery m (a, (a, a)) a
エンベロープジェネレータ
お馴染みの、アタック、ディケイ、サスティン、リリースをパラメータとするエンベロープジェネレータです。
genADSR :: (Given SampleRate, Floating a, Ord a) => a -> a -> a -> a -> Artery m Bool a
ベースを作る
先に紹介した部品を組み合わせ、昔ながらのシンセベースを作ってみましょう。シグモイド関数を適用するのが音の太さの秘訣(?!)。
type Synth a = Given SampleRate => Artery m (Float, Bool) a bass :: Synth Float bass = proc (freq, gate) -> do w <- sawWave -< (freq, 0) env <- genADSR 0.001 2 0 1 -< gate saturator 8 <<< lowpass -< (w, (env * 0.8, 4)) saturator :: (Floating a) => a -> Artery m a a saturator gain = arr $ \x -> 2 / (1 + exp (gain * x)) - 1
ベルを作る
周波数変調や位相変調も、Arrow記法ならこんなに簡単。シンプルだけれど、私のお気に入りの音です。
bell :: Synth Float bell = proc (freq, gate) -> do m <- sineWave -< (64 * freq, 0) env <- genADSR 0.01 0.4 0.2 0.4 -< gate sineWave -< (freq * 2, m * env * 0.5)
リードを作る
減算、FMと来たら次は加算！ビブラートがかかっているのもポイント。
bundle :: Num b => [Artery m a b] -> Artery m a b bundle xs = … harmony :: Given SampleRate => [(Float, Float)] -> Artery m (Float, Float) Float harmony hs = bundle [arr (first (k*)) >>> sineWave >>> arr (*g) | (k, g) <- hs] lead :: Synth Float lead = proc (freq, gate) -> do vib <- sineWave -< (3, 0) s <- harmony [(1, 1), (2, 0.9), (3, 0.05), (4, 0.25), (5, 0.35) , (6, 0.4) , (7, 0.1) , (8, 0.08) , (9, 0.008) , (10, 0.001) , (11, 0.02), (14, 0.009), (16, 0.05), (18, 0.004), (20, 0.003) , (22, 0.002), (24, 0.001), (26, 0.001)] -< (freq * (1 + vib * 0.005), 0) env <- genADSR 0.1 2 1 1 -< gate Moog.lowpass -< (s, (env * 0.9, 1))
鳴らすために
これでFinish…ではありません。シンセにメロディを与え、その出力を具体化しなければならないのです！結構めんどくさい処理があるので、詳細はソースコードを見てください。
bpm = 140 samplePerBeat :: Given SampleRate => Int samplePerBeat = floor $ 60 / bpm * theSampleRate rhythm :: Given SampleRate => String -> Artery m () Bool rhythm = … melody :: Given SampleRate => Int -> Float -> [Int] -> Artery m () Float melody d t = … intro :: Given SampleRate => Artery m () (V2 Float) intro = melody 4 12 [4, 5, 7, 7, 12, 12, 4, 5, 7, 12, 14, 16, 14, 11, 12, 12, 7, 7, 4, 5, 7, 7, 12, 12, 14, 11, 12, 14, 17, 16, 17, 14] &&& rhythm "***-*-*********-*-**-*-*-********" >>> bell >>> arr pure -- モノラル→ステレオ
まず、メロディとリズムを組み合わせ、シンセの入力を生成します。二年前を思い出す……。そして、Arteryを再生したり止めたりするためにFreeモナドが登場します。
type Playlist r = Free (PlaylistF r) start :: Artery IO () r -> Playlist r ClipId stop :: ClipId -> Playlist r () wait :: Float -> Playlist r () runPlaylist :: Given SampleRate => Playlist r Void -> Artery IO () [r]
mainの実装。dsp-artery-ioのwithStreamで実際に音を鳴らします。
main = withStream def (withSampleRate gen) $ threadDelay (40 * 1000 * 1000) where gen :: Given SampleRate => Artery IO () (V2 Float) gen = runPlaylist song >>> arr sum >>> stereo' (saturator 1) song :: Given SampleRate => Playlist (V2 Float) a song = do i <- start intro wait (4 * 2) stop i forever $ do i <- start bassline j <- start mainMelody wait (4 * 8) stop i stop j
結果
ドラムはちょっと勘弁…
まとめ
Haskellでもそこそこの音は出せますが、やっぱりC++などで実装されたものに比べて処理が重いのが難点です。高速化が今後の課題となりそうです。
Arrowは、Haskellらしいプログラミングをする上での素晴らしい知恵の一つです。よりよいHaskellライフのために、Arrowが効く場面を見つけていきたいですね―― というか、Arrowはもっとevalされるべき。
