diff options
Diffstat (limited to '3rdparty/portmidi/pm_cl/cffi-portmidi.lisp')
-rw-r--r-- | 3rdparty/portmidi/pm_cl/cffi-portmidi.lisp | 384 |
1 files changed, 384 insertions, 0 deletions
diff --git a/3rdparty/portmidi/pm_cl/cffi-portmidi.lisp b/3rdparty/portmidi/pm_cl/cffi-portmidi.lisp new file mode 100644 index 00000000000..4b3ad9c3e00 --- /dev/null +++ b/3rdparty/portmidi/pm_cl/cffi-portmidi.lisp @@ -0,0 +1,384 @@ +;;; ********************************************************************** +;;; Copyright (C) 2005 Heinrich Taube, <taube (at) uiuc (dot) edu> +;;; +;;; This program is free software; you can redistribute it and/or +;;; modify it under the terms of the Lisp Lesser Gnu Public License. +;;; See http://www.cliki.net/LLGPL for the text of this agreement. +;;; ********************************************************************** + + +;;; A CFFI interface to Portmidi. Should run in most Common Lisp +;;; implementations on Linux, OS X and Windows. For information about +;;; CFFI see http://common-lisp.net/project/cffi/ + +(in-package :cl-user) + +(defvar *libportmidi* + (let ((type #+(or darwin macos macosx) "dylib" + #+(or linux linux-target (and unix pc386) freebsd) "so" + #+(or win32 microsoft-32 cygwin) "dll") + (paths (list "/usr/lib/" "/usr/local/lib/" *load-pathname*))) + (loop for d in paths + for p = (make-pathname :name "libportmidi" :type type + :defaults d) + when (probe-file p) do (return p) + finally + (error "Library \"portmidi.~A\" not found. Fix *libportmidi*." + type)))) + +;;; linux: guess i need to load porttime.so first (?) osx doesnt seem +;;; to need this lib at all... + +#+(or linux (and clisp unix (not macos))) +(let ((lpt (merge-pathnames "libporttime" *libportmidi*))) + (if (probe-file lpt) + (cffi:load-foreign-library lpt) + (error "Porttime: ~a not found. Fix *libportmidi* path." lpt))) + +;;; load portmidi lib + +(cffi:load-foreign-library *libportmidi*) + +(defpackage :portmidi + (:use :common-lisp) + (:nicknames :pm :pt) + (:shadow :initialize :terminate :time :start :stop :abort + :close :read :write :poll) + (:export :Initialize :Terminate + :HasHostError :GetErrorText :GetHostErrorText + :CountDevices :GetDefaultInputDeviceID + :GetDefaultOutputDeviceID :GetDeviceInfo + :Message :Message.status :Message.data1 :Message.data2 + :Event.message :Event.timestamp + ;; event buffers added to api + :EventBufferNew :EventBufferFree :EventBufferElt + :EventBufferMap + :OpenInput :OpenOutput :SetFilter :SetChannelMask + :Abort :Close :Read :Write :Poll :WriteShort :WriteSysex + ;; filtering constants + :filt-active :filt-sysex :filt-clock :filt-play :filt-f9 + :filt-fd :filt-reset :filt-note :filt-channel-aftertouch + :filt-poly-aftertouch :filt-program :filt-control + :filt-pitchbend :filt-mtc :filt-song-position + :filt-song-select :filt-tune :filt-tick :filt-undefined + :filt-realtime :filt-aftertouch :filt-systemcommon + ;; porttime. + :Start :Stop :Started :Time + ;; initialization insurers added to api + :portmidi :*portmidi* )) + +(in-package :portmidi) + +(cffi:defcstruct pm-device-info + (struct-version :int) + (interf :pointer) + (name :pointer) + (input :int) + (output :int) + (opened :int)) + +(cffi:define-foreign-type pm-message () ':long) +(cffi:define-foreign-type pm-timestamp () ':long) +(cffi:defcstruct pm-event + (message pm-message) + (timestamp pm-timestamp)) +(cffi:define-foreign-type pm-error () ':int) + +(cffi:define-foreign-type port-midi-stream () ':void) +(cffi:define-foreign-type pm-device-id () ':int) +(cffi:define-foreign-type pm-time-proc-ptr () ':pointer) +(cffi:defcfun ("Pm_WriteSysEx" pm-write-sys-ex) pm-error (stream :pointer) (when pm-timestamp) (msg :pointer)) +(cffi:defcfun ("Pm_WriteShort" pm-write-short) pm-error (stream :pointer) (when pm-timestamp) (msg :long)) +(cffi:defcfun ("Pm_Write" pm-write) pm-error (stream :pointer) (buffer :pointer) (length :long)) +(cffi:defcfun ("Pm_Poll" pm-poll) pm-error (stream :pointer)) +(cffi:defcfun ("Pm_Read" pm-read) pm-error (stream :pointer) (buffer :pointer) (length :long)) +(cffi:defcfun ("Pm_Close" pm-close) pm-error (stream :pointer)) +(cffi:defcfun ("Pm_Abort" pm-abort) pm-error (stream :pointer)) +;(cffi:defcfun ("Pm_SetChannelMask" pm-set-channel-mask) pm-error (stream :pointer) (mask :int)) +(cffi:defcfun ("Pm_SetFilter" pm-set-filter) pm-error (stream :pointer) (filters :long)) +(cffi:defcfun ("Pm_OpenOutput" pm-open-output) pm-error (stream :pointer) (output-device pm-device-id) (output-driver-info :pointer) (buffer-size :long) (time-proc pm-time-proc-ptr) (time-info :pointer) (latency :long)) +(cffi:defcfun ("Pm_OpenInput" pm-open-input) pm-error (stream :pointer) (input-device pm-device-id) (input-driver-info :pointer) (buffer-size :long) (time-proc pm-time-proc-ptr) (time-info :pointer)) +(cffi:defcfun ("Pm_GetDeviceInfo" pm-get-device-info) :pointer (id pm-device-id)) +(cffi:defcfun ("Pm_GetDefaultOutputDeviceID" pm-get-default-output-device-id) pm-device-id) +(cffi:defcfun ("Pm_GetDefaultInputDeviceID" pm-get-default-input-device-id) pm-device-id) +(cffi:defcfun ("Pm_CountDevices" pm-count-devices) :int) +(cffi:defcfun ("Pm_GetHostErrorText" pm-get-host-error-text) :void (msg :pointer) (len :unsigned-int)) +(cffi:defcfun ("Pm_GetErrorText" pm-get-error-text) :pointer (errnum pm-error)) +(cffi:defcfun ("Pm_HasHostError" pm-has-host-error) :int (stream :pointer)) +(cffi:defcfun ("Pm_Terminate" pm-terminate) pm-error) +(cffi:defcfun ("Pm_Initialize" pm-initialize) pm-error) + +;;; porttime.h + +(cffi:define-foreign-type pt-error () ':int) +(cffi:define-foreign-type pt-timestamp () ':long) +(cffi:defcfun ("Pt_Start" pt-start) pt-error (a :int) (b :pointer) (c :pointer)) +(cffi:defcfun ("Pt_Stop" pt-stop) pt-error ) +(cffi:defcfun ("Pt_Started" pt-started) :int) +(cffi:defcfun ("Pt_Time" pt-time) pt-timestamp) + +(defconstant true 1) +(defconstant false 0) +(defconstant pmNoError 0) +(defconstant pmHostError -10000) +(defconstant pm-no-device -1) +(defconstant pm-default-sysex-buffer-size 1024) +(defconstant filt-active 1) +(defconstant filt-sysex 2) +(defconstant filt-clock 4) +(defconstant filt-play 8) +(defconstant filt-f9 16) +(defconstant filt-fd 32) +(defconstant filt-reset 64) +(defconstant filt-note 128) +(defconstant filt-channel-aftertouch 256) +(defconstant filt-poly-aftertouch 512) +(defconstant filt-program 1024) +(defconstant filt-control 2048) +(defconstant filt-pitchbend 4096) +(defconstant filt-mtc 8192) +(defconstant filt-song-position 16384) +(defconstant filt-song-select 32768) +(defconstant filt-tune 65536) +(defconstant filt-tick filt-f9) +(defconstant filt-undefined (logior filt-f9 filt-fd)) +(defconstant filt-realtime (logior filt-active filt-sysex + filt-clock filt-play + filt-undefined filt-reset)) +(defconstant filt-aftertouch (logior filt-channel-aftertouch + filt-poly-aftertouch )) +(defconstant filt-systemcommon (logior filt-mtc filt-song-position + filt-song-select filt-tune)) +(defvar *portmidi* nil) ; t if loaded + +;;; +;;; utils +;;; + +(defvar host-error-text (make-string 256 :initial-element #\*)) + +(defmacro with-pm-error (form) + (let ((v (gensym))) + `(let ((,v ,form)) + (if (not (= ,v pmNoError)) + (if (= ,v pmHostError) + (cffi:with-foreign-string (host-error host-error-text) + (pm-get-host-error-text host-error + (length host-error-text)) + (error "Host error is: ~a" + (cffi:foreign-string-to-lisp host-error))) + (error (cffi:foreign-string-to-lisp + (pm-get-error-text ,v)))) + ,v)))) + +(defun portmidi () + ;; initializer, call before using lib + (or *portmidi* + (progn (pm-initialize) + (setq *portmidi* t)))) + +(defun Message (status data1 data2) + ;; portmidi messages are just unsigneds + (logior (logand (ash data2 16) #xFF0000) + (logand (ash data1 08) #xFF00) + (logand status #xFF))) + +(defun Message.status (m) + (logand m #xFF)) + +(defun Message.data1 (m) + (logand (ash m -08) #xFF)) + +(defun Message.data2 (m) + (logand (ash m -16) #xFF)) + +;;; accessors + +(defun DeviceInfo.interf (ptr) + (cffi:foreign-string-to-lisp + (cffi:foreign-slot-value ptr 'pm-device-info 'interf))) + +(defun DeviceInfo.name (ptr) + (cffi:foreign-string-to-lisp + (cffi:foreign-slot-value ptr 'pm-device-info 'name))) + +(defun DeviceInfo.input (ptr) + (if (= (cffi:foreign-slot-value ptr 'pm-device-info 'input) 0) + nil + t)) + +(defun DeviceInfo.output (ptr) + (if (= (cffi:foreign-slot-value ptr 'pm-device-info 'output) 0) + nil + t)) + +(defun DeviceInfo.opened (ptr) + (if (= (cffi:foreign-slot-value ptr 'pm-device-info 'opened) 0) + nil + t)) + +(defun Event.message (e &optional (v nil vp)) + (if vp + (progn + (setf (cffi:foreign-slot-value e 'pm-event 'message) v) + v) + (cffi:foreign-slot-value e 'pm-event 'message))) + +(defun Event.timestamp (e &optional (v nil vp)) + (if vp + (progn + (setf (cffi:foreign-slot-value e 'pm-event 'timestamp) v) + v) + (cffi:foreign-slot-value e 'pm-event 'timestamp))) + +;;; functions + +(defun Initialize () + (with-pm-error (pm-initialize))) + +(defun terminate () + (with-pm-error (pm-terminate))) + + +(defun HasHostError (pms) + (pm-has-host-error pms)) + +(defun GetErrorText (err) + (pm-get-error-text err)) + +; how do i do this? +;(progn +; (defalien "pm-GetHostErrorText" void (a c-string) (b unsigned-int)) +; (defun GetHostErrorText () +; (pm-GetHostErrorText 256))) + +(defun CountDevices () + (portmidi) + (pm-count-devices )) + +(defun GetDefaultInputDeviceID () + (let ((id (pm-get-default-input-device-id ))) + (if (= id pm-no-device) nil id))) + +(defun GetDefaultOutputDeviceID () + (let ((id (pm-get-default-output-device-id ))) + (if (= id pm-no-device) nil id))) + +;replaced by lispy version end of file. +;(defun GetDeviceInfo (id) (pm-get-device-info id)) + +(defun OpenInput (device bufsiz) + ;; portmidi: timer must be running before opening + (unless (Started) (Start)) + (cffi:with-foreign-object (p1 :pointer) + (let ((err (pm-open-input p1 device (cffi:null-pointer) + bufsiz (cffi:null-pointer) (cffi:null-pointer)))) + (if (= err pmNoError) + (cffi:mem-ref p1 :pointer) + (error (pm-get-error-text err)))))) + +(defun OpenOutput (device bufsiz latency) + (unless (Started) (Start)) + (cffi:with-foreign-object (p1 :pointer) ;(p (* PortMidi)) + (let ((err (pm-open-output p1 device (cffi:null-pointer) + bufsiz (cffi:null-pointer) (cffi:null-pointer) + latency))) + (if (= err pmNoError) + (cffi:mem-ref p1 :pointer) + (error (pm-get-error-text err)))))) + +(defun SetFilter (a filts) + (with-pm-error + (pm-set-filter a filts))) + +;(defun SetChannelMask (pms mask) +; (with-pm-error (pm-set-channel-mask pms mask))) + +(defun Abort (pms) + (with-pm-error (pm-abort pms))) + +(defun Close (pms) + (with-pm-error (pm-close pms))) + +(defun EventBufferFree (buf) + (cffi:foreign-free buf)) + +(defun EventBufferNew (len) + (cffi:foreign-alloc 'pm-event :count len)) + +(defun EventBufferElt (buf i) + ;; buf is POINTER to buf + (cffi:mem-aref buf 'pm-event i)) + +(defun EventBufferSet (buffer index timestamp message) + (setf (cffi:foreign-slot-value + (cffi:mem-aref buffer 'pm-event index) 'pm-event 'timestamp) + timestamp) + (setf (cffi:foreign-slot-value + (cffi:mem-aref buffer 'pm-event index) 'pm-event 'message) + message) + (values)) + +(defun EventBufferMap (fn buf end) + (loop for i below end + for e = (EventBufferElt buf i) + do (funcall fn (Event.message e) (Event.timestamp e))) + (values)) + +(defun Read (pms *evbuf len) + (let ((res (pm-read pms *evbuf len))) + (if (< res 0) + (error (pm-get-error-text res)) + res))) + +(defun Poll (pms) + (let ((res (pm-poll pms))) + (cond ((= res 0) nil) + ((= res 1) t) + (t (error (pm-get-error-text res)))))) + +(defun Write (pms *evbuf len) + (with-pm-error (pm-write pms *evbuf len))) + +(defun WriteShort (pms when msg) + (with-pm-error (pm-write-short pms when msg))) + +(defun WriteSysex (pms when string) + (cffi:with-foreign-string (ptr string) + (with-pm-error (pm-write-sys-ex pms when ptr)))) + +;;; porttime.h + +(defun Started () + (let ((res (pt-started))) + (if (= res false) nil t))) + +(defun Start () + ;; NB: This has to be called before opening output or input. + ;; it seems that if its called 2x we get an error. + (unless (Started) + (with-pm-error (pt-start 1 (cffi:null-pointer) (cffi:null-pointer)))) + (values)) + +(defun Stop () + (when (Started) + (with-pm-error (pt-stop))) + (values)) + +(defun Time () + (pt-time)) + +(defun GetDeviceInfo (&optional id) + (flet ((getone (id) + (let ((d (pm-get-device-info id))) + (list :id id + :name (DeviceInfo.name d) + :type (if (DeviceInfo.input d) ':input ':output) + :open (DeviceInfo.opened d))))) + ;; make sure lib is initialized before checking devices + (portmidi) + (if id (getone id) + (loop for i below (CountDevices) + collect (getone i))))) + +(pushnew ':portmidi *features*) |