Work-in-progress repo for ambisonics extensions for OM-SoX
Alexander Nguyen
25.01.25 a590ad25dc2fa20301f47b7b6c84e5f176e36db2
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   )