| commit | author | age | ||
| 92c40d | 1 | ;********************************************************************* |
| AN | 2 | ; OM-SoX, (c) 2011-2014 Marlon Schumacher (CIRMMT/McGill University) * |
| 3 | ; http://sourceforge.net/projects/omsox/ * | |
| 4 | ; * | |
| 5 | ; Multichannel Audio Manipulation and Functional Batch Processing. * | |
| 6 | ; DSP based on SoX - (c) C.Bagwell and Contributors * | |
| 7 | ; http://sox.sourceforge.net/ * | |
| 8 | ;********************************************************************* | |
| 9 | ; | |
| 10 | ;This program is free software; you can redistribute it and/or | |
| 11 | ;modify it under the terms of the GNU General Public License | |
| 12 | ;as published by the Free Software Foundation; either version 2 | |
| 13 | ;of the License, or (at your option) any later version. | |
| 14 | ; | |
| 15 | ;See file LICENSE for further informations on licensing terms. | |
| 16 | ; | |
| 17 | ;This program is distributed in the hope that it will be useful, | |
| 18 | ;but WITHOUT ANY WARRANTY; without even the implied warranty of | |
| 19 | ;MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | |
| 20 | ;GNU General Public License for more details. | |
| 21 | ; | |
| 22 | ;You should have received a copy of the GNU General Public License | |
| 23 | ;along with this program; if not, write to the Free Software | |
| 24 | ;Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307,10 USA. | |
| 25 | ; | |
| 26 | ;Authors: M. Schumacher, J. Bresson | |
| 27 | ||
| 28 | (in-package :om) | |
| 29 | ||
| 30 | (print "loading OM-SoX player for OM version >= 6.8") | |
| 31 | ||
| 32 | ; player specific controls | |
| 33 | ; I need a 'record' button - including a choice of channels I guess | |
| 34 | ; Might have a 'spread' numbox later | |
| 35 | ; Where are things like selection (region) and loop etc. set? | |
| 36 | ||
| 37 | (defmethod make-player-specific-controls ((self (eql :soxplayer)) control-view) | |
| 38 | (let ((snd (object (editor control-view)))) | |
| 39 | ; ------------------------------------------ | |
| 40 | (list | |
| 41 | (om-make-dialog-item 'om-static-text | |
| 42 | (om-make-point 400 8) | |
| 43 | (om-make-point 40 20) "Gain" ;level | |
| 44 | :font *om-default-font1*) | |
| 45 | ||
| 46 | (om-make-dialog-item 'edit-numBox | |
| 47 | (om-make-point 360 8) | |
| 48 | (om-make-point 40 20) (format nil " ~4f" (om-round (sox-vol-convert (vol snd)) 3)) | |
| 49 | :min-val -76 :max-val 12 | |
| 50 | ;:incr 0.01 | |
| 51 | :font *om-default-font1* | |
| 52 | :bg-color *om-white-color* | |
| 53 | :value (sox-vol-convert (vol snd)) | |
| 54 | :afterfun #'(lambda (item) | |
| 55 | ||
| 56 | (setf (vol snd) (sox-convert-vol (value item))) | |
| 57 | (om-set-dialog-item-text item (format () " ~4f" (om-round (value item) 3))) ; not sure this is needed | |
| 58 | )) | |
| 59 | ||
| 60 | ||
| 61 | (om-make-dialog-item 'om-static-text (om-make-point 480 8) | |
| 62 | (om-make-point 70 20) "Panning" | |
| 63 | :font *om-default-font1*) | |
| 64 | ;PAN | |
| 65 | (om-make-dialog-item 'edit-numBox | |
| 66 | (om-make-point 440 8) | |
| 67 | (om-make-point 40 20) | |
| 68 | (format nil " ~4f" (sox-pan-convert (pan snd) (tracknum snd))) | |
| 69 | :font *om-default-font1* | |
| 70 | ;:incr 0.1 | |
| 71 | :min-val 0.0 :max-val 64.0 ; the minvalue is '0' which means "no panning" | |
| 72 | :fg-color (if (< (tracknum snd) 1.0) *om-gray-color* *om-black-color*) ; how can this be evaluated after every value change? | |
| 73 | :bg-color *om-white-color* | |
| 74 | :value (sox-pan-convert (pan snd) (tracknum snd)) | |
| 75 | :afterfun #'(lambda (item) | |
| 76 | (om-set-dialog-item-text item (format () " ~4f" (value item))) | |
| 77 | (setf (pan snd) (second (sox-convert-pan (value item)))) | |
| 78 | (setf (tracknum snd) (first (sox-convert-pan (value item)))) | |
| 79 | ) | |
| 80 | ) | |
| 81 | ||
| 82 | ||
| 83 | ;; might add a menu for the 'mode' of the sonagram in the player panel settings | |
| 84 | (om-make-dialog-item 'om-check-box (om-make-point 530 6) | |
| 85 | (om-make-point 100 20) "Sonagram" | |
| 86 | :font *om-default-font1* | |
| 87 | :di-action | |
| 88 | #'(lambda (item) | |
| 89 | (let* ((editor (editor control-view)) | |
| 90 | (thesound (object editor))) | |
| 91 | (when (om-checked-p item) | |
| 92 | (unless (pict-spectre thesound) | |
| 93 | (setf (pict-spectre thesound) | |
| 94 | (sox-spectrogram thesound nil nil :mode "negativ-monochrome" :legend nil)))) | |
| 95 | (set-edit-param (editor control-view) :show-spectrum (om-checked-p item)) | |
| 96 | (om-invalidate-view (panel editor)))) | |
| 97 | :checked-p (get-edit-param (editor control-view) :show-spectrum) | |
| 98 | ) | |
| 99 | )) | |
| 100 | ) | |
| 101 | ||
| 102 | ;(defmethod player-special-action ((self (eql :soxplayer))) (launch-multiplayer-app)) | |
| 103 | ;(defmethod player-type ((player (eql :soxplayer))) :UDP) | |
| 104 | ||
| 105 | ;(defun init-soxplayer-app () | |
| 106 | ;; enable soxplayer-engine for sound class: | |
| 107 | ; (pushnew :soxplayer *enabled-players*) | |
| 108 | ; (add-player-for-object sound :soxplayer)) | |
| 109 | ||
| 110 | ;;(init-soxplayer-app) | |
| 111 | ;(om-add-init-func 'init-soxplayer-app) | |
| 112 | ||
| 113 | (enable-player :soxplayer) | |
| 114 | ||
| 115 | (defmethod player-name ((self (eql :soxplayer))) "OM-SoX player") | |
| 116 | (defmethod player-desc ((self (eql :soxplayer))) "external SoX player, requires OM-SoX library.") | |
| 117 | (add-player-for-object 'sound :soxplayer) | |
| 118 | ||
| 119 | ;================== | |
| 120 | ; APP | |
| 121 | ;================== | |
| 122 | ||
| 123 | (defvar *sox-play-list* nil) | |
| 124 | (defvar *sox-play-temp* "sox-play.aiff") | |
| 125 | (defvar *sox-temp-recorded-file* nil) | |
| 126 | ||
| 127 | (defun init-soxplayer-app () | |
| 128 | (unless (probe-file *sox-path*) | |
| 129 | (sox-not-found))) | |
| 130 | ||
| 131 | (om-add-init-func 'init-soxplayer-app) | |
| 132 | ||
| 133 | #| | |
| 134 | (defmethod InitPlayingSeq ((player (eql 'soxplayer)) dur &key (port nil)) | |
| 135 | (setf *sox-play-list* nil) | |
| 136 | (unless (probe-file *sox-path*) | |
| 137 | (om-beep-msg "SoX-executable not found!") | |
| 138 | )) | |
| 139 | |# | |
| 140 | ||
| 141 | ;================ | |
| 142 | ; PROTOCOL | |
| 143 | ;================ | |
| 144 | ||
| 145 | ;(defvar *multiplayer-file-to-play* (defmethod Pause-Player ((self (eql 'soxplayer))) (om-beep)) ;there's currently no good method for Pause-Player | |
| 146 | ;(defmethod Continue-Player ((self (eql 'soxplayer))) nil) | |
| 147 | ||
| 148 | (defmethod Reset-Player ((self (eql :soxplayer)) &optional view) | |
| 149 | (declare (ignore view)) | |
| 150 | (print "resetting player") | |
| 151 | (when (probe-file (outfile *sox-play-temp*)) (delete-file (outfile *sox-play-temp*))) | |
| 152 | (setf *sox-play-list* nil) | |
| 153 | t) | |
| 154 | ||
| 155 | ||
| 156 | ; (defmethod InitPlayingSeq ((player (eql 'multiplayer)) dur &key (port nil)) t) | |
| 157 | ; (defmethod FinalizePlayingSeq ((player (eql 'multiplayer)) dur &key (port nil)) t) | |
| 158 | ||
| 159 | ; sequence is prepare-to-play and then player-start | |
| 160 | (defmethod prepare-to-play ((engine (eql :soxplayer)) (player omplayer) object at interval param) | |
| 161 | (call-next-method) | |
| 162 | ) | |
| 163 | ; (declare (ignore approx)) | |
| 164 | ; (push (list object at interval) *sox-play-list*)) | |
| 165 | ||
| 166 | (defmethod player-start ((engine (eql :soxplayer)) &optional play-list) (call-next-method)) | |
| 167 | ||
| 168 | (defmethod player-play-object ((engine (eql :soxplayer)) (object sound) &key interval) | |
| 169 | ; (print "soxplayer play") | |
| 170 | (sox-play object)) | |
| 171 | ||
| 172 | (defmethod player-stop ((engine (eql :soxplayer)) &optional play-list) | |
| 173 | ;(print "soxplayer stop") | |
| 174 | (declare (ignore view)) | |
| 175 | (sox-kill nil)) | |
| 176 | ||
| 177 | ||
| 178 | ||
| 179 | #| | |
| 180 | ; currently no scheme for player-pause and player-continue | |
| 181 | (defmethod player-pause ((engine (eql :soxplayer)) &optional play-list) | |
| 182 | (sox-kill nil)) | |
| 183 | (defmethod player-continue ((engine (eql :soxplayer)) &optional play-list) | |
| 184 | nil) | |
| 185 | |# | |
| 186 | ||
| 187 | #| | |
| 188 | (defmethod Reset-Player ((self (eql 'soxplayer)) &optional view) | |
| 189 | (declare (ignore view)) | |
| 190 | (print "resetting player") | |
| 191 | (when (probe-file (outfile *sox-play-temp*)) (delete-file (outfile *sox-play-temp*))) | |
| 192 | (setf *sox-play-list* nil) | |
| 193 | t) | |
| 194 | |# | |
| 195 | ||
| 196 | #| | |
| 197 | (defmethod player-record ((engine (eql :soxplayer))) | |
| 198 | (setf *sox-temp-recorded-file* | |
| 199 | (om-choose-new-file-dialog :prompt "Choose a name and location for the recorded audio file." | |
| 200 | :directory (outfile nil))) | |
| 201 | (when *sox-temp-recorded-file* | |
| 202 | (sox-rec *sox-temp-recorded-file*))) | |
| 203 | ||
| 204 | ;;; must return the recorded object | |
| 205 | (defmethod player-record-stop ((engine (eql :soxplayer))) | |
| 206 | (sox-kill nil) | |
| 207 | (probe-file *sox-temp-recorded-file*)) | |
| 208 | ||
| 209 | ||
| 210 | (defmethod audio-record-start ((self (eql 'soxplayer))) | |
| 211 | (setf *sox-temp-recorded-file* | |
| 212 | (om-choose-new-file-dialog :prompt "Choose a name and location for the recorded audio file." | |
| 213 | :directory (outfile nil))) | |
| 214 | (when *sox-temp-recorded-file* | |
| 215 | (sox-rec *sox-temp-recorded-file*))) | |
| 216 | ||
| 217 | (defmethod audio-record-stop ((self (eql 'soxplayer))) | |
| 218 | (sox-kill nil) | |
| 219 | (probe-file *sox-temp-recorded-file*)) | |
| 220 | |# | |
| 221 | ||
| 222 | #| | |
| 223 | (defmethod audio-record-start ((self (eql 'soxplayer))) | |
| 224 | (setf *sox-temp-recorded-file* | |
| 225 | (om-choose-new-file-dialog :prompt "Choose a name and location for the recorded audio file." | |
| 226 | :directory (outfile nil))) | |
| 227 | (when *sox-temp-recorded-file* | |
| 228 | (sox-rec *sox-temp-recorded-file*))) | |
| 229 | ||
| 230 | (defmethod audio-record-stop ((self (eql 'soxplayer))) | |
| 231 | (sox-kill nil) | |
| 232 | (probe-file *sox-temp-recorded-file*)) | |
| 233 | |# | |
| 234 | ||
| 235 | ; this needs to be redefined | |
| 236 | ||
| 237 | #| | |
| 238 | ;;;;; | |
| 239 | ;;; SPECIFIES SOMETHING TO BE PLAYED ATHER A GIVEN DELAY (<at>) PAST THE CALL TO PLAYER-START | |
| 240 | ;;; THE DEFAULT BEHAVIOUR IS TO SCHEDULE 'player-play' AT DELAY | |
| 241 | (defmethod prepare-to-play ((engine t) (player omplayer) object at interval) | |
| 242 | (schedule-task player | |
| 243 | #'(lambda () | |
| 244 | ;(print (list object engine at interval)) | |
| 245 | (player-play-object engine object :interval interval)) | |
| 246 | at)) | |
| 247 | ||
| 248 | ;;; PLAY (NOW) | |
| 249 | (defmethod player-play-object ((engine t) object &key interval) | |
| 250 | ;(print (format nil "~A : play ~A - ~A" engine object interval)) | |
| 251 | t) | |
| 252 | ||
| 253 | ;;; START (PLAY WHAT IS SCHEDULED) | |
| 254 | (defmethod player-start ((engine t) &optional play-list) | |
| 255 | ;(print (format nil "~A : start" engine)) | |
| 256 | t) | |
| 257 | ||
| 258 | ;;; PAUSE (all) | |
| 259 | (defmethod player-pause ((engine t) &optional play-list) | |
| 260 | ;(print (format nil "~A : pause" engine)) | |
| 261 | t) | |
| 262 | ||
| 263 | ;;; CONTINUE (all) | |
| 264 | (defmethod player-continue ((engine t) &optional play-list) | |
| 265 | ;(print (format nil "~A : continue" engine)) | |
| 266 | t) | |
| 267 | ||
| 268 | ;;; STOP (all) | |
| 269 | (defmethod player-stop ((engine t) &optional play-list) | |
| 270 | ;(print (format nil "~A : stop" engine)) | |
| 271 | t) | |
| 272 | ||
| 273 | ;;; SET LOOP (called before play) | |
| 274 | (defmethod player-set-loop ((engine t) &optional start end) | |
| 275 | ;(print (format nil "~A : set loop" engine)) | |
| 276 | t) | |
| 277 | ||
| 278 | (defmethod player-loop ((engine t) &optional play-list) | |
| 279 | ;(print (format nil "~A : loop" engine)) | |
| 280 | t) | |
| 281 | ||
| 282 | (defmethod player-record ((engine t)) | |
| 283 | ;(print (format nil "~A : record" engine)) | |
| 284 | t) | |
| 285 | ||
| 286 | ;;; must return the recorded object | |
| 287 | (defmethod player-record-stop ((engine t)) | |
| 288 | ;(print (format nil "~A : record stop" engine)) | |
| 289 | nil) | |
| 290 | |# | |
| 291 | ||
| 292 | ;######## METHODS FOR SOX-PLAY ########### | |
| 293 | ||
| 294 | (defvar *sox-running-processes* nil "keeps a list of process-ids of currently running sox-processes") | |
| 295 | ||
| 296 | ; Q What is it that makes sox-play back only a subsection of a sound (selection) ... it's not 'clipping' | |
| 297 | ; This way we could implement pause & continue methods. | |
| 298 | ||
| 299 | (defmethod! sox-play ((self string) &key clipping samplerate bitdepth gain pan) | |
| 300 | :icon 07 | |
| 301 | :initvals '(nil nil nil nil nil nil) | |
| 302 | :doc "Play back a sound using the OM-SoX library" | |
| 303 | :numouts 1 | |
| 304 | (sox-play-print self) | |
| 305 | (if (probe-file *sox-path*) | |
| 306 | (let* ((inpath self)) | |
| 307 | (setf thestring (format nil "~s ~a ~s -q" (namestring *sox-path*) *sox-options* (namestring inpath))) | |
| 308 | (setf thestring (sox-samplebits thestring bitdepth samplerate *sox-audio-device*)) | |
| 309 | (when clipping (setf thestring (string+ thestring | |
| 310 | (format nil " trim ~d ~d " (first clipping) (- (second clipping) (first clipping)))))) | |
| 311 | ||
| 312 | ; pan means that a sound is going to be panned between the two adjacent channels determined by the scalar. | |
| 313 | ; E.g. a value of 4.5 means between ch4 and ch5 (producing a 5-channel file) --> like the mix-console | |
| 314 | ||
| 315 | (if pan | |
| 316 | (progn | |
| 317 | (sox-print "sox-play: Panning a sound") | |
| 318 | (sox-play (sox-pan->sox-remix self gain pan) ;if both pan and gain it should go into the function directly, otherwise only gain | |
| 319 | :clipping clipping :samplerate samplerate :bitdepth bitdepth) | |
| 320 | ) | |
| 321 | ||
| 322 | (progn | |
| 323 | (when gain (setf thestring (string+ thestring (format nil " gain ~d " gain)))) | |
| 324 | ;(when *normalize* (setf thestring (string+ thestring " norm " (makestring *normalize-level*)))) | |
| 325 | ||
| 326 | (setf localpid (om-cmd-line thestring nil nil)) | |
| 327 | ;(print thestring) | |
| 328 | ;(print localpid) | |
| 329 | (setf *sox-running-processes* (x-append *sox-running-processes* localpid)) | |
| 330 | (om-run-process "remove-terminated-pid" #'sox-remove-pid | |
| 331 | (if clipping (- (cadr clipping) (car clipping)) (sox-sound-duration self)) | |
| 332 | localpid) | |
| 333 | ))) | |
| 334 | (sox-not-found)) | |
| 335 | self | |
| 336 | ) | |
| 337 | ||
| 338 | (defmethod! sox-play ((self pathname) &key clipping samplerate bitdepth gain pan) | |
| 339 | (sox-play (namestring self) :clipping clipping :samplerate samplerate :bitdepth bitdepth :gain gain :pan pan) | |
| 340 | ) | |
| 341 | ||
| 342 | (defmethod! sox-play ((self list) &key clipping samplerate bitdepth gain pan) | |
| 343 | (sox-play-print self) | |
| 344 | (mapcar (lambda (thesound) | |
| 345 | (sox-play thesound :clipping clipping :samplerate samplerate :bitdepth bitdepth :gain gain :pan pan)) self)) | |
| 346 | ; (sox-play thesound :clipping clipping :samplerate samplerate :bitdepth bitdepth :gain gain :pan pan)) self)) | |
| 347 | ||
| 348 | (defmethod! sox-play ((self sound) &key clipping samplerate bitdepth gain pan) | |
| 349 | (sox-play-print self) | |
| 350 | (if (sound-path self) | |
| 351 | (let ((gain (or gain (sox-vol-convert (vol self))))) | |
| 352 | (if (equal (tracknum self) 0) | |
| 353 | (sox-play (pathname (sound-path self)) | |
| 354 | :clipping clipping ;(or clipping (markers self)) | |
| 355 | :samplerate samplerate | |
| 356 | :bitdepth bitdepth | |
| 357 | :gain gain | |
| 358 | :pan pan) | |
| 359 | (sox-play (make-instance 'sox-pan | |
| 360 | :sound self | |
| 361 | :gains gain | |
| 362 | :panning (or pan (+ (tracknum self) (* 0.01 (pan self)))) | |
| 363 | :clipping clipping | |
| 364 | :samplerate samplerate | |
| 365 | :bitdepth bitdepth) | |
| 366 | ) | |
| 367 | ) | |
| 368 | ) | |
| 369 | (om-beep-msg (format nil "OM-SoX: Cannot play sound with path \"~s\"" (sound-path self))) | |
| 370 | ) | |
| 371 | ) | |
| 372 | ||
| 373 | ; ###### sox-mix ##### | |
| 374 | (defmethod! sox-play ((self sox-mix) &key clipping samplerate bitdepth gain pan) | |
| 375 | (sox-play-print self) | |
| 376 | (if (probe-file *sox-path*) | |
| 377 | (let* ((pathlist (sound self)) | |
| 378 | (gainlist (db->lin (gains self)))) | |
| 379 | (setf thestring (format nil "~s ~a -m " (namestring *sox-path*) *sox-options*)) | |
| 380 | (loop for path in pathlist | |
| 381 | for gain in gainlist do | |
| 382 | (setf thestring (string+ thestring (format nil " -v~d ~s" gain (namestring path))))) ; could also be a pipe | |
| 383 | (setf thestring (sox-samplebits thestring bitdepth samplerate *sox-audio-device*)) | |
| 384 | (when clipping (setf thestring (string+ thestring | |
| 385 | (format nil " trim ~d ~d " (first clipping) (- (second clipping) (first clipping)))))) | |
| 386 | ; (when *normalize* (setf thestring (string+ thestring " norm " (makestring *normalize-level*)))) | |
| 387 | (setf localpid (om-cmd-line thestring nil nil)) | |
| 388 | ;(print thestring) | |
| 389 | ;(print localpid) | |
| 390 | (setf *sox-running-processes* (x-append *sox-running-processes* localpid)) | |
| 391 | (om-run-process "remove-terminated-pid" #'sox-remove-pid | |
| 392 | (if clipping (- (cadr clipping) (car clipping)) (list-max (sox-sound-duration (sound self)))) | |
| 393 | localpid) | |
| 394 | ) | |
| 395 | (sox-not-found)) | |
| 396 | self | |
| 397 | ) | |
| 398 | ||
| 399 | ; ###### sox-merge ##### | |
| 400 | (defmethod! sox-play ((self sox-merge) &key clipping samplerate bitdepth gain pan) | |
| 401 | (sox-play-print self) | |
| 402 | (if (probe-file *sox-path*) | |
| 403 | (let* ((pathlist (sound self)) | |
| 404 | (gainlist (db->lin (gains self)))) | |
| 405 | (setf thestring (format nil "~s ~a -M " (namestring *sox-path*) *sox-options*)) | |
| 406 | (loop for path in pathlist | |
| 407 | for gain in gainlist do | |
| 408 | (setf thestring (string+ thestring (format nil " -v~d ~s" gain (namestring path))))) ; could also be a pipe | |
| 409 | (setf thestring (sox-samplebits thestring bitdepth samplerate *sox-audio-device*)) | |
| 410 | (when clipping (setf thestring (string+ thestring | |
| 411 | (format nil " trim ~d ~d " (first clipping) (- (second clipping) (first clipping)))))) | |
| 412 | (setf localpid (om-cmd-line thestring nil nil)) | |
| 413 | ;(print thestring) | |
| 414 | ;(print localpid) | |
| 415 | (setf *sox-running-processes* (x-append *sox-running-processes* localpid)) | |
| 416 | (om-run-process "remove-terminated-pid" #'sox-remove-pid | |
| 417 | (if clipping (- (cadr clipping) (car clipping)) (list-max (sox-sound-duration (sound self)))) | |
| 418 | localpid) | |
| 419 | ) | |
| 420 | (sox-not-found)) | |
| 421 | self | |
| 422 | ) | |
| 423 | ||
| 424 | ; ###### sox-concatenate ##### | |
| 425 | (defmethod! sox-play ((self sox-concatenate) &key clipping samplerate bitdepth gain pan) | |
| 426 | (sox-play-print self) | |
| 427 | (if (probe-file *sox-path*) | |
| 428 | (let* ((pathlist (sound self)) | |
| 429 | (gainlist (db->lin (gains self)))) | |
| 430 | (setf thestring (format nil "~s ~a " (namestring *sox-path*) *sox-options*)) | |
| 431 | (loop for path in pathlist | |
| 432 | for gain in gainlist do | |
| 433 | (setf thestring (string+ thestring (format nil " -v~d ~s" gain (namestring path))))) | |
| 434 | (setf thestring (sox-samplebits thestring bitdepth samplerate *sox-audio-device*)) | |
| 435 | (when clipping (setf thestring (string+ thestring | |
| 436 | (format nil " trim ~d ~d " (first clipping) (- (second clipping) (first clipping)))))) | |
| 437 | (setf localpid (om-cmd-line thestring nil nil)) | |
| 438 | ;(print thestring) | |
| 439 | (print localpid) | |
| 440 | (setf *sox-running-processes* (x-append *sox-running-processes* localpid)) | |
| 441 | (om-run-process "remove-terminated-pid" #'sox-remove-pid | |
| 442 | (if clipping (- (cadr clipping) (car clipping)) (list-max (sox-sound-duration (sound self)))) | |
| 443 | localpid) | |
| 444 | ) | |
| 445 | (sox-not-found)) | |
| 446 | self | |
| 447 | ) | |
| 448 | ||
| 449 | ; ###### sox-splice ##### | |
| 450 | (defmethod! sox-play ((self sox-splice) &key clipping samplerate bitdepth gain pan) | |
| 451 | (sox-play-print self) | |
| 452 | (if (probe-file *sox-path*) | |
| 453 | (let* ((pathlist (sound self)) | |
| 454 | (gainlist (db->lin (gains self)))) | |
| 455 | (setf thestring (format nil "~s ~a " (namestring *sox-path*) *sox-options*)) | |
| 456 | (loop for path in pathlist | |
| 457 | for gain in gainlist do | |
| 458 | (setf thestring (string+ thestring (format nil " -v~d ~s" gain (namestring path))))) | |
| 459 | (setf thestring (sox-samplebits thestring bitdepth samplerate *sox-audio-device*)) | |
| 460 | (when clipping (setf thestring (string+ thestring | |
| 461 | (format nil " trim ~d ~d " (first clipping) (- (second clipping) (first clipping)))))) | |
| 462 | (setf localpid (om-cmd-line thestring nil nil)) | |
| 463 | ;(print thestring) | |
| 464 | (print localpid) | |
| 465 | (setf *sox-running-processes* (x-append *sox-running-processes* localpid)) | |
| 466 | (om-run-process "remove-terminated-pid" #'sox-remove-pid | |
| 467 | (if clipping (- (cadr clipping) (car clipping)) (list-max (sox-sound-duration (sound self)))) | |
| 468 | localpid) | |
| 469 | ) | |
| 470 | (sox-not-found)) | |
| 471 | self | |
| 472 | ) | |
| 473 | ||
| 474 | ; ###### sox-pan ##### | |
| 475 | (defmethod! sox-play ((self sox-pan) &key clipping samplerate bitdepth gain pan) | |
| 476 | (sox-play-print self) | |
| 477 | (sox-play (sox-pan->sox-remix (sound self) (car (list! (gains self))) (car (list! (panning self))) (numchannels self)) | |
| 478 | :clipping clipping | |
| 479 | :samplerate samplerate | |
| 480 | :bitdepth bitdepth | |
| 481 | )) | |
| 482 | ||
| 483 | ; ###### sox-remix ##### | |
| 484 | (defmethod! sox-play ((self sox-remix) &key clipping samplerate bitdepth gain pan) | |
| 485 | (sox-play-print self) | |
| 486 | (if (probe-file *sox-path*) | |
| 487 | (let* ((inpath (sound self))) | |
| 488 | (setf thestring (format nil "~s ~a ~s -q" (namestring *sox-path*) *sox-options* (namestring inpath))) | |
| 489 | (setf thestring (sox-samplebits thestring bitdepth samplerate *sox-audio-device*)) | |
| 490 | (setf thestring (string+ thestring (format nil " remix ~a" | |
| 491 | (sox-remixconc-no-norm (gain-matrix self) (channel-matrix self)) | |
| 492 | ))) | |
| 493 | ||
| 494 | (when clipping (setf thestring (string+ thestring | |
| 495 | (format nil " trim ~d ~d " (first clipping) (- (second clipping) (first clipping)))))) | |
| 496 | ; (when *normalize* (setf thestring (string+ thestring " norm " (makestring *normalize-level*)))) | |
| 497 | ||
| 498 | (setf localpid (om-cmd-line thestring nil nil)) | |
| 499 | ;(print thestring) | |
| 500 | ;(print localpid) | |
| 501 | (setf *sox-running-processes* (x-append *sox-running-processes* localpid)) | |
| 502 | (om-run-process "remove-terminated-pid" #'sox-remove-pid | |
| 503 | (if clipping (- (cadr clipping) (car clipping)) (sox-sound-duration (sound self))) | |
| 504 | localpid) | |
| 505 | ) | |
| 506 | (sox-not-found)) | |
| 507 | self | |
| 508 | ) | |
| 509 | ||
| 510 | ; ###### sox-mix-console ##### | |
| 511 | (defmethod! sox-play ((self sox-mix-console) &key clipping samplerate bitdepth gain pan) | |
| 512 | (sox-play-print self) | |
| 513 | (if (probe-file *sox-path*) | |
| 514 | (sox-play (make-instance 'sox-mix | |
| 515 | :sound (sox-process (sox-pan->sox-remix (sound self) (gains self) (panning self)) ;(numchannels self)) | |
| 516 | "" | |
| 517 | :output "pipe") | |
| 518 | ) | |
| 519 | :clipping clipping :samplerate samplerate :bitdepth bitdepth) | |
| 520 | (sox-not-found)) | |
| 521 | self | |
| 522 | ) | |
| 523 | ||
| 524 | ;##### helper functions ################## -> probably better in utilities. | |
| 525 | ||
| 526 | ; basically, when connecting sox-record to a sox-input class it should allow for doing this. | |
| 527 | ||
| 528 | ;; recording function | |
| 529 | (defmethod! sox-rec (filepath &key duration filetype samplerate bitdepth gain channel) ;better call it fileformat? or audioformat? | |
| 530 | :icon 07 | |
| 531 | :initvals '(nil nil nil nil) | |
| 532 | :menuins '((2 (("aif" "aif") ("wav" "wav") ("flac" "flac") ("ogg" "ogg")))) | |
| 533 | :doc "records incoming audio through sox into a file" | |
| 534 | :numouts 1 | |
| 535 | (if (probe-file *sox-path*) | |
| 536 | (let* ((outpath (or filepath (om-choose-new-file-dialog :prompt "Choose a name and location for the recorded audio file" | |
| 537 | :directory (outfile nil))))) | |
| 538 | (when outpath | |
| 539 | (setf outpath (om-make-pathname :directory (pathname-directory outpath) | |
| 540 | :name (pathname-name outpath) | |
| 541 | :type (or filetype (pathname-type outpath))));) | |
| 542 | (setf thestring (format nil "~s -d" (namestring *sox-path*))) | |
| 543 | (setf thestring (sox-samplebits thestring bitdepth samplerate outpath)) | |
| 544 | ||
| 545 | (when duration (setf thestring (string+ thestring (format nil " trim 0 ~d" duration)))) | |
| 546 | (when gain (setf thestring (string+ thestring (format nil " gain ~d " gain)))) | |
| 547 | (when channel (setf thestring (string+ thestring (format nil " remix ~a" channel)))) | |
| 548 | ||
| 549 | (setf localpid (om-cmd-line thestring nil nil)) | |
| 550 | ;(print thestring) | |
| 551 | (setf *sox-running-processes* (x-append *sox-running-processes* localpid)) | |
| 552 | (when duration (om-run-process "remove-terminated-pid" #'sox-remove-pid duration localpid)) | |
| 553 | ; NB the soundobject throws an error if the soundfile is not there yet | |
| 554 | outpath | |
| 555 | )) | |
| 556 | (sox-not-found)) | |
| 557 | ) | |
| 558 | ||
| 559 | ; ######### command-line functions ########## | |
| 560 | ; sox-kill terminates running sox play/rec processes | |
| 561 | (defmethod! sox-kill (process-ids) | |
| 562 | :icon 01 | |
| 563 | :initvals '(nil) | |
| 564 | :numouts 1 | |
| 565 | #+win32(sys::call-system "taskkill /F /IM \"sox.exe\"") | |
| 566 | #| some experiments to retrieve the pid from Windows DOS console | |
| 567 | (sys::call-system "tasklist /v | find \"sox.exe\"") | |
| 568 | (sys::call-system "tasklist /v | find \"sox.exe\" | taskkill /F /IM") | |
| 569 | (om-cmd-line "tasklist /F /IM \"sox.exe\"" nil nil) | |
| 570 | |# | |
| 571 | #+(or macosx linux) (let ((pid-list (list! (or process-ids *sox-running-processes*)))) | |
| 572 | (loop for pid in pid-list do (om-cmd-line (format nil "kill ~d" pid) *sys-console*)) | |
| 573 | (setf *sox-running-processes* nil) | |
| 574 | ;(print (format nil "killed pids ~s" pid-list)) | |
| 575 | (when (om-find-process "remove-terminated-pid") (om-kill-process (om-find-process "remove-terminated-pid"))) | |
| 576 | ) | |
| 577 | ) | |
| 578 | ||
| 579 | (defun sox-remove-pid (wait-time localpid) | |
| 580 | (sleep wait-time) | |
| 581 | (sox-play-print (string+ "auto remove " (number-to-string localpid))) | |
| 582 | (delete localpid *sox-running-processes*)) | |
