Last active
October 7, 2017 17:31
-
-
Save wasamasa/569390ff182114f868f6c89da981fa52 to your computer and use it in GitHub Desktop.
Playing the piano with Kawa
This file contains hidden or bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
;; ~/.config/midi.scm/config | |
((default-instrument-id . 4) | |
(default-velocity . 127) | |
(default-volume . 127) | |
(map (97 . 60) ; a -> c4 | |
(119 . 61) ; w -> c4# | |
(115 . 62) ; s -> d4 | |
(101 . 63) ; e -> d4# | |
(100 . 64) ; d -> e4 | |
(102 . 65) ; f -> f4 | |
(116 . 66) ; t -> f4# | |
(103 . 67) ; g -> g4 | |
(121 . 68) ; y -> g4# | |
(104 . 69) ; h -> a4 | |
(117 . 70) ; u -> a4# | |
(106 . 71)) ; j -> b4 | |
(soundbank . "/usr/share/soundfonts/FluidR3_GM.sf2")) |
This file contains hidden or bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
#!/usr/bin/env kawa | |
;; superseded by https://github.com/wasamasa/waka | |
(import (scheme base)) | |
;;; utils | |
(define (print . items) | |
(for-each (lambda (item) (display item) (newline)) items)) | |
(define (alist-ref key alist) | |
(let ((match (assoc key alist))) | |
(if match | |
(cdr match) | |
match))) | |
(define user-config-path | |
(let ((data-home (get-environment-variable "XDG_CONFIG_HOME"))) | |
(if (and data-home (eqv? (string-ref data-home 0) #\/)) | |
(string-append data-home "/midi.scm/config") | |
(string-append (get-environment-variable "HOME") | |
"/.config/midi.scm/config")))) | |
(define user-config | |
(if (file-exists? user-config-path) | |
(with-input-from-file user-config-path read) | |
'())) | |
(define user-instrument-id (alist-ref 'default-instrument-id user-config)) | |
(define user-map (alist-ref 'map user-config)) | |
(define user-soundbank-path (alist-ref 'soundbank user-config)) | |
(define user-velocity (alist-ref 'default-velocity user-config)) | |
(define user-volume (alist-ref 'default-volume user-config)) | |
;;; MIDI fun | |
;; adapted from http://patater.com/gbaguy/javamidi.htm | |
(define-alias MidiChannel javax.sound.midi.MidiChannel) | |
(define-alias MidiSystem javax.sound.midi.MidiSystem) | |
(define-alias Soundbank javax.sound.midi.Soundbank) | |
(define-alias Synthesizer javax.sound.midi.Synthesizer) | |
(print "Initializing MIDI...") | |
(define syn (MidiSystem:getSynthesizer)) | |
(Synthesizer:open syn) | |
(define channels (Synthesizer:getChannels syn)) | |
(define channel (channels 0)) | |
(define velocity (or user-velocity 64)) | |
(define volume-control-number 7) | |
(define volume (or user-volume 127)) | |
(MidiChannel:controlChange channel volume-control-number volume) | |
(define soundbank | |
(if user-soundbank-path | |
(let ((path ::String user-soundbank-path)) | |
(MidiSystem:getSoundbank (java.io.File path))) | |
(Synthesizer:getDefaultSoundbank syn))) | |
(define instruments (Soundbank:getInstruments soundbank)) | |
(define instrument-id (or user-instrument-id 0)) | |
(define instrument | |
(if (< instrument-id instruments:length) | |
(instruments instrument-id) | |
(begin | |
(print "Out of bounds, falling back to instrument zero...") | |
(instruments 0)))) | |
(Synthesizer:loadInstrument syn instrument) | |
;; without this line the instrument isn't actually used... | |
(MidiChannel:programChange channel instrument-id) | |
(print "MIDI initialized!") | |
(define (note->string note) | |
(when (or (< note 0) (> note 127)) | |
(error "Note must be between 0 and 127 (inclusive)")) | |
(let* ((octave (- (quotient note 12) 1)) | |
(note+sharp (case (remainder note 12) | |
((0) '("c")) | |
((1) '("c" . "#")) | |
((2) '("d")) | |
((3) '("d" . "#")) | |
((4) '("e")) | |
((5) '("f")) | |
((6) '("f" . "#")) | |
((7) '("g")) | |
((8) '("g" . "#")) | |
((9) '("a")) | |
((10) '("a" . "#")) | |
((11) '("b")) | |
(else (error "This shouldn't happen")))) | |
(note (car note+sharp)) | |
(sharp (cdr note+sharp))) | |
(if (null? sharp) | |
(string-append note (number->string octave)) | |
(string-append note (number->string octave) sharp)))) | |
(define (byte->note byte) | |
(if user-map | |
(let ((mapping (assoc byte user-map))) | |
(if mapping | |
(cdr mapping) | |
#f)) | |
byte)) | |
;;; free play mode | |
(define-alias TerminalBuilder org.jline.terminal.TerminalBuilder) | |
(define-alias Terminal org.jline.terminal.Terminal) | |
(define stdin | |
(let* ((builder (TerminalBuilder:builder)) | |
(builder (builder:nativeSignals #t)) | |
(builder (builder:signalHandler Terminal:SignalHandler:SIG_IGN)) | |
(terminal (builder:build))) | |
(terminal:enterRawMode) | |
(terminal:reader))) | |
(print "Exit with C-d") | |
(let loop () | |
(let ((byte (stdin:read))) | |
(case byte | |
((4) #f) ; EOF | |
((10 13) (newline) (loop)) ; CR/LF | |
(else | |
(let ((note (byte->note byte))) | |
(when note | |
(MidiChannel:noteOn channel note velocity) | |
(display (note->string note)) | |
(display " ") | |
(flush-output-port))) | |
(loop))))) | |
(newline) |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment