;*********************************************************************
|
; 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 <sox-input> and returns value for a sox-statistic provided in <sox-effect>.
|
|
<output> specifies a filename, directory, or path for a (temporary) textfile into which the analysis results are written before being returned by sox-analysis.
|
<channel> 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.
|
<clipping> allows to apply the analysis on a selected region of the audio input, specified by start and end time (in seconds).
|
<recursive> is an experimental option allowing to apply a sox-analysis recursively to audio input (e.g. trimming).
|
<batch-mode> 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))
|
))
|
)
|
