Autres/audacity
1
0
Fork 0
mirror of https://github.com/cookiengineer/audacity synced 2026-01-11 07:05:47 +01:00
Code Issues Releases Wiki Activity

Locate and position the current Audacity source code, and clear a variety of old junk out of the way into junk-branches

Browse Source
This commit is contained in:
ra
2010-01-23 19:44:49 +00:00
commit e74978ba77
1011 changed files with 781704 additions and 0 deletions
Download Patch File Download Diff File Expand all files Collapse all files

304
nyquist/fileio.lsp Normal file
View File

@@ -0,0 +1,304 @@
;; 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\\")
(setdir "c:\\temp\\")
(setdir "d:\\tmp\\")
(setdir "d:\\temp\\")
(setdir "e:\\tmp\\")
(setdir "e:\\temp\\")
(get-temp-path)))
(format t "Set *default-sf-dir* to \"~A\" in fileio.lsp~%"
*default-sf-dir*)
(setdir current))))
;; 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))))
(defmacro s-save-autonorm (expression &rest arglist)
`(let ((peak (s-save (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)
;;
(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.~%"))
;; 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)
(format t (if (eq *autonorm-type* 'PREVIOUS)
" new normalization factor is ~A~%"
" suggested normalization factor is ~A~%")
*autonorm*))
(t
(format t "Peak was ~A,~%" peak)
(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))
(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 (snd-coterm
(s-read ny:fname
:time-offset ny:offset)
ny:addend)
ny:addend))
,maxlen ny:fname ny:offset SND-HEAD-NONE 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)
(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 time-offset
0, 0, 0, 0.0, 0))
(format t "Duration written: ~A~%" (car *rslt*))
ny:peak))