[96fb8ad] | 1 | --- audacity-1.2.1.orig/nyquist/misc.lsp |
---|
| 2 | +++ audacity-1.2.1/nyquist/misc.lsp |
---|
| 3 | @@ -74,19 +74,3 @@ |
---|
| 4 | (setf fullpath ":"))) |
---|
| 5 | fullpath) |
---|
| 6 | (t nil)))) |
---|
| 7 | - |
---|
| 8 | -;; real-random -- pick a random real from a range |
---|
| 9 | -;; |
---|
| 10 | -(defun real-random (from to) |
---|
| 11 | - (cond ((= from to) from) |
---|
| 12 | - (t |
---|
| 13 | - (+ from |
---|
| 14 | - (* (random 10000) |
---|
| 15 | - 0.0001 |
---|
| 16 | - (- to from)))))) |
---|
| 17 | - |
---|
| 18 | -;; power -- raise a number to some power x^y |
---|
| 19 | -;; |
---|
| 20 | -(defun power (x y) |
---|
| 21 | - (exp (* (log (float x)) y))) |
---|
| 22 | - |
---|
| 23 | --- audacity-1.2.1.orig/nyquist/nyinit.lsp |
---|
| 24 | +++ audacity-1.2.1/nyquist/nyinit.lsp |
---|
| 25 | @@ -26,7 +26,7 @@ |
---|
| 26 | (setf *WATCH* NIL) |
---|
| 27 | |
---|
| 28 | (format t "~%Nyquist -- A Language for Sound Synthesis and Composition~%") |
---|
| 29 | -(format t " Copyright (c) 1991-2003 by Roger B. Dannenberg~%") |
---|
| 30 | +(format t " Copyright (c) 1991,1992,1995 by Roger B. Dannenberg~%") |
---|
| 31 | (format t " Version 2.29~%~%") |
---|
| 32 | |
---|
| 33 | (setf *gc-flag* t) |
---|
| 34 | --- audacity-1.2.1.orig/nyquist/nyquist.lsp |
---|
| 35 | +++ audacity-1.2.1/nyquist/nyquist.lsp |
---|
| 36 | @@ -6,10 +6,7 @@ |
---|
| 37 | ;;; ########################################################### |
---|
| 38 | ;;; |
---|
| 39 | |
---|
| 40 | -;;; |
---|
| 41 | -;;; Modifications for using Nyquist within Audacity |
---|
| 42 | -;;; by Dominic Mazzoni |
---|
| 43 | -;;; |
---|
| 44 | +(load "fileio.lsp") |
---|
| 45 | |
---|
| 46 | (prog () |
---|
| 47 | (setq lppp -12.0) (setq lpp -9.0) (setq lp -6.0) (setq lmp -3.0) |
---|
| 48 | @@ -217,7 +214,7 @@ |
---|
| 49 | (cond ((> hz (/ *SOUND-SRATE* 2)) |
---|
| 50 | (format t "Warning: buzz nominal frequency (~A hz) will alias at current sample rate (~A hz).\n" |
---|
| 51 | hz *SOUND-SRATE*))) |
---|
| 52 | - (setf n (min n 1)) ; avoid divide by zero problem |
---|
| 53 | + (setf n (max n 1)) ; avoid divide by zero problem |
---|
| 54 | (scale-db (get-loud) |
---|
| 55 | (snd-buzz n ; number of harmonics |
---|
| 56 | *SOUND-SRATE* ; output sample rate |
---|
| 57 | @@ -344,6 +341,7 @@ |
---|
| 58 | d ; duration |
---|
| 59 | phase))) ; phase |
---|
| 60 | |
---|
| 61 | + |
---|
| 62 | ;; FMLFO -- like LFO but uses frequency modulation |
---|
| 63 | ;; |
---|
| 64 | (defun fmlfo (freq &optional (sound *SINE-TABLE*) (phase 0.0)) |
---|
| 65 | @@ -358,6 +356,7 @@ |
---|
| 66 | (t |
---|
| 67 | (error "frequency must be a number or sound"))))) |
---|
| 68 | |
---|
| 69 | + |
---|
| 70 | ;; OSC - table lookup oscillator |
---|
| 71 | ;; |
---|
| 72 | (defun osc (pitch &optional (duration 1.0) |
---|
| 73 | @@ -761,6 +760,51 @@ |
---|
| 74 | ,s)) |
---|
| 75 | |
---|
| 76 | |
---|
| 77 | +;; COMPUTE-DEFAULT-SOUND-FILE -- construct and set *default-sound-file* |
---|
| 78 | +;; |
---|
| 79 | +;; (this is harder than it might seem because the default place for |
---|
| 80 | +;; sound files is in /tmp, which is shared by users, so we'd like to |
---|
| 81 | +;; use a user-specific name to avoid collisions) |
---|
| 82 | +;; |
---|
| 83 | +(defun compute-default-sound-file () |
---|
| 84 | + (let (inf user extension) |
---|
| 85 | + ; the reason for the user name is that if UserA creates a temp file, |
---|
| 86 | + ; then UserB will not be able to overwrite it. The user name is a |
---|
| 87 | + ; way to give each user a unique temp file name. Note that we don't |
---|
| 88 | + ; want each session to generate a unique name because Nyquist doesn't |
---|
| 89 | + ; delete the sound file at the end of the session. |
---|
| 90 | + (system "echo $USER > ny_username.tmp") |
---|
| 91 | + (setf inf (open "ny_username.tmp")) |
---|
| 92 | + (cond (inf |
---|
| 93 | + (setf user (read inf)) |
---|
| 94 | + (close inf) |
---|
| 95 | + (system "rm ny_username.tmp")) |
---|
| 96 | + (t ; must not be unix, make up a generic name |
---|
| 97 | + (setf user 'nyquist))) |
---|
| 98 | + (cond ((null user) |
---|
| 99 | + (format t |
---|
| 100 | +"Please type your user-id so that I can construct a default |
---|
| 101 | +sound-file name. To avoid this message in the future, add |
---|
| 102 | +this to your .login file: |
---|
| 103 | + setenv USER <your id here> |
---|
| 104 | +or add this to your init.lsp file: |
---|
| 105 | + (setf *default-sound-file* \"<your filename here>\") |
---|
| 106 | + (setf *default-sf-dir* \"<full pathname of desired directory here>\") |
---|
| 107 | + |
---|
| 108 | +Your id please: ") |
---|
| 109 | + (setf user (read)))) |
---|
| 110 | + ; now compute the extension based on *default-sf-format* |
---|
| 111 | + (cond ((= *default-sf-format* snd-head-AIFF) |
---|
| 112 | + (setf extension ".aif")) |
---|
| 113 | + ((= *default-sf-format* snd-head-Wave) |
---|
| 114 | + (setf extension ".wav")) |
---|
| 115 | + (t |
---|
| 116 | + (setf extension ".snd"))) |
---|
| 117 | + (setf *default-sound-file* |
---|
| 118 | + (strcat (string-downcase (symbol-name user)) "-temp" extension)) |
---|
| 119 | + (format t "Default sound file is ~A.~%" *default-sound-file*))) |
---|
| 120 | + |
---|
| 121 | + |
---|
| 122 | ;; CONTROL-WARP -- apply a warp function to a control function |
---|
| 123 | ;; |
---|
| 124 | (defun control-warp (warp-fn control &optional wrate) |
---|
| 125 | @@ -792,6 +836,9 @@ |
---|
| 126 | (snd-srate sound) |
---|
| 127 | (local-to-global 0) *START* *STOP* (db-to-linear (get-loud)))) |
---|
| 128 | |
---|
| 129 | +; (s-plot (progv '(*TIME* *START*)'(0.0 0.5)(cue (snd-sine 20 1 100 1)))1000) |
---|
| 130 | +;(s-plot(progv'(*TIME* *START*)'(0.0 0.5)(cue(cue (snd-sine 20 1 100 1))))1000) |
---|
| 131 | + |
---|
| 132 | ;; (sound sound) |
---|
| 133 | ;; Same as (cue sound), except also warps the sound. |
---|
| 134 | ;; Note that the *WARP* can change the pitch of the |
---|
| 135 | @@ -861,6 +908,13 @@ |
---|
| 136 | (setfn control sound) |
---|
| 137 | |
---|
| 138 | |
---|
| 139 | +;; (cue-file string) |
---|
| 140 | +;; Loads a sound file with the given name, returning a sound which is |
---|
| 141 | +;; transformed to the current environment. |
---|
| 142 | +;(defun cue-file (name) |
---|
| 143 | +; (cue (snd-load name *SOUND-SRATE*))) |
---|
| 144 | + |
---|
| 145 | + |
---|
| 146 | ;; (env t1 t2 t4 l1 l2 l3 &optional duration) |
---|
| 147 | ;; Creates a 4-phase envelope. |
---|
| 148 | ;; tN is the duration of phase N, and lN is the final level of |
---|
| 149 | @@ -1327,6 +1381,54 @@ |
---|
| 150 | ; |
---|
| 151 | (load "seq" :verbose NIL) |
---|
| 152 | |
---|
| 153 | +;(defmacro with%environment (env &rest expr) |
---|
| 154 | +; `(progv ',*environment-variables* ',env ,@expr)) |
---|
| 155 | +; |
---|
| 156 | +;(defmacro seq (&rest list) |
---|
| 157 | +; (display "seq" list) |
---|
| 158 | +; (cond ((null list) |
---|
| 159 | +; (snd-zero *time* *sound-srate*)) |
---|
| 160 | +; ((null (cdr list)) |
---|
| 161 | +; (car list)) |
---|
| 162 | +; ((null (cddr list)) |
---|
| 163 | +; `(let* ((first%sound ,(car list)) |
---|
| 164 | +; (s%rate (snd-srate first%sound))) |
---|
| 165 | +; (snd-seq first%sound |
---|
| 166 | +; #'(lambda (t0) |
---|
| 167 | +; (with%environment |
---|
| 168 | +; ,(the%environment) (setf *time* t0) |
---|
| 169 | +; (force-srate s%rate ,(cadr list))))))) |
---|
| 170 | +; (t |
---|
| 171 | +; `(let* ((first%sound ,(car list)) |
---|
| 172 | +; (s%rate (snd-srate first%sound))) |
---|
| 173 | +; (snd-seq first%sound |
---|
| 174 | +; #'(lambda (t0) |
---|
| 175 | +; (format t "snd-seq applying lambda") |
---|
| 176 | +; (with%environment |
---|
| 177 | +; ,(the%environment) (setf *time* t0) |
---|
| 178 | +; (seq (force-srate s%rate ,(cadr list)) |
---|
| 179 | +; ,@(cddr list))))) )))) |
---|
| 180 | +; |
---|
| 181 | +; |
---|
| 182 | +;(defmacro seqrep (pair sound) |
---|
| 183 | +; `(let ((,(car pair) 0) |
---|
| 184 | +; ($loop-count (1- ,(cadr pair)))) |
---|
| 185 | +; (cond ((< 0 $loop-count) |
---|
| 186 | +; (seqrep2 ,(car pair) ,sound)) |
---|
| 187 | +; ((= 0 $loop-count) |
---|
| 188 | +; ,sound) |
---|
| 189 | +; (t |
---|
| 190 | +; (snd-zero *time* *sound-srate*))))) |
---|
| 191 | +; |
---|
| 192 | +; |
---|
| 193 | +;(defmacro seqrep2 (var sound) |
---|
| 194 | +; `(cond ((< ,var $loop-count) |
---|
| 195 | +; (seq (prog1 ,sound (setf ,var (1+ ,var))) |
---|
| 196 | +; (seqrep2 ,var ,sound))) |
---|
| 197 | +; ((= ,var $loop-count) |
---|
| 198 | +; ,sound))) |
---|
| 199 | + |
---|
| 200 | + |
---|
| 201 | ; set-logical-stop - modify the sound and return it, time is shifted and |
---|
| 202 | ; stretched |
---|
| 203 | (defun set-logical-stop (snd tim) |
---|
| 204 | @@ -1532,4 +1634,4 @@ |
---|
| 205 | (defun osc-pulse (hz bias &optional (compare-shape *step-shape*)) |
---|
| 206 | (compare bias (osc-tri hz) compare-shape)) |
---|
| 207 | |
---|
| 208 | -(setf NY:ALL 1000000000) |
---|
| 209 | + |
---|
| 210 | --- audacity-1.2.1.orig/nyquist/seq.lsp |
---|
| 211 | +++ audacity-1.2.1/nyquist/seq.lsp |
---|
| 212 | @@ -176,21 +176,18 @@ |
---|
| 213 | (error (format nil "Negative stretch factor in TIMED-SEQ: ~A" event))) |
---|
| 214 | (t |
---|
| 215 | (setf start-time (car event))))) |
---|
| 216 | - (cond ((null score) (s-rest 0)) |
---|
| 217 | - (t |
---|
| 218 | - (at (caar score) |
---|
| 219 | - (seqrep (i (length score)) |
---|
| 220 | - (cond ((cdr score) |
---|
| 221 | - (let (event) |
---|
| 222 | - (prog1 |
---|
| 223 | - (set-logical-stop |
---|
| 224 | - (stretch (cadar score) |
---|
| 225 | - (setf event (eval (caddar score)))) |
---|
| 226 | - (- (caadr score) (caar score))) |
---|
| 227 | -; (display "timed-seq" (caddar score) (local-to-global 0)) |
---|
| 228 | - (setf score (cdr score))))) |
---|
| 229 | - (t |
---|
| 230 | - (stretch (cadar score) (eval (caddar score))))))))))) |
---|
| 231 | + (at (caar score) |
---|
| 232 | + (seqrep (i (length score)) |
---|
| 233 | + (cond ((cdr score) |
---|
| 234 | + (let (event) |
---|
| 235 | + (prog1 |
---|
| 236 | + (set-logical-stop (stretch (cadar score) |
---|
| 237 | + (setf event (eval (caddar score)))) |
---|
| 238 | + (- (caadr score) (caar score))) |
---|
| 239 | +; (display "timed-seq" (caddar score) (local-to-global 0)) |
---|
| 240 | + (setf score (cdr score))))) |
---|
| 241 | + (t |
---|
| 242 | + (stretch (cadar score) (eval (caddar score))))))))) |
---|
| 243 | |
---|
| 244 | |
---|
| 245 | |
---|
| 246 | --- audacity-1.2.1.orig/nyquist/system.lsp |
---|
| 247 | +++ audacity-1.2.1/nyquist/system.lsp |
---|
| 248 | @@ -1,23 +1,18 @@ |
---|
| 249 | -; system.lsp -- machine/system-dependent definitions |
---|
| 250 | +;; system.lsp -- system-dependent lisp code |
---|
| 251 | |
---|
| 252 | -;; default behavior is to call SETUP-CONSOLE to get large white typescript |
---|
| 253 | -;; |
---|
| 254 | -;; set *setup-console* to nil in your personal init.lsp to override this behavior |
---|
| 255 | -;; (this may be necessary to work with emacs) |
---|
| 256 | -;; |
---|
| 257 | -(if (not (boundp '*setup-console*)) (setf *setup-console* t)) |
---|
| 258 | -(if *setup-console* (setup-console)) |
---|
| 259 | +; local definition for play |
---|
| 260 | +; this one is for Linux: |
---|
| 261 | |
---|
| 262 | (setf ny:bigendianp nil) |
---|
| 263 | |
---|
| 264 | (if (not (boundp '*default-sf-format*)) |
---|
| 265 | - (setf *default-sf-format* snd-head-Wave)) |
---|
| 266 | + (setf *default-sf-format* snd-head-wave)) |
---|
| 267 | |
---|
| 268 | -;(if (not (boundp '*default-sound-file*)) |
---|
| 269 | -; (setf *default-sound-file* "temp.wav")) |
---|
| 270 | +(if (not (boundp '*default-sound-file*)) |
---|
| 271 | + (compute-default-sound-file)) |
---|
| 272 | |
---|
| 273 | -;(if (not (boundp '*default-sf-dir*)) |
---|
| 274 | -; (setf *default-sf-dir* "")) |
---|
| 275 | +(if (not (boundp '*default-sf-dir*)) |
---|
| 276 | + (setf *default-sf-dir* "./")) |
---|
| 277 | |
---|
| 278 | (if (not (boundp '*default-sf-mode*)) |
---|
| 279 | (setf *default-sf-mode* snd-head-mode-pcm)) |
---|
| 280 | @@ -25,25 +20,8 @@ |
---|
| 281 | (if (not (boundp '*default-sf-bits*)) |
---|
| 282 | (setf *default-sf-bits* 16)) |
---|
| 283 | |
---|
| 284 | -;(if (not (boundp '*default-plot-file*)) |
---|
| 285 | -; (setf *default-plot-file* "points.dat")) |
---|
| 286 | - |
---|
| 287 | -;(if (not (boundp '*plotscript-file*)) |
---|
| 288 | -; (setf *plotscript-file* "sys/unix/rs6k/plotscript")) |
---|
| 289 | - |
---|
| 290 | -; local definition for play |
---|
| 291 | -;(defmacro play (expr) |
---|
| 292 | -; `(s-save-autonorm ,expr NY:ALL *default-sound-file* :play *soundenable*)) |
---|
| 293 | - |
---|
| 294 | - |
---|
| 295 | -;(defun r () |
---|
| 296 | -; (s-save (s-read *default-sound-file*) NY:ALL "" :play t) |
---|
| 297 | -;) |
---|
| 298 | - |
---|
| 299 | - |
---|
| 300 | -; PLAY-FILE -- play a file |
---|
| 301 | -;(defun play-file (name) |
---|
| 302 | -; (s-save (s-read name) NY:ALL "" :play t)) |
---|
| 303 | +(if (not (boundp '*default-plot-file*)) |
---|
| 304 | + (setf *default-plot-file* "points.dat")) |
---|
| 305 | |
---|
| 306 | |
---|
| 307 | ; FULL-NAME-P -- test if file name is a full path or relative path |
---|
| 308 | @@ -51,67 +29,52 @@ |
---|
| 309 | ; (otherwise the *default-sf-dir* will be prepended |
---|
| 310 | ; |
---|
| 311 | (defun full-name-p (filename) |
---|
| 312 | - (or (eq (char filename 0) #\\) |
---|
| 313 | - (eq (char filename 0) #\.) |
---|
| 314 | - (and (> (length filename) 2) |
---|
| 315 | - (both-case-p (char filename 0)) |
---|
| 316 | - (equal (char filename 1) #\:)))) |
---|
| 317 | + (or (eq (char filename 0) #\/) |
---|
| 318 | + (eq (char filename 0) #\.))) |
---|
| 319 | |
---|
| 320 | -(setf *file-separator* #\\) |
---|
| 321 | |
---|
| 322 | -;(defun ny:load-file () (load "*.*")) |
---|
| 323 | -;(defun ny:reload-file () (load "*")) |
---|
| 324 | +(setf *file-separator* #\/) |
---|
| 325 | |
---|
| 326 | |
---|
| 327 | -; save the standard function to write points to a file |
---|
| 328 | -; |
---|
| 329 | -;(setfn s-plot-points s-plot) |
---|
| 330 | +;; PLAY-FILE - play a sound file |
---|
| 331 | +;; |
---|
| 332 | +(defun play-file (name) |
---|
| 333 | +;; (system (strcat "sndplay " (soundfilename name)))) |
---|
| 334 | + (system (strcat "play " (soundfilename name) ))) |
---|
| 335 | + |
---|
| 336 | +;; R - replay last file written with PLAY |
---|
| 337 | +(defun r () (play-file *default-sound-file*)) |
---|
| 338 | + |
---|
| 339 | +;;;; use this old version if you want to use sndplay to play |
---|
| 340 | +;;;; the result file rather than play the samples as they |
---|
| 341 | +;;;; are computed. This version does not autonormalize. |
---|
| 342 | +;; PLAY - write value of an expression to file and play it |
---|
| 343 | +;; |
---|
| 344 | +;(defmacro play (expr) |
---|
| 345 | +; `(prog (specs) |
---|
| 346 | +; (setf specs (s-save (force-srate *sound-srate* ,expr) |
---|
| 347 | +; 1000000000 *default-sound-file*)) |
---|
| 348 | +; (r))) |
---|
| 349 | +;;;; |
---|
| 350 | |
---|
| 351 | -;(defun array-max-abs (points) |
---|
| 352 | -; (let ((m 0.0)) |
---|
| 353 | -; (dotimes (i (length points)) |
---|
| 354 | -; (setf m (max m (abs (aref points i))))) |
---|
| 355 | -; m)) |
---|
| 356 | - |
---|
| 357 | -;(setf graph-width 600) |
---|
| 358 | -;(setf graph-height 220) |
---|
| 359 | - |
---|
| 360 | -;(defun s-plot (snd &optional (n 600)) |
---|
| 361 | -; (show-graphics) |
---|
| 362 | -; (clear-graphics) |
---|
| 363 | -; (cond ((soundp snd) |
---|
| 364 | -; (s-plot-2 snd n (/ graph-height 2) graph-height)) |
---|
| 365 | -; (t |
---|
| 366 | -; (let ((gh (/ graph-height (length snd))) |
---|
| 367 | -; hs) |
---|
| 368 | -; (dotimes (i (length snd)) |
---|
| 369 | -; (setf hs (s-plot-2 (aref snd i) n (+ (/ gh 2) (* i gh)) gh hs))))))) |
---|
| 370 | -; |
---|
| 371 | -; |
---|
| 372 | -;(defun s-plot-2 (snd n y-offset graph-height horizontal-scale) |
---|
| 373 | -; (prog ((points (snd-samples snd n)) |
---|
| 374 | -; maxpoint horizontal-scale vertical-scale) |
---|
| 375 | -; (setf maxpoint (array-max-abs points)) |
---|
| 376 | -; (moveto 0 y-offset) |
---|
| 377 | -; (lineto graph-width y-offset) |
---|
| 378 | -; (moveto 0 y-offset) |
---|
| 379 | -; (cond ((null horizontal-scale) |
---|
| 380 | -; (setf horizontal-scale (/ (float graph-width) (length points))))) |
---|
| 381 | -; (setf vertical-scale (- (/ (float graph-height) 2 maxpoint))) |
---|
| 382 | -; (dotimes (i (length points)) |
---|
| 383 | -; (lineto (truncate (* horizontal-scale i)) |
---|
| 384 | -; (+ y-offset (truncate (* vertical-scale (aref points i)))))) |
---|
| 385 | -; (format t "X Axis: ~A to ~A (seconds)\n" (snd-t0 snd) (/ (length points) (snd-srate snd))) |
---|
| 386 | -; (format t "Y Axis: ~A to ~A\n" (- maxpoint) maxpoint) |
---|
| 387 | -; (format t "~A samples plotted.\n" (length points)) |
---|
| 388 | -; (return horizontal-scale) |
---|
| 389 | -; )) |
---|
| 390 | -; |
---|
| 391 | -; S-EDIT - run the audio editor on a sound |
---|
| 392 | -; |
---|
| 393 | -;(defmacro s-edit (&optional expr) |
---|
| 394 | -; `(prog () |
---|
| 395 | -; (if ,expr (s-save ,expr 1000000000 *default-sound-file*)) |
---|
| 396 | -; (system (format nil "audio_editor ~A &" |
---|
| 397 | -; (soundfilename *default-sound-file*))))) |
---|
| 398 | +; local definition for play |
---|
| 399 | +(defmacro play (expr) |
---|
| 400 | + `(s-save-autonorm ,expr NY:ALL *default-sound-file* :play *soundenable*)) |
---|
| 401 | + |
---|
| 402 | +;; for Linux, modify s-plot (defined in nyquist.lsp) by saving s-plot |
---|
| 403 | +;; in standard-s-plot, then call gnuplot to display the points. |
---|
| 404 | +;; |
---|
| 405 | +;; we also need to save the location of this file so we can find |
---|
| 406 | +;; nyquist-plot.txt, the command file for gnuplot |
---|
| 407 | +;; |
---|
| 408 | +(setf *runtime-path* (current-path)) |
---|
| 409 | +(display "system.lsp" *runtime-path*) |
---|
| 410 | + |
---|
| 411 | +(setfn standard-s-plot s-plot) |
---|
| 412 | + |
---|
| 413 | +(defun s-plot (s) |
---|
| 414 | + (let (plot-file) |
---|
| 415 | + (standard-s-plot s) ;; this calculates the data points |
---|
| 416 | + (setf plot-file (strcat *runtime-path* "nyquist-plot.txt")) |
---|
| 417 | + (system (strcat "gnuplot -persist " plot-file)))) |
---|
| 418 | |
---|
| 419 | --- audacity-1.2.1.orig/nyquist/fileio.lsp |
---|
| 420 | +++ audacity-1.2.1/nyquist/fileio.lsp |
---|
| 421 | @@ -0,0 +1,204 @@ |
---|
| 422 | +;; s-save -- saves a file |
---|
| 423 | +(setf NY:ALL 1000000000) ; 1GIG constant for maxlen |
---|
| 424 | +(defmacro s-save (expression &optional (maxlen NY:ALL) filename |
---|
| 425 | + &key (format '*default-sf-format*) |
---|
| 426 | + (mode '*default-sf-mode*) (bits '*default-sf-bits*) |
---|
| 427 | + (endian NIL) ; nil, :big, or :little -- specifies file format |
---|
| 428 | + (play nil)) |
---|
| 429 | + `(let ((ny:fname ,filename) |
---|
| 430 | + (ny:maxlen ,maxlen) |
---|
| 431 | + (ny:endian ,endian) |
---|
| 432 | + (ny:swap 0)) |
---|
| 433 | + ; allow caller to omit maxlen, in which case the filename will |
---|
| 434 | + ; be a string in the maxlen parameter position and filename will be null |
---|
| 435 | + (cond ((null ny:fname) |
---|
| 436 | + (cond ((stringp ny:maxlen) |
---|
| 437 | + (setf ny:fname ny:maxlen) |
---|
| 438 | + (setf ny:maxlen NY:ALL)) |
---|
| 439 | + (t |
---|
| 440 | + (setf ny:fname *default-sound-file*))))) |
---|
| 441 | + |
---|
| 442 | + (cond ((equal ny:fname "") |
---|
| 443 | + (cond ((not ,play) |
---|
| 444 | + (format t "s-save: no file to write! play option is off!\n")))) |
---|
| 445 | + (t |
---|
| 446 | + (setf ny:fname (soundfilename ny:fname)) |
---|
| 447 | + (format t "Saving sound file to ~A~%" ny:fname))) |
---|
| 448 | + (cond ((eq ny:endian :big) |
---|
| 449 | + (setf ny:swap (if ny:bigendianp 0 1))) |
---|
| 450 | + ((eq ny:endian :little) |
---|
| 451 | + (setf ny:swap (if ny:bigendianp 1 0)))) |
---|
| 452 | + (snd-save ',expression ny:maxlen ny:fname ,format ,mode ,bits ny:swap ,play))) |
---|
| 453 | + |
---|
| 454 | +(defmacro s-save-autonorm (expression &rest arglist) |
---|
| 455 | + `(let ((peak (s-save (scale *autonorm* ,expression) ,@arglist))) |
---|
| 456 | + (autonorm-update peak))) |
---|
| 457 | + |
---|
| 458 | +;; The "AutoNorm" facility: when you play something, the Nyquist play |
---|
| 459 | +;; command will automatically compute what normalization factor you |
---|
| 460 | +;; should have used. If you play the same thing again, the normalization |
---|
| 461 | +;; factor is automatically applied. |
---|
| 462 | +;; |
---|
| 463 | +;; Call AUTONORM-OFF to turn off this feature, and AUTONORM-ON to turn |
---|
| 464 | +;; it back on. |
---|
| 465 | +;; |
---|
| 466 | +;; *autonorm-target* is the peak value we're aiming for (it's set below 1 |
---|
| 467 | +;; so allow the next signal to get slightly louder without clipping) |
---|
| 468 | +;; |
---|
| 469 | +(setf *autonorm-target* 0.9) |
---|
| 470 | + |
---|
| 471 | +(defun autonorm-on () |
---|
| 472 | + (setf *autonorm* 1.0) |
---|
| 473 | + (setf *autonorm-previous-peak* 1.0) |
---|
| 474 | + (setf *autonormflag* t) |
---|
| 475 | + (format t "AutoNorm feature is on.~%")) |
---|
| 476 | + |
---|
| 477 | +(if (not (boundp '*autonormflag*)) (autonorm-on)) |
---|
| 478 | + |
---|
| 479 | +(defun autonorm-off () |
---|
| 480 | + (setf *autonormflag* nil) |
---|
| 481 | + (setf *autonorm* 1.0) |
---|
| 482 | + (format t "AutoNorm feature is off.~%")) |
---|
| 483 | + |
---|
| 484 | +(defun autonorm-update (peak) |
---|
| 485 | + (cond ((and *autonormflag* (> peak 0.0)) |
---|
| 486 | + (setf *autonorm-previous-peak* (/ peak *autonorm*)) |
---|
| 487 | + (setf *autonorm* (/ *autonorm-target* *autonorm-previous-peak*)) |
---|
| 488 | + (format t "AutoNorm: peak was ~A,~%" *autonorm-previous-peak*) |
---|
| 489 | + (format t " peak after normalization was ~A,~%" peak) |
---|
| 490 | + (format t " new normalization factor is ~A~%" *autonorm*) |
---|
| 491 | + *autonorm-previous-peak* |
---|
| 492 | + ) |
---|
| 493 | + (t peak) |
---|
| 494 | + )) |
---|
| 495 | + |
---|
| 496 | +;; s-read -- reads a file |
---|
| 497 | +(defun s-read (filename &key (time-offset 0) (srate *sound-srate*) |
---|
| 498 | + (dur 10000.0) (nchans 1) (format *default-sf-format*) |
---|
| 499 | + (mode *default-sf-mode*) (bits *default-sf-bits*) (endian NIL)) |
---|
| 500 | + (let ((swap 0)) |
---|
| 501 | + (cond ((eq endian :big) |
---|
| 502 | + (setf swap (if ny:bigendianp 0 1))) |
---|
| 503 | + ((eq endian :little) |
---|
| 504 | + (setf swap (if ny:bigendianp 1 0)))) |
---|
| 505 | + (snd-read (soundfilename filename) time-offset |
---|
| 506 | + (local-to-global 0) format nchans mode bits swap srate |
---|
| 507 | + dur))) |
---|
| 508 | + |
---|
| 509 | +;; SF-INFO -- print sound file info |
---|
| 510 | +;; |
---|
| 511 | +(defun sf-info (filename) |
---|
| 512 | + (let (s format channels mode bits srate dur flags) |
---|
| 513 | + (format t "~A:~%" (soundfilename filename)) |
---|
| 514 | + (setf s (s-read filename)) |
---|
| 515 | + (setf format (car *rslt*)) |
---|
| 516 | + (setf channels (cadr *rslt*)) |
---|
| 517 | + (setf mode (caddr *rslt*)) |
---|
| 518 | + (setf bits (cadddr *rslt*)) |
---|
| 519 | + (setf *rslt* (cddddr *rslt*)) |
---|
| 520 | + (setf srate (car *rslt*)) |
---|
| 521 | + (setf dur (cadr *rslt*)) |
---|
| 522 | + (setf flags (caddr *rslt*)) |
---|
| 523 | + (format t "Format: ~A~%" |
---|
| 524 | + (nth format '("none" "AIFF" "IRCAM" "NeXT" "Wave"))) |
---|
| 525 | + (cond ((setp (logand flags snd-head-channels)) |
---|
| 526 | + (format t "Channels: ~A~%" channels))) |
---|
| 527 | + (cond ((setp (logand flags snd-head-mode)) |
---|
| 528 | + (format t "Mode: ~A~%" |
---|
| 529 | + (nth mode '("ADPCM" "PCM" "uLaw" "aLaw" "Float" "UPCM"))))) |
---|
| 530 | + (cond ((setp (logand flags snd-head-bits)) |
---|
| 531 | + (format t "Bits/Sample: ~A~%" bits))) |
---|
| 532 | + (cond ((setp (logand flags snd-head-srate)) |
---|
| 533 | + (format t "SampleRate: ~A~%" srate))) |
---|
| 534 | + (cond ((setp (logand flags snd-head-dur)) |
---|
| 535 | + (format t "Duration: ~A~%" dur))) |
---|
| 536 | + )) |
---|
| 537 | + |
---|
| 538 | +;; SETP -- tests whether a bit is set (non-zero) |
---|
| 539 | +; |
---|
| 540 | +(defun setp (bits) (not (zerop bits))) |
---|
| 541 | + |
---|
| 542 | +;; SOUNDFILENAME -- add default directory to name to get filename |
---|
| 543 | +;; |
---|
| 544 | +(defun soundfilename (filename) |
---|
| 545 | + (cond ((= 0 (length filename)) |
---|
| 546 | + (break "filename must be at least one character long" filename)) |
---|
| 547 | + ((full-name-p filename)) |
---|
| 548 | + (t |
---|
| 549 | + ; if sf-dir nonempty and does not end with filename separator, |
---|
| 550 | + ; append one |
---|
| 551 | + (cond ((and (< 0 (length *default-sf-dir*)) |
---|
| 552 | + (not (eq (char *default-sf-dir* |
---|
| 553 | + (1- (length *default-sf-dir*))) |
---|
| 554 | + *file-separator*))) |
---|
| 555 | + (setf *default-sf-dir* (strcat *default-sf-dir* (string *file-separator*))) |
---|
| 556 | + (format t "Warning: appending \"~A\" to *default-sf-dir*~%" |
---|
| 557 | + *file-separator*))) |
---|
| 558 | + (setf filename (strcat *default-sf-dir* (string filename))))) |
---|
| 559 | + filename) |
---|
| 560 | + |
---|
| 561 | + |
---|
| 562 | +(setfn s-read-format car) |
---|
| 563 | +(setfn s-read-channels cadr) |
---|
| 564 | +(setfn s-read-mode caddr) |
---|
| 565 | +(setfn s-read-bits cadddr) |
---|
| 566 | +(defun s-read-swap (rslt) (car (cddddr rslt))) |
---|
| 567 | +(defun s-read-srate (rslt) (cadr (cddddr rslt))) |
---|
| 568 | +(defun s-read-dur (rslt) (caddr (cddddr rslt))) |
---|
| 569 | +(defun s-read-byte-offset (rslt) (car (cddddr (cddddr rslt)))) |
---|
| 570 | +(defun round (x) (truncate (+ 0.5 x))) |
---|
| 571 | + |
---|
| 572 | +;; change defaults for PLAY macro: |
---|
| 573 | +(setf *soundenable* t) |
---|
| 574 | +(defun sound-on () (setf *soundenable* t)) |
---|
| 575 | +(defun sound-off () (setf *soundenable* nil)) |
---|
| 576 | + |
---|
| 577 | +(defmacro s-add-to (expr maxlen filename &optional time-offset) |
---|
| 578 | + `(let ((ny:fname (soundfilename ,filename)) |
---|
| 579 | + ny:input ny:rslt ny:offset |
---|
| 580 | + ) |
---|
| 581 | + (cond ((setf ny:input (s-read ny:fname :time-offset ,time-offset)) |
---|
| 582 | + (setf ny:rslt *rslt*) |
---|
| 583 | + (format t "Adding sound to ~A at offset ~A~%" |
---|
| 584 | + ny:fname ,time-offset) |
---|
| 585 | + (setf ny:offset (s-read-byte-offset ny:rslt)) |
---|
| 586 | + |
---|
| 587 | + (snd-overwrite '(let ((ny:addend ,expr)) |
---|
| 588 | + (sum (snd-coterm |
---|
| 589 | + (s-read ny:fname :time-offset ,time-offset) |
---|
| 590 | + ny:addend) |
---|
| 591 | + ny:addend)) |
---|
| 592 | + ,maxlen ny:fname ny:offset |
---|
| 593 | + (s-read-mode ny:rslt) (s-read-bits ny:rslt) |
---|
| 594 | + (s-read-srate ny:rslt) (s-read-channels ny:rslt)) |
---|
| 595 | + (format t "Duration written: ~A~%" (car *rslt*))) |
---|
| 596 | + ((setf ny:input (s-read ny:fname :time-offset 0)) |
---|
| 597 | + (format t "Could not open ~A at time offset ~A~%" |
---|
| 598 | + ny:fname ,time-offset)) |
---|
| 599 | + (t |
---|
| 600 | + (format t "Could not open ~A~%" ny:fname))))) |
---|
| 601 | + |
---|
| 602 | + |
---|
| 603 | +(defmacro s-overwrite (expr maxlen filename &optional time-offset) |
---|
| 604 | + `(let ((ny:fname (soundfilename ,filename)) |
---|
| 605 | + ny:input ny:rslt ny:offset) |
---|
| 606 | + (setf ny:offset ,time-offset) |
---|
| 607 | + (cond ((null ny:offset) (setf ny:offset 0))) |
---|
| 608 | + (cond ((setf ny:input (s-read ny:fname :time-offset ny:offset)) |
---|
| 609 | + (setf ny:rslt *rslt*) |
---|
| 610 | + (format t "Overwriting ~A at offset ~A~%" ny:fname ny:offset) |
---|
| 611 | + (setf ny:offset (s-read-byte-offset ny:rslt)) |
---|
| 612 | + (display "s-overwrite" ny:offset) |
---|
| 613 | + (snd-overwrite `,expr ,maxlen ny:fname ny:offset |
---|
| 614 | + (s-read-format ny:rslt) |
---|
| 615 | + (s-read-mode ny:rslt) (s-read-bits ny:rslt) |
---|
| 616 | + (s-read-swap ny:rslt) |
---|
| 617 | + (s-read-srate ny:rslt) (s-read-channels ny:rslt)) |
---|
| 618 | + (format t "Duration written: ~A~%" (car *rslt*))) |
---|
| 619 | + ((s-read ny:fname :time-offset 0) |
---|
| 620 | + (format t "Could not open ~A at time offset ~A~%" |
---|
| 621 | + ny:fname ,time-offset)) |
---|
| 622 | + (t |
---|
| 623 | + (format t "Could not open ~A~%" ny:fname))))) |
---|
| 624 | + |
---|
| 625 | + |
---|
| 626 | --- audacity-1.2.1.orig/nyquist/nyquist-plot.txt |
---|
| 627 | +++ audacity-1.2.1/nyquist/nyquist-plot.txt |
---|
| 628 | @@ -0,0 +1,3 @@ |
---|
| 629 | +set nokey |
---|
| 630 | +plot "points.dat" with lines |
---|
| 631 | + |
---|