#lang racket/base ;; BCR2000 sysex in/out (provide midi->bcl bcr2000-transaction bcr2000-encoder bcr2000-for/knobs bcr2000-open bcr2000-close) (require racket/match) ;; ******** WRITE ********* ;; Output state machine. Each script line is tagged with a sequence ;; number. We keep track of the state in a parameter. ;; TODO: probably needs rate limiter. (define bcr2000-port (make-parameter #f)) (define bcr2000-count (make-parameter 0)) (define sysex-header '(#xF0 ;; Sysex start #x00 #x20 #x32 ;; Beringher ID #x00 #x15 #x20 ;; Device ID )) (define sysex-footer '(#xF7)) (define (counter-hilo count) (let ((hi (bitwise-and #xFF (arithmetic-shift count -8))) (lo (bitwise-and #xFF count))) `(,hi ,lo))) (define (format-sysex-bytes bytes count [header sysex-header] [footer sysex-footer]) (list->bytes (append header (counter-hilo count) (bytes->list bytes) footer))) (define (bcr2000-write-line str) (let ((count (bcr2000-count))) (begin (display str) (newline)) ;; debug (write-bytes (format-sysex-bytes (string->bytes/utf-8 str) count) (bcr2000-port)) (bcr2000-count (add1 count)))) (define (bcr2000-open [dev "/dev/midi3"]) (bcr2000-port (open-output-file dev #:exists 'append))) (define (bcr2000-close) (close-output-port (bcr2000-port)) (bcr2000-port #f)) (define (bcr2000-flush) (flush-output (bcr2000-port))) ;(bcr2000-open) ;; Send a BCL patch to the BCR2000 (define (bcr2000-patch [patch "test.bcl"]) (for ((line (in-lines (open-input-file patch)))) (bcr2000-write-line line) (bcr2000-flush))) (define (bcr2000-transaction thunk) (parameterize ((bcr2000-count 0)) ;; is this re-initialized per transaction? (bcr2000-write-line "$rev R1") (thunk) (bcr2000-write-line "$end") (bcr2000-flush))) (define (bcr2000-encoder n params) (bcr2000-write-line (format "$encoder ~s" n)) (for ((p params)) (bcr2000-write-line (apply string-append (map (lambda (x) (format " ~a" x)) p))))) (define (bcr2000-for/knobs fn) (for ((row '(0 1 2 3 4 5 6))) ;; One transaction per row + sleep. It seems some kind of rate ;; limiting is necessary. (sleep .5) (bcr2000-transaction (lambda () (for ((col '(0 1 2 3 4 5 6 7))) (let ((enc (+ 1 (* row 8) col))) (bcr2000-encoder enc (fn row col enc)))))))) ;; (define (bcr2000-encoder-params-easy id max [dflt (/ max 2)]) ;; `((.easypar NRPN 1 ,id 0 ,max absolute/14) ;; (.showvalue off) ;; (.mode 1dot) ;; (.resolution 96 192 768 2000) ;; (.default ,dflt))) ;;(bcr2000-transaction ;; (lambda () ;; (bcr2000-encoder 51 (bcr2000-encoder-params-easy 6 500)))) ;; (define (write-sysex-lines strs port) ;; (for ((i (in-naturals)) ;; (s strs))te ;; (write-bytes (format-sysex s i) port))) ;; ******** READ ********* (define (read-list n read) (for/list ((_ (in-range n))) (read))) ;; Ad-hoc parser: needs clean sysex stream! (define (read-sysex-line port) (define (b) (let ((byte (read-byte port))) ;; (printf " ~a" byte) (when (eof-object? byte) (raise byte)) byte)) (define (b/list n) (read-list n b)) (with-handlers ((void (lambda (eof) eof))) (let scan () (if (not (= #xF0 (b))) (scan) ;; skip to start of sysex message (let* ((manid (b/list 3)) (devid (b/list 3)) (seq (b/list 2))) (let next ((acc '())) (let ((byte (b))) (if (= #xF7 byte) (list->bytes (reverse acc)) (next (cons byte acc)))))))))) ;; Parse file (define ((log tag) data) (printf "~a: ~s\n" tag data)) ;; Regexp subst so default reader can be used. (define (requote-strings ln) (regexp-replace* #rx"'" ln "\"")) (define (parse-sysex port [rec (log 'record)] [fld (log 'field)] [end (log 'end)]) (let* ((tokens (open-input-bytes (requote-strings (read-sysex-line port)))) (tag (read tokens)) (slurp (lambda () (cons tag (for/list ((x (in-port read tokens))) x))))) ((cond ((eq? '$end tag) end) ((eq? #\$ (car (string->list (symbol->string tag)))) rec) (else fld)) (slurp)))) ;; Translate midi stream to bcl stream. (define (midi->bcl inport outport) (for ((line (in-port read-sysex-line inport))) (write-bytes line outport) (newline outport)))