Archive for 2010年6月12日|Daily archive page

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 値を適当な値に変更して下さい。
それ以外の解説は、次回に。

以上、如何でしょうか?