source: plugins/audacity/audacity-nyquist.diff @ d9101a5

nyquist/misc.lsp

@@ -74 +74 @@
                   (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)))
-  

nyquist/nyinit.lsp

@@ -26 +26 @@
 (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)

nyquist/nyquist.lsp

@@ -6 +6 @@
 ;;;   ###########################################################
 ;;;
 
-;;;   
-;;;   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 +214 @@
     (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 +341 @@
     d                   ; duration
     phase)))            ; phase
 
+
 ;; FMLFO -- like LFO but uses frequency modulation
 ;;
 (defun fmlfo (freq &optional (sound *SINE-TABLE*) (phase 0.0))
@@ -358 +356 @@
           (t
            (error "frequency must be a number or sound")))))
 
+
 ;; OSC - table lookup oscillator
 ;;
 (defun osc (pitch &optional (duration 1.0) 
@@ -761 +760 @@
       ,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 +836 @@
          (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 +908 @@
 (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 +1381 @@
 ; 
 (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 +1634 @@
 (defun osc-pulse (hz bias &optional (compare-shape *step-shape*))
   (compare bias (osc-tri hz) compare-shape))
 
-(setf NY:ALL 1000000000)
+

nyquist/seq.lsp

@@ -176 +176 @@
              (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)))))))))
 
 
 

nyquist/system.lsp

@@ -1 @@
-; 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 +20 @@
 (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 +29 @@
 ; (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))))
 

nyquist/fileio.lsp

@@ +1 @@
+;; 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)))))
+
+

nyquist/nyquist-plot.txt

@@ +1 @@
+set nokey
+plot "points.dat" with lines
+