Autres/audacity
1
0
Fork 0
mirror of https://github.com/cookiengineer/audacity synced 2026-01-11 15:15:57 +01:00
Code Issues Releases Wiki Activity

Update portmidi to SVN r227.

Browse Source
This commit is contained in:
lllucius
2013-10-31 07:33:41 +00:00
parent a30f9e913b
commit bb63fa0d07
118 changed files with 15017 additions and 12291 deletions
Download Patch File Download Diff File Expand all files Collapse all files

104
lib-src/portmidi/pm_cl/README_CL.txt Normal file
View File

@@ -0,0 +1,104 @@
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)

384
lib-src/portmidi/pm_cl/cffi-portmidi.lisp Normal file
View File

@@ -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*)

112
lib-src/portmidi/pm_cl/test-no-cm.lisp Normal file
View File

@@ -0,0 +1,112 @@
;; 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)