summaryrefslogtreecommitdiffstatshomepage
path: root/3rdparty/portmidi/pm_cl/cffi-portmidi.lisp
diff options
context:
space:
mode:
Diffstat (limited to '3rdparty/portmidi/pm_cl/cffi-portmidi.lisp')
-rw-r--r--3rdparty/portmidi/pm_cl/cffi-portmidi.lisp384
1 files changed, 0 insertions, 384 deletions
diff --git a/3rdparty/portmidi/pm_cl/cffi-portmidi.lisp b/3rdparty/portmidi/pm_cl/cffi-portmidi.lisp
deleted file mode 100644
index 4b3ad9c3e00..00000000000
--- a/3rdparty/portmidi/pm_cl/cffi-portmidi.lisp
+++ /dev/null
@@ -1,384 +0,0 @@
-;;; **********************************************************************
-;;; 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*)