ybot_serial.xtm

(sys:load-preload-check 'ybot_serial)
(define *xtmlib-ybot_serial-loaded* #f)

(impc:aot:suppress-aot-do
 (sys:load "libs/core/scheduler.xtm")
 (sys:load "libs/contrib/ybot/ybot_adt.xtm")
 (sys:load "libs/contrib/librs232.xtm")
 ;(sys:load "libs/contrib/ybot/ybot_dynamic_buffer.xtm")
 )
(impc:aot:insert-forms
 (sys:load "libs/core/scheduler.xtm")
 (sys:load "libs/contrib/ybot/ybot_adt.xtm" 'quiet)
 (sys:load "libs/contrib/librs232.xtm" 'quiet)
 ;(sys:load "libs/contrib/ybot/ybot_dynamic_buffer.xtm" 'quiet)
 )


;;;;;;;;;;;;; Serial Port management ;;;;;;;;;;;;
(bind-func list-ports:[i64]*
  (lambda ()
    (let ((n:i64 (i32toi64 (comEnumerate)))
          (loop:[i64,i64]*
           (lambda (i:i64)
             (cond
              ((< i n)
               (printf "Port %d:\t%s\n" i (comGetPortName (i64toi32 i)))
               (loop (+ i 1)))
              (else n)))))
      (loop 0))))


(bind-func serial_port_id:[i64,i8*]*
  (lambda (port_name)
    (let* ((n:i64 (i32toi64 (comEnumerate)))
           (loop:[i64,i64]*
            (lambda (i:i64)
              (cond
               ((and (<= 0 i) (< i n))
                (let* ((name:i8* (comGetPortName (i64toi32 i)))
                       (a (strlen name)) (b (strlen port_name)) (c (if (< a b) a b)))
                  (cond
                   ((= 0:i32 (strncmp name port_name c)) i)
                   (else
                    (loop (+ i 1))))))
               (else
                (printf "No serial port found matching name %s\n" port_name)
                -1)))))
        (loop 0))))


(bind-func openSerialPort
  (lambda (index:i64)
    (comOpen (i64toi32 index) (i64toi32 115200))))


;;;;;; Serial data management ;;;;;;

;; Serial data queue
(bind-type YbotSerialQueue <i8*,i64> (printer? . #f) (constructor? . #f))

(bind-func enqueue_serial_char
  (let ((tail 0) (head 0))
    (lambda (q:XTM_SERIAL_QUEUE c:i8)
      (pset! (aref-ptr XTM_SERIAL_EVENT_QUEUE (% tail XTM_MIDI_EVENT_QUEUE_SIZE))
              (Pm_Message_Type msg) (Pm_Message_Data1 msg) (Pm_Message_Data2 msg) (Pm_Message_Channel msg)
              timestamp (clock_clock))
      (set! tail (+ tail 1))
      #t)))

(bind-func dequeue_midi_event
  (let ((head 0) (tail 0))
    (lambda ()
      (set! tail (enqueue_midi_event.tail:i64))
      (if (< (+ head XTM_MIDI_EVENT_QUEUE_SIZE) tail)
          (begin (println "Warning: MIDI overrun (head:" head "tail:" tail ") events dropped")
                 (set! head tail)))
      (if (< head tail)
          (let ((res (aref-ptr XTM_MIDI_EVENT_QUEUE (% head XTM_MIDI_EVENT_QUEUE_SIZE))))
            (set! head (+ head 1))
            res)
          null)))) ;; underrun

(bind-func available_midi_events
  (lambda ()
    (let ((head (dequeue_midi_event.head:i64))
          (tail (enqueue_midi_event.tail:i64)))
      (if (< (+ head XTM_MIDI_EVENT_QUEUE_SIZE) tail)
          (begin (println "Warning: MIDI overrun - dropping old events")
                 (dequeue_midi_event.head:i64 tail)
                 0)
          (- tail head)))))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; 
;; Scheme listener code
;;

(define *run-scheme-midi-listener* #t)

;; should be redefined to 'do' something
(define midi-note-on
  (lambda (timestamp pitch volume chan)
    (println 'note-on ': pitch volume chan 'timestamp: timestamp)))

;; should be redefined to 'do' something
(define midi-note-off
  (lambda (timestamp pitch volume chan)
    (println 'note-off: pitch volume chan 'timestamp: timestamp)))

;; should be redefined to 'do' something
(define midi-cc
  (lambda (timestamp controller value chan)
    (println 'midi-cc ': controller value chan 'timestamp: timestamp)))

;; scheme midi event listener
(define scheme-midi-listener
  (lambda (beat dur)
    (dotimes (i (available_midi_events))
      (let* ((evt (dequeue_midi_event))
             (type (get_midi_evt_type evt))
             (a (get_midi_evt_a evt))
             (b (get_midi_evt_b evt))
             (chan (get_midi_evt_channel evt))
             (timestamp (get_midi_evt_timestamp evt)))
        (cond ((= type #x90)
               (midi-note-on timestamp a b chan))
              ((= type #x80)
               (midi-note-off timestamp a b chan))
              ((= type #xB0)
               (midi-cc timestamp a b chan)) 
              (else #f))))
    (callback (*metro* (+ beat (* .5 dur))) 'scheme-midi-listener (+ beat dur) dur)))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;;;; Some helpful functions for using MIDI devices by name ;;;
(bind-func midi_input_port_id:[i32,i8*]*
  (lambda (port_name)
    (let* ((n:i32 (Pm_CountDevices))
           (loop:[i32,i32]*
            (lambda (i:i32)
              (cond
               ((and (<= (i64toi32 0) i) (< i n))
                (let* ((info:PmDeviceInfo* (Pm_GetDeviceInfo i))
                       (name:i8* (tref info 2))
                       (input:bool (= (i64toi32 1) (tref info 3)))
                       (a (strlen name)) (b (strlen port_name)) (c (if (< a b) a b)))
                  (cond
                   ((and input (= (i64toi32 0) (strncmp name port_name c))) i)
                   (else
                    (loop (+ i (i64toi32 1)))))))
               (else
                (printf "No MIDI input port found with name %s\n" port_name)
                (i64toi32 -1))))))
        (loop (i64toi32 0)))))
                  

(bind-func midi_output_port_id:[i32,i8*]*
  (lambda (port_name)
    (let* ((n:i32 (Pm_CountDevices))
           (loop:[i32,i32]*
            (lambda (i:i32)
              (cond
               ((and (<= (i64toi32 0) i) (< i n))
                (let* ((info:PmDeviceInfo* (Pm_GetDeviceInfo i))
                       (name:i8* (tref info 2))
                       (output:bool (= (i64toi32 1) (tref info 4)))
                       (a (strlen name)) (b (strlen port_name)) (c (if (< a b) a b)))
                  (cond
                   ((and output (= (i64toi32 0) (strncmp name port_name c))) i)
                   (else
                    (loop (+ i (i64toi32 1)))))))
               (else
                (printf "No MIDI output port found with name %s\n" port_name)
                (i64toi32 -1))))))
        (loop (i64toi32 0)))))



;; first off create a native 'clock' scheduler
;; update rate of 200hz
(bind-val clock_sched [void]* (clock_scheduler 200.0))

(pm_initialize)
(pm_print_devices)

;; start with a default midi stream
(bind-val midi_in PmStream* (pm_create_input_stream 0))

;; OVERRIDE default midi in
(bind-func set_midi_in
  (lambda (idx)
     (set! midi_in (pm_create_input_stream idx))
     void))

(bind-func midi_note_on
  (lambda (timestamp:i32 pitch:i32 volume:i32 chan:i32)
    (println "NOTE_ON :" pitch volume chan "timestamp:" timestamp)
    void))

(bind-func midi_note_off
  (lambda (timestamp:i32 pitch:i32 volume:i32 chan:i32)
    (println "NOTE_OFF:" pitch volume chan "timestamp:" timestamp)
    void))

(bind-func midi_cc
  (lambda (timestamp:i32 controller:i32 value:i32 chan:i32)
    (println "MIDI_CC :" controller value chan "timestamp:" timestamp)
    void))

;; by default don't print non note/cc MIDI messages
(bind-func midi_msg
  (lambda (timestamp:i32 type:i32 a:i32 b:i32 chan:i32)
    ;; (println "MIDIMSG: " type a b chan)
    void))

(bind-func midi_read_msg
  (let ((buffer_length 1024)
        (input_buffer:PmEvent* (zalloc buffer_length))
        (msg:PmMessage 0)
        (timestamp:i32 0)
        (read_count 0)
        (i:i32 0))
    (lambda ()
      (set! read_count 0)
      ;; if you have more than one midi input device, you should call
      ;; Pm_Read on all your devices here
      (set! read_count (Pm_Read midi_in input_buffer buffer_length))
      (if (> read_count 0)
          (begin
            (dotimes (i read_count)
              (set! msg (tref (pref-ptr input_buffer i) 0))
              (set! timestamp (tref (pref-ptr input_buffer i) 1))
              (cond ((= (Pm_Message_Type msg) MIDI_NOTE_ON)
                     (enqueue_midi_event msg timestamp)
                     (if (= (Pm_Message_Data2 msg) 0)
                         (midi_note_off timestamp
                                        (Pm_Message_Data1 msg)
                                        (Pm_Message_Data2 msg)
                                        (Pm_Message_Channel msg))
                         (midi_note_on timestamp
                                       (Pm_Message_Data1 msg)
                                       (Pm_Message_Data2 msg)
                                       (Pm_Message_Channel msg))))
                    ((= (Pm_Message_Type msg) MIDI_NOTE_OFF)
                     (enqueue_midi_event msg timestamp)                     
                     (midi_note_off timestamp
                                    (Pm_Message_Data1 msg)
                                    (Pm_Message_Data2 msg)
                                    (Pm_Message_Channel msg)))
                    ((= (Pm_Message_Type msg) MIDI_CONTROL_CHANGE)
                     (if XTM_MIDI_CC_QUEUEING (enqueue_midi_event msg timestamp))                         
                     (midi_cc timestamp
                              (Pm_Message_Data1 msg)
                              (Pm_Message_Data2 msg)
                              (Pm_Message_Channel msg)))
                    (else
                     (midi_msg timestamp
                               (Pm_Message_Type msg)
                               (Pm_Message_Data1 msg)
                               (Pm_Message_Data2 msg)
                               (Pm_Message_Channel msg))))
              void)
            void)
          void))))

;; poll for midi messages at 100hz
(bind-func midi_input_polling
  (lambda (time)
    (midi_read_msg)
    (sched clock_sched (+ time 0.01) midi_input_polling:[void,double]*)))

(xtmX (midi_input_polling (+ (clock_sched.time) 1.0)))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
;; uncomment and call the following line
;; to start listening on your preferred midi input device 
;;

;; (set_midi_in 3)  ;; i.e. input device 3

;; uncomment and call this to start the scheme midi listener
;; (scheme-midi-listener (*metro* 'get-beat 4) 1/24))