Update Nyquist runtime to r288

Totally forgot about these when upgrading Nyquist to r288.

Author: lllucius

nyquist/dspprims.lsp

@@ -1,4 +1,4 @@
-;; envelopes.lsp -- support functions for envelope editor in jNyqIDE
+;; envelopes.lsp -- support functions for envelope editor in NyquistIDE
 
 #| In Nyquist, editable envelopes are saved as one entry in the workspace
 named *envelopes*. The entry is an association list where each element
@@ -18,7 +18,7 @@ To convert envelope data into functions, call (MAKE-ENV-FUNCTIONS).
 This function should be on the workspace's list of functions to call.
 (See ADD-ACTION-TO-WORKSPACE in Nyquist Manual.)
 
-When the jNyqIDE wants to get the envelope data from the workspace, it
+When the NyquistIDE wants to get the envelope data from the workspace, it
 should call (GET-ENV-DATA), which will dump formatted data to Nyquist's
 standard output as follows:
 
@@ -119,7 +119,7 @@ Saving the workspace automatically is something that Nyquist should do
   (make-env-function name expression)
   ; make sure envelopes are redefined when workspace is loaded
   (add-to-workspace '*envelopes*) ; so *envelopes* will be saved
-  (describe '*envelopes* "data for envelope editor in jNyqIDE")
+  (describe '*envelopes* "data for envelope editor in NyquistIDE")
   (add-action-to-workspace 'make-env-functions)
   nil)
 

nyquist/envelopes.lsp

@@ -33,6 +33,7 @@
   (cond ((equal *default-sf-dir* "") (setf *default-sf-dir* path))))
 
 ;; s-save -- saves a file
+(setf *in-s-save* nil)
 (setf NY:ALL 1000000000)	; 1GIG constant for maxlen
 (defmacro s-save (expression &optional (maxlen NY:ALL) filename 
                   &key (format '*default-sf-format*)
@@ -42,27 +43,47 @@
   `(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*)))))
+         (ny:swap 0) 
+         max-sample)     ; return value
+     (cond (*in-s-save*
+            (error "Recursive call to s-save (maybe play?) detected!")))
+     (progv '(*in-s-save*) '(t)
+       ; 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 (bigendianp) 0 1)))
-		   ((eq ny:endian :little)
-			(setf ny:swap (if (bigendianp) 1 0))))
-     (snd-save ',expression ny:maxlen ny:fname ,format ,mode ,bits ny:swap ,play)))
+       (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 (bigendianp) 0 1)))
+             ((eq ny:endian :little)
+              (setf ny:swap (if (bigendianp) 1 0))))
+       ; print device info the first time sound is played
+       (cond (,play
+              (cond ((not (boundp '*snd-list-devices*))
+                     (setf *snd-list-devices* t))))) ; one-time show
+       (setf max-sample
+             (snd-save ',expression ny:maxlen ny:fname ,format 
+                       ,mode ,bits ny:swap ,play))
+       ; more information if *snd-list-devices* was unbound:
+       (cond (,play
+              (cond (*snd-list-devices*
+		     (format t "\nSet *snd-list-devices* = t\n~A\n~A\n~A\n~A\n\n"
+                  "  and call play to see device list again."
+                  "Set *snd-device* to a fixnum to select an output device"
+                  "  or set *snd-device* to a substring of a device name"
+                  "  to select the first device containing the substring.")))
+	      (setf *snd-list-devices* nil))) ; normally nil
+       max-sample)))
 
 ;; MULTICHANNEL-MAX -- find peak over all channels
 ;;
@@ -217,21 +238,21 @@
             (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 swap 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 swap (car *rslt*))
-    (setf srate (cadr *rslt*))
-    (setf dur (caddr *rslt*))
-    (setf flags (cadddr *rslt*))
+    (setf format (snd-read-format *rslt*))
+    (setf channels (snd-read-channels *rslt*))
+    (setf mode (snd-read-mode *rslt*))
+    (setf bits (snd-read-bits *rslt*))
+    ; (setf swap (snd-read-swap *rslt*))
+    (setf srate (snd-read-srate *rslt*))
+    (setf dur (snd-read-dur *rslt*))
+    (setf flags (snd-read-flags *rslt*))
     (format t "Format: ~A~%" 
             (nth format '("none" "AIFF" "IRCAM" "NeXT" "Wave" "PAF" "SVX"
                           "NIST" "VOC" "W64" "MAT4" "Mat5" "PVF" "XI" "HTK"
@@ -290,14 +311,15 @@
   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))))
+(setfn snd-read-format car)
+(setfn snd-read-channels cadr)
+(setfn snd-read-mode caddr)
+(setfn snd-read-bits cadddr)
+(defun snd-read-swap (rslt) (car (cddddr rslt)))
+(defun snd-read-srate (rslt) (cadr (cddddr rslt)))
+(defun snd-read-dur (rslt) (caddr (cddddr rslt)))
+(defun snd-read-flags (rslt) (cadddr (cddddr rslt)))
+(defun snd-read-byte-offset (rslt) (cadr (cddddr (cddddr rslt))))
 
 ;; round is tricky because truncate rounds toward zero as does C
 ;; in other words, rounding is down for positive numbers and up
@@ -328,7 +350,7 @@
                                           :time-offset ny:offset)
                                          ny:addend)
                                     ny:addend))
-                   ,maxlen ny:fname ny:offset SND-HEAD-NONE 0 0 0 0.0))
+                   ,maxlen ny:fname ny:offset SND-HEAD-NONE 0 0 0))
     (format t "Duration written: ~A~%" (car *rslt*))
     ny:peak))
 
@@ -338,9 +360,9 @@
          (ny:peak 0.0)
          ny:input ny:rslt (ny:offset ,time-offset))
     (format t "Overwriting ~A at offset ~A~%" ny:fname ny:offset)
-    (setf ny:offset (s-read-byte-offset ny:rslt))
+    (setf ny:offset (snd-read-byte-offset ny:rslt))
     (setf ny:peak (snd-overwrite `,expr ,maxlen ny:fname ny:offset
-                   SND-HEAD-NONE 0 0 0 0.0))
+                   SND-HEAD-NONE 0 0 0))
     (format t "Duration written: ~A~%" (car *rslt*))
     ny:peak))
 

nyquist/fileio.lsp

@@ -6,81 +6,3 @@
 
 ; (load "test.lsp")
 
-
-
-;; "_" (UNDERSCORE) - translation function
-;;
-;; Third party plug-ins are not translated by gettext in Audacity, but may include a
-;; list of translations named *locale*. The format of *locale* must be:
-;; (LIST (language-list) [(language-list) ...]) 
-;; Each language-list is an a-list in the form:
-;; ("cc" ((list "string" "translated-string") [(list "string" "translated-string") ...]))
-;; where "cc" is the quoted country code.
-;;
-(setfn underscore _)
-;;
-(defun _(txt &aux newtxt)
-  (when (boundp '*locale*)
-    (when (not (listp *locale*))
-          (error "bad argument type" *locale*))
-    (let* ((cc (get '*audacity* 'language))
-           (translations (second (assoc cc *locale* :test 'string-equal))))
-      (if translations
-          (let ((translation (second (assoc txt translations :test 'string=))))
-            (if translation
-                (if (stringp translation)
-                    (setf newtxt translation)
-                    (error "bad argument type" translation))
-                (format t "No ~s translation of ~s.~%" cc txt)))
-          (progn
-            (setf *locale* '*unbound*)
-            (format t "No ~s translations.~%" cc)))))
-  (if newtxt newtxt (underscore txt)))
-
-
-;;; Some helpers for parsing strings returned by (aud-do "GetInfo: ...
-
-(defun eval-string (string)
-  ;;; Evaluate a string as a LISP expression.
-  ;;; If 'string' is not a valid LISP expression, the behaviour is undefined.
-  (eval (read (make-string-input-stream string))))
-
-(defmacro quote-string (string)
-  ;;; Prepend a single quote to a string
-  `(setf ,string (format nil "\'~a" ,string)))
-
-(defun aud-get-info (str)
-  ;;; Return "GetInfo: type=type" as Lisp list, or throw error
-  ;;; Audacity 2.3.0 does not fail if type is not recognised, it 
-  ;;; falls back to a default, so test for valid types.
-  ;;; 'Commands+' is not supported in Audacity 2.3.0
-  (let (type
-        info
-        (types '("Commands" "Menus" "Preferences"
-                "Tracks" "Clips" "Envelopes" "Labels" "Boxes")))
-    ;Case insensitive search, then set 'type' with correct case string, or  NIL.
-    (setf type (first (member str types :test 'string-equal)))
-    (if (not type)
-        (error (format nil "bad argument '~a' in (aud-get-info ~a)" str str)))
-    (setf info (aud-do (format nil "GetInfo: type=~a format=LISP" type)))
-    (if (not (last info))
-        (error (format nil "(aud-get-info ~a) failed.~%" str)))
-    (let* ((info-string (first info))
-           (sanitized ""))
-      ;; Escape backslashes
-      (dotimes (i (length info-string))
-        (setf ch (subseq info-string i (1+ i)))
-        (if (string= ch "\\")
-            (string-append sanitized "\\\\")
-            (string-append sanitized ch)))
-      (eval-string (quote-string sanitized)))))
-
-
-;;; *NYQ-PATH* is not required as path to Nyquist .lsp files
-;;; is already defined (but not previously documented) as *runtime-path*
-;;(setf *NYQ-PATH* (current-path))
-
-;;; Load wrapper functions for aud-do commands.
-;;; If commented out, "aud-do-support.lsp" may be loaded by a plug-in.
-;;; Example: (lisp-loader (strcat *runtime-path* "aud-do-support.lsp"))
-(load "aud-do-support.lsp")

nyquist/follow.lsp

@@ -42,7 +42,8 @@
 ;                  Typically, you want this on.
 ; *xlisp-traceback* -- print XLISP traceback on error in XLISP mode
 ;                      Typically, you do not want this because the full
-;                      stack can be long and tedious.
+;                      stack can be long and tedious. Also allow XLISP
+;                      traceback in SAL mode if *sal-break* is true.
 
 (setf *sal-mode* nil)
 
@@ -192,3 +193,43 @@
        ;; search for either .lsp or .sal file
        (sal-load ,file-name)))
 
+;; 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.
+   (setf user (get-user))
+#|
+   (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 user) "-temp" extension))
+    (format t "Default sound file is ~A.~%" *default-sound-file*)))
+
+