Spatial/OM-SoX_hoaencode.git

chore: some linting for sox-hoaencode class

Marlon Schumacher

5 days ago 4020656850c3f64875a927ae9687127c163d9099

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
	27
	28	(in-package :om)
	29
	30	; %%%%%%%%%%%%%%% SOX-ANALYSIS %%%%%%%%%%%%%%%%%%%%
	31	; Main Analysis Function
	32
	33	; sox-analysis should be updated with a 'samplevals' analysis.
	34
	35	(defmethod! sox-analysis ((sox-input pathname) (sox-statistic string) &key outpath channel clipping recursive batch-mode)
	36	:icon 08
	37	:initvals '(nil "" nil 1 nil nil "break")
	38	:menuins '((1 (("filetype" "filetype") ("samplerate" "samplerate") ("channels" "channels") ("comment" "comment")
	39	("samplecount" "samplecount") ("duration" "duration") ("scale-factor" "scale-factor") ("peak amplitude" "peak amplitude")
	40	("max positive amplitude" "max positive amplitude") ("max negative amplitude" "max negative amplitude")
	41	("mid amplitude" "mid amplitude") ("mean amplitude" "mean amplitude") ("mean norm amplitude" "mean norm amplitude")
	42	("rms amplitude" "rms amplitude") ("max delta amplitude" "max delta amplitude") ("min delta amplitude" "min delta amplitude")
	43	("mean delta amplitude" "mean delta amplitude") ("rms delta amplitude" "rms delta amplitude") ("dc offset" "dc offset")
	44	("headroom" "headroom") ("peak level" "peak level") ("rms level" "rms level") ("rms peak level" "rms peak level")
	45	("rms trough level" "rms trough level") ("fundamental frequency" "fundamental frequency") ("crest factor" "crest factor")
	46	("flat factor" "flat factor") ("peak count" "peak count") ("bit depth ratio" "bit depth ratio")))
	47	(5 (("On" On) ("Off" Off))) (6 (("break" break) ("repeat" repeat) ("cycle" cycle))))
	48	:indoc '("Audio input to be analyzed [sound, path, string/pipe, sox-input]"
	49	"Sox-statistic to be analyzed for [string]" "Outpath type (directory, filename, filepath) [path]"
	50	"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]"
	51	"recursive (when 'on' applies analysis recursively to audio) [symbol]" "Mode for batch-processing (break, repeat, cycle) [symbol]")
	52	: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>.
	53
	54	<output> specifies a filename, directory, or path for a (temporary) textfile into which the analysis results are written before being returned by sox-analysis.
	55	<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.
	56	<clipping> allows to apply the analysis on a selected region of the audio input, specified by start and end time (in seconds).
	57	<recursive> is an experimental option allowing to apply a sox-analysis recursively to audio input (e.g. trimming).
	58	<batch-mode> determines the behaviour when processing lists of sox-inputs and sox-statistics that differ in length.
	59	Amplitudes are linear (between -1 1), levels are in dBFS.
	60
	61	NB: If 'Delete Temporary Files' is checked in OM's Audio Preferences, the temporary file will be deleted after the value has been returned.
	62	"
	63
	64	(if (probe-file sox-path)
	65
	66	(let ((outfile (create-path sox-input outpath "txt"))
	67	(numchannels (if (integerp channel) 1 (sox-sound-channels sox-input))))
	68	(sox-print "outfile" outfile)
	69	(setf str (format nil "~s ~a ~s -n" (namestring sox-path) sox-options (namestring sox-input)))
	70
	71	; prepare soundfile
	72	(sox-prepare-input channel clipping)
	73
	74	; CALL SOX ANALYSIS FUNCTIONS ------------- NB: these functions set the variable 'str' and 'thelist' inside
	75	; here the first analysis function -sox-stat
	76	(sox-ana1 sox-statistic str outfile recursive)
	77	; here the other analysis function -sox-stats
	78	(sox-ana2 sox-statistic str outfile recursive)
	79	; here another analysis function -sox-info
	80	(sox-ana3 sox-statistic sox-input outfile recursive)
	81	; here the sox-dft function
	82	(sox-dft-analysis sox-statistic str outfile recursive)
	83	; here the sox-samples function
	84	(sox-sample-analysis sox-statistic sox-input str () () outfile recursive)
	85	; retrieve values
	86	(setf thevalue (sox-get-analysis-data sox-statistic thelist numchannels))
	87	;optional removal of analysis file
	88	(add-tmp-file outfile)
	89	(when delete-inter-file (clean-tmp-files))
	90	;return value
	91	(sox-prepare-analysis-value sox-statistic thevalue)
	92	)
	93	(sox-not-found))
	94	)
	95
	96	(defun sox-get-analysis-value (sox-statistic str outfile recursive thelist numchannels)
	97	(when (equal sox-statistic "dft-analysis")
	98	(sox-dft-analysis sox-statistic str outfile recursive))
	99	; get the sox-statistics
	100	(if (equal sox-statistic "dft-analysis")
	101	(setf thevalue thelist)
	102	(setf thevalue (sox-get-analysis-data sox-statistic thelist numchannels)))
	103	)
	104
	105	; For Sound & String
	106	(defmethod! sox-analysis ((sox-input sound) (sox-statistic string) &key outpath channel clipping recursive batch-mode)
	107	(sox-analysis (sound-path sox-input) sox-statistic :outpath outpath :channel channel :clipping clipping :recursive recursive :batch-mode batch-mode))
	108
	109	; For String (pipe) & String
	110	(defmethod! sox-analysis ((sox-input string) (sox-statistic string) &key outpath channel clipping recursive batch-mode)
	111	(if (probe-file sox-path)
	112
	113	(let ((outfile (create-path sox-input outpath "txt"))
	114	(numchannels (if (integerp channel) 1 (sox-sound-channels sox-input))))
	115	(sox-print "outfile" outfile)
	116	(setf str (format nil "~s ~a ~s -n" (namestring sox-path) sox-options sox-input))
	117
	118	; prepare soundfile
	119	(sox-prepare-input channel clipping)
	120
	121	; CALL SOX ANALYSIS FUNCTIONS -------------
	122	(sox-ana1 sox-statistic str outfile recursive)
	123	(sox-ana2 sox-statistic str outfile recursive)
	124	(sox-ana3 sox-statistic sox-input outfile recursive)
	125	(sox-dft-analysis sox-statistic str outfile recursive)
	126	(sox-sample-analysis sox-statistic sox-input str channel clipping outfile recursive)
	127
	128	; here get the sox-statistics
	129	(setf thevalue (sox-get-analysis-data sox-statistic thelist numchannels))
	130
	131	;optional removal of analysis file
	132	(add-tmp-file outfile)
	133	(when delete-inter-file (clean-tmp-files))
	134	;return value
	135	(sox-prepare-analysis-value sox-statistic thevalue)
	136	)
	137	(sox-not-found))
	138	)
	139
	140	;%%%%%%%%%% sox-classes %%%%%%%%%%%%%%
	141
	142	;sox-mix
	143
	144	(defmethod! sox-analysis ((sox-input sox-mix) (sox-statistic string) &key outpath channel clipping recursive batch-mode)
	145	(if (probe-file sox-path)
	146
	147	(let ((outfile (create-path sox-input outpath "txt"))
	148	(filenames (loop for soundfile in (sound sox-input) collect
	149	(namestring soundfile)))
	150	(numchannels (if (integerp channel) 1
	151	(loop for sound in (sound sox-input) maximize
	152	(sox-sound-channels sound)))))
	153
	154	(setf str (format nil "~s ~a -m" (namestring sox-path) sox-options))
	155
	156	;input combiner-stuff
	157	(if (gains sox-input)
	158	(loop for filename in filenames do
	159	for gain in (db->lin (list! (gains sox-input))) do ; repeat gains if a single value?
	160	(setf str (string+ str (format nil " -v~d ~s " gain filename ))))
	161	(loop for filename in filenames do
	162	(setf str (string+ str (format nil " ~s " filename)))))
	163
	164	(setf str (string+ str " -n "))
	165
	166	; prepare soundfile
	167	(sox-prepare-input channel clipping)
	168
	169	; CALL SOX ANALYSIS FUNCTIONS -------------
	170	(sox-ana1 sox-statistic str outfile recursive)
	171	(sox-ana2 sox-statistic str outfile recursive)
	172	(sox-ana3-abort sox-statistic)
	173	(sox-dft-analysis sox-statistic str outfile recursive)
	174	(sox-sample-analysis sox-statistic sox-input str channel clipping outfile recursive)
	175
	176	; get the sox-statistics
	177	(setf thevalue (sox-get-analysis-data sox-statistic thelist numchannels))
	178
	179	;optional removal of analysis file
	180	(add-tmp-file outfile)
	181	(when delete-inter-file (clean-tmp-files))
	182	;return value
	183	(sox-prepare-analysis-value sox-statistic thevalue)
	184	)
	185	(sox-not-found))
	186	)
	187
	188	; sox-merge
	189
	190	(defmethod! sox-analysis ((sox-input sox-merge) (sox-statistic string) &key outpath channel clipping recursive batch-mode)
	191	(if (probe-file sox-path)
	192
	193	(let ((outfile (create-path sox-input outpath "txt"))
	194	(filenames (loop for soundfile in (sound sox-input) collect
	195	(namestring soundfile)))
	196	(numchannels (if (integerp channel) 1 2)))
	197
	198	(setf str (format nil "~s ~a -M" (namestring sox-path) sox-options))
	199
	200	;input combiner-stuff
	201	(if (gains sox-input)
	202	(loop for filename in filenames do
	203	for gain in (db->lin (list! (gains sox-input))) do ; repeat gains if a single value?
	204	(setf str (string+ str (format nil " -v~d ~s " gain filename ))))
	205	(loop for filename in filenames do
	206	(setf str (string+ str (format nil " ~s " filename)))))
	207	(setf str (string+ str " -n "))
	208
	209	; prepare soundfile
	210	(when (and channel (integerp channel))
	211	(setf str (concatenate 'string str
	212	(format nil " remix ~d" channel))))
	213	(when (and clipping (equal (length clipping) 2))
	214	(setf str (concatenate 'string str
	215	(format nil " trim ~d ~d" (first clipping) (- (second clipping) (first clipping))))))
	216
	217	; CALL SOX ANALYSIS FUNCTIONS -------------
	218	(sox-ana1 sox-statistic str outfile recursive)
	219	(sox-ana2 sox-statistic str outfile recursive)
	220	(sox-ana3-abort sox-statistic)
	221	(when (equal sox-statistic "dft-analysis")
	222	(progn
	223	(om-beep-msg "dft-analysis not supported for multi-channel audio.")
	224	(om-abort)))
	225	;(sox-sample-analysis sox-statistic sox-input str channel clipping outfile recursive)
	226	; ######### IS THIS LEGIT? We could always analyze a given channel!
	227
	228	; get the sox-statistics
	229	(setf thevalue (sox-get-analysis-data sox-statistic thelist numchannels))
	230
	231	;optional removal of analysis file
	232	(add-tmp-file outfile)
	233	(when delete-inter-file (clean-tmp-files))
	234	;return value
	235	(sox-prepare-analysis-value sox-statistic thevalue)
	236	)
	237	(sox-not-found))
	238	)
	239
	240
	241	; sox-concatenate
	242
	243	(defmethod! sox-analysis ((sox-input sox-concatenate) (sox-statistic string) &key outpath channel clipping recursive batch-mode)
	244	(if (probe-file sox-path)
	245
	246	(let ((outfile (create-path sox-input outpath "txt"))
	247	(filenames (loop for soundfile in (sound sox-input) collect
	248	(namestring soundfile)))
	249	(numchannels (if (integerp channel) 1 (sox-sound-channels (first (sound sox-input))))))
	250
	251	(setf str (format nil "~s ~a " (namestring sox-path) sox-options))
	252
	253	;input combiner stuff
	254	(if (gains sox-input)
	255	(loop for filename in filenames do
	256	for gain in (db->lin (list! (gains sox-input))) do ; repeat gains if a single value?
	257	(setf str (string+ str (format nil " -v~d ~s " gain filename ))))
	258	(loop for filename in filenames do
	259	(setf str (string+ str (format nil " ~s " filename)))))
	260	(setf str (string+ str " -n "))
	261
	262	; prepare soundfile
	263	(when (and channel (integerp channel))
	264	(setf str (concatenate 'string str
	265	(format nil " remix ~d" channel))))
	266	(when (and clipping (equal (length clipping) 2))
	267	(setf str (concatenate 'string str
	268	(format nil " trim ~d ~d" (first clipping) (- (second clipping) (first clipping))))))
	269
	270
	271	; CALL SOX ANALYSIS FUNCTIONS -------------
	272	(sox-ana1 sox-statistic str outfile recursive)
	273	(sox-ana2 sox-statistic str outfile recursive)
	274	(sox-ana3-abort sox-statistic)
	275	(sox-dft-analysis sox-statistic str outfile recursive)
	276	(sox-sample-analysis sox-statistic sox-input str channel clipping outfile recursive)
	277
	278	; get the sox-statistics
	279	(setf thevalue (sox-get-analysis-data sox-statistic thelist numchannels))
	280
	281	;optional removal of analysis file
	282	(add-tmp-file outfile)
	283	(when delete-inter-file (clean-tmp-files))
	284	;return value
	285	(sox-prepare-analysis-value sox-statistic thevalue)
	286	)
	287	(sox-not-found))
	288	)
	289
	290	;sox-record
	291
	292	(defmethod! sox-analysis ((sox-input sox-record) (sox-statistic string) &key outpath channel clipping recursive batch-mode)
	293	(if (probe-file sox-path)
	294
	295	(let ((outfile (create-path sox-input outpath "txt")))
	296
	297	(setf str (format nil "~s ~a ~s -q -n" (namestring sox-path) sox-options sox-audio-device))
	298
	299	;input combiner stuff
	300	; (cond ((and (channels sox-input) (gains sox-input))
	301	(let ((newstr (format nil " remix" )))
	302	(loop for channel in (channels sox-input)
	303	for gain in (gains sox-input) do
	304	(setf newstr (string+ newstr (format nil " ~av~d " channel (db->lin gain)))))
	305	(setf str (string+ str newstr)))
	306
	307	; prepare soundfile
	308	(when (and channel (integerp channel))
	309	(setf str (concatenate 'string str
	310	(format nil " remix ~a" channel))))
	311	(if (and clipping (equal (length clipping) 2))
	312	(setf str (concatenate 'string str
	313	(format nil " trim ~d ~d" (first clipping) (- (second clipping) (first clipping)))))
	314	(setf str (string+ str (format nil " trim 0 ~d " (duration sox-input)))))
	315	; why this special treatment here? shouldn't it be sox-prepare-inpu?
	316
	317	; CALL SOX ANALYSIS FUNCTIONS -------------
	318	(sox-ana1 sox-statistic str outfile recursive)
	319	(sox-ana2 sox-statistic str outfile recursive)
	320	(sox-ana3-abort sox-statistic)
	321	; I should have a function "sox-dft-channel-check" which is always the same
	322	(if (and (equal sox-statistic "dft-analysis") (> (length (channels sox-input)) 1)) ; is it really "length (channels sox-input)"??
	323	(progn
	324	(om-beep-msg "dft-analysis not supported for multi-channel audio.")
	325	(om-abort))
	326	(sox-dft-analysis sox-statistic str outfile recursive))
	327	(sox-sample-analysis sox-statistic sox-input str channel clipping outfile recursive)
	328
	329	; get the sox-statistics
	330	(setf thevalue (sox-get-analysis-data sox-statistic thelist (length (channels sox-input))))
	331
	332	;optional removal of analysis file
	333	(add-tmp-file outfile)
	334	(when delete-inter-file (clean-tmp-files))
	335	;return value
	336	(sox-prepare-analysis-value sox-statistic thevalue)
	337	)
	338	(sox-not-found))
	339	)
	340
	341	;sox-remix
	342
	343	(defmethod! sox-analysis ((sox-input sox-remix) (sox-statistic string) &key outpath channel clipping recursive batch-mode)
	344	(if (probe-file sox-path)
	345
	346	(let* ((inpath (sound sox-input))
	347	(outfile (create-path inpath outpath "txt"))
	348	(params (list! (channel-matrix sox-input))))
	349
	350	(setf str (format nil "~s ~a ~s" (namestring sox-path) sox-options (namestring inpath)))
	351
	352	(setf str (string+ str (format nil " -n remix ~a" (sox-remixconc-no-norm (gain-matrix sox-input) (channel-matrix sox-input)))))
	353
	354	; prepare soundfile
	355	(when (and channel (integerp channel))
	356	(om-beep-msg "channel selection not possible with sox-split or sox-remix as input")
	357	(om-abort))
	358	(when (and clipping (equal (length clipping) 2))
	359	(setf str (concatenate 'string str
	360	(format nil " trim ~d ~d" (first clipping) (- (second clipping) (first clipping))))))
	361
	362	; CALL SOX ANALYSIS FUNCTIONS -------------
	363	(sox-ana1 sox-statistic str outfile recursive)
	364	(sox-ana2 sox-statistic str outfile recursive)
	365	(sox-ana3-abort sox-statistic)
	366
	367	(if (and (equal sox-statistic "dft-analysis") (> (length (channel-matrix sox-input)) 1))
	368	(progn
	369	(om-beep-msg "dft-analysis not supported for multi-channel audio.")
	370	(om-abort))
	371	(sox-dft-analysis sox-statistic str outfile recursive))
	372	; what about samplevalues when there's more than 1 channel?
	373	(sox-sample-analysis sox-statistic sox-input str channel clipping outfile recursive)
	374
	375	; get the sox-statistics
	376	(setf thevalue (sox-get-analysis-data sox-statistic thelist (length (channel-matrix sox-input))))
	377
	378	;optional removal of analysis file
	379	(add-tmp-file outfile)
	380	(when delete-inter-file (clean-tmp-files))
	381	;return value
	382	(sox-prepare-analysis-value sox-statistic thevalue)
	383	)
	384	(sox-not-found))
	385	)
	386
	387	; sox split
	388	(defmethod! sox-analysis ((sox-input sox-split) (sox-statistic string) &key outpath channel clipping recursive batch-mode)
	389	(if (probe-file sox-path)
	390
	391	(let*
	392	((thesoundfile (sound sox-input))
	393	(channels (channels sox-input))
	394	(gains (gains sox-input))
	395	(list-of-remixes (loop for channel in channels
	396	for gain in gains collect
	397	(make-instance 'sox-remix
	398	:sound thesoundfile
	399	:gain-matrix (list gain)
	400	:channel-matrix (list (list channel)))))
	401
	402	(list-of-outpaths (loop for channel in channels
	403	collect
	404	(format nil "~a_omsox-ch~d" (pathname-name thesoundfile) channel))
	405	))
	406
	407	;(sox-print "list-of-remixes" list-of-remixes)
	408	;(sox-print "list-of-outpaths" list-of-outpaths)
	409
	410	(sox-analysis list-of-remixes sox-statistic
	411	:outpath (or outpath list-of-outpaths)
	412	:channel channel
	413	:clipping clipping
	414	:recursive recursive
	415	:batch-mode batch-mode))
	416
	417	(sox-not-found))
	418	)
	419
	420
	421	;%%%%%%%%%%% LIST methods %%%%%%%%%%%%%
	422
	423	; what about the batch-modes?
	424
	425	; For Sound & List
	426	(defmethod! sox-analysis ((sox-input sound) (sox-statistic list) &key outpath channel clipping recursive batch-mode)
	427	(flat (mapcar (lambda (thesox-statistics)
	428	(sox-analysis sox-input thesox-statistics :outpath outpath :channel channel :clipping clipping :recursive recursive :batch-mode batch-mode)) sox-statistic)))
	429	; For sox-input class & List
	430	(defmethod! sox-analysis ((sox-input sox-input) (sox-statistic list) &key outpath channel clipping recursive batch-mode)
	431	(flat (mapcar (lambda (thesox-statistics)
	432	(sox-analysis sox-input thesox-statistics :outpath outpath :channel channel :clipping clipping :recursive recursive :batch-mode batch-mode)) sox-statistic)))
	433
	434	; For String & List
	435	(defmethod! sox-analysis ((sox-input string) (sox-statistic list) &key outpath channel clipping recursive batch-mode)
	436	(flat (mapcar (lambda (thesox-statistics)
	437	(sox-analysis sox-input thesox-statistics :outpath outpath :channel channel :clipping clipping :recursive recursive :batch-mode batch-mode)) sox-statistic)))
	438
	439	; For List & String
	440	(defmethod! sox-analysis ((sox-input list) (sox-statistic string) &key outpath channel clipping recursive batch-mode)
	441	(if (and (listp outpath) (first outpath))
	442	(mapcar (lambda (file thepath)
	443	(sox-analysis file sox-statistic :outpath thepath :channel channel :clipping clipping :recursive recursive :batch-mode batch-mode)) sox-input outpath)
	444	(flat (mapcar (lambda (file)
	445	(sox-analysis file sox-statistic :outpath outpath :channel channel :clipping clipping :recursive recursive :batch-mode batch-mode)) sox-input))))
	446
	447	; For list & List & string/list
	448	(defmethod! sox-analysis ((sox-input list) (sox-statistic list) &key outpath channel clipping recursive batch-mode)
	449	(let (
	450	(numsounds (length sox-input))
	451	(numsox-statistics (length sox-statistic)))
	452
	453	(when (> numsounds numsox-statistics)
	454	(progn
	455	(when (equal batch-mode 'cycle)
	456	(progn
	457	(setf sox-statistic
	458	(flat (group-list sox-statistic (list numsounds) 'circular)))
	459	(sox-print "sox-statistic" sox-statistic)
	460	))
	461	(when (equal batch-mode 'repeat)
	462	(setf sox-statistic
	463	(flat (x-append sox-statistic (repeat-n (last sox-statistic) (- numsounds numsox-statistics))))))))
	464
	465	(if (consp outpath)
	466	(mapcar (lambda (file thepaths)
	467	(sox-analysis file sox-statistic :outpath thepaths :channel channel :clipping clipping :recursive recursive :batch-mode batch-mode)) sox-input outpath)
	468
	469	(mapcar (lambda (file)
	470	(sox-analysis file sox-statistic :outpath outpath :channel channel :clipping clipping :recursive recursive :batch-mode batch-mode)) sox-input))))
	471
	472
	473	; %%%%%%%%%%%% Sox-Spectrogram %%%%%%%%%%%%
	474
	475	;(defmethod! sox-spectrogram ((snd t) clipping channel &key legend size contrast color-depth mode nyquist window windowsize outpath)
	476	; (om-beep-msg (format nil "!!! Wrong input for sox-spectrogram ~A" snd)))
	477
	478	(defmethod! sox-spectrogram ((snd sound) clipping channel &key legend size contrast color-depth color-type mode nyquist window windowsize outpath)
	479	(sox-spectrogram (sound-path snd) clipping channel :legend legend :size size :contrast contrast :color-depth color-depth :color-type color-type
	480	:mode mode :nyquist nyquist :window window :windowsize windowsize :outpath outpath))
	481
	482	(defmethod! sox-spectrogram ((snd pathname) clipping channel &key legend size contrast color-depth color-type mode nyquist window windowsize outpath)
	483	(sox-spectrogram (namestring snd) clipping channel :legend legend :size size :contrast contrast :color-depth color-depth :color-type color-type
	484	:mode mode :nyquist nyquist :window window :windowsize windowsize :outpath (or outpath (pathname-name snd))))
	485
	486	; what's the difference between this method for 'string' and the above for 'pathname'? string should be is a pipe.
	487	(defmethod! sox-spectrogram ((snd string) clipping channel &key legend size contrast color-depth color-type mode nyquist window windowsize outpath)
	488
	489	:icon 80
	490	:initvals '(nil nil nil t nil nil nil nil nil nil nil nil) ; could expand its keywords with defaults when shift-clicking
	491	:indoc '("audio input" "clipping (region between 2 time values)" "channel selection" "spectrogram w/ legend" "size in pixels X * Y"
	492	"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")
	493	:menuins '((7 (("1" 1) ("2" 2) ("3" 3) ("4" 4) ("5" 5) ("6" 6))) ;("monochrome" "monochrome") ("negativ-monochrome" "negativ-monochrome")))
	494	(8 (("positiv" "positiv") ("negativ" "negativ") ("monochrome" "monochrome") ("negativ-monochrome" "negativ-monochrome")))
	495	(10 (("Hann" "Hann") ("Hamming" "Hamming") ("Bartlett" "Bartlett") ("Rectangular" "Rectangular") ("Kaiser" "Kaiser")))
	496	(11 (("129" 129) ("257" 257) ("513" 513) ("1025" 1025) ("2049" 2049))))
	497
	498	(sox-print "sound" snd)
	499	(if (probe-file sox-path)
	500
	501	(let* ((inpath snd)
	502	(outfile (create-path snd outpath "png"))
	503	(name (format nil "~s" (pathname-name outfile))))
	504
	505	(cond
	506	((and (numberp nyquist) (integerp channel))
	507	(setf thestring
	508	(format nil "~s ~s -n remix ~d rate -v ~d spectrogram -o ~s -c \"OM-SoX spectrogram\""
	509	(namestring sox-path)
	510	(namestring inpath)
	511	channel
	512	(* 2 nyquist)
	513	(namestring outfile)
	514	)))
	515	((numberp nyquist)
	516	(setf thestring
	517	(format nil "~s ~s -n rate ~d spectrogram -o ~s -c \"OM-SoX spectrogram\""
	518	(namestring sox-path)
	519	(namestring inpath)
	520	(* 2 nyquist)
	521	(namestring outfile)
	522	)))
	523	((integerp channel)
	524	(setf thestring
	525	(format nil "~s ~s -n remix ~d spectrogram -o ~s -c \"OM-SoX spectrogram\""
	526	(namestring sox-path)
	527	(namestring inpath)
	528	channel
	529	(namestring outfile)
	530	)))
	531
	532	((not (or (numberp nyquist) (integerp channel)))
	533	(setf thestring
	534	(format nil "~s ~s -n spectrogram -o ~s -c \"OM-SoX spectrogram\""
	535	(namestring sox-path)
	536	(namestring inpath)
	537	(namestring outfile)
	538	))))
	539
	540	(when (equal (length clipping) 2)
	541	(setf thestring (concatenate 'string thestring (format nil " -S ~d -d ~d" (first clipping) (- (second clipping) (first clipping))))))
	542	(when (equal (length size) 2)
	543	(setf thestring (concatenate 'string thestring (format nil " -x ~d -y ~d" (first size) (second size)))))
	544	(when (equal (length contrast) 2)
	545	(setf thestring (concatenate 'string thestring (format nil " -z ~d -Z ~d" (abs (first contrast)) (second contrast)))))
	546	(when (integerp color-depth)
	547	(setf thestring (concatenate 'string thestring (format nil " -q ~d" color-depth))))
	548	(when (stringp mode)
	549	(cond ((equal mode "negativ") (setf thestring (concatenate 'string thestring (format nil " -l" ))))
	550	((equal mode "monochrome") (setf thestring (concatenate 'string thestring (format nil " -m" ))))
	551	((equal mode "negativ-monochrome") (setf thestring (concatenate 'string thestring (format nil " -l -m" ))))))
	552	(when (numberp color-type)
	553	(setf thestring (concatenate 'string thestring (format nil " -p ~D" color-type ))))
	554	(when (stringp window)
	555	(cond ((equal window "Hann")
	556	(setf thestring (concatenate 'string thestring (format nil " -w ~s" window))))
	557	((equal window "Hamming")
	558	(setf thestring (concatenate 'string thestring (format nil " -w ~s" window))))
	559	((equal window "Bartlett")
	560	(setf thestring (concatenate 'string thestring (format nil " -w ~s" window))))
	561	((equal window "Rectangular")
	562	(setf thestring (concatenate 'string thestring (format nil " -w ~s" window))))
	563	((equal window "Kaiser")
	564	(setf thestring (concatenate 'string thestring (format nil " -w ~s" window))))))
	565	(when (numberp windowsize)
	566	(setf thestring (concatenate 'string thestring (format nil " -Y ~d" windowsize))))
	567
	568	;cosmetics
	569	(if legend
	570	(setf thestring (concatenate 'string thestring
	571	(format nil " -t ~s " name)))
	572	(setf thestring (concatenate 'string thestring
	573	(format nil " -t ~s -r" name))))
	574	(om-cmd-line thestring sys-console)
	575
	576	;make a picture object
	577	(let ((myoutfile (probe-file outfile))
	578	(mypict (make-instance 'picture)))
	579	(setf (background mypict) myoutfile)
	580
	581	;optional removal of image file
	582	(add-tmp-file myoutfile)
	583	(when delete-inter-file (clean-tmp-files))
	584	mypict)
	585	)
	586	(sox-not-found)
	587	))
	588
	589
	590	;;; Sox - Noiseprofile -------------------------------------------
	591
	592	(defmethod! sox-noiseprofile ((snd pathname) clipping &key outpath)
	593
	594	:icon 80
	595	:initvals '(nil nil nil)
	596	:indoc '("a soundfile (sound object, pathname, or string)" "Specify section of audio (start- and endposition in secs.) to be used for noiseprint" "outfile")
	597	:doc "Calculate a profile of the audio for use with sox-denoise (for noise reduction)"
	598
	599	(if (probe-file sox-path)
	600
	601	(let ((outfile (create-path snd outpath "npf")))
	602
	603	(setf thestring
	604	(format nil "~s ~s -n "
	605	(namestring sox-path)
	606	(namestring snd)
	607	))
	608	(when (equal (length clipping) 2)
	609	(setf thestring (concatenate 'string thestring
	610	(format nil " trim ~d ~d" (first clipping) (- (second clipping) (first clipping))))))
	611	(setf thestring (concatenate 'string thestring
	612	(format nil " noiseprof ~s" (namestring outfile))))
	613	(sox-print "thestring" thestring)
	614	(om-cmd-line thestring sys-console)
	615	(probe-file outfile)
	616	)
	617	(sox-not-found)
	618	))
	619
	620	(defmethod! sox-noiseprofile ((snd t) clipping &key outpath)
	621	(om-beep-msg (format nil "!!! Wrong input for sox-noiseprofile ~A" snd)))
	622
	623	(defmethod! sox-noiseprofile ((snd sound) clipping &key outpath)
	624	(sox-noiseprofile (sound-path snd) clipping :outpath outpath))
	625
	626	(defmethod! sox-noiseprofile ((snd string) clipping &key outpath)
	627	(sox-noiseprofile (pathname snd) clipping :outpath outpath))
	628
	629
	630	;; helper functions ----------------------------------------
	631
	632	(defun sox-read-file (self)
	633	; should check for the analysis descriptors as line beginnings here to prevent warnings or use -V0 option to suppress warnings!!
	634	; and other sox printouts getting accumulated into the list
	635	(with-open-file (f self :direction :input)
	636	(let ((line (read-line f nil 'eof))
	637	(rep nil))
	638	(loop while (not (equal line 'eof)) do
	639	(multiple-value-bind (name rest)
	640	(string-until-char
	641	(remove-if #'(lambda (c) (or (= 194 c) (= 160 c) (= 35 c) (= 44 c))) line :key 'char-code)
	642	":")
	643	(when name
	644	(if rest
	645	(pushr (list name (read-from-string rest)) rep)
	646	(let ((linedata (data-from-line name)))
	647	(pushr (list (apply 'concatenate (cons 'string
	648	(mapcar #'(lambda (item)
	649	;(concatenate 'string (string item) " "))
	650	(concatenate 'string (format nil "~f" item) " "))
	651	(butlast linedata))))
	652	(car (last linedata)))
	653	rep))))
	654	(setf line (read-line f nil 'eof)))
	655	)
	656	rep)))
	657
	658	; this function must remove the "," and the first 'string'
	659	; perhaps make a textfile?
	660	(defmethod! sox-read-noiseprof-file (self)
	661	(with-open-file (f self :direction :input)
	662	(let ((line (read-line f nil 'eof)))
	663	(loop while (not (or (equal (read-from-string line) 'Channel) (equal line 'eof))) collect
	664	(data-from-line line)
	665	do (setf line (read-line f nil 'eof)))
	666	)))
	667
	668	; READS THE SOUND SAMPLES for SOX FIR?
	669	(defmethod! sox-read-samples-file ((self pathname))
	670	(with-open-file (f self :direction :input)
	671	(let ((line (read-line f nil 'eof)))
	672	(cddr (loop while (not (equal line 'eof)) collect
	673	(data-from-line line)
	674	do (setf line (read-line f nil 'eof))))
	675	)))
	676
	677	(defmethod! sox-read-samples-file-nt ((self pathname))
	678	(with-open-file (f self :direction :input)
	679	(let ((line (read-line f nil 'eof)))
	680	(cddr (loop while (not (equal line 'eof)) collect
	681	(cdr (data-from-line line))
	682	do (setf line (read-line f nil 'eof))))
	683	)))
	684
	685	(defmethod! sox-read-freq-file (self)
	686	(with-open-file (f self :direction :input)
	687	(let ((line (read-line f nil 'eof)))
	688	(loop while (not (or (equal (read-from-string line) 'Samples) (equal line 'eof))) collect
	689	(data-from-line line)
	690	do (setf line (read-line f nil 'eof)))
	691	)))
	692
	693	(defun rec-read-from-string (string)
	694	(labels ((fun (x) (multiple-value-list (read-from-string x nil))))
	695	(if (null (read-from-string string nil))
	696	nil
	697	(cons (car (fun string))
	698	(rec-read-from-string (coerce (nthcdr (cadr (fun string)) (coerce string 'list)) 'string))))))
	699
	700	;(char-code #\,)
	701
	702
	703	(defun sox-get-analysis-data (sox-statistic list numchannels)
	704	(sox-print "sox-statistic" sox-statistic)
	705	(let ((thevalue
	706	(if (or (equal sox-statistic "dft-analysis")
	707	(equal sox-statistic "sample-analysis"))
	708	list
	709	; these are specific analysis modes
	710
	711	(if (< numchannels 2)
	712
	713	(nth (cond ; choose sox-statistic to return
	714	((equal sox-statistic "samplecount") 0)
	715	((equal sox-statistic "duration") 1)
	716	((equal sox-statistic "scale-factor") 2)
	717	((equal sox-statistic "max positive amplitude") 3)
	718	((equal sox-statistic "max negative amplitude") 4)
	719	((equal sox-statistic "mid amplitude") 5)
	720	((equal sox-statistic "mean norm amplitude") 6)
	721	((equal sox-statistic "mean amplitude") 7)
	722	((equal sox-statistic "rms amplitude") 8)
	723	((equal sox-statistic "max delta amplitude") 9)
	724	((equal sox-statistic "min delta amplitude") 10)
	725	((equal sox-statistic "mean delta amplitude") 11)
	726	((equal sox-statistic "rms delta amplitude") 12)
	727	((equal sox-statistic "fundamental frequency") 13)
	728	((equal sox-statistic "headroom") 14) ;-> db? or without?
	729	;stat stuff
	730
	731	((equal sox-statistic "dc offset") 0)
	732	((equal sox-statistic "peak level") 3)
	733	((equal sox-statistic "peak amplitude") 3)
	734	((equal sox-statistic "rms level") 4)
	735	((equal sox-statistic "rms peak level") 5)
	736	((equal sox-statistic "rms trough level") 6)
	737	((equal sox-statistic "crest factor") 7)
	738	((equal sox-statistic "flat factor") 8)
	739	((equal sox-statistic "peak count") 9)
	740	((equal sox-statistic "bit depth ratio") 10)
	741	;soxi stuff
	742	((equal sox-statistic "comment") 0)
	743	((equal sox-statistic "samplerate") 0)
	744	((equal sox-statistic "channels") 0)
	745	((equal sox-statistic "filetype") 0)
	746	)
	747	thelist)
	748
	749	(nth (cond ; choose sox-statistic to return
	750	((equal sox-statistic "samplecount") 0)
	751	((equal sox-statistic "duration") 1)
	752	((equal sox-statistic "scale-factor") 2)
	753	((equal sox-statistic "max positive amplitude") 3.)
	754	((equal sox-statistic "max negative amplitude") 4)
	755	((equal sox-statistic "mid amplitude") 5)
	756	((equal sox-statistic "mean norm amplitude") 6)
	757	((equal sox-statistic "mean amplitude") 7)
	758	((equal sox-statistic "rms amplitude") 8)
	759	((equal sox-statistic "max delta amplitude") 9)
	760	((equal sox-statistic "min delta amplitude") 10)
	761	((equal sox-statistic "mean delta amplitude") 11)
	762	((equal sox-statistic "rms delta amplitude") 12)
	763	((equal sox-statistic "fundamental frequency") 13)
	764	((equal sox-statistic "headroom") 14)
	765	;stat stuff
	766	;when multichannel this shifts by one as a header line is added to the textfile!
	767	((equal sox-statistic "dc offset") 1)
	768	((equal sox-statistic "peak level") 4)
	769	((equal sox-statistic "peak amplitude") 4)
	770	((equal sox-statistic "rms level") 5)
	771	((equal sox-statistic "rms peak level") 6)
	772	((equal sox-statistic "rms trough level") 7)
	773	((equal sox-statistic "crest factor") 8)
	774	((equal sox-statistic "flat factor") 9)
	775	((equal sox-statistic "peak count") 10)
	776	((equal sox-statistic "bit depth ratio") 11)
	777	;soxi stuff
	778	((equal sox-statistic "comment") 0)
	779	((equal sox-statistic "samplerate") 0)
	780	((equal sox-statistic "channels") 0)
	781	((equal sox-statistic "filetype") 0)
	782	)
	783	thelist)))))
	784
	785	(if (numberp thevalue)
	786	thevalue
	787	;(coerce thevalue 'double-float) ;looking for a way to avoid scientific notation
	788	thevalue)))
	789
	790	;should be called sox-stat
	791	(defun sox-ana1 (sox-statistic str outfile recursive)
	792	(when
	793	(or (equal sox-statistic "samplecount")
	794	(equal sox-statistic "duration")
	795	(equal sox-statistic "scale-factor")
	796	(equal sox-statistic "max positive amplitude")
	797	(equal sox-statistic "max negative amplitude")
	798	(equal sox-statistic "mid amplitude")
	799	(equal sox-statistic "mean norm amplitude")
	800	(equal sox-statistic "mean amplitude")
	801	(equal sox-statistic "rms amplitude")
	802	(equal sox-statistic "max delta amplitude")
	803	(equal sox-statistic "min delta amplitude")
	804	(equal sox-statistic "mean delta amplitude")
	805	(equal sox-statistic "rms delta amplitude")
	806	(equal sox-statistic "fundamental frequency")
	807	(equal sox-statistic "headroom"))
	808
	809	(if (eql recursive 'on)
	810	(progn
	811	(setf str (sox-concat str " : newfile : restart "))
	812	(om-cmd-line str sys-console))
	813	(progn
	814	(om-cmd-line str sys-console)
	815	))
	816	(progn
	817	(sox-print "ana1" "ana1")
	818	(setf str (concatenate 'string str
	819	(format nil " stat 2> ~s" (namestring outfile))))
	820	(if (eql recursive 'on)
	821	(progn
	822	(setf str (sox-concat str " : newfile : restart "))
	823	(om-cmd-line str sys-console))
	824	(progn
	825	(sox-print "str" str)
	826	(om-cmd-line str sys-console)
	827	))
	828	(probe-file outfile)
	829	)
	830
	831	;read in stat analysis file -----------------
	832
	833	(setf thelist (second (mat-trans (sox-read-file outfile))))
	834	(when (> (length thelist) 15)
	835	(setf thelist (list-modulo thelist 15)))
	836	))
	837
	838	;should be called sox-stats
	839	(defun sox-ana2 (sox-statistic str outfile recursive)
	840	(when
	841	(or
	842	(equal sox-statistic "dc offset")
	843	(equal sox-statistic "peak level")
	844	(equal sox-statistic "peak amplitude")
	845	(equal sox-statistic "rms level")
	846	(equal sox-statistic "rms peak level")
	847	(equal sox-statistic "rms peak amplitude")
	848	(equal sox-statistic "rms trough level")
	849	(equal sox-statistic "crest factor")
	850	(equal sox-statistic "flat factor")
	851	(equal sox-statistic "peak count")
	852	(equal sox-statistic "bit depth ratio"))
	853	(progn
	854	(sox-print "ana2" "ana2")
	855	(setf str (concatenate 'string str
	856	(format nil " stats 2> ~s" (namestring outfile))))
	857	(if (eql recursive 'on)
	858	(progn
	859	(setf str (sox-concat str " : newfile : restart "))
	860	(om-cmd-line str sys-console))
	861	(progn
	862	(sox-print "str" str)
	863	(om-cmd-line str sys-console)
	864	))
	865	(probe-file outfile)
	866
	867	;read in stats analysis file ------------------
	868
	869	(setf thelist (second (mat-trans (sox-read-file outfile))))
	870	(when (> (length thelist) 15)
	871	(setf thelist (list-modulo thelist 15)))
	872	)))
	873
	874
	875	; should be called sox-info
	876	(defun sox-ana3 (sox-statistic input outfile recursive) ;Probably also 'recursive' doesn't make any sense...
	877	(when (cond ((equal sox-statistic "comment") (setf str (format nil "~s --i -a ~s 1> ~s" (namestring sox-path) (namestring input) (namestring outfile))))
	878	((equal sox-statistic "samplerate") (setf str (format nil "~s --i -r ~s 1> ~s" (namestring sox-path) (namestring input) (namestring outfile))))
	879	((equal sox-statistic "channels") (setf str (format nil "~s --i -c ~s 1> ~s" (namestring sox-path) (namestring input) (namestring outfile))))
	880	((equal sox-statistic "filetype") (setf str (format nil "~s --i -t ~s 1> ~s" (namestring sox-path) (namestring input) (namestring outfile)))))
	881	(progn
	882	(if (eql recursive 'on)
	883	(progn
	884	(setf str (sox-concat str " : newfile : restart "))
	885	(om-cmd-line str sys-console))
	886	(progn
	887	(sox-print "ana3" "ana3")
	888	(om-cmd-line str sys-console)
	889	))
	890	;read in stats anaylsis file ------------------
	891	(setf thelist (cdr (car (sox-read-file outfile))))
	892	)))
	893
	894	(defun sox-ana3-abort (sox-statistic)
	895	(when (cond ((equal sox-statistic "filetype") t)
	896	((equal sox-statistic "samplerate") t)
	897	((equal sox-statistic "channels") t)
	898	((equal sox-statistic "comment") t)
	899	)
	900	(progn ;it could theoretically work for other inputs - shall be added in the future
	901	(om-beep-msg "These sox-statistics are only available for sound files")
	902	(om-abort))
	903	))
	904
	905
	906	(defun sox-prepare-analysis-value (sox-statistic thevalue)
	907	(list! (cond ((equal sox-statistic "headroom") (lin->db thevalue))
	908	((equal sox-statistic "peak amplitude") (db->lin thevalue))
	909	(t thevalue))
	910	))
	911
	912
	913	; this is a utility function - better: sox-prepare-audio-input
	914	(defun sox-prepare-input (channel clipping)
	915	(when (and channel (integerp channel))
	916	(setf str (sox-concat (format nil " remix ~d" channel) str)))
	917	(when (and clipping (equal (length clipping) 2))
	918	(cond ((symbolp (first clipping))
	919	(setf str (sox-concat (format nil " trim ~a ~ds" (symbol-to-string (first clipping))
	920	(- (string-to-number (string-until-char (symbol-to-string (second clipping)) "s"))
	921	(string-to-number (string-until-char (symbol-to-string (first clipping)) "s"))))
	922	str)))
	923	((stringp (first clipping))
	924	(setf str (sox-concat (format nil " trim ~a ~ds" (first clipping)
	925	(- (string-to-number (string-until-char (second clipping) "s"))
	926	(string-to-number (string-until-char (first clipping) "s"))))
	927	str)))
	928	((numberp (first clipping))
	929	(setf str (sox-concat (format nil " trim ~d ~d" (first clipping) (- (second clipping) (first clipping))) str))))
	930	)
	931	str)
	932
	933
	934
	935
	936
	937	;======= SAMPLE ANALYSIS FUNCTION ======
	938
	939	; need to check how this is being used with sox-convolve (i.e. whether the channels are taken care of already)
	940	(defmethod! sox-sound-samplevalues ((infile sound) &key channel clipping outfile)
	941	(let* ((outpath (or outfile (create-path infile nil "txt")))
	942	(samples-file (sox-write-dat-file infile outpath :channel channel :clipping clipping))
	943	(thesamples (sox-read-samples-file samples-file)))
	944
	945	;optional removal of analysis file
	946	(add-tmp-file outpath)
	947	(when delete-inter-file (clean-tmp-files))
	948	thesamples))
	949
	950	(defmethod! sox-sound-samplevals ((infile pathname))
	951	(let* ((outpath (create-path infile nil "txt"))
	952	(samples-file (sox-write-dat-file infile outpath))
	953	(thesamples (sox-read-samples-file samples-file)))
	954
	955	;optional removal of analysis file
	956	(add-tmp-file outpath)
	957	(clean-tmp-files)
	958	thesamples))
	959
	960
	961	;;
	962	(defmethod! sox-write-dat-file ((infile pathname) (outpath pathname) &key channel clipping)
	963	(if (probe-file sox-path)
	964	(let* ((infile (namestring infile))
	965	(outfile (namestring outpath)))
	966	(setf str (format nil "~s ~a ~s -t dat ~s " (namestring sox-path) sox-options infile outfile))
	967	(sox-prepare-input channel clipping)
	968	(om-cmd-line str sys-console)
	969	(probe-file outfile))
	970	(sox-not-found)))
	971
	972	(defmethod! sox-write-dat-file ((infile sound) (outpath pathname) &key channel clipping)
	973	(sox-write-dat-file (sound-path infile) outpath :channel channel :clipping clipping))
	974
	975	;======= DFT ANALYSIS FUNCTION ========
	976
	977	(defun sox-dft-analysis (sox-statistic str outfile recursive)
	978	(when (equal sox-statistic "dft-analysis")
	979	(progn
	980	(setf str (concatenate 'string str (format nil " stat -freq 2> ~s" (namestring outfile))))
	981
	982	(if (eql recursive 'on)
	983	(progn
	984	(setf str (sox-concat str " : newfile : restart "))
	985	(om-cmd-line str sys-console))
	986	(progn
	987	(sox-print "str" str)
	988	(om-cmd-line str sys-console)
	989	))
	990	(probe-file outfile)
	991	;read in stats anaylsis file ------------------
	992	(setf thelist (sox-freq->dftlist (sox-read-freq-file outfile))))
	993	))
	994
	995	(defun sox-sample-analysis (sox-statistic inpath str channel range outfile recursive)
	996	(when (equal sox-statistic "sample-analysis")
	997	(progn
	998	(sox-write-samples-file inpath outfile range channel)
	999	; don't know if this "if" here actually applies
	1000	(if (eql recursive 'on)
	1001	(progn
	1002	(setf str (sox-concat str " : newfile : restart "))
	1003	(om-cmd-line str sys-console))
	1004	(progn
	1005	(sox-print "str" str)
	1006	(om-cmd-line str sys-console)
	1007	))
	1008	(probe-file outfile)
	1009	;read in anaylsis file ------------------
	1010	(setf thelist (sox-read-samples-file outfile)))
	1011	))
	1012
	1013
	1014	;---- conversion functions ------
	1015
	1016	(defun sox-freq->dftlist (self)
	1017	(let ((temp nil)
	1018	(result nil))
	1019	(loop for element in self do
	1020	(when (and temp (= (car element) 0))
	1021	(push (reverse temp) result)
	1022	(setf temp nil))
	1023	(push element temp));)
	1024	(push (reverse temp) result)
	1025	(reverse result)
	1026	))
	1027
	1028	(defmethod! dftlist->bpflist ((dftlist list))
	1029	:icon '(141)
	1030	(loop for dft in dftlist
	1031	collect
	1032	(let* ((translist (mat-trans dft)))
	1033	(simple-bpf-from-list (first translist) (lin->db (mag->lin (second translist) 4096 1)) 'bpf 10)
	1034	)))
	1035
	1036	(defmethod! dftlist->picture ((dftlist list) &key (minval -60) (maxval 0) (exponent 1))
	1037	:icon '(141)
	1038	:initvals '(nil -60 0 1)
	1039	(let* ((formattedlist (loop for dft in dftlist
	1040	collect
	1041	(om- 1.0 (mag->lin (second (mat-trans dft)) 4096 1))
	1042	))
	1043	(pixellist (lin->db (reverse (mat-trans formattedlist)))))
	1044	(if (or minval maxval exponent)
	1045	(om-scale-exp pixellist (db->lin minval) (db->lin maxval) (* 10 exponent))
	1046	pixellist)
	1047	))
	1048
	1049	;%%%%%%% some extra analysis functions %%%%%%%%%%
	1050
	1051	; ---- sox-sound-duration ------
	1052
	1053	(defmethod sox-sound-duration ((self list)) (flat (mapcar #'(lambda (thesound) (sox-sound-duration thesound)) self)))
	1054
	1055	(defmethod sox-sound-duration ((self t))
	1056	(if (probe-file sox-path)
	1057	(let ((thestream
	1058	(sys:run-shell-command (format nil "~s --i -D ~s" (namestring sox-path) (namestring self)) :wait nil :output :stream)))
	1059	(sox-read-stream thestream (format nil "Cannot get duration of ~s" self)))
	1060	(sox-not-found)))
	1061
	1062	(defmethod sox-sound-duration ((self sound))
	1063	(sox-sound-duration (sound-path self)))
	1064
	1065	; ---- sox-sound-sr (samplerate) ------
	1066
	1067	(defmethod sox-sound-sr ((self pathname)) ;shouldn't this be "t" for strings?
	1068	(if (probe-file sox-path)
	1069	(let ((thestream
	1070	(sys:run-shell-command (format nil "~s --i -r ~s" (namestring sox-path) (namestring self)) :wait nil :output :stream)))
	1071	(sox-read-stream thestream (format nil "Cannot get samplerate of ~s" self)))
	1072	(sox-not-found)))
	1073
	1074	(defmethod sox-sound-sr ((self sound))
	1075	(sox-sound-sr (sound-path self)))
	1076
	1077	(defmethod sox-sound-sr ((self list)) (flat (mapcar #'(lambda (thesound) (sox-sound-sr thesound)) self)))
	1078
	1079	; --- sox-sound-samples (number of samples) ---
	1080
	1081	; this is not very accurate!
	1082	(defmethod sox-sound-samples ((self pathname))
	1083	(if (probe-file sox-path)
	1084	(let ((thestream
	1085	(sys:run-shell-command (format nil "~s --i -s ~s" (namestring sox-path) (namestring self)) :wait nil :output :stream)))
	1086	(sox-read-stream thestream (format nil "Cannot get number of samples of ~s" self)))
	1087	(sox-not-found)))
	1088
	1089	(defmethod sox-sound-samples ((self sound))
	1090	(sox-sound-samples (sound-path self)))
	1091
	1092	(defmethod sox-sound-samples ((self list)) (flat (mapcar #'(lambda (thesound) (sox-sound-sr thesound)) self)))
	1093
	1094	; --- sox-sound-channels (number of channels) ---
	1095
	1096	(defmethod sox-sound-channels ((self sound))
	1097	(sox-sound-channels (sound-path self))
	1098	)
	1099
	1100	(defmethod sox-sound-channels ((self t)) ;for pathname and string
	1101	(if (probe-file sox-path)
	1102	(let ((thestream
	1103	;(om-cmd-line (format nil "~s --i -c ~s" (namestring sox-path) (namestring self)) sys-console nil )
	1104	(sys:run-shell-command (format nil "~s --i -c ~s" (namestring sox-path) (namestring self)) :wait nil :output :stream)
	1105	))
	1106	(sox-read-stream thestream (format nil "Cannot get number of channels of ~s" self)))
	1107	(sox-not-found)
	1108	)
	1109	)
	1110
	1111	(defmethod sox-sound-channels ((self list)) (flat (mapcar #'(lambda (thesound) (sox-sound-channels thesound)) self)))
	1112
	1113	;;; detect file type
	1114
	1115	(defmethod sox-sound-type ((self t)) ;for pathname and string
	1116	(if (probe-file sox-path)
	1117	(let ((thestream
	1118	;(om-cmd-line (format nil "~s --i -c ~s" (namestring sox-path) (namestring self)) sys-console nil )
	1119	(sys:run-shell-command (format nil "~s --i -t ~s" (namestring sox-path) (namestring self)) :wait nil :output :stream)
	1120	))
	1121	(sox-read-stream thestream (format nil "Cannot get type of ~s" self)))
	1122	(sox-not-found)
	1123	)
	1124	)
	1125
	1126	(defmethod sox-sound-type ((self sound))
	1127	(sox-sound-type (sound-path self))
	1128	)
	1129
	1130	; ********
	1131
	1132	(defmethod sox-sound-bits ((self t)) ;for pathname and string
	1133	(if (probe-file sox-path)
	1134	(let ((thestream
	1135	;(om-cmd-line (format nil "~s --i -c ~s" (namestring sox-path) (namestring self)) sys-console nil )
	1136	(sys:run-shell-command (format nil "~s --i -b ~s" (namestring sox-path) (namestring self)) :wait nil :output :stream)
	1137	))
	1138	(sox-read-stream thestream (format nil "Cannot get bitsize of ~s" self)))
	1139	(sox-not-found)
	1140	)
	1141	)
	1142
	1143	(defmethod sox-sound-bits ((self sound))
	1144	(sox-sound-bits (sound-path self))
	1145	)
	1146
	1147	;perhaps I need something like this for reading from the bash (for OMPursuit etc)
	1148	(defun sox-read-stream (thestream error-message)
	1149	(if (stream-eofp thestream)
	1150	(progn
	1151	(om-beep-msg (format nil error-message))
	1152	;(om-abort)
	1153	)
	1154	(with-open-stream (thestream thestream) (read-from-string (read-line thestream))
	1155	))
	1156	)