/usr/share/audacity/nyquist/fileio.lsp is in audacity-data 2.2.1-1.
This file is owned by root:root, with mode 0o644.
The actual contents of the file can be viewed below.
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 210 211 212 213 214 215 216 217 218 219 220 221 222 223 224 225 226 227 228 229 230 231 232 233 234 235 236 237 238 239 240 241 242 243 244 245 246 247 248 249 250 251 252 253 254 255 256 257 258 259 260 261 262 263 264 265 266 267 268 269 270 271 272 273 274 275 276 277 278 279 280 281 282 283 284 285 286 287 288 289 290 291 292 293 294 295 296 297 298 299 300 301 302 303 304 305 306 307 308 309 310 311 312 313 314 315 316 317 318 319 320 321 322 323 324 325 326 327 328 329 330 331 332 333 334 335 336 337 338 339 340 341 342 343 344 345 | ;; fileio.lsp
;; if *default-sf-dir* undefined, set it to user's tmp directory
;;
(cond ((not (boundp '*default-sf-dir*))
;; it would be nice to use get-temp-path, but when running
;; the Java-based IDE, Nyquist does not get environment
;; variables to tell TMP or TEMP or USERPROFILE
;; We want to avoid the current directory because it may
;; be read-only. Search for some likely paths...
;; Note that since these paths don't work for Unix or OS X,
;; they will not be used, so no system-dependent code is
;; needed
(let ((current (setdir ".")))
(setf *default-sf-dir*
(or (setdir "c:\\tmp\\" nil)
(setdir "c:\\temp\\" nil)
(setdir "d:\\tmp\\" nil)
(setdir "d:\\temp\\" nil)
(setdir "e:\\tmp\\" nil)
(setdir "e:\\temp\\" nil)
(get-temp-path)))
(format t "Set *default-sf-dir* to \"~A\" in fileio.lsp~%"
*default-sf-dir*)
(setdir current))))
;; if the steps above fail, then *default-sf-dir* might be "" (especially
;; on windows), and the current directory could be read-only on Vista and
;; Windows 7. Therefore, the Nyquist IDE will subsequently call
;; suggest-default-sf-dir with Java's idea of a valid temp directory.
;; If *default-sf-dir* is the empty string (""), this will set the variable:
(defun suggest-default-sf-dir (path)
(cond ((equal *default-sf-dir* "") (setf *default-sf-dir* path))))
;; 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 (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)))
;; MULTICHANNEL-MAX -- find peak over all channels
;;
(defun multichannel-max (snd samples)
(cond ((soundp snd)
(snd-max snd samples))
((arrayp snd) ;; assume it is multichannel sound
(let ((peak 0.0) (chans (length snd)))
(dotimes (i chans)
(setf peak (max peak (snd-max (aref snd i) (/ samples chans)))))
peak))
(t (error "unexpected value in multichannel-max" snd))))
;; AUTONORM -- look ahead to find peak and normalize sound to 80%
;;
(defun autonorm (snd)
(let (peak)
(cond (*autonormflag*
(cond ((and (not (soundp snd))
(not (eq (type-of snd) 'ARRAY)))
(error "AUTONORM (or PLAY?) got unexpected value" snd))
((eq *autonorm-type* 'previous)
(scale *autonorm* snd))
((eq *autonorm-type* 'lookahead)
(setf peak (multichannel-max snd *autonorm-max-samples*))
(setf peak (max 0.001 peak))
(setf *autonorm* (/ *autonorm-target* peak))
(scale *autonorm* snd))
(t
(error "unknown *autonorm-type*"))))
(t snd))))
(init-global *clipping-threshold* (/ 127.0 128.0))
(defmacro s-save-autonorm (expression &rest arglist)
`(let ((peak (s-save (autonorm ,expression) ,@arglist)))
(when (and *clipping-error* (> peak *clipping-threshold*))
(format t "s-save-autonorm peak ~A from ~A~%" peak ,expression)
(error "clipping"))
(autonorm-update peak)))
;; If the amplitude exceeds *clipping-threshold*, an error will
;; be raised if *clipping-error* is set.
;;
(init-global *clipping-error* nil)
;; 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)
;;
(init-global *autonorm-target* 0.9)
;;
;; *autonorm-type* selects the autonorm algorithm to use
;; 'previous means normalize according to the last computed sound
;; 'precompute means precompute *autonorm-max-samples* samples in
;; memory and normalize according to the peak
;;
(init-global *autonorm-type* 'lookahead)
(init-global *autonorm-max-samples* 1000000) ; default is 4MB buffer
;;
(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 explain-why-autonorm-failed ()
(format t "~A~A~A~A~A~A"
" *autonorm-type* is LOOKAHEAD and your sound got\n"
" louder after the lookahead period, resulting in\n"
" too large a scale factor and clipping. Consider\n"
" setting *autonorm-type* to 'PREVIOUS. Alternatively,\n"
" try turning off autonorm, e.g. \"exec autonorm-off()\"\n"
" or in Lisp mode, (autonorm-off), and scale your sound\n"
" as follows.\n"))
;; AUTONORM-UPDATE -- called with true peak to report and prepare
;;
;; after saving/playing a file, we have the true peak. This along
;; with the autonorm state is printed in a summary and the autonorm
;; state is updated for next time.
;;
;; There are currently two types: PREVIOUS and LOOKAHEAD
;; With PREVIOUS:
;; compute the true peak and print the before and after peak
;; along with the scale factor to be used next time
;; With LOOKAHEAD:
;; compute the true peak and print the before and after peak
;; along with the "suggested scale factor" that would achieve
;; the *autonorm-target*
;;
(defun autonorm-update (peak)
(cond ((> peak 1.0)
(format t "*** CLIPPING DETECTED! ***~%")))
(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)
(cond ((eq *autonorm-type* 'PREVIOUS)
(cond ((zerop *autonorm*)
(setf *autonorm* 1.0)))
(format t " new normalization factor is ~A~%" *autonorm*))
((eq *autonorm-type* 'LOOKAHEAD)
(cond ((> peak 1.0)
(explain-why-autonorm-failed)))
(format t " suggested manual normalization factor is ~A~%"
*autonorm*))
(t
(format t
" unexpected value for *autonorm-type*, reset to LOOKAHEAD\n")
(setf *autonorm-type* 'LOOKAHEAD))))
(t
(format t "Peak was ~A,~%" peak)
(cond ((> peak 0.0)
(format t " suggested normalization factor is ~A~%"
(/ *autonorm-target* peak))))))
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 (bigendianp) 0 1)))
((eq endian :little)
(setf swap (if (bigendianp) 1 0))))
(if (minusp dur) (error "s-read :dur is negative" dur))
(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 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*))
(format t "Format: ~A~%"
(nth format '("none" "AIFF" "IRCAM" "NeXT" "Wave" "PAF" "SVX"
"NIST" "VOC" "W64" "MAT4" "Mat5" "PVF" "XI" "HTK"
"SDS" "AVR" "SD2" "FLAC" "CAF")))
(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"
"unknown" "double" "GSM610" "DWVW" "DPCM"
"msadpcm")))))
(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)))
;; IS-FILE-SEPARATOR -- is this a file path separation character, e.g. "/"?
;;
(defun is-file-separator (c)
(or (eq c *file-separator*)
(and (eq *file-separator* #\\) ;; if this is windows (indicated by "\")
(eq c #\/)))) ;; then "/" is also a file separator
;; 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 (is-file-separator
(char *default-sf-dir*
(1- (length *default-sf-dir*))))))
(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)))))
;; now we have a file name, but it may be relative to current directory, so
;; expand it with the current directory
(cond ((relative-path-p filename)
;; get current working directory and build full name
(let ((path (setdir ".")))
(cond (path
(setf filename (strcat path (string *file-separator*)
(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))))
;; round is tricky because truncate rounds toward zero as does C
;; in other words, rounding is down for positive numbers and up
;; for negative numbers. You can convert rounding up to rounding
;; down by subtracting one, but this fails on the integers, so
;; we need a special test if (- x 0.5) is an integer
(defun round (x)
(cond ((> x 0) (truncate (+ x 0.5)))
((= (- x 0.5) (truncate (- x 0.5))) (truncate x))
(t (truncate (- x 0.5)))))
;; change defaults for PLAY macro:
(init-global *soundenable* t)
(defun sound-on () (setf *soundenable* t))
(defun sound-off () (setf *soundenable* nil))
(defun coterm (snd1 snd2)
(multichan-expand #'snd-coterm snd1 snd2))
(defmacro s-add-to (expr maxlen filename &optional (time-offset 0.0))
`(let ((ny:fname (soundfilename ,filename))
ny:peak ny:input (ny:offset ,time-offset))
(format t "Adding sound to ~A at offset ~A~%"
ny:fname ,time-offset)
(setf ny:peak (snd-overwrite '(let ((ny:addend ,expr))
(sum (coterm
(s-read ny:fname
:time-offset ny:offset)
ny:addend)
ny:addend))
,maxlen ny:fname ny:offset SND-HEAD-NONE 0 0 0 0.0))
(format t "Duration written: ~A~%" (car *rslt*))
ny:peak))
(defmacro s-overwrite (expr maxlen filename &optional (time-offset 0.0))
`(let ((ny:fname (soundfilename ,filename))
(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:peak (snd-overwrite `,expr ,maxlen ny:fname ny:offset
SND-HEAD-NONE 0 0 0 0.0))
(format t "Duration written: ~A~%" (car *rslt*))
ny:peak))
|