レガシーコード生産ガイド

私に教えられることなら

少しだけClojure 8 / Clojureにシーツ・オブ・サウンドを演奏させる

プログラミングClojure第2版を読みながら続き。

方針

  • 基本的に本の説明をそのままor自分の言葉に直しただけで書き直すようなことはしない
  • サンプルコードが長くて理解しづらい、練習したいなと思うものは細かく試して書いてみる
  • 読んだ時点で書かれてなかったり省略されているか、疑問に思ったことを調べて書く
  • 後から書かれていたら参照のために簡単にメモする

離れたところから影響を及ぼす

で説明されてる動的束縛とは全く関係ないんだけど、

clojure自体のソースではどういう風に^:dynamicやbinding使われてるんだろ?→シンボル一覧みたいなの出してsourceでmapしてtakeして少しずつdynamic探していけばいいかな→source関数は何返すんだろ、(class (source defn))してみるか

で、defnのソース表示したら

;; 省略
        (let [m (if (string? (first fdecl))
                  {:doc (first fdecl)}
                  {})
              fdecl (if (string? (first fdecl))
                      (next fdecl)
                      fdecl)
              m (if (map? (first fdecl))
                  (conj m (first fdecl))
                  m)
              fdecl (if (map? (first fdecl))
                      (next fdecl)
                      fdecl)
              fdecl (if (vector? (first fdecl))
                      (list fdecl)
                      fdecl)
              m (if (map? (last fdecl))
                  (conj m (last fdecl))
                  m)
;; 省略

うお、letこんな使い方するんだ!していいんだ!とちょっとびっくりした。関数宣言を先頭から見ていってメタデータを作っていってるんだけど、同じ変数複数回letする作法ありなんだ。今度から使おう。

で、sourceは表示だけしてnilを返すので、dynamicの使いドコロだけ調べてみた

stackoverflow.com

テストとグローバルリソースか、なるほど。

スネークゲーム

ゲームを作るときの構成の参考にするために、簡単にまとめてみる。

  • グローバル定数に依存するコードは躊躇無く書いてある。
  • 蛇、りんごなどのゲームのアプリケーション領域のデータは、この後のp154で述べられているようにマップが使われている。マップの中も、java.awt.Color以外は簡単なシーケンスで表現されている。
  • 蛇やりんごの生成はデータの生成のみ、蛇の移動や方向転換などは全て前の状態を取って変化後の状態を返す。move(snake)であってsnake.move()ではない。
  • 副作用の層ではそれらを書き換える条件、タイミングのみを担当する
  • 描画はマルチメソッドを使って外から定義する。snakeやapple自体は自分をどう描画するか知らない。snake.draw()みたいな設計とは違う。

音を鳴らす

一気に飛んで6.5レコード。楽器弾いてるのでここが一番気になってた。

とりあえずサンプルコードを見ながら音を鳴らしてみる。音の名前をpitchというのは(正式なところはわからないけど)違和感があったので、Note.nameにした。あといくつか自分にとってわかりやすく変更。

(ns music.core)

(import 'javax.sound.midi.MidiSystem)

(defrecord Note [name octave duration])


;; bpm、音価
;; ============================================================================

;; 130 (beat/min)
;; 1/130 (min/beat)
;; 1/130 * 60 (sec/beat)
;; 1/130 * 60 * 1000 (msec/beat)
;; 1/130 * 60 * 1000 * 4 (msec/bar)

(defn bpm->bar-ms [bpm]
  (* (/ 1 bpm) 60 1000 4))

(defn duration->msec [duration bpm]
  (double (* duration (bpm->bar-ms bpm))))


;; 音名、Interval
;; ============================================================================

(def key-nums {:C 0, :C# 1, :Db 1, :D 2, :D# 3, :Eb 3, :E 4,
               :F 5, :F# 6, :Gb 6, :G 7, :G# 8, :Ab 8, :A 9,
               :A# 10, :Bb 10, :B 11})

;; MidiNote
;; ============================================================================

(defprotocol MidiNote
  (to-msec [this bpm])
  (key-number [this])
  (play [this tempo midi-channel]))

(defn midi-key-number [note-name octave]
  (+ (note-name key-nums) (* 12 (inc octave))))

(extend-type Note
  MidiNote
  (to-msec [this bpm] (duration->msec (:duration this) bpm))
  (key-number [this] (midi-key-number (:name this) (:octave this)))
  (play [this bpm midi-ch]
    (let [keynum (key-number this), velocity (or (:velocity this) 80)]
      (.noteOn midi-ch keynum velocity)
      (Thread/sleep (to-msec this bpm))
      (.noteOff midi-ch keynum velocity))))

;; 演奏
;; ============================================================================
(defn perform [notes & {:keys [bpm] :or {bpm 120}}]
  (with-open [synth (doto (MidiSystem/getSynthesizer) .open)]
    (let [channel (aget (.getChannels synth) 0)]
      (doseq [note notes]
        (play note bpm channel)))))

タルカスの最初でも流してみる

(defn same-duration-notes [duration notes]
  (map (fn [[k o]] (->Note k o duration)) (partition 2 2 notes)))

(def tarkus (take 20 (cycle (same-duration-notes 1/8 [:F 3 :Bb 3 :Eb 4 :Bb 3 :Ab 4 :Eb 4 :Bb 3 :E 4 :B 3 :F# 3]))))

(perform tarkus :bpm 140)でデレレレデレレデレレが流れる。

最初にちょっとモタって、最後はブツッと切れてしまう。というか、スレッドスリープさせるの……?midiのシーケンス生成して演奏させたいけど、深みに嵌りそうだし、overtone?とか便利そうなライブラリもあるっぽいので今回はこれで我慢する。

Clojureにシーツ・オブ・サウンドを演奏させたい

コード進行、bpm、音符数を指定すれば、延々とそれにあったスケールなどを鳴らし続けるようにしてみる。

最終的なコードの形を考えて近づけていってみる。

(def progression [:A :major, :F# :altered, :B :dorian, :E :mixo-b9th])
(perform (take 2000 (sheets-of-sound (one-bars progression) 1/8)) 150)

こんなカンジで、ルートとスケールを指定して、sheets-of-soundで無限シーケンスを作成したい。

音の並べ方は、とりあえず今回は上行・下行だけにする。

どんなデータ構造にするか

例えばメジャースケールなら、[0 2 4 5 7 9 11]とルートからのインターバルを作り、それとC-Bまでの12音のcycleを使い、available noteの無限シーケンスを作る。

コード進行は、小節数・キー(ルート)・使用スケールのレコードにする。

スケールのシーケンスを作る

まずはそれぞれのスケールのインターバルを定義する。

(def scale-intervals
  { :major      [0 4 7 11],
    :altered    [0 3 4 8 10],
    :dorian     [0 3 7 9 10],
    :mixo       [0 4 7 10],
    :mixo-b9th  [0 1 4 7 10],
    :penta      [0 2 4 7 9],
    :mpenta     [0 3 5 6 7 10],
    :comdim     [0 1 3 4 6 7 9 10],
    :patmartino [0 2 3 5 6 7 9 10 11]
  })

スケール全部にするとまったく進行がわからなくなりそうなので、コードトーンと特徴音だけにしておいた。

CからBまでを繰り返す無限シーケンスを用意し、任意の音から始まるシーケンスを取れるようにする。

(def all-notes (cycle [:C :C# :D :D# :E :F :F# :G :G# :A :A# :B]))

(defn notes-from [note-name] (drop-while #(not= note-name %) all-notes))

スケールの無限シーケンスを作る。

  • notes-fromで任意の音から始まる12音の列を作る
  • scale-intervalsも無限リストにする
  • 12音列の先頭から0始まりのインデックスを見ていき、12で割ったあまりが選んだスケール列のfirstならば、その音を拾う
  • 12音列、スケール列のrestに対して繰り返す

で、いいかな。作ってみる。

(defn indexed [seq] (map-indexed #(identity [%1 %2]) seq))

(defn drop-while-rem-is [indexed-coll divider remi]
  (drop-while #(not= (rem (first %) divider) remi) indexed-coll))

(defn available-notes [intervals notes]
  (lazy-seq
   (let [[interval & _] intervals,
         dropped (drop-while-rem-is notes 12 interval),
         [[_ note]] dropped]
     (cons note (available-notes (rest intervals) (rest dropped))))))

(defn make-scale [key name]
  (let [intervals (cycle (name scale-intervals)),
        notes (indexed (notes-from key))]
    (available-notes intervals notes)))

思ったより難しかった。試してみよう。

user=> (take 14 (make-scale :A :major))
(:A :B :C# :D :E :F# :G# :A :B :C# :D :E :F# :G#)

user=> (take 14 (make-scale :C :major))
(:C :D :E :F :G :A :B :C :D :E :F :G :A :B)

user=> (take 14 (make-scale :Bb :major))
;; 無限ループ!

user=> (take 14 (make-scale :A# :major))
(:A# :C :D :D# :F :G :A :A# :C :D :D# :F :G :A)

上手くいってるみたいだけど、全部シャープで定義してるの忘れてフラットを渡したら無限ループして危ない。シャープとフラットで同音のものも判定できる関数を追加しよう。

(def same-note { :C# :Db, :D# :Eb, :F# :Gb, :G# :Ab, :A# :Bb })

(defn note-equal [a b]
  (or (= a b)
      (= (same-note a) b)
      (= (same-note b) a)))

(defn notes-from [note-name] 
  (drop-while #(not (note-equal note-name %)) all-notes))

試してみる。

user=> (take 14 (make-scale :Bb :major))
(:A# :C :D :D# :F :G :A :A# :C :D :D# :F :G :A)

user=> (take 7 (make-scale :C :mixo-b9th))
(:C :C# :E :F :G :A :A#)

できた!

割と淡々と書いてるけど、Clojureのシーケンスが便利すぎて感動しまくってる。最高だ。

コード進行を決める

(defrecord ChordProg [bar key scale])

(defn one-bars [coll]
  (map (fn [[key scale]] (->ChordProg 1 key scale)) (partition 2 2 coll)))

(defn progs [coll]
  (map (fn [[bar key scale]] (->ChordProg bar key scale)) (partition 3 3 coll)))

(def progressions 
  { :I-VI-II-V-onA (one-bars [:A :major, :F# :altered, :B :dorian, :E :mixo-b9th])
    :JazzBlues-onE (progs [1 :E :mixo, 1 :A :penta,
                           1/2 :E :mixo, 1/2 :F# :altered, 1/2 :B :dorian, 1/2 :E :mixo-b9th,
                           1 :A :mixo, 1 :A :comdim,
                           1 :E :penta, 1/2 :G# :patmartino, 1/2 :C# :altered,
                           1 :F# :mpenta, 1 :B :altered,
                           1/2 :G# :mpenta, 1/2 :C# :altered, 1/2 :F# :dorian, 1/2 :B :mixo-b9th])
  })

キーとスケールに加えて小節数も持たせた。

スケール上行下行させてみる

まず上行。オクターブ決め打ちで、スケールを前から順番にノートにしていけば良さそう。コードプログレッションと音価を受け取り、指定された小節を埋めるのに必要な数だけスケール上行を取り出してノートに変換する。

(defn notes-fills-bar [bar duration]
  (/ bar duration))

(defn progression->upward-notes [prog octave duration]
  (let [{:keys [bar key scale]} prog
        n (notes-fills-bar bar duration)
        notes (take n (make-scale key scale))]
    (map #(->Note % octave duration) notes)))

(defn progressions->upward-notes [progs octave duration]
  (reduce #(concat %1 (progression->upward-notes %2 octave duration)) () progs))

た、試してみる。

user=> (perform (progressions->upward-notes (music.core/progressions :JazzBlues-onE) 4 1/8) :bpm 100)

ウオオオオオーーーッッ!!!音楽だ!!音楽になってる!!やったぜ!!

progressions->upward-notesが返すのはコード進行1コーラス分のシーケンスなので、そのまま渡して大丈夫だった。cycleで囲めば、Ctrl-Cするまで再生し続ける。

下行は、ちょっと面倒なのでprogression->upward-notesが作った1コード分のシーケンスをそのままreverseする。

(defn progression->downward-notes [prog octave duration]
  (reverse (progression->upward-notes prog octave duration)))

(defn progressions->downward-notes [progs octave duration]
  (reduce #(concat %1 (progression->downward-notes %2 octave duration)) () progs))

おわり

体力が尽きたのでsheets-of-soundはまた今度にする。いつかこう、簡単マイナスワン生成器みたいなの作りたい。

以下に全コードを載せる。暇な人は(play-neo-classical)を聞いてみてほしい。

あと今回からLighttableを使ってみた。めっちゃカッチョイイしinstareplが便利なんだけど、警告でコードの一番下が隠れたり、プラグイン入れたら大分挙動が怪しくなったので暫く格闘が必要そうだ。

(ns music.core)

(import 'javax.sound.midi.MidiSystem)

(defrecord Note [name octave duration])


;; bpm、音価
;; ============================================================================
;; 130 (beat/min)
;; 1/130 (min/beat)
;; 1/130 * 60 (sec/beat)
;; 1/130 * 60 * 1000 (msec/beat)
;; 1/130 * 60 * 1000 * 4 (msec/bar)

(defn bpm->bar-ms [bpm]
  (* (/ 1 bpm) 60 1000 4))

(defn duration->msec [duration bpm]
  (double (* duration (bpm->bar-ms bpm))))


;; 音名、Interval
;; ============================================================================
(def key-nums {:C 0, :C# 1, :Db 1, :D 2, :D# 3, :Eb 3, :E 4,
               :F 5, :F# 6, :Gb 6, :G 7, :G# 8, :Ab 8, :A 9,
               :A# 10, :Bb 10, :B 11})

;; MidiNote
;; ============================================================================
(defprotocol MidiNote
  (to-msec [this bpm])
  (key-number [this])
  (play [this tempo midi-channel]))

(defn midi-key-number [note-name octave]
  (+ (note-name key-nums) (* 12 (inc octave))))

(extend-type Note
  MidiNote
  (to-msec [this bpm] (duration->msec (:duration this) bpm))
  (key-number [this] (midi-key-number (:name this) (:octave this)))
  (play [this bpm midi-ch]
    (let [keynum (key-number this), velocity (or (:velocity this) 80)]
      (.noteOn midi-ch keynum velocity)
      (Thread/sleep (to-msec this bpm))
      (.noteOff midi-ch keynum velocity))))

;; 演奏
;; ============================================================================
(defn perform [notes & {:keys [bpm] :or {bpm 120}}]
  (with-open [synth (doto (MidiSystem/getSynthesizer) .open)]
    (let [channel (aget (.getChannels synth) 0)]
      (doseq [note notes]
        (play note bpm channel)))))

;; タルカス
;; ============================================================================
(defn same-duration-notes [duration notes]
  (map (fn [[k o]] (->Note k o duration)) (partition 2 2 notes)))

(def tarkus (take 20 (cycle (same-duration-notes 1/8 [:F 3 :Bb 3 :Eb 4 :Bb 3 :Ab 4 :Eb 4 :Bb 3 :E 4 :B 3 :F# 3]))))

;; シーツ・オブ・サウンド
;; ============================================================================
(defrecord ChordProg [bar key scale])

(defn one-bars [coll]
  (map (fn [[key scale]] (->ChordProg 1 key scale)) (partition 2 2 coll)))

(defn progs [coll]
  (map (fn [[bar key scale]] (->ChordProg bar key scale)) (partition 3 3 coll)))

(def progressions 
  { :I-VI-II-V-onA (one-bars [:A :major, :F# :altered, :B :dorian, :E :mixo-b9th])
    :JazzBlues-onE (progs [1 :E :mixo, 1 :A :penta,
                           1/2 :E :mixo, 1/2 :F# :altered, 1/2 :B :dorian, 1/2 :E :mixo-b9th,
                           1 :A :mixo, 1 :A :comdim,
                           1 :E :penta, 1/2 :G# :patmartino, 1/2 :C# :altered,
                           1 :F# :mpenta, 1 :B :altered,
                           1/2 :G# :mpenta, 1/2 :C# :altered, 1/2 :F# :dorian, 1/2 :B :mixo-b9th])
    :Neo-Classical (progs [1/2 :E :min, 1/2 :B :maj, 1/2 :D :min, 1/2 :A :maj, 1/2 :A :min, 1/2 :E :min, 1/2 :F# :maj, 1/2 :B :maj])
  })

(def scale-intervals
  { :major      [0 4 7 11],
    :altered    [0 3 4 8 10],
    :dorian     [0 3 7 9 10],
    :mixo       [0 4 7 10],
    :mixo-b9th  [0 1 4 7 10],
    :penta      [0 2 4 7 9],
    :mpenta     [0 3 5 6 7 10],
    :comdim     [0 1 3 4 6 7 9 10],
    :patmartino [0 2 3 5 6 7 9 10 11],
    :min        [0 3 7],
    :maj        [0 4 7],
    :dim        [0 3 6]
  })

(def all-notes (cycle [:C :C# :D :D# :E :F :F# :G :G# :A :A# :B]))

(def same-note { :C# :Db, :D# :Eb, :F# :Gb, :G# :Ab, :A# :Bb })

(defn note-equal [a b]
  (or (= a b)
      (= (same-note a) b)
      (= (same-note b) a)))

(defn notes-from [note-name] 
  (drop-while #(not (note-equal note-name %)) all-notes))

(defn indexed [seq] (map-indexed #(identity [%1 %2]) seq))

(defn drop-while-rem-is [indexed-coll divider remi]
  (drop-while #(not= (rem (first %) divider) remi) indexed-coll))

(defn available-notes [intervals notes]
  (lazy-seq
   (let [[interval & _] intervals,
         dropped (drop-while-rem-is notes 12 interval),
         [[_ note]] dropped]
     (cons note (available-notes (rest intervals) (rest dropped))))))

(defn make-scale [key name]
  (let [intervals (cycle (name scale-intervals)),
        notes (indexed (notes-from key))]
    (available-notes intervals notes)))

(defn notes-fills-bar [bar duration]
  (/ bar duration))

(defn progression->upward-notes [prog octave duration]
  (let [{:keys [bar key scale]} prog
        n (notes-fills-bar bar duration)
        notes (take n (make-scale key scale))]
    (map #(->Note % octave duration) notes)))

(defn progressions->upward-notes [progs octave duration]
  (reduce #(concat %1 (progression->upward-notes %2 octave duration)) () progs))

(defn progression->downward-notes [prog octave duration]
  (reverse (progression->upward-notes prog octave duration)))

(defn progressions->downward-notes [progs octave duration]
  (reduce #(concat %1 (progression->downward-notes %2 octave duration)) () progs))
  
(defn play-neo-classical []
  (perform (cycle (progressions->downward-notes 
    (music.core/progressions :Neo-Classical) 5 1/12)) :bpm 160))
広告を非表示にする