;*********************************************************************
|
; OM-SoX, (c) 2011-2014 Marlon Schumacher (CIRMMT/McGill University) *
|
; http://sourceforge.net/projects/omsox/ *
|
; *
|
; Multichannel Audio Manipulation and Functional Batch Processing. *
|
; DSP based on SoX - (c) C.Bagwell and Contributors *
|
; http://sox.sourceforge.net/ *
|
;*********************************************************************
|
;
|
;This program is free software; you can redistribute it and/or
|
;modify it under the terms of the GNU General Public License
|
;as published by the Free Software Foundation; either version 2
|
;of the License, or (at your option) any later version.
|
;
|
;See file LICENSE for further informations on licensing terms.
|
;
|
;This program is distributed in the hope that it will be useful,
|
;but WITHOUT ANY WARRANTY; without even the implied warranty of
|
;MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
;GNU General Public License for more details.
|
;
|
;You should have received a copy of the GNU General Public License
|
;along with this program; if not, write to the Free Software
|
;Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307,10 USA.
|
;
|
;Authors: M. Schumacher
|
|
(in-package :om)
|
|
(print "loading OM-SoX player for OM version < 6.7")
|
|
;######## SOX-PLAY ###########
|
|
; Logic:
|
; the keywords gain, pan, in-channels are ignored when sox-input classes are used.
|
; For sound objects the keywords override the ones given by the sound obj's internal parameters
|
|
|
(defmethod! sox-play ((self string) &key clipping samplerate bitdepth gain pan)
|
:icon 08
|
:initvals '(nil nil nil nil nil nil)
|
:doc "Play back a sound using the OM-SoX library"
|
:numouts 1
|
(sox-play-print self)
|
(if (probe-file *sox-path*)
|
(let* ((inpath self))
|
(setf thestring (format nil "~s ~a ~s -q" (namestring *sox-path*) *sox-options* (namestring inpath)))
|
(setf thestring (sox-samplebits thestring bitdepth samplerate *sox-audio-device*))
|
(when clipping (setf thestring (string+ thestring
|
(format nil " trim ~d ~d " (first clipping) (- (second clipping) (first clipping))))))
|
|
; pan means that a sound is going to be panned between the two adjacent channels determined by the scalar.
|
; E.g. a value of 4.5 means between ch4 and ch5 (producing a 5-channel file) --> like the mix-console
|
|
(if pan
|
(progn
|
(sox-print "sox-play: Panning a sound")
|
(sox-play (sox-pan->sox-remix self gain pan) ;if both pan and gain it should go into the function directly, otherwise only gain
|
:clipping clipping :samplerate samplerate :bitdepth bitdepth)
|
)
|
|
(progn
|
(when gain (setf thestring (string+ thestring (format nil " gain ~d " gain))))
|
;(when *normalize* (setf thestring (string+ thestring " norm " (makestring *normalize-level*))))
|
|
(setf localpid (om-cmd-line thestring nil nil))
|
;(print thestring)
|
;(print localpid)
|
(setf *sox-running-processes* (x-append *sox-running-processes* localpid))
|
(om-run-process "remove-terminated-pid" sox-remove-pid
|
(if clipping (- (cadr clipping) (car clipping)) (sox-sound-duration self))
|
localpid)
|
)))
|
(sox-not-found))
|
self
|
)
|
|
(defmethod! sox-play ((self pathname) &key clipping samplerate bitdepth gain pan)
|
(sox-play (namestring self) :clipping clipping :samplerate samplerate :bitdepth bitdepth :gain gain :pan pan)
|
)
|
|
(defmethod! sox-play ((self list) &key clipping samplerate bitdepth gain pan)
|
(sox-play-print self)
|
(mapcar (lambda (thesound)
|
(sox-play thesound :clipping clipping :samplerate samplerate :bitdepth bitdepth :gain gain :pan pan)) self))
|
; (sox-play thesound :clipping clipping :samplerate samplerate :bitdepth bitdepth :gain gain :pan pan)) self))
|
|
(defmethod! sox-play ((self sound) &key clipping samplerate bitdepth gain pan)
|
(sox-play-print self)
|
(if (sound-path self)
|
(let ((gain (or gain (sox-vol-convert (vol self)))))
|
(if (equal (tracknum self) 0)
|
(sox-play (pathname (sound-path self))
|
:clipping clipping ;(or clipping (markers self))
|
:samplerate samplerate
|
:bitdepth bitdepth
|
:gain gain
|
:pan pan)
|
(sox-play (make-instance 'sox-pan
|
:sound self
|
:gains gain
|
:panning (or pan (+ (tracknum self) (* 0.01 (pan self))))
|
:clipping clipping
|
:samplerate samplerate
|
:bitdepth bitdepth)
|
)
|
)
|
)
|
(om-beep-msg (format nil "OM-SoX: Cannot play sound with path \"~s\"" (sound-path self)))
|
)
|
)
|
|
; ###### sox-mix #####
|
(defmethod! sox-play ((self sox-mix) &key clipping samplerate bitdepth gain pan)
|
(sox-play-print self)
|
(if (probe-file *sox-path*)
|
(let* ((pathlist (sound self))
|
(gainlist (db->lin (gains self))))
|
(setf thestring (format nil "~s ~a -m " (namestring *sox-path*) *sox-options*))
|
(loop for path in pathlist
|
for gain in gainlist do
|
(setf thestring (string+ thestring (format nil " -v~d ~s" gain (namestring path))))) ; could also be a pipe
|
(setf thestring (sox-samplebits thestring bitdepth samplerate *sox-audio-device*))
|
(when clipping (setf thestring (string+ thestring
|
(format nil " trim ~d ~d " (first clipping) (- (second clipping) (first clipping))))))
|
; (when *normalize* (setf thestring (string+ thestring " norm " (makestring *normalize-level*))))
|
(setf localpid (om-cmd-line thestring nil nil))
|
;(print thestring)
|
;(print localpid)
|
(setf *sox-running-processes* (x-append *sox-running-processes* localpid))
|
(om-run-process "remove-terminated-pid" sox-remove-pid
|
(if clipping (- (cadr clipping) (car clipping)) (list-max (sox-sound-duration (sound self))))
|
localpid)
|
)
|
(sox-not-found))
|
self
|
)
|
|
; ###### sox-merge #####
|
(defmethod! sox-play ((self sox-merge) &key clipping samplerate bitdepth gain pan)
|
(sox-play-print self)
|
(if (probe-file *sox-path*)
|
(let* ((pathlist (sound self))
|
(gainlist (db->lin (gains self))))
|
(setf thestring (format nil "~s ~a -M " (namestring *sox-path*) *sox-options*))
|
(loop for path in pathlist
|
for gain in gainlist do
|
(setf thestring (string+ thestring (format nil " -v~d ~s" gain (namestring path))))) ; could also be a pipe
|
(setf thestring (sox-samplebits thestring bitdepth samplerate *sox-audio-device*))
|
(when clipping (setf thestring (string+ thestring
|
(format nil " trim ~d ~d " (first clipping) (- (second clipping) (first clipping))))))
|
(setf localpid (om-cmd-line thestring nil nil))
|
;(print thestring)
|
;(print localpid)
|
(setf *sox-running-processes* (x-append *sox-running-processes* localpid))
|
(om-run-process "remove-terminated-pid" sox-remove-pid
|
(if clipping (- (cadr clipping) (car clipping)) (list-max (sox-sound-duration (sound self))))
|
localpid)
|
)
|
(sox-not-found))
|
self
|
)
|
|
; ###### sox-concatenate #####
|
(defmethod! sox-play ((self sox-concatenate) &key clipping samplerate bitdepth gain pan)
|
(sox-play-print self)
|
(if (probe-file *sox-path*)
|
(let* ((pathlist (sound self))
|
(gainlist (db->lin (gains self))))
|
(setf thestring (format nil "~s ~a " (namestring *sox-path*) *sox-options*))
|
(loop for path in pathlist
|
for gain in gainlist do
|
(setf thestring (string+ thestring (format nil " -v~d ~s" gain (namestring path)))))
|
(setf thestring (sox-samplebits thestring bitdepth samplerate *sox-audio-device*))
|
(when clipping (setf thestring (string+ thestring
|
(format nil " trim ~d ~d " (first clipping) (- (second clipping) (first clipping))))))
|
(setf localpid (om-cmd-line thestring nil nil))
|
;(print thestring)
|
(print localpid)
|
(setf *sox-running-processes* (x-append *sox-running-processes* localpid))
|
(om-run-process "remove-terminated-pid" sox-remove-pid
|
(if clipping (- (cadr clipping) (car clipping)) (list-max (sox-sound-duration (sound self))))
|
localpid)
|
)
|
(sox-not-found))
|
self
|
)
|
|
; ###### sox-splice #####
|
(defmethod! sox-play ((self sox-splice) &key clipping samplerate bitdepth gain pan)
|
(sox-play-print self)
|
(if (probe-file *sox-path*)
|
(let* ((pathlist (sound self))
|
(gainlist (db->lin (gains self))))
|
(setf thestring (format nil "~s ~a " (namestring *sox-path*) *sox-options*))
|
(loop for path in pathlist
|
for gain in gainlist do
|
(setf thestring (string+ thestring (format nil " -v~d ~s" gain (namestring path)))))
|
(setf thestring (sox-samplebits thestring bitdepth samplerate *sox-audio-device*))
|
(when clipping (setf thestring (string+ thestring
|
(format nil " trim ~d ~d " (first clipping) (- (second clipping) (first clipping))))))
|
(setf localpid (om-cmd-line thestring nil nil))
|
;(print thestring)
|
(print localpid)
|
(setf *sox-running-processes* (x-append *sox-running-processes* localpid))
|
(om-run-process "remove-terminated-pid" sox-remove-pid
|
(if clipping (- (cadr clipping) (car clipping)) (list-max (sox-sound-duration (sound self))))
|
localpid)
|
)
|
(sox-not-found))
|
self
|
)
|
|
; ###### sox-pan #####
|
(defmethod! sox-play ((self sox-pan) &key clipping samplerate bitdepth gain pan)
|
(sox-play-print self)
|
(sox-play (sox-pan->sox-remix (sound self) (car (list! (gains self))) (car (list! (panning self))) (numchannels self)) ;(car (list! (gains self)))
|
;the (car (list! (panning self))) should be taken care of at initialize-instance... but maybe the editors need lists...
|
:clipping clipping
|
:samplerate samplerate
|
:bitdepth bitdepth
|
))
|
|
; ###### sox-remix #####
|
(defmethod! sox-play ((self sox-remix) &key clipping samplerate bitdepth gain pan)
|
(sox-play-print self)
|
(if (probe-file *sox-path*)
|
(let* ((inpath (sound self)))
|
(setf thestring (format nil "~s ~a ~s -q" (namestring *sox-path*) *sox-options* (namestring inpath)))
|
(setf thestring (sox-samplebits thestring bitdepth samplerate *sox-audio-device*))
|
(setf thestring (string+ thestring (format nil " remix ~a"
|
(sox-remixconc-no-norm (gain-matrix self) (channel-matrix self))
|
)))
|
|
(when clipping (setf thestring (string+ thestring
|
(format nil " trim ~d ~d " (first clipping) (- (second clipping) (first clipping))))))
|
; (when *normalize* (setf thestring (string+ thestring " norm " (makestring *normalize-level*))))
|
|
(setf localpid (om-cmd-line thestring nil nil))
|
;(print thestring)
|
;(print localpid)
|
(setf *sox-running-processes* (x-append *sox-running-processes* localpid))
|
(om-run-process "remove-terminated-pid" sox-remove-pid
|
(if clipping (- (cadr clipping) (car clipping)) (sox-sound-duration (sound self)))
|
localpid)
|
)
|
(sox-not-found))
|
self
|
)
|
|
; ###### sox-mix-console #####
|
(defmethod! sox-play ((self sox-mix-console) &key clipping samplerate bitdepth gain pan)
|
(sox-play-print self)
|
(if (probe-file *sox-path*)
|
(sox-play (make-instance 'sox-mix
|
:sound (sox-process (sox-pan->sox-remix (sound self) (gains self) (panning self)) ;(numchannels self))
|
""
|
:output "pipe")
|
)
|
:clipping clipping :samplerate samplerate :bitdepth bitdepth)
|
(sox-not-found))
|
self
|
)
|
|
|
;##### helper functions ################## -> probably better in utilities.
|
|
; it should be possible to connect a sox-record to a sox-input class it should allow for doing this.
|
|
;; recording function
|
(defmethod! sox-rec (filepath &key duration filetype samplerate bitdepth gain channel) ;better call it fileformat? or audioformat?
|
:icon 08
|
:initvals '(nil nil nil nil)
|
:menuins '((2 (("aif" "aif") ("wav" "wav") ("flac" "flac") ("ogg" "ogg"))))
|
:doc "records incoming audio through sox into a file"
|
:numouts 1
|
(if (probe-file *sox-path*)
|
(let* ((outpath (or filepath (om-choose-new-file-dialog :prompt "Choose a name and location for the recorded audio file"
|
:directory (outfile nil)))))
|
(when outpath
|
(setf outpath (om-make-pathname :directory (pathname-directory outpath)
|
:name (pathname-name outpath)
|
:type (or filetype (pathname-type outpath))));)
|
(setf thestring (format nil "~s -d" (namestring *sox-path*)))
|
(setf thestring (sox-samplebits thestring bitdepth samplerate outpath))
|
|
(when duration (setf thestring (string+ thestring (format nil " trim 0 ~d" duration))))
|
(when gain (setf thestring (string+ thestring (format nil " gain ~d " gain))))
|
(when channel (setf thestring (string+ thestring (format nil " remix ~a" channel))))
|
|
(setf localpid (om-cmd-line thestring nil nil))
|
;(print thestring)
|
(setf *sox-running-processes* (x-append *sox-running-processes* localpid))
|
(when duration (om-run-process "remove-terminated-pid" sox-remove-pid duration localpid))
|
; NB the soundobject throws an error if the soundfile is not there yet
|
outpath
|
))
|
(sox-not-found))
|
)
|
|
; ######### command-line functions ##########
|
; sox-kill terminates running sox play/rec processes
|
(defmethod! sox-kill (process-ids)
|
:icon 01
|
:initvals '(nil)
|
:numouts 1
|
#+win32(sys::call-system "taskkill /F /IM \"sox.exe\"")
|
#| some experiments to retrieve the pid from Windows DOS console
|
(sys::call-system "tasklist /v | find \"sox.exe\"")
|
(sys::call-system "tasklist /v | find \"sox.exe\" | taskkill /F /IM")
|
(om-cmd-line "tasklist /F /IM \"sox.exe\"" nil nil)
|
|#
|
#+macosx(let ((pid-list (list! (or process-ids *sox-running-processes*))))
|
(loop for pid in pid-list do (om-cmd-line (format nil "kill ~d" pid) *sys-console*))
|
(setf *sox-running-processes* nil)
|
;(print (format nil "killed pids ~s" pid-list))
|
(when (om-find-process "remove-terminated-pid") (om-kill-process (om-find-process "remove-terminated-pid")))
|
)
|
)
|
|
(defun sox-remove-pid (wait-time localpid)
|
(sleep wait-time)
|
(print (string+ "auto remove " (number-to-string localpid)))
|
(delete localpid *sox-running-processes*))
|
|
|
;;;===========================================
|
;;; INTERFACE OM : USE SOX AS A SOUND PLAYER
|
;;;===========================================
|
|
(unless (find :soxplayer *audio-players*) (pushr :soxplayer *audio-players*))
|
(defmethod audio-player-name ((self (eql :soxplayer))) "Sox") ; should be spelled "SoX"
|
(defmethod audio-player-desc ((self (eql :soxplayer))) "Requires OM-SoX library")
|
|
(add-assoc-player *general-player* 'soxplayer)
|
|
(defvar *sox-play-list* nil)
|
(defvar *sox-play-temp* "sox-play.aiff")
|
|
(defmethod InitPlayingSeq ((player (eql 'soxplayer)) dur &key (port nil))
|
(setf *sox-play-list* nil)
|
(unless (probe-file *sox-path*)
|
(om-beep-msg "SoX-executable not found!")
|
))
|
|
|
;This is BEFORE playplayer
|
(defmethod FinalizePlayingSeq ((player (eql 'soxplayer)) dur &key (port nil))
|
(when *sox-play-list* ;*sox-play-list* = sound, offset, interval
|
(setf *sox-play-list*
|
(if (= 1 (length *sox-play-list*))
|
(let ((sound (first (car *sox-play-list*)))
|
(offset (ms->sec (second (car *sox-play-list*))))
|
(interval (ms->sec (third (car *sox-play-list*)))))
|
(sox-print "FinalizePlayingSeq: single case")
|
(if (zerop offset)
|
;(sox-print (list sound interval)) ; = sox, interval, pan is accounted for in PlayPlayer (via the sound object)
|
(sox-print (list (sox-process sound "" :output "pipe") interval))
|
(progn
|
(sox-print "this is with offset")
|
(sox-print (list (sox-process sound (string+ (sox-pad offset)) :output "pipe" ) interval)) ;what's this doing? converting into a path yes?
|
)
|
)
|
)
|
(progn ;this looks like the Maquette case
|
(sox-print "FinalizePlayingSeq: list case")
|
(list
|
(sox-process
|
(make-instance 'sox-mix
|
:sound (mapcar #'(lambda (pl-item)
|
(let* ((sound (car pl-item)))
|
(sox-process
|
(if (equal (tracknum sound) 0) sound (make-instance 'sox-pan :sound sound)) ;sound
|
(if (zerop (cadr pl-item)) "" (sox-pad (ms->sec (cadr pl-item)))) ;offset
|
:samplerate *audio-sr*
|
:output "pipe"))
|
)
|
*sox-play-list*)
|
)
|
""
|
:output *sox-play-temp*)
|
(ms->sec (third (car *sox-play-list*))))) ;interval
|
)))
|
(sox-print (string+ "Finalize END " (makestring *sox-play-list*))))
|
|
|
(defmethod* PrepareToPlay ((player (eql 'soxplayer)) (self sound) at &key approx port interval voice)
|
(declare (ignore approx))
|
(push (list self at interval) *sox-play-list*))
|
|
; ========== = = = = =
|
|
(defmethod Play-player ((self (eql 'soxplayer)))
|
(when (sox-print (string+ "Play Player BEGIN " (makestring *sox-play-list*)))
|
(cond ((subtypep (type-of (car *sox-play-list*)) 'sound)
|
(let* ((sound (car (sox-print *sox-play-list*)))
|
(clipping (cadr *sox-play-list*)))
|
(sox-print "Play-player: Playing a sound object")
|
(if (equal (tracknum (car *sox-play-list*)) 0)
|
(sox-play sound :clipping clipping)
|
(sox-play (make-instance 'sox-pan :sound sound) :clipping clipping))
|
)
|
)
|
(t
|
(progn
|
(sox-print "Play-player: Playing not a sound object")
|
(sox-play (car (sox-print *sox-play-list*)) :clipping (cadr *sox-play-list*))
|
))))
|
)
|
|
(defmethod Stop-Player ((self (eql 'soxplayer)) &optional view)
|
(declare (ignore view))
|
(sox-kill nil))
|
|
(defmethod Pause-Player ((self (eql 'soxplayer))) (om-beep)) ;there's currently no good method for Pause-Player
|
(defmethod Continue-Player ((self (eql 'soxplayer))) nil)
|
|
(defmethod Reset-Player ((self (eql 'soxplayer)) &optional view)
|
(declare (ignore view))
|
(sox-print "resetting player")
|
(when (and *delete-inter-file* (probe-file (outfile *sox-play-temp*))) (delete-file (outfile *sox-play-temp*)))
|
(setf *sox-play-list* nil)
|
t)
|
|
(defmethod audio-record-start ((self (eql 'soxplayer)))
|
(setf *sox-temp-recorded-file*
|
(om-choose-new-file-dialog :prompt "Choose a name and location for the recorded audio file."
|
:directory (outfile nil)))
|
(when *sox-temp-recorded-file*
|
(sox-rec *sox-temp-recorded-file*)))
|
|
(defmethod audio-record-stop ((self (eql 'soxplayer)))
|
(sox-kill nil)
|
(probe-file *sox-temp-recorded-file*))
|
|
#|
|
;;;=================================
|
;;; PLAYBACK FOR SOX-INPUT CLASSES
|
;;;=================================
|
|
(defmethod play-obj? ((self sox-input)) t)
|
|
(defmethod* PrepareToPlay ((player (eql 'soxplayer)) (self sound) at &key approx port interval voice)
|
(declare (ignore approx))
|
(push (list self at interval) *sox-play-list*))
|
|
;the new player method for the sox-input classes could just have a new method for 'sox-input'
|
(defmethod* PrepareToPlay ((player t) (self sox-input) at &key approx port interval voice)
|
(declare (ignore approx))
|
;(print "bingo")
|
(push (list self at interval) *sox-play-list*))
|
;(sox-play self))
|
|
(defmethod InitPlayingSeq ((player (eql 'soxplayer)) dur &key (port nil)) t)
|
|
(defmethod FinalizePlayingSeq ((player (eql 'soxplayer)) dur &key (port nil)) t)
|
|
(defmethod Play-player ((self (eql 'sox-input)))
|
(print "Playing")
|
(sox-play *sox-play-list*))
|
|#
|
|
; SPREAD FUNCTION
|
; Macro for multichannel files.
|
; Where a 'spread' parameter determines how 'spread' the channels are - similar to vbap.
|
#|
|
(om-round (om+ 3.75 ;panning
|
|
(arithm-ser
|
(om* 150 ; spread
|
-0.005)
|
(om* 150 ;spread
|
0.005)
|
|
(om/ (om- (om+ 3.75 (om* 150
|
; spread
|
-0.005))
|
(om+ 3.75 (om* 150
|
; spread
|
0.005)))
|
2)))
|
2)
|
|#
|
|
;;; collect-ressources function from OM 6.7
|
(defun collect-resources (path)
|
(loop for item in (om-directory path) append
|
(cond ((directoryp item) (collect-resources item))
|
((om-persistant-p item)
|
(let ((fileres (get-resources item)))
|
(loop for restype in fileres append
|
(loop for path in (cdr restype) collect
|
(let ((*relative-path-reference* item)
|
(corrected-path (if (and (stringp path) (pathnamep (read-from-string path)))
|
(read-from-string path)
|
path)))
|
(list (car restype) (restore-path corrected-path))
|
)))))
|
(t nil)
|
)))
|
