diff options
Diffstat (limited to '3rdparty/portmidi/pm_cl')
-rw-r--r-- | 3rdparty/portmidi/pm_cl/README_CL.txt | 104 | ||||
-rw-r--r-- | 3rdparty/portmidi/pm_cl/cffi-portmidi.lisp | 384 | ||||
-rw-r--r-- | 3rdparty/portmidi/pm_cl/test-no-cm.lisp | 112 |
3 files changed, 0 insertions, 600 deletions
diff --git a/3rdparty/portmidi/pm_cl/README_CL.txt b/3rdparty/portmidi/pm_cl/README_CL.txt deleted file mode 100644 index be4c63591f6..00000000000 --- a/3rdparty/portmidi/pm_cl/README_CL.txt +++ /dev/null @@ -1,104 +0,0 @@ -README_CL.txt for PortMidi -Roger B. Dannenberg -17 Jan 2007 - -This is a Common Lisp interface to PortMidi. - -On Mac OSX, you need to build PortMidi as a dynamic link library -before you can use PortMidi from Common Lisp. - -You can build PortMidi as a dynamic link library by running this: - -cd portmidi -make -F pm_mac/Makefile.osx install-with-xcode - -This is just a shortcut for: - -cd portmidi/pm_mac -sudo xcodebuild -project pm_mac.xcodeproj -configuration Deployment install DSTROOT=/ - -You can check the file and the architecture for which it is built using: - file /usr/local/lib/libportmidi.dylib - -If you've done this install of portmidi, then you should also have - /usr/local/include/portmidi.h -This will be necessary to successfully build the cffi interface below. - -To test PortMidi with Common Lisp, I (RBD) am using SBCL, which I -downloaded from http://prdownloads.sourceforge.net/sbcl. Currently, I use - sbcl-0.9.17-x86-darwin-binary.tar.bz2 -To install this, I unpacked it by just double-clicking in the finder. Then, -from a command window, I became root using "sudo sh", and then typed: -# INSTALL_ROOT=/usr/local -# sh install.sh -# exit - -I also downloaded cffi-061012.tar.gz from - http://common-lisp.net/project/cffi/tarballs/?M=D - -To compile cffi, use the following, where "/Lisp/cffi/" is replaced by -the actual directory of cffi, e.g. - "/Users/rbd/sbcl-0.9.17-x86-darwin/cffi-061012": - -% sbcl -* (require 'asdf) -* (push "/Lisp/cffi/" asdf:*central-registry*) -* (asdf:oos 'asdf:load-op :cffi) -* (quit) - -Download Common Music's portmidi module from cvs and build the c side: -(Replace "/Lisp" with your lisp directory, e.g. -"/Users/rbd/sbcl-0.9.17-x86-darwin". These cvs commands will create -a new directory, portmidi.) - -% cd /Lisp -% export CVSROOT=:pserver:anonymous@commonmusic.cvs.sourceforge.net:/cvsroot/commonmusic -% cvs login # press Return at password prompt -% cvs checkout portmidi -% cd portmidi -% ./configure -% make -% cd .. - -Now compile/load the portmidi module just like cffi. Again, change -"/Lisp/cffi/" and "/Lisp/portmidi" to correspond to your local file system. -(Note that /Lisp becomes your lisp directory, and "cffi" becomes your -cffi folder name, e.g. "cffi-061012". - -% sbcl -* (require 'asdf) -* (push "/Lisp/cffi/" asdf:*central-registry*) -* (asdf:oos 'asdf:load-op :cffi) -* (push "/Lisp/portmidi/" asdf:*central-registry*) -* (asdf:oos 'asdf:load-op :portmidi) - -Look in the file /Lisp/portmidi/test.lisp for a test of the lisp interface to -portmidi. For example, while still running sbcl: - -* (pm:portmidi) ; initialize portmidi -* (pt:start) ; start time -* (pt:time) ; get time -* (pprint (pm:GetDeviceInfo)) ; get list of devices -((:ID 0 :NAME "IAC Driver Bus 1" :TYPE :INPUT :OPEN NIL) - (:ID 1 :NAME "IAC Driver Bus 1" :TYPE :OUTPUT :OPEN NIL)) - -Notice that test.lisp assumes MIDI input devices are connected -and uses some hard-wired device numbers, so it may not run -as is without error. - -Since test.lisp uses some Common Music calls, I (RBD) wrote a -simpler test, test-no-cm.lisp, which is in the same folder as -this (README_CL.txt) file. To use it, first check that the -values for outid (4) and inid (1) actually match PortMidi device -id's for output and input devices, and make sure the input -device is a keyboard that can generate a middle-C -- otherwise -the program will hang waiting for input. Run sbcl from this -pm_cl folder, and type: - -(load "test-no-cm.lisp") - -The program pauses frequently by calling (READ), so you -should type t or something, then <RETURN> to continue. - - -(Thanks to Leigh Smith and Rick Taube) 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*) diff --git a/3rdparty/portmidi/pm_cl/test-no-cm.lisp b/3rdparty/portmidi/pm_cl/test-no-cm.lisp deleted file mode 100644 index fd8527e6298..00000000000 --- a/3rdparty/portmidi/pm_cl/test-no-cm.lisp +++ /dev/null @@ -1,112 +0,0 @@ -;; this is a half-baked sequence of PortMidi calls to test the interface -;; No calls to Common Music are made, hence test-no-cm.lisp - -; setup cffi if it has not been done already -(if (not (boundp '*clpath*)) - (load "setup-pm.lisp")) - -(defun println (s) (print s) (terpri)) - -;; initialize portmidi lib -(pm:portmidi) -;; timer testing -(pt:Start ) -(pt:Started) -(format t "time is ~A, type something~%" (pt:Time)) -(read) -(format t "time is ~A, type something~%" (pt:Time)) -(read) -(pt:Time) -(format t "time is ~A, type something~%" (pt:Time)) - -;; device testing -(pm:CountDevices) -(pprint (pm:GetDeviceInfo )) -(defparameter inid (pm:GetDefaultInputDeviceID )) -(pm:GetDeviceInfo inid) -(defparameter outid (pm:GetDefaultOutputDeviceID )) -(pm:GetDeviceInfo outid) -;; output testing -(defparameter outid 4) ; 4 = my SimpleSynth -(defparameter outdev (pm:OpenOutput outid 100 1000)) -(pm:getDeviceInfo outid) ; :OPEN should be T -;; message tests -(defun pm (m &optional (s t)) - (format s "#<message :op ~2,'0x :ch ~2,'0d :data1 ~3,'0d :data2 ~3,'0d>" - (ash (logand (pm:Message.status m) #xf0) -4) - (logand (pm:Message.status m) #x0f) - (pm:Message.data1 m) - (pm:Message.data2 m))) -(defparameter on (pm:message #b10010000 60 64)) -(terpri) -(pm on) -(pm:Message.status on) -(logand (ash (pm:Message.status on) -4) #x0f) -(pm:Message.data1 on) -(pm:Message.data2 on) -(pm:WriteShort outdev (+ (pm:time) 100) on) -(defparameter off (pm:message #b10000000 60 64)) -(terpri) -(pm off) -(terpri) -(println "type something for note off") -(read) -(pm:WriteShort outdev (+ (pm:time) 100) off) -(println "type something to close output device") -(read) -(pm:Close outdev) -;; event buffer testing -(defparameter buff (pm:EventBufferNew 8)) -(loop for i below 8 for x = (pm:EventBufferElt buff i) - ;; set buffer events - do - (pm:Event.message x (pm:message #b1001000 (+ 60 i) (+ 100 i))) - (pm:Event.timestamp x (* 1000 i))) -(loop for i below 8 for x = (pm:EventBufferElt buff i) - ;; check buffer contents - collect (list (pm:Event.timestamp x) - (pm:Message.data1 (pm:Event.message x)) - (pm:Message.data2 (pm:Event.message x)))) -(pm:EventBufferFree buff) -;; input testing -- requires external midi keyboard -(println (pm:GetDeviceInfo )) -(defparameter inid 1) ; 1 = my external keyboard -(defparameter indev (pm:OpenInput inid 256)) -(pm:GetDeviceInfo inid) ; :OPEN should be T -(pm:SetFilter indev pm:filt-realtime) ; ignore active sensing etc. -(println "poll says:") -(println (pm:Poll indev)) -(println "play midi keyboard and type something") -(read) -;; -;; ...play midi keyboard, then ... -;; -(println "poll says") -(println (pm:Poll indev)) -(defparameter buff (pm:EventBufferNew 32)) -(defparameter num (pm:Read indev buff 32)) -(println "pm:Read gets") -(println num) -(println "input messages:") -(pm:EventBufferMap (lambda (a b) b (terpri) (pm a)) - buff num) -(pm:Poll indev) - -(println "play keyboard, to stop, play middle-C") - -;;; recv testing - -(defparameter pitch 0) -(loop while (/= pitch 60) do - (let ((n (pm:Read indev buff 1))) - (cond ((= n 1) - (pm:EventBufferMap - (lambda (a b) - b (pm a) (terpri) - (setf pitch (pm:Message.data1 a))) - buff n))))) - -(pm:EventBufferFree buff) -(pm:Close indev) - - |