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

Steve's new replacement http://bugzilla.audacityteam.org/attachment.cgi?id=299, for http://bugzilla.audacityteam.org/show_bug.cgi?id=554

Browse Source
This commit is contained in:
v.audacity
2012-07-18 23:21:54 +00:00
parent 16fd848f9e
commit 9483c9ac6b
1 changed files with 74 additions and 54 deletions
Download Patch File Download Diff File Expand all files Collapse all files

128
plug-ins/sample-data-export.ny
View File

@@ -33,12 +33,12 @@
(when (not (boundp 'LR-prefix))(setq LR-prefix nil)) (when (not (boundp 'LR-prefix))(setq LR-prefix nil))
(setq default-filename "sample-data") ; default filename (setq default-filename "sample-data") ; default filename
(setq err "") ; initialise error mesaage (setq err "") ; initialise error mesaage
(setq *float-format* "%1.5f") ; 5 decimal places (setq *float-format* "%1.5f") ; 5 decimal places
(when (equal (string-trim " .,\/" number) "") (when (equal (string-trim " .,\/" number) "")
(setq number "100")) ; default=100 (setq number "100")) ; default=100
(defun add-error (e-string) (defun add-error (e-string)
@@ -59,10 +59,10 @@
(sqr (mult (aref s 1)(aref s 1))) (sqr (mult (aref s 1)(aref s 1)))
(avgsq (mult 0.5 (sum sql sqr))) (avgsq (mult 0.5 (sum sql sqr)))
(avgsq (snd-avg avgsq number number op-average))) (avgsq (snd-avg avgsq number number op-average)))
(linear-to-db (peak (snd-sqrt avgsq) 1))) (lin-to-db (peak (snd-sqrt avgsq) 1)))
(let* ((sndsq (mult snd snd)) (let* ((sndsq (mult snd snd))
(avgsq (snd-avg sndsq number number op-average))) (avgsq (snd-avg sndsq number number op-average)))
(linear-to-db (peak (snd-sqrt avgsq) 1))))) (lin-to-db (peak (snd-sqrt avgsq) 1)))))
;;; dc off-set mono ;;; dc off-set mono
@@ -79,9 +79,9 @@
(if (arrayp sig) (if (arrayp sig)
(let ((lin0 (dc-off-mon (aref sig 0) number)) (let ((lin0 (dc-off-mon (aref sig 0) number))
(lin1 (dc-off-mon (aref sig 1) number))) (lin1 (dc-off-mon (aref sig 1) number)))
(list lin0 (linear-to-db (abs lin0)) lin1 (linear-to-db (abs lin1)))) (list lin0 (lin-to-db (abs lin0)) lin1 (lin-to-db (abs lin1))))
(let ((lin (dc-off-mon sig number))) (let ((lin (dc-off-mon sig number)))
(list lin (linear-to-db (abs lin)))))) (list lin (lin-to-db (abs lin))))))
(defun checknumber () (defun checknumber ()
@@ -96,8 +96,8 @@
;;; home directory ;;; home directory
(defun home () (defun home ()
(if (windowsp) (if (windowsp)
(get-env "UserProfile") ; Windows (get-env "UserProfile") ; Windows
(get-env "HOME"))) ; Mac / Linux (get-env "HOME"))) ; Mac / Linux
;;; Check if Windows ;;; Check if Windows
@@ -105,6 +105,14 @@
(char= #\\ *file-separator*)) (char= #\\ *file-separator*))
;;; Windows safe linear-to-db
(setf ln10over20 (/ (log 10.0) 20))
(defun lin-to-db (val)
(if (= val 0)
"[-inf]"
(/ (log val) ln10over20)))
;;; Check if Mac ;;; Check if Mac
(defun macp () (defun macp ()
(string-equal (subseq (get-env "HOME") 0 6) "/Users")) (string-equal (subseq (get-env "HOME") 0 6) "/Users"))
@@ -127,9 +135,9 @@
;;; get sample and convert to dB if required ;;; get sample and convert to dB if required
(defun snd-get (snd &optional (dB 0)) (defun snd-get (snd &optional (dB 0))
(if (= dB 0) ; dB scale (if (= dB 0) ; dB scale
(linear-to-db (abs (snd-fetch snd))) (lin-to-db (abs (snd-fetch snd)))
(snd-fetch snd))) ; linear scale (snd-fetch snd))) ; linear scale
;; fileformat 0=Text List, 1=Indexed List, 2=Time Indexed, 3=CSV, ;; fileformat 0=Text List, 1=Indexed List, 2=Time Indexed, 3=CSV,
@@ -137,18 +145,18 @@
;; Optional 'same' [line] argument is either 'true' or 'nil' ;; Optional 'same' [line] argument is either 'true' or 'nil'
(defun formatprint (val snd &optional same) (defun formatprint (val snd &optional same)
(case fileformat (case fileformat
(0 (format fp "~a~a" ; text list (0 (format fp "~a~a" ; text list
(snd-get snd units) (snd-get snd units)
(if same "\t" "\n"))) (if same "\t" "\n")))
(1 (format fp "~a\t~a~a" ; indexed list (1 (format fp "~a\t~a~a" ; indexed list
val val
(snd-get snd units) (snd-get snd units)
(if same "\t" "\n"))) (if same "\t" "\n")))
(2 (format fp "~a\t~a~a" ; time index (2 (format fp "~a\t~a~a" ; time index
(/ (1- val) *sound-srate*) (/ (1- val) *sound-srate*)
(snd-get snd units) (snd-get snd units)
(if same "\t" "\n"))) (if same "\t" "\n")))
(3 (format fp "~a~a" ; csv (3 (format fp "~a~a" ; csv
(snd-get snd units) (snd-get snd units)
(if (or (= chan 2) same) "," "\n"))))) (if (or (= chan 2) same) "," "\n")))))
@@ -157,13 +165,13 @@
(defun print-text (s-in) (defun print-text (s-in)
(do ((n 1 (1+ n))) (do ((n 1 (1+ n)))
((> n number)) ((> n number))
(if (arrayp s-in) ; Stereo (alternate lines) (if (arrayp s-in) ; Stereo (alternate lines)
(progn (progn
;; option to prefix alternate lines with L/R ;; option to prefix alternate lines with L/R
(when LR-prefix (when LR-prefix
(unless (or (= header 0)(= fileformat 3)) (unless (or (= header 0)(= fileformat 3))
(format fp "~a" (first LR-prefix)))) (format fp "~a" (first LR-prefix))))
(if (= chan 0) ; IF 'Same Line' then "True" (if (= chan 0) ; IF 'Same Line' then "True"
(formatprint n (aref s-in 0) T) (formatprint n (aref s-in 0) T)
(formatprint n (aref s-in 0))) (formatprint n (aref s-in 0)))
(when LR-prefix (when LR-prefix
@@ -235,12 +243,12 @@
;; if file name not set use default ;; if file name not set use default
(if (string-equal filename "") (if (string-equal filename "")
(setq filename default-filename)) (setq filename default-filename))
(setdir (strcat path fileseparator)) ; set target directory (setdir (strcat path fileseparator)) ; set target directory
;; set file pointer or error ;; set file pointer or error
(let ((realdir (string-right-trim fileseparator (setdir ".")))) (let ((realdir (string-right-trim fileseparator (setdir "."))))
(if (or (string= path realdir) (if (or (string= path realdir)
(and (or (windowsp) ; case insensitive (and (or (windowsp) ; case insensitive
(macp)) ; assume case insensitive (macp)) ; assume case insensitive
(string-equal path realdir))) (string-equal path realdir)))
;; makefilename or error ;; makefilename or error
(setq filename (makefilename filename FileExt)) (setq filename (makefilename filename FileExt))
@@ -278,19 +286,31 @@
(defun normhead () (defun normhead ()
(format nil (if (= fileformat 4) ; html
(format nil
"~a ~a~%~aSample Rate: ~a Hz.~%Length processed: ~a samples ~a seconds.~a"
filename ; file name
(get 'info 'channels) ; mono/stereo
(get 'info 'chan-order) ; Channel Order
(get 'info 'srate) ; sample rate
number ; number of samples
(get 'info 'duration) ; duration (seconds)
(if (> (length optext)0)
(format nil "~%~a~%~%~%" optext) ; optional text
(format nil "~%~%~%"))) ; no optional text
(format nil
"~a ~a~%~aSample Rate: ~a Hz. Sample values on ~a scale.~%~ "~a ~a~%~aSample Rate: ~a Hz. Sample values on ~a scale.~%~
Length processed: ~a samples ~a seconds.~a" Length processed: ~a samples ~a seconds.~a"
filename ; file name filename ; file name
(get 'info 'channels) ; mono/stereo (get 'info 'channels) ; mono/stereo
(get 'info 'chan-order) ; Channel Order (get 'info 'chan-order) ; Channel Order
(get 'info 'srate) ; sample rate (get 'info 'srate) ; sample rate
(get 'info 'units) ; units (get 'info 'units) ; units
number ; number of samples number ; number of samples
(get 'info 'duration) ; duration (seconds) (get 'info 'duration) ; duration (seconds)
(if (> (length optext)0) (if (> (length optext)0)
(format nil "~%~a~%~%~%" optext) ; optional text (format nil "~%~a~%~%~%" optext) ; optional text
(format nil "~%~%~%")))) ; no optional text (format nil "~%~%~%"))))) ; no optional text
(defun fullhead () (defun fullhead ()
@@ -306,7 +326,7 @@ DC offset: ~a~a"
number ; number of samples number ; number of samples
(get 'info 'duration) ; duration (seconds) (get 'info 'duration) ; duration (seconds)
(setq smax (stereomax s)) ; peak amplitude linear (setq smax (stereomax s)) ; peak amplitude linear
(linear-to-db smax) ; peak amplitude dB (lin-to-db smax) ; peak amplitude dB
(srms s) ; rms (srms s) ; rms
(let ((vals (dc-off s))) ; DC offset (let ((vals (dc-off s))) ; DC offset
(if (= (length vals) 2) ; mono (if (= (length vals) 2) ; mono
@@ -425,15 +445,15 @@ ul {
</ul> </ul>
" "
(string-right-trim ".html" filename) (string-right-trim ".html" filename)
(format nil "<h2>~a</h2>" optext) ; Optional heading (format nil "<h2>~a</h2>" optext) ; Optional heading
(get 'info 'channels) ; mono/stereo (get 'info 'channels) ; mono/stereo
number ; number of samples number ; number of samples
(get 'info 'duration) ; duration (seconds) (get 'info 'duration) ; duration (seconds)
(get 'info 'srate) ; sample rate (get 'info 'srate) ; sample rate
(setq smax (stereomax s)) ; peak amplitude linear (setq smax (stereomax s)) ; peak amplitude linear
(linear-to-db smax) ; peak amplitude dB (lin-to-db smax) ; peak amplitude dB
(srms s) ; rms (srms s) ; rms
(let ((vals (dc-off s))) ; DC offset (let ((vals (dc-off s))) ; DC offset
(if (= (length vals) 2) ; mono (if (= (length vals) 2) ; mono
(format nil "~a linear, &nbsp;&nbsp;~a dB." (format nil "~a linear, &nbsp;&nbsp;~a dB."
(first vals)(second vals)) (first vals)(second vals))
@@ -480,15 +500,15 @@ Daulton (<a href=
(if val2 (if val2
;; stereo ;; stereo
(let ((time (/ (1- id) *sound-srate*)) (let ((time (/ (1- id) *sound-srate*))
(db1 (linear-to-db (abs val1))) (db1 (lin-to-db (abs val1)))
(db2 (linear-to-db (abs val2)))) (db2 (lin-to-db (abs val2))))
(format fp (format fp
"<tr>~%<td>~a</td>~%<td>~a</td>~%<td>~a</td>~%<td>~a</td>~%~ "<tr>~%<td>~a</td>~%<td>~a</td>~%<td>~a</td>~%<td>~a</td>~%~
<td>~a</td>~%<td>~a</td>~%</tr>~%" <td>~a</td>~%<td>~a</td>~%</tr>~%"
id time val1 val2 db1 db2)) id time val1 val2 db1 db2))
;; mono ;; mono
(let ((time (/ (1- id) *sound-srate*)) (let ((time (/ (1- id) *sound-srate*))
(db (linear-to-db (abs val1)))) (db (lin-to-db (abs val1))))
(format fp (format fp
"<tr>~%<td>~a</td>~%<td>~a</td>~%<td>~a</td>~%<td>~a</td>~%</tr>~%" "<tr>~%<td>~a</td>~%<td>~a</td>~%<td>~a</td>~%<td>~a</td>~%</tr>~%"
id time val1 db)))) id time val1 db))))
@@ -534,11 +554,11 @@ Daulton (<a href=
;; stereo sample order ;; stereo sample order
(putprop 'info (putprop 'info
(cond (cond
((and (= fileformat 3)(= chan 0)) ; csv, channel in column ((and (= fileformat 3)(= chan 0)) ; csv, channel in column
"One column per channel.\n") "One column per channel.\n")
((and (= fileformat 3)(= chan 2)) ; csv, channel in row ((and (= fileformat 3)(= chan 2)) ; csv, channel in row
"One row per channel.\n") "One row per channel.\n")
((or (soundp s)(= fileformat 4)) ; mono soundor HTML ((or (soundp s)(= fileformat 4)) ; mono soundor HTML
"") "")
((= chan 0) "Left channel then Right channel on same line.\n") ((= chan 0) "Left channel then Right channel on same line.\n")
((= chan 1) "Left and right channels on alternate lines.\n") ((= chan 1) "Left and right channels on alternate lines.\n")
@@ -557,11 +577,11 @@ Daulton (<a href=
(if (> (length err) 0) (if (> (length err) 0)
;; output error message if enabled ;; output error message if enabled
(if (= messages 2) (if (= messages 2)
(s-rest 0) ; return nul sound (s-rest 0) ; return nul sound
(format nil "Error.~%~a" err)) ; return errors (format nil "Error.~%~a" err)) ; return errors
;; else print to file ;; else print to file
(progn (progn
(put-head-info) ; put basic info for headers (put-head-info) ; put basic info for headers
(if (= fileformat 4) (if (= fileformat 4)
(printhtml) ; html output (printhtml) ; html output
(printdata)))) ; text output (printdata)))) ; text output