;********************************************************************* ; 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) ; %%%%%%%%%%%%%%% SOX-ANALYSIS %%%%%%%%%%%%%%%%%%%% ; Main Analysis Function ; sox-analysis should be updated with a 'samplevals' analysis. (defmethod! sox-analysis ((sox-input pathname) (sox-statistic string) &key outpath channel clipping recursive batch-mode) :icon 08 :initvals '(nil "" nil 1 nil nil "break") :menuins '((1 (("filetype" "filetype") ("samplerate" "samplerate") ("channels" "channels") ("comment" "comment") ("samplecount" "samplecount") ("duration" "duration") ("scale-factor" "scale-factor") ("peak amplitude" "peak amplitude") ("max positive amplitude" "max positive amplitude") ("max negative amplitude" "max negative amplitude") ("mid amplitude" "mid amplitude") ("mean amplitude" "mean amplitude") ("mean norm amplitude" "mean norm amplitude") ("rms amplitude" "rms amplitude") ("max delta amplitude" "max delta amplitude") ("min delta amplitude" "min delta amplitude") ("mean delta amplitude" "mean delta amplitude") ("rms delta amplitude" "rms delta amplitude") ("dc offset" "dc offset") ("headroom" "headroom") ("peak level" "peak level") ("rms level" "rms level") ("rms peak level" "rms peak level") ("rms trough level" "rms trough level") ("fundamental frequency" "fundamental frequency") ("crest factor" "crest factor") ("flat factor" "flat factor") ("peak count" "peak count") ("bit depth ratio" "bit depth ratio"))) (5 (("On" On) ("Off" Off))) (6 (("break" break) ("repeat" repeat) ("cycle" cycle)))) :indoc '("Audio input to be analyzed [sound, path, string/pipe, sox-input]" "Sox-statistic to be analyzed for [string]" "Outpath type (directory, filename, filepath) [path]" "Channel of input audio on which to run the analysis [string]" "Specify region (start and endpoint in seconds) of input audio to be analyzed [list]" "recursive (when 'on' applies analysis recursively to audio) [symbol]" "Mode for batch-processing (break, repeat, cycle) [symbol]") :doc "Main audio analysis function for OM-SoX. Takes audio provided in and returns value for a sox-statistic provided in . specifies a filename, directory, or path for a (temporary) textfile into which the analysis results are written before being returned by sox-analysis. allows to specify a channel of the input audio on which the analysis will be performed. NB: Ignored when the input is a sox-input class. allows to apply the analysis on a selected region of the audio input, specified by start and end time (in seconds). is an experimental option allowing to apply a sox-analysis recursively to audio input (e.g. trimming). determines the behaviour when processing lists of sox-inputs and sox-statistics that differ in length. Amplitudes are linear (between -1 1), levels are in dBFS. NB: If 'Delete Temporary Files' is checked in OM's Audio Preferences, the temporary file will be deleted after the value has been returned. " (if (probe-file *sox-path*) (let ((outfile (create-path sox-input outpath "txt")) (numchannels (if (integerp channel) 1 (sox-sound-channels sox-input)))) (sox-print "outfile" outfile) (setf str (format nil "~s ~a ~s -n" (namestring *sox-path*) *sox-options* (namestring sox-input))) ; prepare soundfile (sox-prepare-input channel clipping) ; CALL SOX ANALYSIS FUNCTIONS ------------- NB: these functions set the variable 'str' and 'thelist' inside ; here the first analysis function -sox-stat (sox-ana1 sox-statistic str outfile recursive) ; here the other analysis function -sox-stats (sox-ana2 sox-statistic str outfile recursive) ; here another analysis function -sox-info (sox-ana3 sox-statistic sox-input outfile recursive) ; here the sox-dft function (sox-dft-analysis sox-statistic str outfile recursive) ; here the sox-samples function (sox-sample-analysis sox-statistic sox-input str () () outfile recursive) ; retrieve values (setf thevalue (sox-get-analysis-data sox-statistic thelist numchannels)) ;optional removal of analysis file (add-tmp-file outfile) (when *delete-inter-file* (clean-tmp-files)) ;return value (sox-prepare-analysis-value sox-statistic thevalue) ) (sox-not-found)) ) (defun sox-get-analysis-value (sox-statistic str outfile recursive thelist numchannels) (when (equal sox-statistic "dft-analysis") (sox-dft-analysis sox-statistic str outfile recursive)) ; get the sox-statistics (if (equal sox-statistic "dft-analysis") (setf thevalue thelist) (setf thevalue (sox-get-analysis-data sox-statistic thelist numchannels))) ) ; For Sound & String (defmethod! sox-analysis ((sox-input sound) (sox-statistic string) &key outpath channel clipping recursive batch-mode) (sox-analysis (sound-path sox-input) sox-statistic :outpath outpath :channel channel :clipping clipping :recursive recursive :batch-mode batch-mode)) ; For String (pipe) & String (defmethod! sox-analysis ((sox-input string) (sox-statistic string) &key outpath channel clipping recursive batch-mode) (if (probe-file *sox-path*) (let ((outfile (create-path sox-input outpath "txt")) (numchannels (if (integerp channel) 1 (sox-sound-channels sox-input)))) (sox-print "outfile" outfile) (setf str (format nil "~s ~a ~s -n" (namestring *sox-path*) *sox-options* sox-input)) ; prepare soundfile (sox-prepare-input channel clipping) ; CALL SOX ANALYSIS FUNCTIONS ------------- (sox-ana1 sox-statistic str outfile recursive) (sox-ana2 sox-statistic str outfile recursive) (sox-ana3 sox-statistic sox-input outfile recursive) (sox-dft-analysis sox-statistic str outfile recursive) (sox-sample-analysis sox-statistic sox-input str channel clipping outfile recursive) ; here get the sox-statistics (setf thevalue (sox-get-analysis-data sox-statistic thelist numchannels)) ;optional removal of analysis file (add-tmp-file outfile) (when *delete-inter-file* (clean-tmp-files)) ;return value (sox-prepare-analysis-value sox-statistic thevalue) ) (sox-not-found)) ) ;%%%%%%%%%% sox-classes %%%%%%%%%%%%%% ;sox-mix (defmethod! sox-analysis ((sox-input sox-mix) (sox-statistic string) &key outpath channel clipping recursive batch-mode) (if (probe-file *sox-path*) (let ((outfile (create-path sox-input outpath "txt")) (filenames (loop for soundfile in (sound sox-input) collect (namestring soundfile))) (numchannels (if (integerp channel) 1 (loop for sound in (sound sox-input) maximize (sox-sound-channels sound))))) (setf str (format nil "~s ~a -m" (namestring *sox-path*) *sox-options*)) ;input combiner-stuff (if (gains sox-input) (loop for filename in filenames do for gain in (db->lin (list! (gains sox-input))) do ; repeat gains if a single value? (setf str (string+ str (format nil " -v~d ~s " gain filename )))) (loop for filename in filenames do (setf str (string+ str (format nil " ~s " filename))))) (setf str (string+ str " -n ")) ; prepare soundfile (sox-prepare-input channel clipping) ; CALL SOX ANALYSIS FUNCTIONS ------------- (sox-ana1 sox-statistic str outfile recursive) (sox-ana2 sox-statistic str outfile recursive) (sox-ana3-abort sox-statistic) (sox-dft-analysis sox-statistic str outfile recursive) (sox-sample-analysis sox-statistic sox-input str channel clipping outfile recursive) ; get the sox-statistics (setf thevalue (sox-get-analysis-data sox-statistic thelist numchannels)) ;optional removal of analysis file (add-tmp-file outfile) (when *delete-inter-file* (clean-tmp-files)) ;return value (sox-prepare-analysis-value sox-statistic thevalue) ) (sox-not-found)) ) ; sox-merge (defmethod! sox-analysis ((sox-input sox-merge) (sox-statistic string) &key outpath channel clipping recursive batch-mode) (if (probe-file *sox-path*) (let ((outfile (create-path sox-input outpath "txt")) (filenames (loop for soundfile in (sound sox-input) collect (namestring soundfile))) (numchannels (if (integerp channel) 1 2))) (setf str (format nil "~s ~a -M" (namestring *sox-path*) *sox-options*)) ;input combiner-stuff (if (gains sox-input) (loop for filename in filenames do for gain in (db->lin (list! (gains sox-input))) do ; repeat gains if a single value? (setf str (string+ str (format nil " -v~d ~s " gain filename )))) (loop for filename in filenames do (setf str (string+ str (format nil " ~s " filename))))) (setf str (string+ str " -n ")) ; prepare soundfile (when (and channel (integerp channel)) (setf str (concatenate 'string str (format nil " remix ~d" channel)))) (when (and clipping (equal (length clipping) 2)) (setf str (concatenate 'string str (format nil " trim ~d ~d" (first clipping) (- (second clipping) (first clipping)))))) ; CALL SOX ANALYSIS FUNCTIONS ------------- (sox-ana1 sox-statistic str outfile recursive) (sox-ana2 sox-statistic str outfile recursive) (sox-ana3-abort sox-statistic) (when (equal sox-statistic "dft-analysis") (progn (om-beep-msg "dft-analysis not supported for multi-channel audio.") (om-abort))) ;(sox-sample-analysis sox-statistic sox-input str channel clipping outfile recursive) ; ######### IS THIS LEGIT? We could always analyze a given channel! ; get the sox-statistics (setf thevalue (sox-get-analysis-data sox-statistic thelist numchannels)) ;optional removal of analysis file (add-tmp-file outfile) (when *delete-inter-file* (clean-tmp-files)) ;return value (sox-prepare-analysis-value sox-statistic thevalue) ) (sox-not-found)) ) ; sox-concatenate (defmethod! sox-analysis ((sox-input sox-concatenate) (sox-statistic string) &key outpath channel clipping recursive batch-mode) (if (probe-file *sox-path*) (let ((outfile (create-path sox-input outpath "txt")) (filenames (loop for soundfile in (sound sox-input) collect (namestring soundfile))) (numchannels (if (integerp channel) 1 (sox-sound-channels (first (sound sox-input)))))) (setf str (format nil "~s ~a " (namestring *sox-path*) *sox-options*)) ;input combiner stuff (if (gains sox-input) (loop for filename in filenames do for gain in (db->lin (list! (gains sox-input))) do ; repeat gains if a single value? (setf str (string+ str (format nil " -v~d ~s " gain filename )))) (loop for filename in filenames do (setf str (string+ str (format nil " ~s " filename))))) (setf str (string+ str " -n ")) ; prepare soundfile (when (and channel (integerp channel)) (setf str (concatenate 'string str (format nil " remix ~d" channel)))) (when (and clipping (equal (length clipping) 2)) (setf str (concatenate 'string str (format nil " trim ~d ~d" (first clipping) (- (second clipping) (first clipping)))))) ; CALL SOX ANALYSIS FUNCTIONS ------------- (sox-ana1 sox-statistic str outfile recursive) (sox-ana2 sox-statistic str outfile recursive) (sox-ana3-abort sox-statistic) (sox-dft-analysis sox-statistic str outfile recursive) (sox-sample-analysis sox-statistic sox-input str channel clipping outfile recursive) ; get the sox-statistics (setf thevalue (sox-get-analysis-data sox-statistic thelist numchannels)) ;optional removal of analysis file (add-tmp-file outfile) (when *delete-inter-file* (clean-tmp-files)) ;return value (sox-prepare-analysis-value sox-statistic thevalue) ) (sox-not-found)) ) ;sox-record (defmethod! sox-analysis ((sox-input sox-record) (sox-statistic string) &key outpath channel clipping recursive batch-mode) (if (probe-file *sox-path*) (let ((outfile (create-path sox-input outpath "txt"))) (setf str (format nil "~s ~a ~s -q -n" (namestring *sox-path*) *sox-options* *sox-audio-device*)) ;input combiner stuff ; (cond ((and (channels sox-input) (gains sox-input)) (let ((newstr (format nil " remix" ))) (loop for channel in (channels sox-input) for gain in (gains sox-input) do (setf newstr (string+ newstr (format nil " ~av~d " channel (db->lin gain))))) (setf str (string+ str newstr))) ; prepare soundfile (when (and channel (integerp channel)) (setf str (concatenate 'string str (format nil " remix ~a" channel)))) (if (and clipping (equal (length clipping) 2)) (setf str (concatenate 'string str (format nil " trim ~d ~d" (first clipping) (- (second clipping) (first clipping))))) (setf str (string+ str (format nil " trim 0 ~d " (duration sox-input))))) ; why this special treatment here? shouldn't it be sox-prepare-inpu? ; CALL SOX ANALYSIS FUNCTIONS ------------- (sox-ana1 sox-statistic str outfile recursive) (sox-ana2 sox-statistic str outfile recursive) (sox-ana3-abort sox-statistic) ; I should have a function "sox-dft-channel-check" which is always the same (if (and (equal sox-statistic "dft-analysis") (> (length (channels sox-input)) 1)) ; is it really "length (channels sox-input)"?? (progn (om-beep-msg "dft-analysis not supported for multi-channel audio.") (om-abort)) (sox-dft-analysis sox-statistic str outfile recursive)) (sox-sample-analysis sox-statistic sox-input str channel clipping outfile recursive) ; get the sox-statistics (setf thevalue (sox-get-analysis-data sox-statistic thelist (length (channels sox-input)))) ;optional removal of analysis file (add-tmp-file outfile) (when *delete-inter-file* (clean-tmp-files)) ;return value (sox-prepare-analysis-value sox-statistic thevalue) ) (sox-not-found)) ) ;sox-remix (defmethod! sox-analysis ((sox-input sox-remix) (sox-statistic string) &key outpath channel clipping recursive batch-mode) (if (probe-file *sox-path*) (let* ((inpath (sound sox-input)) (outfile (create-path inpath outpath "txt")) (params (list! (channel-matrix sox-input)))) (setf str (format nil "~s ~a ~s" (namestring *sox-path*) *sox-options* (namestring inpath))) (setf str (string+ str (format nil " -n remix ~a" (sox-remixconc-no-norm (gain-matrix sox-input) (channel-matrix sox-input))))) ; prepare soundfile (when (and channel (integerp channel)) (om-beep-msg "channel selection not possible with sox-split or sox-remix as input") (om-abort)) (when (and clipping (equal (length clipping) 2)) (setf str (concatenate 'string str (format nil " trim ~d ~d" (first clipping) (- (second clipping) (first clipping)))))) ; CALL SOX ANALYSIS FUNCTIONS ------------- (sox-ana1 sox-statistic str outfile recursive) (sox-ana2 sox-statistic str outfile recursive) (sox-ana3-abort sox-statistic) (if (and (equal sox-statistic "dft-analysis") (> (length (channel-matrix sox-input)) 1)) (progn (om-beep-msg "dft-analysis not supported for multi-channel audio.") (om-abort)) (sox-dft-analysis sox-statistic str outfile recursive)) ; what about samplevalues when there's more than 1 channel? (sox-sample-analysis sox-statistic sox-input str channel clipping outfile recursive) ; get the sox-statistics (setf thevalue (sox-get-analysis-data sox-statistic thelist (length (channel-matrix sox-input)))) ;optional removal of analysis file (add-tmp-file outfile) (when *delete-inter-file* (clean-tmp-files)) ;return value (sox-prepare-analysis-value sox-statistic thevalue) ) (sox-not-found)) ) ; sox split (defmethod! sox-analysis ((sox-input sox-split) (sox-statistic string) &key outpath channel clipping recursive batch-mode) (if (probe-file *sox-path*) (let* ((thesoundfile (sound sox-input)) (channels (channels sox-input)) (gains (gains sox-input)) (list-of-remixes (loop for channel in channels for gain in gains collect (make-instance 'sox-remix :sound thesoundfile :gain-matrix (list gain) :channel-matrix (list (list channel))))) (list-of-outpaths (loop for channel in channels collect (format nil "~a_omsox-ch~d" (pathname-name thesoundfile) channel)) )) ;(sox-print "list-of-remixes" list-of-remixes) ;(sox-print "list-of-outpaths" list-of-outpaths) (sox-analysis list-of-remixes sox-statistic :outpath (or outpath list-of-outpaths) :channel channel :clipping clipping :recursive recursive :batch-mode batch-mode)) (sox-not-found)) ) ;%%%%%%%%%%% LIST methods %%%%%%%%%%%%% ; what about the batch-modes? ; For Sound & List (defmethod! sox-analysis ((sox-input sound) (sox-statistic list) &key outpath channel clipping recursive batch-mode) (flat (mapcar (lambda (thesox-statistics) (sox-analysis sox-input thesox-statistics :outpath outpath :channel channel :clipping clipping :recursive recursive :batch-mode batch-mode)) sox-statistic))) ; For sox-input class & List (defmethod! sox-analysis ((sox-input sox-input) (sox-statistic list) &key outpath channel clipping recursive batch-mode) (flat (mapcar (lambda (thesox-statistics) (sox-analysis sox-input thesox-statistics :outpath outpath :channel channel :clipping clipping :recursive recursive :batch-mode batch-mode)) sox-statistic))) ; For String & List (defmethod! sox-analysis ((sox-input string) (sox-statistic list) &key outpath channel clipping recursive batch-mode) (flat (mapcar (lambda (thesox-statistics) (sox-analysis sox-input thesox-statistics :outpath outpath :channel channel :clipping clipping :recursive recursive :batch-mode batch-mode)) sox-statistic))) ; For List & String (defmethod! sox-analysis ((sox-input list) (sox-statistic string) &key outpath channel clipping recursive batch-mode) (if (and (listp outpath) (first outpath)) (mapcar (lambda (file thepath) (sox-analysis file sox-statistic :outpath thepath :channel channel :clipping clipping :recursive recursive :batch-mode batch-mode)) sox-input outpath) (flat (mapcar (lambda (file) (sox-analysis file sox-statistic :outpath outpath :channel channel :clipping clipping :recursive recursive :batch-mode batch-mode)) sox-input)))) ; For list & List & string/list (defmethod! sox-analysis ((sox-input list) (sox-statistic list) &key outpath channel clipping recursive batch-mode) (let ( (numsounds (length sox-input)) (numsox-statistics (length sox-statistic))) (when (> numsounds numsox-statistics) (progn (when (equal batch-mode 'cycle) (progn (setf sox-statistic (flat (group-list sox-statistic (list numsounds) 'circular))) (sox-print "sox-statistic" sox-statistic) )) (when (equal batch-mode 'repeat) (setf sox-statistic (flat (x-append sox-statistic (repeat-n (last sox-statistic) (- numsounds numsox-statistics)))))))) (if (consp outpath) (mapcar (lambda (file thepaths) (sox-analysis file sox-statistic :outpath thepaths :channel channel :clipping clipping :recursive recursive :batch-mode batch-mode)) sox-input outpath) (mapcar (lambda (file) (sox-analysis file sox-statistic :outpath outpath :channel channel :clipping clipping :recursive recursive :batch-mode batch-mode)) sox-input)))) ; %%%%%%%%%%%% Sox-Spectrogram %%%%%%%%%%%% ;(defmethod! sox-spectrogram ((snd t) clipping channel &key legend size contrast color-depth mode nyquist window windowsize outpath) ; (om-beep-msg (format nil "!!! Wrong input for sox-spectrogram ~A" snd))) (defmethod! sox-spectrogram ((snd sound) clipping channel &key legend size contrast color-depth color-type mode nyquist window windowsize outpath) (sox-spectrogram (sound-path snd) clipping channel :legend legend :size size :contrast contrast :color-depth color-depth :color-type color-type :mode mode :nyquist nyquist :window window :windowsize windowsize :outpath outpath)) (defmethod! sox-spectrogram ((snd pathname) clipping channel &key legend size contrast color-depth color-type mode nyquist window windowsize outpath) (sox-spectrogram (namestring snd) clipping channel :legend legend :size size :contrast contrast :color-depth color-depth :color-type color-type :mode mode :nyquist nyquist :window window :windowsize windowsize :outpath (or outpath (pathname-name snd)))) ; what's the difference between this method for 'string' and the above for 'pathname'? string should be is a pipe. (defmethod! sox-spectrogram ((snd string) clipping channel &key legend size contrast color-depth color-type mode nyquist window windowsize outpath) :icon 80 :initvals '(nil nil nil t nil nil nil nil nil nil nil nil) ; could expand its keywords with defaults when shift-clicking :indoc '("audio input" "clipping (region between 2 time values)" "channel selection" "spectrogram w/ legend" "size in pixels X * Y" "choose white / blackpoint for spectrogram (list in db)" "n/a" "color mode" "specify nyquist frequency" "choose windowing function for STFTs" "choose windowsize for STFTs" "outpath") :menuins '((7 (("1" 1) ("2" 2) ("3" 3) ("4" 4) ("5" 5) ("6" 6))) ;("monochrome" "monochrome") ("negativ-monochrome" "negativ-monochrome"))) (8 (("positiv" "positiv") ("negativ" "negativ") ("monochrome" "monochrome") ("negativ-monochrome" "negativ-monochrome"))) (10 (("Hann" "Hann") ("Hamming" "Hamming") ("Bartlett" "Bartlett") ("Rectangular" "Rectangular") ("Kaiser" "Kaiser"))) (11 (("129" 129) ("257" 257) ("513" 513) ("1025" 1025) ("2049" 2049)))) (sox-print "sound" snd) (if (probe-file *sox-path*) (let* ((inpath snd) (outfile (create-path snd outpath "png")) (name (format nil "~s" (pathname-name outfile)))) (cond ((and (numberp nyquist) (integerp channel)) (setf thestring (format nil "~s ~s -n remix ~d rate -v ~d spectrogram -o ~s -c \"OM-SoX spectrogram\"" (namestring *sox-path*) (namestring inpath) channel (* 2 nyquist) (namestring outfile) ))) ((numberp nyquist) (setf thestring (format nil "~s ~s -n rate ~d spectrogram -o ~s -c \"OM-SoX spectrogram\"" (namestring *sox-path*) (namestring inpath) (* 2 nyquist) (namestring outfile) ))) ((integerp channel) (setf thestring (format nil "~s ~s -n remix ~d spectrogram -o ~s -c \"OM-SoX spectrogram\"" (namestring *sox-path*) (namestring inpath) channel (namestring outfile) ))) ((not (or (numberp nyquist) (integerp channel))) (setf thestring (format nil "~s ~s -n spectrogram -o ~s -c \"OM-SoX spectrogram\"" (namestring *sox-path*) (namestring inpath) (namestring outfile) )))) (when (equal (length clipping) 2) (setf thestring (concatenate 'string thestring (format nil " -S ~d -d ~d" (first clipping) (- (second clipping) (first clipping)))))) (when (equal (length size) 2) (setf thestring (concatenate 'string thestring (format nil " -x ~d -y ~d" (first size) (second size))))) (when (equal (length contrast) 2) (setf thestring (concatenate 'string thestring (format nil " -z ~d -Z ~d" (abs (first contrast)) (second contrast))))) (when (integerp color-depth) (setf thestring (concatenate 'string thestring (format nil " -q ~d" color-depth)))) (when (stringp mode) (cond ((equal mode "negativ") (setf thestring (concatenate 'string thestring (format nil " -l" )))) ((equal mode "monochrome") (setf thestring (concatenate 'string thestring (format nil " -m" )))) ((equal mode "negativ-monochrome") (setf thestring (concatenate 'string thestring (format nil " -l -m" )))))) (when (numberp color-type) (setf thestring (concatenate 'string thestring (format nil " -p ~D" color-type )))) (when (stringp window) (cond ((equal window "Hann") (setf thestring (concatenate 'string thestring (format nil " -w ~s" window)))) ((equal window "Hamming") (setf thestring (concatenate 'string thestring (format nil " -w ~s" window)))) ((equal window "Bartlett") (setf thestring (concatenate 'string thestring (format nil " -w ~s" window)))) ((equal window "Rectangular") (setf thestring (concatenate 'string thestring (format nil " -w ~s" window)))) ((equal window "Kaiser") (setf thestring (concatenate 'string thestring (format nil " -w ~s" window)))))) (when (numberp windowsize) (setf thestring (concatenate 'string thestring (format nil " -Y ~d" windowsize)))) ;cosmetics (if legend (setf thestring (concatenate 'string thestring (format nil " -t ~s " name))) (setf thestring (concatenate 'string thestring (format nil " -t ~s -r" name)))) (om-cmd-line thestring *sys-console*) ;make a picture object (let ((myoutfile (probe-file outfile)) (mypict (make-instance 'picture))) (setf (background mypict) myoutfile) ;optional removal of image file (add-tmp-file myoutfile) (when *delete-inter-file* (clean-tmp-files)) mypict) ) (sox-not-found) )) ;;; Sox - Noiseprofile ------------------------------------------- (defmethod! sox-noiseprofile ((snd pathname) clipping &key outpath) :icon 80 :initvals '(nil nil nil) :indoc '("a soundfile (sound object, pathname, or string)" "Specify section of audio (start- and endposition in secs.) to be used for noiseprint" "outfile") :doc "Calculate a profile of the audio for use with sox-denoise (for noise reduction)" (if (probe-file *sox-path*) (let ((outfile (create-path snd outpath "npf"))) (setf thestring (format nil "~s ~s -n " (namestring *sox-path*) (namestring snd) )) (when (equal (length clipping) 2) (setf thestring (concatenate 'string thestring (format nil " trim ~d ~d" (first clipping) (- (second clipping) (first clipping)))))) (setf thestring (concatenate 'string thestring (format nil " noiseprof ~s" (namestring outfile)))) (sox-print "thestring" thestring) (om-cmd-line thestring *sys-console*) (probe-file outfile) ) (sox-not-found) )) (defmethod! sox-noiseprofile ((snd t) clipping &key outpath) (om-beep-msg (format nil "!!! Wrong input for sox-noiseprofile ~A" snd))) (defmethod! sox-noiseprofile ((snd sound) clipping &key outpath) (sox-noiseprofile (sound-path snd) clipping :outpath outpath)) (defmethod! sox-noiseprofile ((snd string) clipping &key outpath) (sox-noiseprofile (pathname snd) clipping :outpath outpath)) ;; helper functions ---------------------------------------- (defun sox-read-file (self) ; should check for the analysis descriptors as line beginnings here to prevent warnings or use -V0 option to suppress warnings!! ; and other sox printouts getting accumulated into the list (with-open-file (f self :direction :input) (let ((line (read-line f nil 'eof)) (rep nil)) (loop while (not (equal line 'eof)) do (multiple-value-bind (name rest) (string-until-char (remove-if #'(lambda (c) (or (= 194 c) (= 160 c) (= 35 c) (= 44 c))) line :key 'char-code) ":") (when name (if rest (pushr (list name (read-from-string rest)) rep) (let ((linedata (data-from-line name))) (pushr (list (apply 'concatenate (cons 'string (mapcar #'(lambda (item) ;(concatenate 'string (string item) " ")) (concatenate 'string (format nil "~f" item) " ")) (butlast linedata)))) (car (last linedata))) rep)))) (setf line (read-line f nil 'eof))) ) rep))) ; this function must remove the "," and the first 'string' ; perhaps make a textfile? (defmethod! sox-read-noiseprof-file (self) (with-open-file (f self :direction :input) (let ((line (read-line f nil 'eof))) (loop while (not (or (equal (read-from-string line) 'Channel) (equal line 'eof))) collect (data-from-line line) do (setf line (read-line f nil 'eof))) ))) ; READS THE SOUND SAMPLES for SOX FIR? (defmethod! sox-read-samples-file ((self pathname)) (with-open-file (f self :direction :input) (let ((line (read-line f nil 'eof))) (cddr (loop while (not (equal line 'eof)) collect (data-from-line line) do (setf line (read-line f nil 'eof)))) ))) (defmethod! sox-read-samples-file-nt ((self pathname)) (with-open-file (f self :direction :input) (let ((line (read-line f nil 'eof))) (cddr (loop while (not (equal line 'eof)) collect (cdr (data-from-line line)) do (setf line (read-line f nil 'eof)))) ))) (defmethod! sox-read-freq-file (self) (with-open-file (f self :direction :input) (let ((line (read-line f nil 'eof))) (loop while (not (or (equal (read-from-string line) 'Samples) (equal line 'eof))) collect (data-from-line line) do (setf line (read-line f nil 'eof))) ))) (defun rec-read-from-string (string) (labels ((fun (x) (multiple-value-list (read-from-string x nil)))) (if (null (read-from-string string nil)) nil (cons (car (fun string)) (rec-read-from-string (coerce (nthcdr (cadr (fun string)) (coerce string 'list)) 'string)))))) ;(char-code #\,) (defun sox-get-analysis-data (sox-statistic list numchannels) (sox-print "sox-statistic" sox-statistic) (let ((thevalue (if (or (equal sox-statistic "dft-analysis") (equal sox-statistic "sample-analysis")) list ; these are specific analysis modes (if (< numchannels 2) (nth (cond ; choose sox-statistic to return ((equal sox-statistic "samplecount") 0) ((equal sox-statistic "duration") 1) ((equal sox-statistic "scale-factor") 2) ((equal sox-statistic "max positive amplitude") 3) ((equal sox-statistic "max negative amplitude") 4) ((equal sox-statistic "mid amplitude") 5) ((equal sox-statistic "mean norm amplitude") 6) ((equal sox-statistic "mean amplitude") 7) ((equal sox-statistic "rms amplitude") 8) ((equal sox-statistic "max delta amplitude") 9) ((equal sox-statistic "min delta amplitude") 10) ((equal sox-statistic "mean delta amplitude") 11) ((equal sox-statistic "rms delta amplitude") 12) ((equal sox-statistic "fundamental frequency") 13) ((equal sox-statistic "headroom") 14) ;-> db? or without? ;stat stuff ((equal sox-statistic "dc offset") 0) ((equal sox-statistic "peak level") 3) ((equal sox-statistic "peak amplitude") 3) ((equal sox-statistic "rms level") 4) ((equal sox-statistic "rms peak level") 5) ((equal sox-statistic "rms trough level") 6) ((equal sox-statistic "crest factor") 7) ((equal sox-statistic "flat factor") 8) ((equal sox-statistic "peak count") 9) ((equal sox-statistic "bit depth ratio") 10) ;soxi stuff ((equal sox-statistic "comment") 0) ((equal sox-statistic "samplerate") 0) ((equal sox-statistic "channels") 0) ((equal sox-statistic "filetype") 0) ) thelist) (nth (cond ; choose sox-statistic to return ((equal sox-statistic "samplecount") 0) ((equal sox-statistic "duration") 1) ((equal sox-statistic "scale-factor") 2) ((equal sox-statistic "max positive amplitude") 3.) ((equal sox-statistic "max negative amplitude") 4) ((equal sox-statistic "mid amplitude") 5) ((equal sox-statistic "mean norm amplitude") 6) ((equal sox-statistic "mean amplitude") 7) ((equal sox-statistic "rms amplitude") 8) ((equal sox-statistic "max delta amplitude") 9) ((equal sox-statistic "min delta amplitude") 10) ((equal sox-statistic "mean delta amplitude") 11) ((equal sox-statistic "rms delta amplitude") 12) ((equal sox-statistic "fundamental frequency") 13) ((equal sox-statistic "headroom") 14) ;stat stuff ;when multichannel this shifts by one as a header line is added to the textfile! ((equal sox-statistic "dc offset") 1) ((equal sox-statistic "peak level") 4) ((equal sox-statistic "peak amplitude") 4) ((equal sox-statistic "rms level") 5) ((equal sox-statistic "rms peak level") 6) ((equal sox-statistic "rms trough level") 7) ((equal sox-statistic "crest factor") 8) ((equal sox-statistic "flat factor") 9) ((equal sox-statistic "peak count") 10) ((equal sox-statistic "bit depth ratio") 11) ;soxi stuff ((equal sox-statistic "comment") 0) ((equal sox-statistic "samplerate") 0) ((equal sox-statistic "channels") 0) ((equal sox-statistic "filetype") 0) ) thelist))))) (if (numberp thevalue) thevalue ;(coerce thevalue 'double-float) ;looking for a way to avoid scientific notation thevalue))) ;should be called sox-stat (defun sox-ana1 (sox-statistic str outfile recursive) (when (or (equal sox-statistic "samplecount") (equal sox-statistic "duration") (equal sox-statistic "scale-factor") (equal sox-statistic "max positive amplitude") (equal sox-statistic "max negative amplitude") (equal sox-statistic "mid amplitude") (equal sox-statistic "mean norm amplitude") (equal sox-statistic "mean amplitude") (equal sox-statistic "rms amplitude") (equal sox-statistic "max delta amplitude") (equal sox-statistic "min delta amplitude") (equal sox-statistic "mean delta amplitude") (equal sox-statistic "rms delta amplitude") (equal sox-statistic "fundamental frequency") (equal sox-statistic "headroom")) (if (eql recursive 'on) (progn (setf str (sox-concat str " : newfile : restart ")) (om-cmd-line str *sys-console*)) (progn (om-cmd-line str *sys-console*) )) (progn (sox-print "ana1" "ana1") (setf str (concatenate 'string str (format nil " stat 2> ~s" (namestring outfile)))) (if (eql recursive 'on) (progn (setf str (sox-concat str " : newfile : restart ")) (om-cmd-line str *sys-console*)) (progn (sox-print "str" str) (om-cmd-line str *sys-console*) )) (probe-file outfile) ) ;read in stat analysis file ----------------- (setf thelist (second (mat-trans (sox-read-file outfile)))) (when (> (length thelist) 15) (setf thelist (list-modulo thelist 15))) )) ;should be called sox-stats (defun sox-ana2 (sox-statistic str outfile recursive) (when (or (equal sox-statistic "dc offset") (equal sox-statistic "peak level") (equal sox-statistic "peak amplitude") (equal sox-statistic "rms level") (equal sox-statistic "rms peak level") (equal sox-statistic "rms peak amplitude") (equal sox-statistic "rms trough level") (equal sox-statistic "crest factor") (equal sox-statistic "flat factor") (equal sox-statistic "peak count") (equal sox-statistic "bit depth ratio")) (progn (sox-print "ana2" "ana2") (setf str (concatenate 'string str (format nil " stats 2> ~s" (namestring outfile)))) (if (eql recursive 'on) (progn (setf str (sox-concat str " : newfile : restart ")) (om-cmd-line str *sys-console*)) (progn (sox-print "str" str) (om-cmd-line str *sys-console*) )) (probe-file outfile) ;read in stats analysis file ------------------ (setf thelist (second (mat-trans (sox-read-file outfile)))) (when (> (length thelist) 15) (setf thelist (list-modulo thelist 15))) ))) ; should be called sox-info (defun sox-ana3 (sox-statistic input outfile recursive) ;Probably also 'recursive' doesn't make any sense... (when (cond ((equal sox-statistic "comment") (setf str (format nil "~s --i -a ~s 1> ~s" (namestring *sox-path*) (namestring input) (namestring outfile)))) ((equal sox-statistic "samplerate") (setf str (format nil "~s --i -r ~s 1> ~s" (namestring *sox-path*) (namestring input) (namestring outfile)))) ((equal sox-statistic "channels") (setf str (format nil "~s --i -c ~s 1> ~s" (namestring *sox-path*) (namestring input) (namestring outfile)))) ((equal sox-statistic "filetype") (setf str (format nil "~s --i -t ~s 1> ~s" (namestring *sox-path*) (namestring input) (namestring outfile))))) (progn (if (eql recursive 'on) (progn (setf str (sox-concat str " : newfile : restart ")) (om-cmd-line str *sys-console*)) (progn (sox-print "ana3" "ana3") (om-cmd-line str *sys-console*) )) ;read in stats anaylsis file ------------------ (setf thelist (cdr (car (sox-read-file outfile)))) ))) (defun sox-ana3-abort (sox-statistic) (when (cond ((equal sox-statistic "filetype") t) ((equal sox-statistic "samplerate") t) ((equal sox-statistic "channels") t) ((equal sox-statistic "comment") t) ) (progn ;it could theoretically work for other inputs - shall be added in the future (om-beep-msg "These sox-statistics are only available for sound files") (om-abort)) )) (defun sox-prepare-analysis-value (sox-statistic thevalue) (list! (cond ((equal sox-statistic "headroom") (lin->db thevalue)) ((equal sox-statistic "peak amplitude") (db->lin thevalue)) (t thevalue)) )) ; this is a utility function - better: sox-prepare-audio-input (defun sox-prepare-input (channel clipping) (when (and channel (integerp channel)) (setf str (sox-concat (format nil " remix ~d" channel) str))) (when (and clipping (equal (length clipping) 2)) (cond ((symbolp (first clipping)) (setf str (sox-concat (format nil " trim ~a ~ds" (symbol-to-string (first clipping)) (- (string-to-number (string-until-char (symbol-to-string (second clipping)) "s")) (string-to-number (string-until-char (symbol-to-string (first clipping)) "s")))) str))) ((stringp (first clipping)) (setf str (sox-concat (format nil " trim ~a ~ds" (first clipping) (- (string-to-number (string-until-char (second clipping) "s")) (string-to-number (string-until-char (first clipping) "s")))) str))) ((numberp (first clipping)) (setf str (sox-concat (format nil " trim ~d ~d" (first clipping) (- (second clipping) (first clipping))) str)))) ) str) ;======= SAMPLE ANALYSIS FUNCTION ====== ; need to check how this is being used with sox-convolve (i.e. whether the channels are taken care of already) (defmethod! sox-sound-samplevalues ((infile sound) &key channel clipping outfile) (let* ((outpath (or outfile (create-path infile nil "txt"))) (samples-file (sox-write-dat-file infile outpath :channel channel :clipping clipping)) (thesamples (sox-read-samples-file samples-file))) ;optional removal of analysis file (add-tmp-file outpath) (when *delete-inter-file* (clean-tmp-files)) thesamples)) (defmethod! sox-sound-samplevals ((infile pathname)) (let* ((outpath (create-path infile nil "txt")) (samples-file (sox-write-dat-file infile outpath)) (thesamples (sox-read-samples-file samples-file))) ;optional removal of analysis file (add-tmp-file outpath) (clean-tmp-files) thesamples)) ;; (defmethod! sox-write-dat-file ((infile pathname) (outpath pathname) &key channel clipping) (if (probe-file *sox-path*) (let* ((infile (namestring infile)) (outfile (namestring outpath))) (setf str (format nil "~s ~a ~s -t dat ~s " (namestring *sox-path*) *sox-options* infile outfile)) (sox-prepare-input channel clipping) (om-cmd-line str *sys-console*) (probe-file outfile)) (sox-not-found))) (defmethod! sox-write-dat-file ((infile sound) (outpath pathname) &key channel clipping) (sox-write-dat-file (sound-path infile) outpath :channel channel :clipping clipping)) ;======= DFT ANALYSIS FUNCTION ======== (defun sox-dft-analysis (sox-statistic str outfile recursive) (when (equal sox-statistic "dft-analysis") (progn (setf str (concatenate 'string str (format nil " stat -freq 2> ~s" (namestring outfile)))) (if (eql recursive 'on) (progn (setf str (sox-concat str " : newfile : restart ")) (om-cmd-line str *sys-console*)) (progn (sox-print "str" str) (om-cmd-line str *sys-console*) )) (probe-file outfile) ;read in stats anaylsis file ------------------ (setf thelist (sox-freq->dftlist (sox-read-freq-file outfile)))) )) (defun sox-sample-analysis (sox-statistic inpath str channel range outfile recursive) (when (equal sox-statistic "sample-analysis") (progn (sox-write-samples-file inpath outfile range channel) ; don't know if this "if" here actually applies (if (eql recursive 'on) (progn (setf str (sox-concat str " : newfile : restart ")) (om-cmd-line str *sys-console*)) (progn (sox-print "str" str) (om-cmd-line str *sys-console*) )) (probe-file outfile) ;read in anaylsis file ------------------ (setf thelist (sox-read-samples-file outfile))) )) ;---- conversion functions ------ (defun sox-freq->dftlist (self) (let ((temp nil) (result nil)) (loop for element in self do (when (and temp (= (car element) 0)) (push (reverse temp) result) (setf temp nil)) (push element temp));) (push (reverse temp) result) (reverse result) )) (defmethod! dftlist->bpflist ((dftlist list)) :icon '(141) (loop for dft in dftlist collect (let* ((translist (mat-trans dft))) (simple-bpf-from-list (first translist) (lin->db (mag->lin (second translist) 4096 1)) 'bpf 10) ))) (defmethod! dftlist->picture ((dftlist list) &key (minval -60) (maxval 0) (exponent 1)) :icon '(141) :initvals '(nil -60 0 1) (let* ((formattedlist (loop for dft in dftlist collect (om- 1.0 (mag->lin (second (mat-trans dft)) 4096 1)) )) (pixellist (lin->db (reverse (mat-trans formattedlist))))) (if (or minval maxval exponent) (om-scale-exp pixellist (db->lin minval) (db->lin maxval) (* 10 exponent)) pixellist) )) ;%%%%%%% some extra analysis functions %%%%%%%%%% ; ---- sox-sound-duration ------ (defmethod sox-sound-duration ((self list)) (flat (mapcar #'(lambda (thesound) (sox-sound-duration thesound)) self))) (defmethod sox-sound-duration ((self t)) (if (probe-file *sox-path*) (let ((thestream (sys:run-shell-command (format nil "~s --i -D ~s" (namestring *sox-path*) (namestring self)) :wait nil :output :stream))) (sox-read-stream thestream (format nil "Cannot get duration of ~s" self))) (sox-not-found))) (defmethod sox-sound-duration ((self sound)) (sox-sound-duration (sound-path self))) ; ---- sox-sound-sr (samplerate) ------ (defmethod sox-sound-sr ((self pathname)) ;shouldn't this be "t" for strings? (if (probe-file *sox-path*) (let ((thestream (sys:run-shell-command (format nil "~s --i -r ~s" (namestring *sox-path*) (namestring self)) :wait nil :output :stream))) (sox-read-stream thestream (format nil "Cannot get samplerate of ~s" self))) (sox-not-found))) (defmethod sox-sound-sr ((self sound)) (sox-sound-sr (sound-path self))) (defmethod sox-sound-sr ((self list)) (flat (mapcar #'(lambda (thesound) (sox-sound-sr thesound)) self))) ; --- sox-sound-samples (number of samples) --- ; this is not very accurate! (defmethod sox-sound-samples ((self pathname)) (if (probe-file *sox-path*) (let ((thestream (sys:run-shell-command (format nil "~s --i -s ~s" (namestring *sox-path*) (namestring self)) :wait nil :output :stream))) (sox-read-stream thestream (format nil "Cannot get number of samples of ~s" self))) (sox-not-found))) (defmethod sox-sound-samples ((self sound)) (sox-sound-samples (sound-path self))) (defmethod sox-sound-samples ((self list)) (flat (mapcar #'(lambda (thesound) (sox-sound-sr thesound)) self))) ; --- sox-sound-channels (number of channels) --- (defmethod sox-sound-channels ((self sound)) (sox-sound-channels (sound-path self)) ) (defmethod sox-sound-channels ((self t)) ;for pathname and string (if (probe-file *sox-path*) (let ((thestream ;(om-cmd-line (format nil "~s --i -c ~s" (namestring *sox-path*) (namestring self)) *sys-console* nil ) (sys:run-shell-command (format nil "~s --i -c ~s" (namestring *sox-path*) (namestring self)) :wait nil :output :stream) )) (sox-read-stream thestream (format nil "Cannot get number of channels of ~s" self))) (sox-not-found) ) ) (defmethod sox-sound-channels ((self list)) (flat (mapcar #'(lambda (thesound) (sox-sound-channels thesound)) self))) ;;; detect file type (defmethod sox-sound-type ((self t)) ;for pathname and string (if (probe-file *sox-path*) (let ((thestream ;(om-cmd-line (format nil "~s --i -c ~s" (namestring *sox-path*) (namestring self)) *sys-console* nil ) (sys:run-shell-command (format nil "~s --i -t ~s" (namestring *sox-path*) (namestring self)) :wait nil :output :stream) )) (sox-read-stream thestream (format nil "Cannot get type of ~s" self))) (sox-not-found) ) ) (defmethod sox-sound-type ((self sound)) (sox-sound-type (sound-path self)) ) ; ******** (defmethod sox-sound-bits ((self t)) ;for pathname and string (if (probe-file *sox-path*) (let ((thestream ;(om-cmd-line (format nil "~s --i -c ~s" (namestring *sox-path*) (namestring self)) *sys-console* nil ) (sys:run-shell-command (format nil "~s --i -b ~s" (namestring *sox-path*) (namestring self)) :wait nil :output :stream) )) (sox-read-stream thestream (format nil "Cannot get bitsize of ~s" self))) (sox-not-found) ) ) (defmethod sox-sound-bits ((self sound)) (sox-sound-bits (sound-path self)) ) ;perhaps I need something like this for reading from the bash (for OMPursuit etc) (defun sox-read-stream (thestream error-message) (if (stream-eofp thestream) (progn (om-beep-msg (format nil error-message)) ;(om-abort) ) (with-open-stream (thestream thestream) (read-from-string (read-line thestream)) )) )