GUI で midi する。。。または、キーボードを鍵盤に（解説編）

前回の “GUI で midi する。。。または、キーボードを鍵盤に” は如何だったでしょうか？

さて、解説と言っても、短いスクリプなので解説もいらないかもしれません。
今回の目玉は、gs:key-event と midi 関連関数 gs:midi-xxx だと思います。
まずは、gs:key-event から。
この関数で指定したハンドラ関数 key-action が取る引数は、４つあります。

(key-action id type code modifiers)

この内、id はおなじみ、イベント発生場所のコンポーネントID です。
type にはキーが押されたか離れたかで文字列 “pressed” か “released” が入ります。
code はキーコードで、大抵は ASCII コードですが、一部違うものがあります。前回紹介したスクリプトは日本語106用です。他のキーボードでは、動かないキーが有るかもしれません。関数key-action の一行目のコメント・アウトを外して確認して下さい。
modifiers には、SHIFT キーや CTRL キーの状態が入っています。ビット0 が SHIFTキー、ビット1 が CTR Lキーで、それぞれ押されると 1 が入り、押されていなければ、0 が入ります。
参考までに、modifiers の解析用関数を作ってみました。

(define (parse-modifiers n)
  (1 (map int (explode (bits (+ 32 n))))))
(define (translate-modifiers n)
  (let (syms '(left-click middle-click right-click ctrl shift)
        mods  (replace 0 (parse-modifiers n) nil))
    (replace nil (map and mods syms))))

実行すると、

> (parse-modifiers 17)
(1 0 0 0 1)
> (translate-modifiers 17)
(left-click shift)

こんな感じです。この引数には、SHIFT キーや CTRL キーの他にマウス・ボタンの動作も入って、マウス・イベント関数mouse-action でも使われています。
閑話休題、gs:key-event に戻りましょう。
この関数は、

(gs:key-event 'OutputArea 'key-action)

このように、ハンドラが動作するコンポーネントを指定します。
つまり、このコンポーネントがアクティブ時のみイベントが起こります。
これが曲者で、gs:listen ではうまく動かないのです。
gs:check-event でループをまわし、gs:request-focus を使って強制的にコンポーネントをアクティブにすることが必要です。

(while (gs:check-event 10000)
   (gs:request-focus 'OutputArea) ; keep focus in canvas
)

これが gs:key-event を使う時の肝でした。
さて、今回はこれくらいにして、残り midi 関連は、次回に。

以上、如何でしょうか？

GUI で midi する。。。または、キーボードを鍵盤に

newLISP-GS には、midi 用の関数があります。
それを動かすには、newLISP と Java だけでなく soundbank が必要です。
具体的には、Java のインストール・ディレクトリ下の ‘/lib/audio’ （Windows では、’\lib\audio’）に ‘soundbank.gm’ があるかどうかです。なけれな、ダウンロードして所定の場所に置いて下さい。newLISP-GS の マニュアルでは、mid 以上が推奨されています。
newLISP の Domo Folder（newLISPインストール・ディレクトリ下の ‘guiserver’） にある ‘midi-demo.lsp’ を起動して音が鳴れば、OKです。
そして、今回のスクリプトは、

; utility
(define *newlispDir* (env "NEWLISPDIR"))
(load (append *newlispDir* "/guiserver.lsp"))
; define assoc-list of note
(define *plusNote* 0)
(define *wNote* '(si Do Re Mi Fa So La Si DO RE MI FA))
(define ABC   '(59 60 62 64 65 67 69 71 72 74 76 77))
(setq *allNote* (map list *wNote* ABC))
(define keycode (append (map char (explode "ASDFGHJKL;")) (list 513 (char "]"))))
(define *bNote* '(la# nil Do# Re# nil Fa# So# La# nil DO# RE#))
(define ABC   '(58      61  63      66  68  70      73 75))
(extend *allNote* (map list (replace nil (copy *bNote*)) ABC))
(extend keycode (map char (explode "QERYUIP")) (list 512))
(setq *key-note* (transpose (list keycode *allNote*)))
; define handler
(define KW 50)
(define KH 200)
(define (draw-wnote key revflag , i)
  (when (setq i (find key *wNote*))
    (if revflag
        (gs:fill-rect key (+ (* KW i)) 0 KW KH gs:lightGray)
      (gs:draw-rect key (+ (* KW i)) 0 KW KH gs:black))))
(define (draw-bnote key revflag , i)
  (when (setq i (find key *bNote*))
    (if revflag
        (gs:fill-rect key (- (* KW i) (/ KW 2)) 0 KW (/ (* KH 2) 3) gs:lightGray)
      (gs:fill-rect key (- (* KW i) (/ KW 2)) 0 KW (/ (* KH 2) 3) gs:black))
    (gs:draw-rect key (- (* KW i) (/ KW 2)) 0 KW (/ (* KH 2) 3) gs:white)))
(define (key-action id type code modifiers)
  ;(println "id:" id " type:" type " key code:" code " modifiers:" modifiers)
  (let (key (lookup code *key-note*)
        lst '(0 12 -12))
    (if key
        (case type
          ("pressed"  (gs:play-note (+ (key 1) *plusNote*) 2 95 0)
                      (if-not (draw-wnote (key 0) true)
                        (draw-bnote (key 0) true))
                      (gs:update))
          ("released" (gs:delete-tag (key 0))
                      (if-not (draw-wnote (key 0))
                        (draw-bnote (key 0)))
                      (gs:update))
           (true ))
        (case (& modifiers 3)
          (1 (setq *plusNote* (lst 1))) ; shift key
          (2 (setq *plusNote* (lst 2))) ; ctrl  key
          (true (setq *plusNote* (lst 0)))) ; other
  )))
(define (mouse-action x y button cnt mods taglst)
  ;(println " x:" x " y:" y " button:" button " count:" cnt " mods:" mods " tag:" taglst)
  (if (and taglst (not (ends-with (taglst 0) "TEXT")))
      (let (tags (replace "MAIN" (flat (map parse taglst))))
        (if (or (= (length tags) 1) (ends-with (tags 0) "#"))
            (gs:play-note (+ (lookup (sym (tags 0)) *allNote*) *plusNote*) 2 95 0)
          (gs:play-note (+ (lookup (sym (tags 1)) *allNote*) *plusNote*) 2 95 0)))))
; initialization
(define FPosX 50)
(define FPosY 50)
(define FWidth 583)
(define FHeight 300)
(gs:init)
(gs:midi-init)
(gs:midi-patch "Piano" 0)
(gs:frame 'Frame FPosX FPosY FWidth FHeight "KeyBoard Smaple")
(gs:panel 'StatusPanel)
(gs:canvas 'OutputArea)
(gs:set-color 'OutputArea gs:white)
(dolist (s *wNote*) (draw-wnote s))
(dolist (s *bNote*) (and s (draw-bnote s)))
(gs:set-font 'OutputArea "Monospaced" KW)
(gs:draw-text 'TEXT "A S D F G H J K L ; : ]" (* (/ KW 4) 1) (+ KH KW))
(gs:key-event 'OutputArea 'key-action)
(gs:mouse-clicked 'OutputArea 'mouse-action true)
; mount all on frame
(gs:set-border-layout 'Frame)
(gs:set-flow-layout 'StatusPanel "left")
(gs:add-to 'Frame  'OutputArea "center" 'StatusPanel "south")
(gs:set-visible 'Frame true)
; main routine
;(gs:listen)
(while (gs:check-event 10000)
   (gs:request-focus 'OutputArea) ; keep focus in canvas
)
(exit)

こんな感じ。実行すると、

という風に、鍵盤が表示され、キーボードのS、D、F を順に押していくと、ドレミと鳴ります。
後は、ご想像通りです（笑）。お試しあれ。
キーボードをフルに使えば、二列二段で音階を増やせますが、タイトルに有るようにサンプルです。適当に改良して下さい。これで演奏したい人は、いないでしょう？（笑）
マウスで鍵盤をクリックしても鳴ります。
上記画像は、WindowsXPの場合です。他のプラットフォームでは、文字表示の位置がずれているかもしれません。
gs:draw-text 文

(gs:draw-text 'TEXT "A S D F G H J K L ; : ]" (* (/ KW 4) 1) (+ KH KW))

の Y 値を適当な値に変更して下さい。
それ以外の解説は、次回に。

以上、如何でしょうか？