ref: 55ed67a6dbdddc1a12912db6aac3534be698e25f
dir: /plugins/audacity/audacity-nyquist.diff/
--- audacity-1.2.1.orig/nyquist/misc.lsp +++ audacity-1.2.1/nyquist/misc.lsp @@ -74,19 +74,3 @@ (setf fullpath ":"))) fullpath) (t nil)))) - -;; real-random -- pick a random real from a range -;; -(defun real-random (from to) - (cond ((= from to) from) - (t - (+ from - (* (random 10000) - 0.0001 - (- to from)))))) - -;; power -- raise a number to some power x^y -;; -(defun power (x y) - (exp (* (log (float x)) y))) - --- audacity-1.2.1.orig/nyquist/nyinit.lsp +++ audacity-1.2.1/nyquist/nyinit.lsp @@ -26,7 +26,7 @@ (setf *WATCH* NIL) (format t "~%Nyquist -- A Language for Sound Synthesis and Composition~%") -(format t " Copyright (c) 1991-2003 by Roger B. Dannenberg~%") +(format t " Copyright (c) 1991,1992,1995 by Roger B. Dannenberg~%") (format t " Version 2.29~%~%") (setf *gc-flag* t) --- audacity-1.2.1.orig/nyquist/nyquist.lsp +++ audacity-1.2.1/nyquist/nyquist.lsp @@ -6,10 +6,7 @@ ;;; ########################################################### ;;; -;;; -;;; Modifications for using Nyquist within Audacity -;;; by Dominic Mazzoni -;;; +(load "fileio.lsp") (prog () (setq lppp -12.0) (setq lpp -9.0) (setq lp -6.0) (setq lmp -3.0) @@ -217,7 +214,7 @@ (cond ((> hz (/ *SOUND-SRATE* 2)) (format t "Warning: buzz nominal frequency (~A hz) will alias at current sample rate (~A hz).\n" hz *SOUND-SRATE*))) - (setf n (min n 1)) ; avoid divide by zero problem + (setf n (max n 1)) ; avoid divide by zero problem (scale-db (get-loud) (snd-buzz n ; number of harmonics *SOUND-SRATE* ; output sample rate @@ -344,6 +341,7 @@ d ; duration phase))) ; phase + ;; FMLFO -- like LFO but uses frequency modulation ;; (defun fmlfo (freq &optional (sound *SINE-TABLE*) (phase 0.0)) @@ -358,6 +356,7 @@ (t (error "frequency must be a number or sound"))))) + ;; OSC - table lookup oscillator ;; (defun osc (pitch &optional (duration 1.0) @@ -761,6 +760,51 @@ ,s)) +;; COMPUTE-DEFAULT-SOUND-FILE -- construct and set *default-sound-file* +;; +;; (this is harder than it might seem because the default place for +;; sound files is in /tmp, which is shared by users, so we'd like to +;; use a user-specific name to avoid collisions) +;; +(defun compute-default-sound-file () + (let (inf user extension) + ; the reason for the user name is that if UserA creates a temp file, + ; then UserB will not be able to overwrite it. The user name is a + ; way to give each user a unique temp file name. Note that we don't + ; want each session to generate a unique name because Nyquist doesn't + ; delete the sound file at the end of the session. + (system "echo $USER > ny_username.tmp") + (setf inf (open "ny_username.tmp")) + (cond (inf + (setf user (read inf)) + (close inf) + (system "rm ny_username.tmp")) + (t ; must not be unix, make up a generic name + (setf user 'nyquist))) + (cond ((null user) + (format t +"Please type your user-id so that I can construct a default +sound-file name. To avoid this message in the future, add +this to your .login file: + setenv USER <your id here> +or add this to your init.lsp file: + (setf *default-sound-file* \"<your filename here>\") + (setf *default-sf-dir* \"<full pathname of desired directory here>\") + +Your id please: ") + (setf user (read)))) + ; now compute the extension based on *default-sf-format* + (cond ((= *default-sf-format* snd-head-AIFF) + (setf extension ".aif")) + ((= *default-sf-format* snd-head-Wave) + (setf extension ".wav")) + (t + (setf extension ".snd"))) + (setf *default-sound-file* + (strcat (string-downcase (symbol-name user)) "-temp" extension)) + (format t "Default sound file is ~A.~%" *default-sound-file*))) + + ;; CONTROL-WARP -- apply a warp function to a control function ;; (defun control-warp (warp-fn control &optional wrate) @@ -792,6 +836,9 @@ (snd-srate sound) (local-to-global 0) *START* *STOP* (db-to-linear (get-loud)))) +; (s-plot (progv '(*TIME* *START*)'(0.0 0.5)(cue (snd-sine 20 1 100 1)))1000) +;(s-plot(progv'(*TIME* *START*)'(0.0 0.5)(cue(cue (snd-sine 20 1 100 1))))1000) + ;; (sound sound) ;; Same as (cue sound), except also warps the sound. ;; Note that the *WARP* can change the pitch of the @@ -861,6 +908,13 @@ (setfn control sound) +;; (cue-file string) +;; Loads a sound file with the given name, returning a sound which is +;; transformed to the current environment. +;(defun cue-file (name) +; (cue (snd-load name *SOUND-SRATE*))) + + ;; (env t1 t2 t4 l1 l2 l3 &optional duration) ;; Creates a 4-phase envelope. ;; tN is the duration of phase N, and lN is the final level of @@ -1327,6 +1381,54 @@ ; (load "seq" :verbose NIL) +;(defmacro with%environment (env &rest expr) +; `(progv ',*environment-variables* ',env ,@expr)) +; +;(defmacro seq (&rest list) +; (display "seq" list) +; (cond ((null list) +; (snd-zero *time* *sound-srate*)) +; ((null (cdr list)) +; (car list)) +; ((null (cddr list)) +; `(let* ((first%sound ,(car list)) +; (s%rate (snd-srate first%sound))) +; (snd-seq first%sound +; #'(lambda (t0) +; (with%environment +; ,(the%environment) (setf *time* t0) +; (force-srate s%rate ,(cadr list))))))) +; (t +; `(let* ((first%sound ,(car list)) +; (s%rate (snd-srate first%sound))) +; (snd-seq first%sound +; #'(lambda (t0) +; (format t "snd-seq applying lambda") +; (with%environment +; ,(the%environment) (setf *time* t0) +; (seq (force-srate s%rate ,(cadr list)) +; ,@(cddr list))))) )))) +; +; +;(defmacro seqrep (pair sound) +; `(let ((,(car pair) 0) +; ($loop-count (1- ,(cadr pair)))) +; (cond ((< 0 $loop-count) +; (seqrep2 ,(car pair) ,sound)) +; ((= 0 $loop-count) +; ,sound) +; (t +; (snd-zero *time* *sound-srate*))))) +; +; +;(defmacro seqrep2 (var sound) +; `(cond ((< ,var $loop-count) +; (seq (prog1 ,sound (setf ,var (1+ ,var))) +; (seqrep2 ,var ,sound))) +; ((= ,var $loop-count) +; ,sound))) + + ; set-logical-stop - modify the sound and return it, time is shifted and ; stretched (defun set-logical-stop (snd tim) @@ -1532,4 +1634,4 @@ (defun osc-pulse (hz bias &optional (compare-shape *step-shape*)) (compare bias (osc-tri hz) compare-shape)) -(setf NY:ALL 1000000000) + --- audacity-1.2.1.orig/nyquist/seq.lsp +++ audacity-1.2.1/nyquist/seq.lsp @@ -176,21 +176,18 @@ (error (format nil "Negative stretch factor in TIMED-SEQ: ~A" event))) (t (setf start-time (car event))))) - (cond ((null score) (s-rest 0)) - (t - (at (caar score) - (seqrep (i (length score)) - (cond ((cdr score) - (let (event) - (prog1 - (set-logical-stop - (stretch (cadar score) - (setf event (eval (caddar score)))) - (- (caadr score) (caar score))) -; (display "timed-seq" (caddar score) (local-to-global 0)) - (setf score (cdr score))))) - (t - (stretch (cadar score) (eval (caddar score))))))))))) + (at (caar score) + (seqrep (i (length score)) + (cond ((cdr score) + (let (event) + (prog1 + (set-logical-stop (stretch (cadar score) + (setf event (eval (caddar score)))) + (- (caadr score) (caar score))) +; (display "timed-seq" (caddar score) (local-to-global 0)) + (setf score (cdr score))))) + (t + (stretch (cadar score) (eval (caddar score))))))))) --- audacity-1.2.1.orig/nyquist/system.lsp +++ audacity-1.2.1/nyquist/system.lsp @@ -1,23 +1,18 @@ -; system.lsp -- machine/system-dependent definitions +;; system.lsp -- system-dependent lisp code -;; default behavior is to call SETUP-CONSOLE to get large white typescript -;; -;; set *setup-console* to nil in your personal init.lsp to override this behavior -;; (this may be necessary to work with emacs) -;; -(if (not (boundp '*setup-console*)) (setf *setup-console* t)) -(if *setup-console* (setup-console)) +; local definition for play +; this one is for Linux: (setf ny:bigendianp nil) (if (not (boundp '*default-sf-format*)) - (setf *default-sf-format* snd-head-Wave)) + (setf *default-sf-format* snd-head-wave)) -;(if (not (boundp '*default-sound-file*)) -; (setf *default-sound-file* "temp.wav")) +(if (not (boundp '*default-sound-file*)) + (compute-default-sound-file)) -;(if (not (boundp '*default-sf-dir*)) -; (setf *default-sf-dir* "")) +(if (not (boundp '*default-sf-dir*)) + (setf *default-sf-dir* "./")) (if (not (boundp '*default-sf-mode*)) (setf *default-sf-mode* snd-head-mode-pcm)) @@ -25,25 +20,8 @@ (if (not (boundp '*default-sf-bits*)) (setf *default-sf-bits* 16)) -;(if (not (boundp '*default-plot-file*)) -; (setf *default-plot-file* "points.dat")) - -;(if (not (boundp '*plotscript-file*)) -; (setf *plotscript-file* "sys/unix/rs6k/plotscript")) - -; local definition for play -;(defmacro play (expr) -; `(s-save-autonorm ,expr NY:ALL *default-sound-file* :play *soundenable*)) - - -;(defun r () -; (s-save (s-read *default-sound-file*) NY:ALL "" :play t) -;) - - -; PLAY-FILE -- play a file -;(defun play-file (name) -; (s-save (s-read name) NY:ALL "" :play t)) +(if (not (boundp '*default-plot-file*)) + (setf *default-plot-file* "points.dat")) ; FULL-NAME-P -- test if file name is a full path or relative path @@ -51,67 +29,52 @@ ; (otherwise the *default-sf-dir* will be prepended ; (defun full-name-p (filename) - (or (eq (char filename 0) #\\) - (eq (char filename 0) #\.) - (and (> (length filename) 2) - (both-case-p (char filename 0)) - (equal (char filename 1) #\:)))) + (or (eq (char filename 0) #\/) + (eq (char filename 0) #\.))) -(setf *file-separator* #\\) -;(defun ny:load-file () (load "*.*")) -;(defun ny:reload-file () (load "*")) +(setf *file-separator* #\/) -; save the standard function to write points to a file -; -;(setfn s-plot-points s-plot) +;; PLAY-FILE - play a sound file +;; +(defun play-file (name) +;; (system (strcat "sndplay " (soundfilename name)))) + (system (strcat "play " (soundfilename name) ))) + +;; R - replay last file written with PLAY +(defun r () (play-file *default-sound-file*)) + +;;;; use this old version if you want to use sndplay to play +;;;; the result file rather than play the samples as they +;;;; are computed. This version does not autonormalize. +;; PLAY - write value of an expression to file and play it +;; +;(defmacro play (expr) +; `(prog (specs) +; (setf specs (s-save (force-srate *sound-srate* ,expr) +; 1000000000 *default-sound-file*)) +; (r))) +;;;; -;(defun array-max-abs (points) -; (let ((m 0.0)) -; (dotimes (i (length points)) -; (setf m (max m (abs (aref points i))))) -; m)) - -;(setf graph-width 600) -;(setf graph-height 220) - -;(defun s-plot (snd &optional (n 600)) -; (show-graphics) -; (clear-graphics) -; (cond ((soundp snd) -; (s-plot-2 snd n (/ graph-height 2) graph-height)) -; (t -; (let ((gh (/ graph-height (length snd))) -; hs) -; (dotimes (i (length snd)) -; (setf hs (s-plot-2 (aref snd i) n (+ (/ gh 2) (* i gh)) gh hs))))))) -; -; -;(defun s-plot-2 (snd n y-offset graph-height horizontal-scale) -; (prog ((points (snd-samples snd n)) -; maxpoint horizontal-scale vertical-scale) -; (setf maxpoint (array-max-abs points)) -; (moveto 0 y-offset) -; (lineto graph-width y-offset) -; (moveto 0 y-offset) -; (cond ((null horizontal-scale) -; (setf horizontal-scale (/ (float graph-width) (length points))))) -; (setf vertical-scale (- (/ (float graph-height) 2 maxpoint))) -; (dotimes (i (length points)) -; (lineto (truncate (* horizontal-scale i)) -; (+ y-offset (truncate (* vertical-scale (aref points i)))))) -; (format t "X Axis: ~A to ~A (seconds)\n" (snd-t0 snd) (/ (length points) (snd-srate snd))) -; (format t "Y Axis: ~A to ~A\n" (- maxpoint) maxpoint) -; (format t "~A samples plotted.\n" (length points)) -; (return horizontal-scale) -; )) -; -; S-EDIT - run the audio editor on a sound -; -;(defmacro s-edit (&optional expr) -; `(prog () -; (if ,expr (s-save ,expr 1000000000 *default-sound-file*)) -; (system (format nil "audio_editor ~A &" -; (soundfilename *default-sound-file*))))) +; local definition for play +(defmacro play (expr) + `(s-save-autonorm ,expr NY:ALL *default-sound-file* :play *soundenable*)) + +;; for Linux, modify s-plot (defined in nyquist.lsp) by saving s-plot +;; in standard-s-plot, then call gnuplot to display the points. +;; +;; we also need to save the location of this file so we can find +;; nyquist-plot.txt, the command file for gnuplot +;; +(setf *runtime-path* (current-path)) +(display "system.lsp" *runtime-path*) + +(setfn standard-s-plot s-plot) + +(defun s-plot (s) + (let (plot-file) + (standard-s-plot s) ;; this calculates the data points + (setf plot-file (strcat *runtime-path* "nyquist-plot.txt")) + (system (strcat "gnuplot -persist " plot-file)))) --- audacity-1.2.1.orig/nyquist/fileio.lsp +++ audacity-1.2.1/nyquist/fileio.lsp @@ -0,0 +1,204 @@ +;; s-save -- saves a file +(setf NY:ALL 1000000000) ; 1GIG constant for maxlen +(defmacro s-save (expression &optional (maxlen NY:ALL) filename + &key (format '*default-sf-format*) + (mode '*default-sf-mode*) (bits '*default-sf-bits*) + (endian NIL) ; nil, :big, or :little -- specifies file format + (play nil)) + `(let ((ny:fname ,filename) + (ny:maxlen ,maxlen) + (ny:endian ,endian) + (ny:swap 0)) + ; allow caller to omit maxlen, in which case the filename will + ; be a string in the maxlen parameter position and filename will be null + (cond ((null ny:fname) + (cond ((stringp ny:maxlen) + (setf ny:fname ny:maxlen) + (setf ny:maxlen NY:ALL)) + (t + (setf ny:fname *default-sound-file*))))) + + (cond ((equal ny:fname "") + (cond ((not ,play) + (format t "s-save: no file to write! play option is off!\n")))) + (t + (setf ny:fname (soundfilename ny:fname)) + (format t "Saving sound file to ~A~%" ny:fname))) + (cond ((eq ny:endian :big) + (setf ny:swap (if ny:bigendianp 0 1))) + ((eq ny:endian :little) + (setf ny:swap (if ny:bigendianp 1 0)))) + (snd-save ',expression ny:maxlen ny:fname ,format ,mode ,bits ny:swap ,play))) + +(defmacro s-save-autonorm (expression &rest arglist) + `(let ((peak (s-save (scale *autonorm* ,expression) ,@arglist))) + (autonorm-update peak))) + +;; The "AutoNorm" facility: when you play something, the Nyquist play +;; command will automatically compute what normalization factor you +;; should have used. If you play the same thing again, the normalization +;; factor is automatically applied. +;; +;; Call AUTONORM-OFF to turn off this feature, and AUTONORM-ON to turn +;; it back on. +;; +;; *autonorm-target* is the peak value we're aiming for (it's set below 1 +;; so allow the next signal to get slightly louder without clipping) +;; +(setf *autonorm-target* 0.9) + +(defun autonorm-on () + (setf *autonorm* 1.0) + (setf *autonorm-previous-peak* 1.0) + (setf *autonormflag* t) + (format t "AutoNorm feature is on.~%")) + +(if (not (boundp '*autonormflag*)) (autonorm-on)) + +(defun autonorm-off () + (setf *autonormflag* nil) + (setf *autonorm* 1.0) + (format t "AutoNorm feature is off.~%")) + +(defun autonorm-update (peak) + (cond ((and *autonormflag* (> peak 0.0)) + (setf *autonorm-previous-peak* (/ peak *autonorm*)) + (setf *autonorm* (/ *autonorm-target* *autonorm-previous-peak*)) + (format t "AutoNorm: peak was ~A,~%" *autonorm-previous-peak*) + (format t " peak after normalization was ~A,~%" peak) + (format t " new normalization factor is ~A~%" *autonorm*) + *autonorm-previous-peak* + ) + (t peak) + )) + +;; s-read -- reads a file +(defun s-read (filename &key (time-offset 0) (srate *sound-srate*) + (dur 10000.0) (nchans 1) (format *default-sf-format*) + (mode *default-sf-mode*) (bits *default-sf-bits*) (endian NIL)) + (let ((swap 0)) + (cond ((eq endian :big) + (setf swap (if ny:bigendianp 0 1))) + ((eq endian :little) + (setf swap (if ny:bigendianp 1 0)))) + (snd-read (soundfilename filename) time-offset + (local-to-global 0) format nchans mode bits swap srate + dur))) + +;; SF-INFO -- print sound file info +;; +(defun sf-info (filename) + (let (s format channels mode bits srate dur flags) + (format t "~A:~%" (soundfilename filename)) + (setf s (s-read filename)) + (setf format (car *rslt*)) + (setf channels (cadr *rslt*)) + (setf mode (caddr *rslt*)) + (setf bits (cadddr *rslt*)) + (setf *rslt* (cddddr *rslt*)) + (setf srate (car *rslt*)) + (setf dur (cadr *rslt*)) + (setf flags (caddr *rslt*)) + (format t "Format: ~A~%" + (nth format '("none" "AIFF" "IRCAM" "NeXT" "Wave"))) + (cond ((setp (logand flags snd-head-channels)) + (format t "Channels: ~A~%" channels))) + (cond ((setp (logand flags snd-head-mode)) + (format t "Mode: ~A~%" + (nth mode '("ADPCM" "PCM" "uLaw" "aLaw" "Float" "UPCM"))))) + (cond ((setp (logand flags snd-head-bits)) + (format t "Bits/Sample: ~A~%" bits))) + (cond ((setp (logand flags snd-head-srate)) + (format t "SampleRate: ~A~%" srate))) + (cond ((setp (logand flags snd-head-dur)) + (format t "Duration: ~A~%" dur))) + )) + +;; SETP -- tests whether a bit is set (non-zero) +; +(defun setp (bits) (not (zerop bits))) + +;; SOUNDFILENAME -- add default directory to name to get filename +;; +(defun soundfilename (filename) + (cond ((= 0 (length filename)) + (break "filename must be at least one character long" filename)) + ((full-name-p filename)) + (t + ; if sf-dir nonempty and does not end with filename separator, + ; append one + (cond ((and (< 0 (length *default-sf-dir*)) + (not (eq (char *default-sf-dir* + (1- (length *default-sf-dir*))) + *file-separator*))) + (setf *default-sf-dir* (strcat *default-sf-dir* (string *file-separator*))) + (format t "Warning: appending \"~A\" to *default-sf-dir*~%" + *file-separator*))) + (setf filename (strcat *default-sf-dir* (string filename))))) + filename) + + +(setfn s-read-format car) +(setfn s-read-channels cadr) +(setfn s-read-mode caddr) +(setfn s-read-bits cadddr) +(defun s-read-swap (rslt) (car (cddddr rslt))) +(defun s-read-srate (rslt) (cadr (cddddr rslt))) +(defun s-read-dur (rslt) (caddr (cddddr rslt))) +(defun s-read-byte-offset (rslt) (car (cddddr (cddddr rslt)))) +(defun round (x) (truncate (+ 0.5 x))) + +;; change defaults for PLAY macro: +(setf *soundenable* t) +(defun sound-on () (setf *soundenable* t)) +(defun sound-off () (setf *soundenable* nil)) + +(defmacro s-add-to (expr maxlen filename &optional time-offset) + `(let ((ny:fname (soundfilename ,filename)) + ny:input ny:rslt ny:offset + ) + (cond ((setf ny:input (s-read ny:fname :time-offset ,time-offset)) + (setf ny:rslt *rslt*) + (format t "Adding sound to ~A at offset ~A~%" + ny:fname ,time-offset) + (setf ny:offset (s-read-byte-offset ny:rslt)) + + (snd-overwrite '(let ((ny:addend ,expr)) + (sum (snd-coterm + (s-read ny:fname :time-offset ,time-offset) + ny:addend) + ny:addend)) + ,maxlen ny:fname ny:offset + (s-read-mode ny:rslt) (s-read-bits ny:rslt) + (s-read-srate ny:rslt) (s-read-channels ny:rslt)) + (format t "Duration written: ~A~%" (car *rslt*))) + ((setf ny:input (s-read ny:fname :time-offset 0)) + (format t "Could not open ~A at time offset ~A~%" + ny:fname ,time-offset)) + (t + (format t "Could not open ~A~%" ny:fname))))) + + +(defmacro s-overwrite (expr maxlen filename &optional time-offset) + `(let ((ny:fname (soundfilename ,filename)) + ny:input ny:rslt ny:offset) + (setf ny:offset ,time-offset) + (cond ((null ny:offset) (setf ny:offset 0))) + (cond ((setf ny:input (s-read ny:fname :time-offset ny:offset)) + (setf ny:rslt *rslt*) + (format t "Overwriting ~A at offset ~A~%" ny:fname ny:offset) + (setf ny:offset (s-read-byte-offset ny:rslt)) + (display "s-overwrite" ny:offset) + (snd-overwrite `,expr ,maxlen ny:fname ny:offset + (s-read-format ny:rslt) + (s-read-mode ny:rslt) (s-read-bits ny:rslt) + (s-read-swap ny:rslt) + (s-read-srate ny:rslt) (s-read-channels ny:rslt)) + (format t "Duration written: ~A~%" (car *rslt*))) + ((s-read ny:fname :time-offset 0) + (format t "Could not open ~A at time offset ~A~%" + ny:fname ,time-offset)) + (t + (format t "Could not open ~A~%" ny:fname))))) + + --- audacity-1.2.1.orig/nyquist/nyquist-plot.txt +++ audacity-1.2.1/nyquist/nyquist-plot.txt @@ -0,0 +1,3 @@ +set nokey +plot "points.dat" with lines +