Skip to content

Commit 586b86a

Browse files
llluciuslllucius
committed
Update Nyquist to SVN r331
1 parent 29d35e4 commit 586b86a

11 files changed

+451
-384
lines changed

‎nyquist/dspprims.lsp

+35-22
Original file line numberDiff line numberDiff line change
@@ -202,6 +202,14 @@
202202
(defun nyq:abs (s)
203203
(if (soundp s) (snd-abs s) (abs s)))
204204

205+
;; S-AVG -- moving average or peak computation
206+
;;
207+
(defun s-avg (s blocksize stepsize operation)
208+
(multichan-expand "S-AVG" #'snd-avg
209+
'(((SOUND) nil) ((INTEGER) "blocksize") ((INTEGER) "stepsize")
210+
((INTEGER) "operation"))
211+
s blocksize stepsize operation))
212+
205213
;; S-SQRT -- square root of a sound
206214
;;
207215
(defun s-sqrt (s)
@@ -245,22 +253,19 @@
245253

246254

247255
(defun noise-gate (snd &optional (lookahead 0.5) (risetime 0.02) (falltime 0.5)
248-
(floor 0.01) (threshold 0.01))
249-
(ny:typecheck (not (soundp snd))
250-
(ny:error "NOISE-GATE" 1 '((SOUND) "snd") snd))
251-
(ny:typecheck (not (numberp lookahead))
252-
(ny:error "NOISE-GATE" 2 '((NUMBER) "lookahead") lookahead))
253-
(ny:typecheck (not (numberp risetime))
254-
(ny:error "NOISE-GATE" 3 '((NUMBER) "risetime") risetime))
255-
(ny:typecheck (not (numberp falltime))
256-
(ny:error "NOISE-GATE" 4 '((NUMBER) "falltime") falltime))
257-
(ny:typecheck (not (numberp floor))
258-
(ny:error "NOISE-GATE" 5 '((NUMBER) "floor") floor))
259-
(ny:typecheck (not (numberp threshold))
260-
(ny:error "NOISE-GATE" 6 '((NUMBER) "threshold") threshold))
261-
(let ((rms (lp (mult snd snd) (/ *control-srate* 10.0))))
262-
(setf threshold (* threshold threshold))
263-
(mult snd (gate rms floor risetime falltime lookahead threshold "NOISE-GATE"))))
256+
(floor 0.01) (threshold 0.01) &key (rms nil) (link t))
257+
(let ((sense (if rms (rms snd 100.0 nil "NOISE-GATE") (s-abs snd))))
258+
(cond (link
259+
(mult snd (gate sense lookahead risetime falltime floor
260+
threshold "NOISE-GATE")))
261+
(t
262+
(mult snd (multichan-expand "NOISE-GATE" #'gate
263+
'(((SOUND) "sound") ((NUMBER) "lookahead")
264+
((NUMBER) "risetime") ((NUMBER) "falltime")
265+
((NUMBER) "floor") ((NUMBER) "threshold")
266+
((STRING) "source"))
267+
sense lookahead risetime falltime
268+
floor threshold "NOISE-GATE"))))))
264269

265270

266271
;; QUANTIZE -- quantize a sound
@@ -286,18 +291,26 @@
286291

287292
;; RMS -- compute the RMS of a sound
288293
;;
289-
(defun rms (s &optional (rate 100.0) window-size)
294+
(defun rms (s &optional (rate 100.0) window-size (source "RMS"))
295+
(multichan-expand "RMS" #'ny:rms
296+
'(((SOUND) nil) ((POSITIVE) "rate") ((POSITIVE-OR-NULL) "window-size")
297+
((STRING) "source"))
298+
s rate window-size source))
299+
300+
301+
;; NY:RMS -- single channel RMS
302+
;;
303+
(defun ny:rms (s &optional (rate 100.0) window-size source)
290304
(let (rslt step-size)
291-
(ny:typecheck (not (soundp s))
292-
(ny:error "RMS" 1 number-anon s))
305+
(ny:typecheck (not (or (soundp s) (multichannel-soundp s)))
306+
(ny:error source 1 '((SOUND) NIL) s t))
293307
(ny:typecheck (not (numberp rate))
294-
(ny:error "RMS" 2 '((NUMBER) "rate") rate))
308+
(ny:error source 2 '((NUMBER) "rate") rate))
295309
(setf step-size (round (/ (snd-srate s) rate)))
296310
(cond ((null window-size)
297311
(setf window-size step-size))
298312
((not (integerp window-size))
299-
(error "In RMS, 2nd argument (window-size) must be an integer"
300-
window-size)))
313+
(ny:error source 3 '((INTEGER) "window-size" window-size))))
301314
(setf s (prod s s))
302315
(setf result (snd-avg s window-size step-size OP-AVERAGE))
303316
;; compute square root of average

‎nyquist/fileio.lsp

+104-58
Original file line numberDiff line numberDiff line change
@@ -34,56 +34,103 @@
3434

3535
;; s-save -- saves a file
3636
(setf *in-s-save* nil)
37-
(setf NY:ALL 1000000000) ; 1GIG constant for maxlen
38-
(defmacro s-save (expression &optional (maxlen NY:ALL) filename
39-
&key (format '*default-sf-format*)
40-
(mode '*default-sf-mode*) (bits '*default-sf-bits*)
41-
(endian NIL) ; nil, :big, or :little -- specifies file format
42-
(play nil))
43-
`(let ((ny:fname ,filename)
44-
(ny:maxlen ,maxlen)
45-
(ny:endian ,endian)
46-
(ny:swap 0)
47-
max-sample) ; return value
48-
(cond (*in-s-save*
49-
(error "Recursive call to s-save (maybe play?) detected!")))
50-
(progv '(*in-s-save*) '(t)
51-
; allow caller to omit maxlen, in which case the filename will
52-
; be a string in the maxlen parameter position and filename will be null
53-
(cond ((null ny:fname)
54-
(cond ((stringp ny:maxlen)
55-
(setf ny:fname ny:maxlen)
56-
(setf ny:maxlen NY:ALL))
57-
(t
58-
(setf ny:fname *default-sound-file*)))))
59-
60-
(cond ((equal ny:fname "")
61-
(cond ((not ,play)
62-
(format t "s-save: no file to write! play option is off!\n"))))
63-
(t
64-
(setf ny:fname (soundfilename ny:fname))
65-
(format t "Saving sound file to ~A~%" ny:fname)))
66-
(cond ((eq ny:endian :big)
67-
(setf ny:swap (if (bigendianp) 0 1)))
68-
((eq ny:endian :little)
69-
(setf ny:swap (if (bigendianp) 1 0))))
70-
; print device info the first time sound is played
71-
(cond (,play
72-
(cond ((not (boundp '*snd-list-devices*))
73-
(setf *snd-list-devices* t))))) ; one-time show
74-
(setf max-sample
75-
(snd-save ',expression ny:maxlen ny:fname ,format
76-
,mode ,bits ny:swap ,play))
77-
; more information if *snd-list-devices* was unbound:
78-
(cond (,play
79-
(cond (*snd-list-devices*
80-
(format t "\nSet *snd-list-devices* = t\n~A\n~A\n~A\n~A\n\n"
81-
" and call play to see device list again."
82-
"Set *snd-device* to a fixnum to select an output device"
83-
" or set *snd-device* to a substring of a device name"
84-
" to select the first device containing the substring.")))
85-
(setf *snd-list-devices* nil))) ; normally nil
86-
max-sample)))
37+
(setf NY:ALL 576460752303423488) ; constant for maxlen == 1 << 59
38+
;; note that at 16-bytes-per-frame, this could generate a file byte offset
39+
;; that overflows an int64_t. Is this big enough? Time will tell.
40+
;; What if Nyquist is compiled for 32-bit machines and FIXNUM is 32-bits?
41+
;; if we don't have 64-bit ints, use 0x7f000000, which is about 10M less
42+
;; than the maximum signed 32-bit int, giving a lot of "headroom" but still
43+
;; over 2 billion, or about 13.4 hours at 44.1KHz
44+
(if (/= 10000000000 (* 100000 100000))
45+
(setf NY:ALL 2130706432))
46+
47+
48+
;; S-SAVE combines optional and keyword parameters, but this is a really bad
49+
;; idea because keywords and values are used as optional parameters until
50+
;; all the optional parameters are used up. Thus if you leave out filename
51+
;; and progress, but you provide :endian T, then filename becomes :endian and
52+
;; progress becomes T. AARRGG!!
53+
;; I should have required filename and made everything else keyword, but
54+
;; rather than breaking compatibility, I'm using &rest to grab everything,
55+
;; parse the parameters for keywords (giving them priority over optional
56+
;; parameters, and filling in optional parameters as they are encountered.
57+
;;
58+
(defmacro s-save (expression &rest parameters)
59+
(prog (parm (format *default-sf-format*)
60+
(mode *default-sf-mode*)
61+
(bits *default-sf-bits*)
62+
;; endian can be nil, :big, or :little
63+
endian play optionals maxlen filename progress swap)
64+
loop ;; until all parameters are used
65+
(cond ((setf parm (car parameters))
66+
(setf parameters (cdr parameters))
67+
(case parm
68+
(:format (setf format (car parameters)
69+
parameters (cdr parameters)))
70+
(:mode (setf mode (car parameters)
71+
parameters (cdr parameters)))
72+
(:bits (setf bits (car parameters)
73+
parameters (cdr parameters)))
74+
(:endian (setf endian (car parameters)
75+
parameters (cdr parameters)))
76+
(:play (setf play (car parameters)
77+
parameters (cdr parameters)))
78+
(t (setf optionals (cons parm optionals))))
79+
(go loop)))
80+
(cond ((> (length optionals) 3)
81+
(error "S-SAVE got extra parameter(s)")))
82+
(cond ((< (length optionals) 1) ;; need maxlen
83+
(setf optionals (list ny:all))))
84+
(cond ((< (length optionals) 2) ;; need filename
85+
(setf optionals (cons nil optionals))))
86+
(cond ((< (length optionals) 3) ;; need progress
87+
(setf optionals (cons 0 optionals))))
88+
(setf progress (first optionals) ;; note that optionals are in reverse order
89+
filename (second optionals)
90+
maxlen (third optionals))
91+
(cond (*in-s-save*
92+
(error "Recursive call to S-SAVE (or maybe PLAY) detected!")))
93+
94+
;; finally, we have all the parameters and we can call snd-save
95+
(return
96+
`(let ((ny:fname ,filename) (ny:swap 0) (ny:endian ,endian)
97+
(ny:play ,play)
98+
ny:max-sample) ; return value
99+
(progv '(*in-s-save*) '(t)
100+
(if (null ny:fname)
101+
(setf ny:fname *default-sound-file*))
102+
103+
(cond ((equal ny:fname "")
104+
(cond ((not ,play)
105+
(format t "S-SAVE: no file to write! ~
106+
play option is off!\n"))))
107+
(t
108+
(setf ny:fname (soundfilename ny:fname))
109+
(format t "Saving sound file to ~A~%" ny:fname)))
110+
111+
(cond ((eq ny:endian :big)
112+
(setf ny:swap (if (bigendianp) 0 1)))
113+
((eq ny:endian :little)
114+
(setf ny:swap (if (bigendianp) 1 0))))
115+
116+
; print device info the first time sound is played
117+
(cond (ny:play
118+
(cond ((not (boundp '*snd-list-devices*))
119+
(setf *snd-list-devices* t))))) ; one-time show
120+
(setf max-sample
121+
(snd-save ',expression ,maxlen ny:fname ,format
122+
,mode ,bits ny:swap ny:play ,progress))
123+
; more information if *snd-list-devices* was unbound:
124+
(cond (ny:play
125+
(cond (*snd-list-devices*
126+
(format t "\nSet *snd-lfist-devices* = t \n ~
127+
and call play to see device list again.\n~
128+
Set *snd-device* to a fixnum to select an output device\n ~
129+
or set *snd-device* to a substring of a device name\n ~
130+
to select the first device containing the substring.\n")))
131+
(setf *snd-list-devices* nil))) ; normally nil
132+
max-sample)))))
133+
87134

88135
;; MULTICHANNEL-MAX -- find peak over all channels
89136
;;
@@ -226,7 +273,7 @@
226273

227274
;; s-read -- reads a file
228275
(defun s-read (filename &key (time-offset 0) (srate *sound-srate*)
229-
(dur 10000.0) (nchans 1) (format *default-sf-format*)
276+
(dur 10e20) (nchans 1) (format *default-sf-format*)
230277
(mode *default-sf-mode*) (bits *default-sf-bits*) (endian NIL))
231278
(let ((swap 0))
232279
(cond ((eq endian :big)
@@ -319,7 +366,6 @@
319366
(defun snd-read-srate (rslt) (cadr (cddddr rslt)))
320367
(defun snd-read-dur (rslt) (caddr (cddddr rslt)))
321368
(defun snd-read-flags (rslt) (cadddr (cddddr rslt)))
322-
(defun snd-read-byte-offset (rslt) (cadr (cddddr (cddddr rslt))))
323369

324370
;; round is tricky because truncate rounds toward zero as does C
325371
;; in other words, rounding is down for positive numbers and up
@@ -339,7 +385,8 @@
339385
(defun coterm (snd1 snd2)
340386
(multichan-expand #'snd-coterm snd1 snd2))
341387

342-
(defmacro s-add-to (expr maxlen filename &optional (time-offset 0.0))
388+
(defmacro s-add-to (expr maxlen filename
389+
&optional (time-offset 0.0) (progress 0))
343390
`(let ((ny:fname (soundfilename ,filename))
344391
ny:peak ny:input (ny:offset ,time-offset))
345392
(format t "Adding sound to ~A at offset ~A~%"
@@ -350,19 +397,18 @@
350397
:time-offset ny:offset)
351398
ny:addend)
352399
ny:addend))
353-
,maxlen ny:fname ny:offset SND-HEAD-NONE 0 0 0))
400+
,maxlen ny:fname ny:offset ,progress))
354401
(format t "Duration written: ~A~%" (car *rslt*))
355402
ny:peak))
356403

357404

358-
(defmacro s-overwrite (expr maxlen filename &optional (time-offset 0.0))
405+
(defmacro s-overwrite (expr maxlen filename
406+
&optional (time-offset 0.0) (progress 0))
359407
`(let ((ny:fname (soundfilename ,filename))
360408
(ny:peak 0.0)
361409
ny:input ny:rslt (ny:offset ,time-offset))
362410
(format t "Overwriting ~A at offset ~A~%" ny:fname ny:offset)
363-
(setf ny:offset (snd-read-byte-offset ny:rslt))
364-
(setf ny:peak (snd-overwrite `,expr ,maxlen ny:fname ny:offset
365-
SND-HEAD-NONE 0 0 0))
411+
(setf ny:peak (snd-overwrite `,expr ,maxlen ny:fname ny:offset ,progress))
366412
(format t "Duration written: ~A~%" (car *rslt*))
367413
ny:peak))
368414

‎nyquist/init.lsp

+2-81
Original file line numberDiff line numberDiff line change
@@ -1,89 +1,10 @@
11
; init.lsp -- default Nyquist startup file
2+
3+
(setf *breakenable* t)
24
(load "nyinit.lsp" :verbose nil)
35

46
; add your customizations here:
57
; e.g. (setf *default-sf-dir* "...")
68

79
; (load "test.lsp")
810

9-
10-
11-
;; "_" (UNDERSCORE) - translation function
12-
;;
13-
;; Third party plug-ins are not translated by gettext in Audacity, but may include a
14-
;; list of translations named *locale*. The format of *locale* must be:
15-
;; (LIST (language-list) [(language-list) ...])
16-
;; Each language-list is an a-list in the form:
17-
;; ("cc" ((list "string" "translated-string") [(list "string" "translated-string") ...]))
18-
;; where "cc" is the quoted country code.
19-
;;
20-
(setfn underscore _)
21-
;;
22-
(defun _(txt &aux newtxt)
23-
(when (boundp '*locale*)
24-
(when (not (listp *locale*))
25-
(error "bad argument type" *locale*))
26-
(let* ((cc (get '*audacity* 'language))
27-
(translations (second (assoc cc *locale* :test 'string-equal))))
28-
(if translations
29-
(let ((translation (second (assoc txt translations :test 'string=))))
30-
(if translation
31-
(if (stringp translation)
32-
(setf newtxt translation)
33-
(error "bad argument type" translation))
34-
(format t "No ~s translation of ~s.~%" cc txt)))
35-
(progn
36-
(setf *locale* '*unbound*)
37-
(format t "No ~s translations.~%" cc)))))
38-
(if newtxt newtxt (underscore txt)))
39-
40-
41-
;;; Some helpers for parsing strings returned by (aud-do "GetInfo: ...
42-
43-
(defun eval-string (string)
44-
;;; Evaluate a string as a LISP expression.
45-
;;; If 'string' is not a valid LISP expression, the behaviour is undefined.
46-
(eval (read (make-string-input-stream string))))
47-
48-
(defun escape-backslash (in-string)
49-
;;; Escape backslashes
50-
(let (ch (out-string ""))
51-
(dotimes (i (length in-string) out-string)
52-
(setf ch (subseq in-string i (1+ i)))
53-
(if (string= ch "\\")
54-
(string-append out-string "\\\\")
55-
(string-append out-string ch)))))
56-
57-
(defmacro quote-string (string)
58-
;;; Prepend a single quote to a string
59-
`(setf ,string (format nil "\'~a" ,string)))
60-
61-
(defun aud-get-info (str)
62-
;;; Return "GetInfo: type=type" as Lisp list, or throw error
63-
;;; Audacity 2.3.0 does not fail if type is not recognised, it
64-
;;; falls back to a default, so test for valid types.
65-
;;; 'Commands+' is not supported in Audacity 2.3.0
66-
(let (type
67-
info
68-
(types '("Commands" "Menus" "Preferences"
69-
"Tracks" "Clips" "Envelopes" "Labels" "Boxes")))
70-
;Case insensitive search, then set 'type' with correct case string, or NIL.
71-
(setf type (first (member str types :test 'string-equal)))
72-
(if (not type)
73-
(error (format nil "bad argument '~a' in (aud-get-info ~a)" str str)))
74-
(setf info (aud-do (format nil "GetInfo: type=~a format=LISP" type)))
75-
(if (not (last info))
76-
(error (format nil "(aud-get-info ~a) failed.~%" str)))
77-
(let* ((info-string (first info))
78-
(sanitized (escape-backslash info-string)))
79-
(eval-string (quote-string sanitized)))))
80-
81-
82-
;;; *NYQ-PATH* is not required as path to Nyquist .lsp files
83-
;;; is already defined (but not previously documented) as *runtime-path*
84-
;;(setf *NYQ-PATH* (current-path))
85-
86-
;;; Load wrapper functions for aud-do commands.
87-
;;; If commented out, "aud-do-support.lsp" may be loaded by a plug-in.
88-
;;; Example: (lisp-loader (strcat *runtime-path* "aud-do-support.lsp"))
89-
(load "aud-do-support.lsp" :verbose nil)

0 commit comments

Comments
 (0)