| 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.7") | |
| 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 405 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 45 18) (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-black-color* *om-gray-color*) | |
| 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 | (om-make-dialog-item 'numbox | |
| 83 | (om-make-point 70 pos) | |
| 84 | (om-make-point 36 18) | |
| 85 | (format nil " ~2f" (nth (micid self) (micexps (mic-array self)))) | |
| 86 | :value (nth (micid self) (micexps (mic-array self))) | |
| 87 | :font *om-default-font1* | |
| 88 | :incr 0.01 | |
| 89 | :min-val 0.0 :max-val 2.0 | |
| 90 | :afterfun #'(lambda (box) | |
| 91 | (setf (nth (micid self) (micexps (mic-array self))) (value box)) | |
| 92 | (setf (bpcs (mic-array self)) (gen-bpcs (mic-array self))) | |
| 93 | (report-modifications (om-view-container self))) | |
| 94 | ) | |
| 95 | |# | |
| 96 | (om-make-dialog-item 'om-check-box (om-make-point 100 8) | |
| 97 | (om-make-point 100 20) "Sonagram" | |
| 98 | :font *om-default-font1* | |
| 99 | :di-action | |
| 100 | #'(lambda (item) | |
| 101 | (let* ((editor (editor control-view)) | |
| 102 | (thesound (object editor))) | |
| 103 | (when (om-checked-p item) | |
| 104 | (unless (pict-spectre thesound) | |
| 105 | (setf (pict-spectre thesound) | |
| 106 | (sox-spectrogram thesound nil nil :mode "negativ-monochrome" :legend nil)))) | |
| 107 | (setf (pict-spectre? thesound) (om-checked-p item)) | |
| 108 | (om-invalidate-view (panel editor)))) | |
| 109 | :checked-p (pict-spectre? (object (editor control-view))) | |
| 110 | ) | |
| 111 | )) | |
| 112 | ) | |
| 113 | ||
| 114 | ||
| 115 | ||
| 116 | ; needs a menu for the 'mode' of the sonagram in the player panel settings perhaps | |
| 117 | ||
| 118 | ||
| 119 | ;(defmethod player-special-action ((self (eql :soxplayer))) (launch-multiplayer-app)) | |
| 120 | ;(defmethod player-type ((player (eql :soxplayer))) :UDP) | |
| 121 | ||
| 122 | ;(defun init-soxplayer-app () | |
| 123 | ;; enable soxplayer-engine for sound class: | |
| 124 | ; (pushnew :soxplayer *enabled-players*) | |
| 125 | ; (add-player-for-object sound :soxplayer)) | |
| 126 | ||
| 127 | ;;(init-soxplayer-app) | |
| 128 | ;(om-add-init-func 'init-soxplayer-app) | |
| 129 | ||
| 130 | (enable-player :soxplayer) | |
| 131 | ||
| 132 | (defmethod player-name ((self (eql :soxplayer))) "OM-SoX player") | |
| 133 | (defmethod player-desc ((self (eql :soxplayer))) "external SoX player, requires OM-SoX library.") | |
| 134 | ;(defmethod player-special-action ((self (eql :multiplayer))) (launch-multiplayer-app)) | |
| 135 | ;(defmethod player-type ((player (eql :multiplayer))) :UDP) | |
| 136 | (add-player-for-object 'sound :soxplayer) | |
| 137 | ||
| 138 | ;================== | |
| 139 | ; APP | |
| 140 | ;================== | |
| 141 | ||
| 142 | (defvar *sox-play-list* nil) | |
| 143 | (defvar *sox-play-temp* "sox-play.aiff") | |
| 144 | (defvar *sox-temp-recorded-file* nil) | |
| 145 | ||
| 146 | (defun init-soxplayer-app () | |
| 147 | (unless (probe-file *sox-path*) | |
| 148 | (sox-not-found))) | |
| 149 | ||
| 150 | (om-add-init-func 'init-soxplayer-app) | |
| 151 | ||
| 152 | #| | |
| 153 | (defmethod InitPlayingSeq ((player (eql 'soxplayer)) dur &key (port nil)) | |
| 154 | (setf *sox-play-list* nil) | |
| 155 | (unless (probe-file *sox-path*) | |
| 156 | (om-beep-msg "SoX-executable not found!") | |
| 157 | )) | |
| 158 | |# | |
| 159 | ||
| 160 | ;================ | |
| 161 | ; PROTOCOL | |
| 162 | ;================ | |
| 163 | ||
| 164 | ;(defvar *multiplayer-file-to-play* (defmethod Pause-Player ((self (eql 'soxplayer))) (om-beep)) ;there's currently no good method for Pause-Player | |
| 165 | ;(defmethod Continue-Player ((self (eql 'soxplayer))) nil) | |
| 166 | ||
| 167 | (defmethod Reset-Player ((self (eql :soxplayer)) &optional view) | |
| 168 | (declare (ignore view)) | |
| 169 | (print "resetting player") | |
| 170 | (when (probe-file (outfile *sox-play-temp*)) (delete-file (outfile *sox-play-temp*))) | |
| 171 | (setf *sox-play-list* nil) | |
| 172 | t) | |
| 173 | ||
| 174 | ||
| 175 | ; (defmethod InitPlayingSeq ((player (eql 'multiplayer)) dur &key (port nil)) t) | |
| 176 | ; (defmethod FinalizePlayingSeq ((player (eql 'multiplayer)) dur &key (port nil)) t) | |
| 177 | ||
| 178 | ; sequence is prepare-to-play and then player-start | |
| 179 | (defmethod prepare-to-play ((engine (eql :soxplayer)) (player omplayer) object at interval) | |
| 180 | (call-next-method) | |
| 181 | ) | |
| 182 | ; (declare (ignore approx)) | |
| 183 | ; (push (list object at interval) *sox-play-list*)) | |
| 184 | ||
| 185 | (defmethod player-start ((engine (eql :soxplayer)) &optional play-list) (call-next-method)) | |
| 186 | ||
| 187 | (defmethod player-play-object ((engine (eql :soxplayer)) (object sound) &key interval) | |
| 188 | ; (print "soxplayer play") | |
| 189 | (sox-play object)) | |
| 190 | ||
| 191 | (defmethod player-stop ((engine (eql :soxplayer)) &optional play-list) | |
| 192 | ;(print "soxplayer stop") | |
| 193 | (declare (ignore view)) | |
| 194 | (sox-kill nil)) | |
| 195 | ||
| 196 | ||
| 197 | ||
| 198 | #| | |
| 199 | ; currently no scheme for player-pause and player-continue | |
| 200 | (defmethod player-pause ((engine (eql :soxplayer)) &optional play-list) | |
| 201 | (sox-kill nil)) | |
| 202 | (defmethod player-continue ((engine (eql :soxplayer)) &optional play-list) | |
| 203 | nil) | |
| 204 | |# | |
| 205 | ||
| 206 | #| | |
| 207 | (defmethod Reset-Player ((self (eql 'soxplayer)) &optional view) | |
| 208 | (declare (ignore view)) | |
| 209 | (print "resetting player") | |
| 210 | (when (probe-file (outfile *sox-play-temp*)) (delete-file (outfile *sox-play-temp*))) | |
| 211 | (setf *sox-play-list* nil) | |
| 212 | t) | |
| 213 | |# | |
| 214 | ||
| 215 | #| | |
| 216 | (defmethod player-record ((engine (eql :soxplayer))) | |
| 217 | (setf *sox-temp-recorded-file* | |
| 218 | (om-choose-new-file-dialog :prompt "Choose a name and location for the recorded audio file." | |
| 219 | :directory (outfile nil))) | |
| 220 | (when *sox-temp-recorded-file* | |
| 221 | (sox-rec *sox-temp-recorded-file*))) | |
| 222 | ||
| 223 | ;;; must return the recorded object | |
| 224 | (defmethod player-record-stop ((engine (eql :soxplayer))) | |
| 225 | (sox-kill nil) | |
| 226 | (probe-file *sox-temp-recorded-file*)) | |
| 227 | ||
| 228 | ||
| 229 | (defmethod audio-record-start ((self (eql 'soxplayer))) | |
| 230 | (setf *sox-temp-recorded-file* | |
| 231 | (om-choose-new-file-dialog :prompt "Choose a name and location for the recorded audio file." | |
| 232 | :directory (outfile nil))) | |
| 233 | (when *sox-temp-recorded-file* | |
| 234 | (sox-rec *sox-temp-recorded-file*))) | |
| 235 | ||
| 236 | (defmethod audio-record-stop ((self (eql 'soxplayer))) | |
| 237 | (sox-kill nil) | |
| 238 | (probe-file *sox-temp-recorded-file*)) | |
| 239 | |# | |
| 240 | ||
| 241 | #| | |
| 242 | (defmethod audio-record-start ((self (eql 'soxplayer))) | |
| 243 | (setf *sox-temp-recorded-file* | |
| 244 | (om-choose-new-file-dialog :prompt "Choose a name and location for the recorded audio file." | |
| 245 | :directory (outfile nil))) | |
| 246 | (when *sox-temp-recorded-file* | |
| 247 | (sox-rec *sox-temp-recorded-file*))) | |
| 248 | ||
| 249 | (defmethod audio-record-stop ((self (eql 'soxplayer))) | |
| 250 | (sox-kill nil) | |
| 251 | (probe-file *sox-temp-recorded-file*)) | |
| 252 | |# | |
| 253 | ||
| 254 | ; this needs to be redefined | |
| 255 | ||
| 256 | #| | |
| 257 | ;;;;; | |
| 258 | ;;; SPECIFIES SOMETHING TO BE PLAYED ATHER A GIVEN DELAY (<at>) PAST THE CALL TO PLAYER-START | |
| 259 | ;;; THE DEFAULT BEHAVIOUR IS TO SCHEDULE 'player-play' AT DELAY | |
| 260 | (defmethod prepare-to-play ((engine t) (player omplayer) object at interval) | |
| 261 | (schedule-task player | |
| 262 | #'(lambda () | |
| 263 | ;(print (list object engine at interval)) | |
| 264 | (player-play-object engine object :interval interval)) | |
| 265 | at)) | |
| 266 | ||
| 267 | ;;; PLAY (NOW) | |
| 268 | (defmethod player-play-object ((engine t) object &key interval) | |
| 269 | ;(print (format nil "~A : play ~A - ~A" engine object interval)) | |
| 270 | t) | |
| 271 | ||
| 272 | ;;; START (PLAY WHAT IS SCHEDULED) | |
| 273 | (defmethod player-start ((engine t) &optional play-list) | |
| 274 | ;(print (format nil "~A : start" engine)) | |
| 275 | t) | |
| 276 | ||
| 277 | ;;; PAUSE (all) | |
| 278 | (defmethod player-pause ((engine t) &optional play-list) | |
| 279 | ;(print (format nil "~A : pause" engine)) | |
| 280 | t) | |
| 281 | ||
| 282 | ;;; CONTINUE (all) | |
| 283 | (defmethod player-continue ((engine t) &optional play-list) | |
| 284 | ;(print (format nil "~A : continue" engine)) | |
| 285 | t) | |
| 286 | ||
| 287 | ;;; STOP (all) | |
| 288 | (defmethod player-stop ((engine t) &optional play-list) | |
| 289 | ;(print (format nil "~A : stop" engine)) | |
| 290 | t) | |
| 291 | ||
| 292 | ;;; SET LOOP (called before play) | |
| 293 | (defmethod player-set-loop ((engine t) &optional start end) | |
| 294 | ;(print (format nil "~A : set loop" engine)) | |
| 295 | t) | |
| 296 | ||
| 297 | (defmethod player-loop ((engine t) &optional play-list) | |
| 298 | ;(print (format nil "~A : loop" engine)) | |
| 299 | t) | |
| 300 | ||
| 301 | (defmethod player-record ((engine t)) | |
| 302 | ;(print (format nil "~A : record" engine)) | |
| 303 | t) | |
| 304 | ||
| 305 | ;;; must return the recorded object | |
| 306 | (defmethod player-record-stop ((engine t)) | |
| 307 | ;(print (format nil "~A : record stop" engine)) | |
| 308 | nil) | |
| 309 | |# | |
| 310 | ||
| 311 | ;######## METHODS FOR SOX-PLAY ########### | |
| 312 | ||
| 313 | (defvar *sox-running-processes* nil "keeps a list of process-ids of currently running sox-processes") | |
| 314 | ||
| 315 | ; Q What is it that makes sox-play back only a subsection of a sound (selection) ... it's not 'clipping' | |
| 316 | ; This way we could implement pause & continue methods. | |
| 317 | ||
| 318 | (defmethod! sox-play ((self string) &key clipping samplerate bitdepth gain pan) | |
| 319 | :icon 07 | |
| 320 | :initvals '(nil nil nil nil nil nil) | |
| 321 | :doc "Play back a sound using the OM-SoX library" | |
| 322 | :numouts 1 | |
| 323 | (sox-play-print self) | |
| 324 | (if (probe-file *sox-path*) | |
| 325 | (let* ((inpath self)) | |
| 326 | (setf thestring (format nil "~s ~a ~s -q" (namestring *sox-path*) *sox-options* (namestring inpath))) | |
| 327 | (setf thestring (sox-samplebits thestring bitdepth samplerate *sox-audio-device*)) | |
| 328 | (when clipping (setf thestring (string+ thestring | |
| 329 | (format nil " trim ~d ~d " (first clipping) (- (second clipping) (first clipping)))))) | |
| 330 | ||
| 331 | ; pan means that a sound is going to be panned between the two adjacent channels determined by the scalar. | |
| 332 | ; E.g. a value of 4.5 means between ch4 and ch5 (producing a 5-channel file) --> like the mix-console | |
| 333 | ||
| 334 | (if pan | |
| 335 | (progn | |
| 336 | (sox-print "sox-play: Panning a sound") | |
| 337 | (sox-play (sox-pan->sox-remix self gain pan) ;if both pan and gain it should go into the function directly, otherwise only gain | |
| 338 | :clipping clipping :samplerate samplerate :bitdepth bitdepth) | |
| 339 | ) | |
| 340 | ||
| 341 | (progn | |
| 342 | (when gain (setf thestring (string+ thestring (format nil " gain ~d " gain)))) | |
| 343 | ;(when *normalize* (setf thestring (string+ thestring " norm " (makestring *normalize-level*)))) | |
| 344 | ||
| 345 | (setf localpid (om-cmd-line thestring nil nil)) | |
| 346 | ;(print thestring) | |
| 347 | ;(print localpid) | |
| 348 | (setf *sox-running-processes* (x-append *sox-running-processes* localpid)) | |
| 349 | (om-run-process "remove-terminated-pid" #'sox-remove-pid | |
| 350 | (if clipping (- (cadr clipping) (car clipping)) (sox-sound-duration self)) | |
| 351 | localpid) | |
| 352 | ))) | |
| 353 | (sox-not-found)) | |
| 354 | self | |
| 355 | ) | |
| 356 | ||
| 357 | (defmethod! sox-play ((self pathname) &key clipping samplerate bitdepth gain pan) | |
| 358 | (sox-play (namestring self) :clipping clipping :samplerate samplerate :bitdepth bitdepth :gain gain :pan pan) | |
| 359 | ) | |
| 360 | ||
| 361 | (defmethod! sox-play ((self list) &key clipping samplerate bitdepth gain pan) | |
| 362 | (sox-play-print self) | |
| 363 | (mapcar (lambda (thesound) | |
| 364 | (sox-play thesound :clipping clipping :samplerate samplerate :bitdepth bitdepth :gain gain :pan pan)) self)) | |
| 365 | ; (sox-play thesound :clipping clipping :samplerate samplerate :bitdepth bitdepth :gain gain :pan pan)) self)) | |
| 366 | ||
| 367 | (defmethod! sox-play ((self sound) &key clipping samplerate bitdepth gain pan) | |
| 368 | (sox-play-print self) | |
| 369 | (if (sound-path self) | |
| 370 | (let ((gain (or gain (sox-vol-convert (vol self))))) | |
| 371 | (if (equal (tracknum self) 0) | |
| 372 | (sox-play (pathname (sound-path self)) | |
| 373 | :clipping clipping ;(or clipping (markers self)) | |
| 374 | :samplerate samplerate | |
| 375 | :bitdepth bitdepth | |
| 376 | :gain gain | |
| 377 | :pan pan) | |
| 378 | (sox-play (make-instance 'sox-pan | |
| 379 | :sound self | |
| 380 | :gains gain | |
| 381 | :panning (or pan (+ (tracknum self) (* 0.01 (pan self)))) | |
| 382 | :clipping clipping | |
| 383 | :samplerate samplerate | |
| 384 | :bitdepth bitdepth) | |
| 385 | ) | |
| 386 | ) | |
| 387 | ) | |
| 388 | (om-beep-msg (format nil "OM-SoX: Cannot play sound with path \"~s\"" (sound-path self))) | |
| 389 | ) | |
| 390 | ) | |
| 391 | ||
| 392 | ; ###### sox-mix ##### | |
| 393 | (defmethod! sox-play ((self sox-mix) &key clipping samplerate bitdepth gain pan) | |
| 394 | (sox-play-print self) | |
| 395 | (if (probe-file *sox-path*) | |
| 396 | (let* ((pathlist (sound self)) | |
| 397 | (gainlist (db->lin (gains self)))) | |
| 398 | (setf thestring (format nil "~s ~a -m " (namestring *sox-path*) *sox-options*)) | |
| 399 | (loop for path in pathlist | |
| 400 | for gain in gainlist do | |
| 401 | (setf thestring (string+ thestring (format nil " -v~d ~s" gain (namestring path))))) ; could also be a pipe | |
| 402 | (setf thestring (sox-samplebits thestring bitdepth samplerate *sox-audio-device*)) | |
| 403 | (when clipping (setf thestring (string+ thestring | |
| 404 | (format nil " trim ~d ~d " (first clipping) (- (second clipping) (first clipping)))))) | |
| 405 | ; (when *normalize* (setf thestring (string+ thestring " norm " (makestring *normalize-level*)))) | |
| 406 | (setf localpid (om-cmd-line thestring nil nil)) | |
| 407 | ;(print thestring) | |
| 408 | ;(print localpid) | |
| 409 | (setf *sox-running-processes* (x-append *sox-running-processes* localpid)) | |
| 410 | (om-run-process "remove-terminated-pid" #'sox-remove-pid | |
| 411 | (if clipping (- (cadr clipping) (car clipping)) (list-max (sox-sound-duration (sound self)))) | |
| 412 | localpid) | |
| 413 | ) | |
| 414 | (sox-not-found)) | |
| 415 | self | |
| 416 | ) | |
| 417 | ||
| 418 | ; ###### sox-merge ##### | |
| 419 | (defmethod! sox-play ((self sox-merge) &key clipping samplerate bitdepth gain pan) | |
| 420 | (sox-play-print self) | |
| 421 | (if (probe-file *sox-path*) | |
| 422 | (let* ((pathlist (sound self)) | |
| 423 | (gainlist (db->lin (gains self)))) | |
| 424 | (setf thestring (format nil "~s ~a -M " (namestring *sox-path*) *sox-options*)) | |
| 425 | (loop for path in pathlist | |
| 426 | for gain in gainlist do | |
| 427 | (setf thestring (string+ thestring (format nil " -v~d ~s" gain (namestring path))))) ; could also be a pipe | |
| 428 | (setf thestring (sox-samplebits thestring bitdepth samplerate *sox-audio-device*)) | |
| 429 | (when clipping (setf thestring (string+ thestring | |
| 430 | (format nil " trim ~d ~d " (first clipping) (- (second clipping) (first clipping)))))) | |
| 431 | (setf localpid (om-cmd-line thestring nil nil)) | |
| 432 | ;(print thestring) | |
| 433 | ;(print localpid) | |
| 434 | (setf *sox-running-processes* (x-append *sox-running-processes* localpid)) | |
| 435 | (om-run-process "remove-terminated-pid" #'sox-remove-pid | |
| 436 | (if clipping (- (cadr clipping) (car clipping)) (list-max (sox-sound-duration (sound self)))) | |
| 437 | localpid) | |
| 438 | ) | |
| 439 | (sox-not-found)) | |
| 440 | self | |
| 441 | ) | |
| 442 | ||
| 443 | ; ###### sox-concatenate ##### | |
| 444 | (defmethod! sox-play ((self sox-concatenate) &key clipping samplerate bitdepth gain pan) | |
| 445 | (sox-play-print self) | |
| 446 | (if (probe-file *sox-path*) | |
| 447 | (let* ((pathlist (sound self)) | |
| 448 | (gainlist (db->lin (gains self)))) | |
| 449 | (setf thestring (format nil "~s ~a " (namestring *sox-path*) *sox-options*)) | |
| 450 | (loop for path in pathlist | |
| 451 | for gain in gainlist do | |
| 452 | (setf thestring (string+ thestring (format nil " -v~d ~s" gain (namestring path))))) | |
| 453 | (setf thestring (sox-samplebits thestring bitdepth samplerate *sox-audio-device*)) | |
| 454 | (when clipping (setf thestring (string+ thestring | |
| 455 | (format nil " trim ~d ~d " (first clipping) (- (second clipping) (first clipping)))))) | |
| 456 | (setf localpid (om-cmd-line thestring nil nil)) | |
| 457 | ;(print thestring) | |
| 458 | (print localpid) | |
| 459 | (setf *sox-running-processes* (x-append *sox-running-processes* localpid)) | |
| 460 | (om-run-process "remove-terminated-pid" #'sox-remove-pid | |
| 461 | (if clipping (- (cadr clipping) (car clipping)) (list-max (sox-sound-duration (sound self)))) | |
| 462 | localpid) | |
| 463 | ) | |
| 464 | (sox-not-found)) | |
| 465 | self | |
| 466 | ) | |
| 467 | ||
| 468 | ; ###### sox-splice ##### | |
| 469 | (defmethod! sox-play ((self sox-splice) &key clipping samplerate bitdepth gain pan) | |
| 470 | (sox-play-print self) | |
| 471 | (if (probe-file *sox-path*) | |
| 472 | (let* ((pathlist (sound self)) | |
| 473 | (gainlist (db->lin (gains self)))) | |
| 474 | (setf thestring (format nil "~s ~a " (namestring *sox-path*) *sox-options*)) | |
| 475 | (loop for path in pathlist | |
| 476 | for gain in gainlist do | |
| 477 | (setf thestring (string+ thestring (format nil " -v~d ~s" gain (namestring path))))) | |
| 478 | (setf thestring (sox-samplebits thestring bitdepth samplerate *sox-audio-device*)) | |
| 479 | (when clipping (setf thestring (string+ thestring | |
| 480 | (format nil " trim ~d ~d " (first clipping) (- (second clipping) (first clipping)))))) | |
| 481 | (setf localpid (om-cmd-line thestring nil nil)) | |
| 482 | ;(print thestring) | |
| 483 | (print localpid) | |
| 484 | (setf *sox-running-processes* (x-append *sox-running-processes* localpid)) | |
| 485 | (om-run-process "remove-terminated-pid" #'sox-remove-pid | |
| 486 | (if clipping (- (cadr clipping) (car clipping)) (list-max (sox-sound-duration (sound self)))) | |
| 487 | localpid) | |
| 488 | ) | |
| 489 | (sox-not-found)) | |
| 490 | self | |
| 491 | ) | |
| 492 | ||
| 493 | ; ###### sox-pan ##### | |
| 494 | (defmethod! sox-play ((self sox-pan) &key clipping samplerate bitdepth gain pan) | |
| 495 | (sox-play-print self) | |
| 496 | (sox-play (sox-pan->sox-remix (sound self) (car (list! (gains self))) (car (list! (panning self))) (numchannels self)) | |
| 497 | :clipping clipping | |
| 498 | :samplerate samplerate | |
| 499 | :bitdepth bitdepth | |
| 500 | )) | |
| 501 | ||
| 502 | ; ###### sox-remix ##### | |
| 503 | (defmethod! sox-play ((self sox-remix) &key clipping samplerate bitdepth gain pan) | |
| 504 | (sox-play-print self) | |
| 505 | (if (probe-file *sox-path*) | |
| 506 | (let* ((inpath (sound self))) | |
| 507 | (setf thestring (format nil "~s ~a ~s -q" (namestring *sox-path*) *sox-options* (namestring inpath))) | |
| 508 | (setf thestring (sox-samplebits thestring bitdepth samplerate *sox-audio-device*)) | |
| 509 | (setf thestring (string+ thestring (format nil " remix ~a" | |
| 510 | (sox-remixconc-no-norm (gain-matrix self) (channel-matrix self)) | |
| 511 | ))) | |
| 512 | ||
| 513 | (when clipping (setf thestring (string+ thestring | |
| 514 | (format nil " trim ~d ~d " (first clipping) (- (second clipping) (first clipping)))))) | |
| 515 | ; (when *normalize* (setf thestring (string+ thestring " norm " (makestring *normalize-level*)))) | |
| 516 | ||
| 517 | (setf localpid (om-cmd-line thestring nil nil)) | |
| 518 | ;(print thestring) | |
| 519 | ;(print localpid) | |
| 520 | (setf *sox-running-processes* (x-append *sox-running-processes* localpid)) | |
| 521 | (om-run-process "remove-terminated-pid" #'sox-remove-pid | |
| 522 | (if clipping (- (cadr clipping) (car clipping)) (sox-sound-duration (sound self))) | |
| 523 | localpid) | |
| 524 | ) | |
| 525 | (sox-not-found)) | |
| 526 | self | |
| 527 | ) | |
| 528 | ||
| 529 | ; ###### sox-mix-console ##### | |
| 530 | (defmethod! sox-play ((self sox-mix-console) &key clipping samplerate bitdepth gain pan) | |
| 531 | (sox-play-print self) | |
| 532 | (if (probe-file *sox-path*) | |
| 533 | (sox-play (make-instance 'sox-mix | |
| 534 | :sound (sox-process (sox-pan->sox-remix (sound self) (gains self) (panning self)) ;(numchannels self)) | |
| 535 | "" | |
| 536 | :output "pipe") | |
| 537 | ) | |
| 538 | :clipping clipping :samplerate samplerate :bitdepth bitdepth) | |
| 539 | (sox-not-found)) | |
| 540 | self | |
| 541 | ) | |
| 542 | ||
| 543 | ;##### helper functions ################## -> probably better in utilities. | |
| 544 | ||
| 545 | ; basically, when connecting sox-record to a sox-input class it should allow for doing this. | |
| 546 | ||
| 547 | ;; recording function | |
| 548 | (defmethod! sox-rec (filepath &key duration filetype samplerate bitdepth gain channel) ;better call it fileformat? or audioformat? | |
| 549 | :icon 07 | |
| 550 | :initvals '(nil nil nil nil) | |
| 551 | :menuins '((2 (("aif" "aif") ("wav" "wav") ("flac" "flac") ("ogg" "ogg")))) | |
| 552 | :doc "records incoming audio through sox into a file" | |
| 553 | :numouts 1 | |
| 554 | (if (probe-file *sox-path*) | |
| 555 | (let* ((outpath (or filepath (om-choose-new-file-dialog :prompt "Choose a name and location for the recorded audio file" | |
| 556 | :directory (outfile nil))))) | |
| 557 | (when outpath | |
| 558 | (setf outpath (om-make-pathname :directory (pathname-directory outpath) | |
| 559 | :name (pathname-name outpath) | |
| 560 | :type (or filetype (pathname-type outpath))));) | |
| 561 | (setf thestring (format nil "~s -d" (namestring *sox-path*))) | |
| 562 | (setf thestring (sox-samplebits thestring bitdepth samplerate outpath)) | |
| 563 | ||
| 564 | (when duration (setf thestring (string+ thestring (format nil " trim 0 ~d" duration)))) | |
| 565 | (when gain (setf thestring (string+ thestring (format nil " gain ~d " gain)))) | |
| 566 | (when channel (setf thestring (string+ thestring (format nil " remix ~a" channel)))) | |
| 567 | ||
| 568 | (setf localpid (om-cmd-line thestring nil nil)) | |
| 569 | ;(print thestring) | |
| 570 | (setf *sox-running-processes* (x-append *sox-running-processes* localpid)) | |
| 571 | (when duration (om-run-process "remove-terminated-pid" #'sox-remove-pid duration localpid)) | |
| 572 | ; NB the soundobject throws an error if the soundfile is not there yet | |
| 573 | outpath | |
| 574 | )) | |
| 575 | (sox-not-found)) | |
| 576 | ) | |
| 577 | ||
| 578 | ; ######### command-line functions ########## | |
| 579 | ; sox-kill terminates running sox play/rec processes | |
| 580 | (defmethod! sox-kill (process-ids) | |
| 581 | :icon 01 | |
| 582 | :initvals '(nil) | |
| 583 | :numouts 1 | |
| 584 | #+win32(sys::call-system "taskkill /F /IM \"sox.exe\"") | |
| 585 | #| some experiments to retrieve the pid from Windows DOS console | |
| 586 | (sys::call-system "tasklist /v | find \"sox.exe\"") | |
| 587 | (sys::call-system "tasklist /v | find \"sox.exe\" | taskkill /F /IM") | |
| 588 | (om-cmd-line "tasklist /F /IM \"sox.exe\"" nil nil) | |
| 589 | |# | |
| 590 | #+(or macosx linux) (let ((pid-list (list! (or process-ids *sox-running-processes*)))) | |
| 591 | (loop for pid in pid-list do (om-cmd-line (format nil "kill ~d" pid) *sys-console*)) | |
| 592 | (setf *sox-running-processes* nil) | |
| 593 | ;(print (format nil "killed pids ~s" pid-list)) | |
| 594 | (when (om-find-process "remove-terminated-pid") (om-kill-process (om-find-process "remove-terminated-pid"))) | |
| 595 | ) | |
| 596 | ) | |
| 597 | ||
| 598 | (defun sox-remove-pid (wait-time localpid) | |
| 599 | (sleep wait-time) | |
| 600 | (sox-play-print (string+ "auto remove " (number-to-string localpid))) | |
| 601 | (delete localpid *sox-running-processes*)) | |
