mirror of
https://github.com/cookiengineer/audacity
synced 2025-11-27 07:40:10 +01:00
Update Sample Data Export to use file browser
This commit is contained in:
Steve Daulton
@@ -1,15 +1,35 @@
|
||||
$nyquist plug-in
|
||||
$version 3
|
||||
$version 4
|
||||
$type tool
|
||||
$name (_ "Sample Data Export")
|
||||
$manpage "Sample_Data_Export"
|
||||
$debugbutton false
|
||||
$action (_ "Analyzing...")
|
||||
$maxlen 1000001
|
||||
$author (_ "Steve Daulton")
|
||||
$copyright (_ "Released under terms of the GNU General Public License version 2")
|
||||
|
||||
;; sample-data-export.ny by Steve Daulton June 2012.
|
||||
;; Updated July 16 2012.
|
||||
|
||||
$control number (_ "Limit output to first") int-text (_ "samples") 100 1 1000000
|
||||
$control units (_ "Measurement scale") choice ((_ "dB") (_ "Linear")) 0
|
||||
$control filename (_ "Export data to") file (_ "Select a file") "*default*/sample-data.txt" "Text file|*.txt;*.TXT|CSV files|*.csv;*.CSV|HTML files|*.html;*.HTML;*.htm;*.HTM|All files|*.*;*" "save,overwrite"
|
||||
$control fileformat (_ "Index (text files only)") choice ((_ "None")
|
||||
("Count" (_ "Sample Count"))
|
||||
("Time" (_ "Time Indexed")))
|
||||
$control header (_ "Include header information") choice ((_ "None")
|
||||
(_ "Minimal")
|
||||
(_ "Standard")
|
||||
(_ "All")) 0
|
||||
$control optext (_ "Optional header text") string "" ""
|
||||
$control channel-layout (_ "Channel layout for stereo") choice (;i18n-hint: Left and Right
|
||||
("SameLine" (_ "L-R on Same Line"))
|
||||
("Alternate" (_ "Alternate Lines"))
|
||||
;i18n-hint: L for Left
|
||||
("LFirst" (_ "L Channel First"))) 0
|
||||
$control messages (_ "Show messages") choice ((_ "Yes")
|
||||
("Errors" (_ "Errors Only"))
|
||||
(_ "None")) 0
|
||||
|
||||
|
||||
|
||||
;; Released under terms of the GNU General Public License version 2:
|
||||
;; http://www.gnu.org/licenses/old-licenses/gpl-2.0.html
|
||||
@@ -18,95 +38,58 @@ $copyright (_ "Released under terms of the GNU General Public License version 2"
|
||||
;; https://wiki.audacityteam.org/wiki/Nyquist_Plug-ins_Reference
|
||||
|
||||
|
||||
$control number (_ "Limit output to first") string (_ "samples") "100"
|
||||
$control units (_ "Measurement scale") choice (
|
||||
(_ "dB")
|
||||
(_ "Linear")
|
||||
) 0
|
||||
$control fileformat (_ "File data format") choice (
|
||||
("SampleList" (_ "Sample List (txt)"))
|
||||
("IndexedList" (_ "Indexed List (txt)"))
|
||||
("TimeIndexed" (_ "Time Indexed (txt)"))
|
||||
;i18n-hint: "comma separated values"
|
||||
("CSV" (_ "Data (csv)"))
|
||||
("Web" (_ "Web Page (html)"))
|
||||
) 0
|
||||
$control header (_ "Include header information") choice (
|
||||
(_ "None")
|
||||
(_ "Minimal")
|
||||
(_ "Standard")
|
||||
(_ "All")
|
||||
) 2
|
||||
$control optext (_ "Optional header text") string ""
|
||||
$control chan (_ "Channel layout for stereo") choice (
|
||||
;i18n-hint: Left and Right
|
||||
("SameLine" (_ "L-R on Same Line"))
|
||||
("Alternate" (_ "Alternate Lines"))
|
||||
;i18n-hint: L for Left
|
||||
("LFirst" (_ "L Channel First"))
|
||||
) 0
|
||||
$control messages (_ "Show messages") choice (
|
||||
(_ "Yes")
|
||||
("Errors" (_ "Errors Only"))
|
||||
(_ "None")
|
||||
) 0
|
||||
$control filename (_ "File name") string "" (_ "sample-data")
|
||||
$control path (_ "Output folder") string "" (_ "Home directory")
|
||||
$control owrite (_ "Allow files to be overwritten") choice (
|
||||
(_ "No")
|
||||
(_ "Yes")
|
||||
) 0
|
||||
|
||||
|
||||
;; To enable L/R prefix before alternate L/R channels
|
||||
;; To enable L/R prefix before alternate L/R channels
|
||||
;; (text output with header only)
|
||||
;; remove the semicolon from the start of the next line:
|
||||
;(setq LR-prefix '("L: " "R: "))
|
||||
|
||||
(when (not (boundp 'LR-prefix))(setq LR-prefix nil))
|
||||
|
||||
(setq default-filename (_ "sample-data")) ; default filename
|
||||
(setq err "") ; initialise error mesaage
|
||||
|
||||
(setq *float-format* "%1.5f") ; 5 decimal places
|
||||
(when (equal (string-trim " .,\/" number) "")
|
||||
(setq number "100")) ; default=100
|
||||
(setq *float-format* "%1.5f") ; 5 decimal places
|
||||
|
||||
|
||||
(defun add-error (e-string)
|
||||
(setq err (strcat err e-string "\n")))
|
||||
;;; Return file extension or empty string
|
||||
(defun get-extension (fname)
|
||||
(let ((n (1- (length fname)))
|
||||
(ext ""))
|
||||
(do ((i n (1- i)))
|
||||
((= i 0) ext)
|
||||
(when (char= (char fname i) #\.)
|
||||
(setf ext (subseq fname (1+ i)))
|
||||
(return ext)))))
|
||||
|
||||
|
||||
;;; stereo peak
|
||||
(defun stereomax (snd)
|
||||
(if (arrayp s)
|
||||
(max (peak (aref s 0) number)(peak (aref s 1) number))
|
||||
(peak s number)))
|
||||
(if (arrayp *track*)
|
||||
(max (peak (aref *track* 0) number)
|
||||
(peak (aref *track* 1) number))
|
||||
(peak *track* number)))
|
||||
|
||||
|
||||
;;; stereo rms
|
||||
(defun srms (snd)
|
||||
(if (arrayp snd)
|
||||
(let* ((sql (mult (aref s 0)(aref s 0)))
|
||||
(sqr (mult (aref s 1)(aref s 1)))
|
||||
(let* ((sql (mult (aref *track* 0)(aref *track* 0)))
|
||||
(sqr (mult (aref *track* 1)(aref *track* 1)))
|
||||
(avgsq (mult 0.5 (sum sql sqr)))
|
||||
(avgsq (snd-avg avgsq number number op-average)))
|
||||
(lin-to-db (peak (snd-sqrt avgsq) 1)))
|
||||
(let* ((sndsq (mult snd snd))
|
||||
(avgsq (snd-avg sndsq number number op-average)))
|
||||
(lin-to-db (peak (snd-sqrt avgsq) 1)))))
|
||||
|
||||
|
||||
;;; dc off-set mono
|
||||
|
||||
;;; DC off-set mono
|
||||
(defun dc-off-mon (sig len)
|
||||
(let* ((total 0)
|
||||
(sig (snd-copy sig)))
|
||||
(dotimes (num (truncate len))
|
||||
(setq total (+ total (snd-fetch sig))))
|
||||
(/ total (float len))))
|
||||
(let* ((total 0)
|
||||
(sig (snd-copy sig))
|
||||
(ln (truncate len)))
|
||||
(dotimes (num ln)
|
||||
(setq total (+ total (snd-fetch sig))))
|
||||
(/ total (float len))))
|
||||
|
||||
|
||||
;;; compute dc offsets (mono/stereo)
|
||||
;;; DC offset (mono/stereo)
|
||||
(defun dc-off (sig)
|
||||
(if (arrayp sig)
|
||||
(let ((lin0 (dc-off-mon (aref sig 0) number))
|
||||
@@ -116,73 +99,31 @@ $control owrite (_ "Allow files to be overwritten") choice (
|
||||
(list lin (lin-to-db (abs lin))))))
|
||||
|
||||
|
||||
(defun checknumber ()
|
||||
(setq number (min number len))
|
||||
(if (< number 1)
|
||||
(add-error (_ "No samples selected.")))
|
||||
(if (> number 1000000)
|
||||
(add-error (_ "Cannot export more than 1 million samples.")))
|
||||
(setq number (truncate number)))
|
||||
|
||||
|
||||
;;; home directory
|
||||
(defun home ()
|
||||
(if (windowsp)
|
||||
(get-env "UserProfile") ; Windows
|
||||
(get-env "HOME"))) ; Mac / Linux
|
||||
|
||||
|
||||
;;; Check if Windows
|
||||
(defun windowsp ()
|
||||
(char= #\\ *file-separator*))
|
||||
|
||||
|
||||
;;; Windows safe linear-to-db
|
||||
(setf ln10over20 (/ (log 10.0) 20))
|
||||
;;; Platform independent representation of negative infinity
|
||||
(defun lin-to-db (val)
|
||||
(if (= val 0)
|
||||
;i18n-hint abbreviates negative infinity
|
||||
(_ "[-inf]")
|
||||
(/ (log val) ln10over20)))
|
||||
(linear-to-db val)))
|
||||
|
||||
|
||||
;;; Check if Mac
|
||||
(defun macp ()
|
||||
(string-equal (subseq (get-env "HOME") 0 6) "/Users"))
|
||||
|
||||
|
||||
;;; check if file exists
|
||||
(defun filep (fname ext &optional (fnum ""))
|
||||
(let ((fname (format nil "~a~a~a" fname fnum ext)))
|
||||
(if (open fname) T nil)))
|
||||
|
||||
|
||||
(defun makefilename (fname ext)
|
||||
;; avoid overwriting files
|
||||
(if (and (= owrite 0)(filep fname ext))
|
||||
(do ((num 1 (1+ num)))
|
||||
((not (filep fname ext num))
|
||||
(format nil "~a~a~a" fname num ext)))
|
||||
(strcat fname ext)))
|
||||
|
||||
|
||||
;;; get sample and convert to dB if required
|
||||
;;; Get sample and convert to dB if required
|
||||
(defun snd-get (snd &optional (dB 0))
|
||||
(if (= dB 0) ; dB scale
|
||||
(lin-to-db (abs (snd-fetch snd)))
|
||||
(snd-fetch snd))) ; linear scale
|
||||
|
||||
|
||||
;; fileformat 0=Text List, 1=Indexed List, 2=Time Indexed, 3=CSV,
|
||||
;; fileformat 0=Text List, 1=Sample count index, 2=Time index, 3=CSV,
|
||||
;; (4=html but not used here).
|
||||
;; Optional 'same' [line] argument is either 'true' or 'nil'
|
||||
(defun formatprint (val snd &optional same)
|
||||
(case fileformat
|
||||
(0 (format fp "~a~a" ; text list
|
||||
(0 (format fp "~a~a" ; plain list
|
||||
(snd-get snd units)
|
||||
(if same "\t" "\n")))
|
||||
(1 (format fp "~a\t~a~a" ; indexed list
|
||||
val
|
||||
(1 (format fp "~a\t~a~a" ; count index
|
||||
val
|
||||
(snd-get snd units)
|
||||
(if same "\t" "\n")))
|
||||
(2 (format fp "~a\t~a~a" ; time index
|
||||
@@ -191,125 +132,63 @@ $control owrite (_ "Allow files to be overwritten") choice (
|
||||
(if same "\t" "\n")))
|
||||
(3 (format fp "~a~a" ; csv
|
||||
(snd-get snd units)
|
||||
(if (or (= chan 2) same) "," "\n")))))
|
||||
|
||||
(if (or (= channel-layout 2) same) "," "\n")))))
|
||||
|
||||
|
||||
;;; Print sample data to file
|
||||
(defun print-text (s-in)
|
||||
(defun print-text (sig)
|
||||
(do ((n 1 (1+ n)))
|
||||
((> n number))
|
||||
(if (arrayp s-in) ; Stereo (alternate lines)
|
||||
(if (arrayp sig) ; Stereo (alternate lines)
|
||||
(progn
|
||||
;; option to prefix alternate lines with L/R
|
||||
;; option to prefix alternate lines with L/R
|
||||
(when LR-prefix
|
||||
(unless (or (= header 0)(= fileformat 3))
|
||||
(format fp "~a" (first LR-prefix))))
|
||||
(if (= chan 0) ; IF 'Same Line' then "True"
|
||||
(formatprint n (aref s-in 0) T)
|
||||
(formatprint n (aref s-in 0)))
|
||||
(if (= channel-layout 0) ; IF 'Same Line' then "True"
|
||||
(formatprint n (aref sig 0) T)
|
||||
(formatprint n (aref sig 0)))
|
||||
(when LR-prefix
|
||||
(unless (or (= header 0)(= fileformat 3))
|
||||
(format fp "~a" (second LR-prefix))))
|
||||
(formatprint n (aref s-in 1)))
|
||||
(formatprint n s-in))))
|
||||
(formatprint n (aref sig 1)))
|
||||
(formatprint n sig))))
|
||||
|
||||
|
||||
;; Print to file
|
||||
(defun printdata ()
|
||||
(case header
|
||||
(0 (format t (normhead))(format fp (nohead)))
|
||||
(1 (format t (normhead))(format fp (minhead)))
|
||||
(2 (format t (normhead))(format fp (normhead)))
|
||||
(3 (format t (normhead))(format fp (fullhead))))
|
||||
;; Stereo and left channel first
|
||||
(if (and (arrayp s)(= chan 2))
|
||||
(if (and (arrayp *track*)(= channel-layout 2))
|
||||
;; Stereo and left channel first
|
||||
(progn
|
||||
(unless (= header 0) ; Don't print 'channel' if no header
|
||||
(format fp (_ "Left Channel.~%~%")))
|
||||
(print-text (aref s 0))
|
||||
(print-text (aref *track* 0))
|
||||
(if (= header 0) ; Don't print 'channel' if no header
|
||||
(format fp "~%")
|
||||
(format fp (_ "~%~%Right Channel.~%~%")))
|
||||
(print-text (aref s 1))
|
||||
(close fp)
|
||||
(if (= messages 0)
|
||||
(format nil (_ "~aData written to:~%~a~a~a")
|
||||
(normhead) path fileseparator filename)
|
||||
nil))
|
||||
(print-text (aref *track* 1)))
|
||||
;; mono or alternate
|
||||
(print-text *track*))
|
||||
(close fp)
|
||||
(if (= messages 0)
|
||||
(format nil (_ "~aData written to:~%~a") (normhead) filename)
|
||||
(progn
|
||||
(print-text s)
|
||||
(close fp)
|
||||
(if (= messages 0)
|
||||
(format nil (_ "~aData written to:~%~a~a~a")
|
||||
(normhead) path fileseparator filename)
|
||||
nil))))
|
||||
|
||||
|
||||
;;; File destination processing
|
||||
(defun filewriter ()
|
||||
;; Set file extension
|
||||
(setq FileExt
|
||||
(case fileformat
|
||||
(3 ".csv")
|
||||
(4 ".html")
|
||||
(T ".txt")))
|
||||
; file separator as string
|
||||
(setq fileseparator (format nil "~a" *file-separator*))
|
||||
;; strip file separator and spaces
|
||||
(let ((stuff (format nil " ~a" *file-separator*)))
|
||||
(setq filename (string-left-trim stuff filename))
|
||||
(setq path (string-right-trim stuff path)))
|
||||
;; strip file extension if present
|
||||
(if (and (>= (length filename)(length FileExt))
|
||||
(string-equal filename FileExt :start1 (- (length filename)(length FileExt))))
|
||||
(setq filename (subseq filename 0 (- (length filename)(length FileExt)))))
|
||||
;; replace ~/ on Linux/Max
|
||||
(if (and (>= (length path) 2)
|
||||
(not (windowsp)))
|
||||
(if (string-equal path "~/" :end1 2)
|
||||
(setq path (strcat (home)(subseq path 1)))))
|
||||
;; If path not set use home directory
|
||||
(if (or (string-equal path (_ "Home directory"))
|
||||
(string-equal path ""))
|
||||
(setq path (home)))
|
||||
;; if file name not set use default
|
||||
(if (string-equal filename "")
|
||||
(setq filename default-filename))
|
||||
(setdir (strcat path fileseparator)) ; set target directory
|
||||
;; set file pointer or error
|
||||
(let ((realdir (string-right-trim fileseparator (setdir "."))))
|
||||
(if (or (string= path realdir)
|
||||
(and (or (windowsp) ; case insensitive
|
||||
(macp)) ; assume case insensitive
|
||||
(string-equal path realdir)))
|
||||
;; makefilename or error
|
||||
(setq filename (makefilename filename FileExt))
|
||||
(add-error (format nil (_ "Output folder \"~a~a\" cannot be accessed.")
|
||||
path fileseparator))))
|
||||
;; check if file is writeable
|
||||
(when (= (length err) 0)
|
||||
;Open file for output
|
||||
(setq fp (open filename :direction :output))
|
||||
;check file is writeable
|
||||
(if (not fp)
|
||||
(add-error (format nil (_ "\"~a~a~a\" cannot be written.")
|
||||
path fileseparator filename)))))
|
||||
(format t (_ "~aData written to:~%~a") (normhead) filename)
|
||||
"")))
|
||||
|
||||
|
||||
;;; Header text
|
||||
|
||||
(defun nohead ()
|
||||
(if (> (length optext) 0)
|
||||
(format nil "~a~%~a~%"
|
||||
optext
|
||||
(format nil "~a~%~a~%"
|
||||
optext
|
||||
(get 'info 'chan-order))
|
||||
""))
|
||||
|
||||
|
||||
(defun minhead ()
|
||||
(format nil
|
||||
(_ "Sample Rate: ~a Hz. Sample values on ~a scale.~%~a~%~a")
|
||||
(format nil (_ "Sample Rate: ~a Hz. Sample values on ~a scale.~%~a~%~a")
|
||||
(get 'info 'srate) ; sample rate
|
||||
(get 'info 'units) ; units
|
||||
(get 'info 'chan-order) ; Channel Order
|
||||
@@ -319,38 +198,35 @@ $control owrite (_ "Allow files to be overwritten") choice (
|
||||
|
||||
|
||||
(defun normhead ()
|
||||
(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.~%~
|
||||
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
|
||||
(get 'info 'units) ; units
|
||||
number ; number of samples
|
||||
(get 'info 'duration) ; duration (seconds)
|
||||
(if (> (length optext)0)
|
||||
(format nil "~%~a~%~%~%" optext) ; optional text
|
||||
(format nil "~%~%~%"))))) ; no optional text
|
||||
(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.~%~
|
||||
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
|
||||
(get 'info 'units) ; units
|
||||
number ; number of samples
|
||||
(get 'info 'duration) ; duration (seconds)
|
||||
(if (> (length optext)0)
|
||||
(format nil "~%~a~%~%" optext) ; optional text
|
||||
(format nil "~%~%"))))) ; no optional text
|
||||
|
||||
|
||||
(defun fullhead ()
|
||||
(format nil
|
||||
(_ "~a~%Sample Rate: ~a Hz. Sample values on ~a scale. ~a.~%~aLength processed: ~a ~
|
||||
samples, ~a seconds.~%Peak amplitude: ~a (lin) ~a dB. Unweighted RMS: ~a dB.~%~
|
||||
DC offset: ~a~a")
|
||||
(format nil (_ "~a~%Sample Rate: ~a Hz. Sample values on ~a scale. ~a.~%~aLength processed: ~a ~
|
||||
samples, ~a seconds.~%Peak amplitude: ~a (linear) ~a dB. Unweighted RMS: ~a dB.~%~
|
||||
DC offset: ~a~a")
|
||||
filename ; file name
|
||||
(get 'info 'srate) ; sample rate
|
||||
(get 'info 'units) ; units
|
||||
@@ -358,15 +234,15 @@ DC offset: ~a~a")
|
||||
(get 'info 'chan-order) ; Channel Order
|
||||
number ; number of samples
|
||||
(get 'info 'duration) ; duration (seconds)
|
||||
(setq smax (stereomax s)) ; peak amplitude linear
|
||||
(setq smax (stereomax *track*)) ; peak amplitude linear
|
||||
(lin-to-db smax) ; peak amplitude dB
|
||||
(srms s) ; rms
|
||||
(let ((vals (dc-off s))) ; DC offset
|
||||
(srms *track*) ; rms
|
||||
(let ((vals (dc-off *track*))) ; DC offset
|
||||
(if (= (length vals) 2) ; mono
|
||||
(format nil (_ "~a linear, ~a dB.")
|
||||
(first vals)(second vals))
|
||||
(format nil (_ "~a linear, ~a dB.")
|
||||
(first vals) (second vals))
|
||||
(format nil (_ "Left: ~a lin, ~a dB | Right: ~a lin, ~a dB.")
|
||||
(first vals)(second vals)(third vals)(fourth vals))))
|
||||
(first vals) (second vals) (third vals) (fourth vals))))
|
||||
(if (> (length optext)0)
|
||||
(format nil "~%~a~%~%~%" optext) ; optional text
|
||||
(format nil "~%~%~%")))) ; no optional text
|
||||
@@ -472,8 +348,8 @@ ul {
|
||||
<h3>" (_ "Audio data analysis:") "</h3>
|
||||
<ul>
|
||||
<li>" (_ "<b>Sample Rate:</b> ~a Hz.") "</li>"
|
||||
; i18n-hint: abbreviates "linear" and "decibels"
|
||||
"<li>" (_ "<b>Peak Amplitude:</b> ~a (lin) ~a dB.") "</li>"
|
||||
; i18n-hint: abbreviates "decibels"
|
||||
"<li>" (_ "<b>Peak Amplitude:</b> ~a (linear) ~a dB.") "</li>"
|
||||
; i18n-hint: RMS abbreviates root-mean-square, a method of averaging a signal; there also "weighted" versions of it but this isn't that
|
||||
"<li>" (_ "<b>RMS</b> (unweighted): ~a dB.") "</li>"
|
||||
; i18n-hint: DC derives from "direct current" in electronics, really means the zero frequency component of a signal
|
||||
@@ -486,12 +362,12 @@ ul {
|
||||
number ; number of samples
|
||||
(get 'info 'duration) ; duration (seconds)
|
||||
(get 'info 'srate) ; sample rate
|
||||
(setq smax (stereomax s)) ; peak amplitude linear
|
||||
(setq smax (stereomax *track*)) ; peak amplitude linear
|
||||
(lin-to-db smax) ; peak amplitude dB
|
||||
(srms s) ; rms
|
||||
(let ((vals (dc-off s))) ; DC offset
|
||||
(srms *track*) ; rms
|
||||
(let ((vals (dc-off *track*))) ; DC offset
|
||||
(if (= (length vals) 2) ; mono
|
||||
(format nil (_ "~a linear, ~a dB.")
|
||||
(format nil (_ "~a linear, ~a dB.")
|
||||
(first vals)(second vals))
|
||||
(format nil (_ "Left: ~a lin, ~a dB | Right: ~a linear, ~a dB.")
|
||||
(first vals)(second vals)(third vals)(fourth vals))))))
|
||||
@@ -539,41 +415,41 @@ Daulton") " (<a href=
|
||||
(let ((time (/ (1- id) *sound-srate*))
|
||||
(db1 (lin-to-db (abs val1)))
|
||||
(db2 (lin-to-db (abs val2))))
|
||||
(format fp
|
||||
(format fp
|
||||
"<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))
|
||||
;; mono
|
||||
(let ((time (/ (1- id) *sound-srate*))
|
||||
(db (lin-to-db (abs val1))))
|
||||
(format fp
|
||||
"<tr>~%<td>~a</td>~%<td>~a</td>~%<td>~a</td>~%<td>~a</td>~%</tr>~%"
|
||||
(format fp
|
||||
"<tr>~%<td>~a</td>~%<td>~a</td>~%<td>~a</td>~%<td>~a</td>~%</tr>~%"
|
||||
id time val1 db))))
|
||||
|
||||
|
||||
(defun printhtml ()
|
||||
(format t (normhead))
|
||||
(format fp (html-head))
|
||||
(format fp (doc-head))
|
||||
(if (arrayp s)
|
||||
(if (arrayp *track*)
|
||||
(progn
|
||||
(format fp (table-head-stereo))
|
||||
(do ((i 1 (1+ i)))
|
||||
((> i number))
|
||||
(make-htm i
|
||||
(snd-fetch (aref s 0))
|
||||
(snd-fetch (aref s 1)))))
|
||||
(snd-fetch (aref *track* 0))
|
||||
(snd-fetch (aref *track* 1)))))
|
||||
(progn
|
||||
(format fp (table-head-mono))
|
||||
(do ((i 1 (1+ i)))
|
||||
((> i number))
|
||||
(make-htm i (snd-fetch s)))))
|
||||
(make-htm i (snd-fetch *track*)))))
|
||||
(format fp (html-foot))
|
||||
(close fp)
|
||||
(if (= messages 0)
|
||||
(format nil (_ "~aData written to:~%~a~a~a")
|
||||
(normhead) path fileseparator filename)
|
||||
nil))
|
||||
(format nil (_ "~aData written to:~%~a") (normhead) filename)
|
||||
(progn
|
||||
(format t (_ "~aData written to:~%~a") (normhead) filename)
|
||||
"")))
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
;; END OF HTML ;;
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
@@ -584,41 +460,43 @@ Daulton") " (<a href=
|
||||
(putprop 'info (truncate *sound-srate*) 'srate)
|
||||
(putprop 'info (if (= units 0) (_ "dB") (_ "linear")) 'units)
|
||||
(putprop 'info (/ number *sound-srate*) 'duration)
|
||||
(putprop 'info
|
||||
(if (arrayp s)
|
||||
(putprop 'info
|
||||
(if (arrayp *track*)
|
||||
(_ "2 channels (stereo)") (_ "1 channel (mono)"))
|
||||
'channels)
|
||||
;; stereo sample order
|
||||
(putprop 'info
|
||||
(cond
|
||||
((and (= fileformat 3)(= chan 0)) ; csv, channel in column
|
||||
((and (= fileformat 3)(= channel-layout 0)) ; csv, channel in column
|
||||
(format nil (_ "One column per channel.~%")))
|
||||
((and (= fileformat 3)(= chan 2)) ; csv, channel in row
|
||||
((and (= fileformat 3)(= channel-layout 2)) ; csv, channel in row
|
||||
(format nil (_ "One row per channel.~%")))
|
||||
((or (soundp s)(= fileformat 4)) ; mono soundor HTML
|
||||
((or (soundp *track*)(= fileformat 4)) ; mono sound or HTML
|
||||
"")
|
||||
((= chan 0) (format nil (_ "Left channel then Right channel on same line.~%")))
|
||||
((= chan 1) (format nil (_ "Left and right channels on alternate lines.~%")))
|
||||
((= chan 2) (format nil (_ "Left channel first then right channel.~%")))
|
||||
((= channel-layout 0) (format nil (_ "Left channel then Right channel on same line.~%")))
|
||||
((= channel-layout 1) (format nil (_ "Left and right channels on alternate lines.~%")))
|
||||
((= channel-layout 2) (format nil (_ "Left channel first then right channel.~%")))
|
||||
(T (_ "Unspecified channel order")))
|
||||
'chan-order))
|
||||
|
||||
|
||||
;;; get number from string
|
||||
(setq number (read (make-string-input-stream number)))
|
||||
(if (numberp number)
|
||||
(checknumber)
|
||||
(add-error (format nil (_ "~a is not a number.") number)))
|
||||
;;; Specifying a CSV or HTML file overrides the (text only) format selection.
|
||||
(let ((file-extension (get-extension filename)))
|
||||
(cond
|
||||
((string-equal file-extension "csv")
|
||||
(setf fileformat 3))
|
||||
((string-equal file-extension "html")
|
||||
(setf fileformat 4))
|
||||
((string-equal file-extension "htm")
|
||||
(setf fileformat 4))))
|
||||
|
||||
(filewriter)
|
||||
(if (> (length err) 0)
|
||||
;; output error message if enabled
|
||||
(if (= messages 2)
|
||||
nil ; return nil
|
||||
(format nil (_ "Error.~%~a") err)) ; return errors
|
||||
;; else print to file
|
||||
(progn
|
||||
(put-head-info) ; put basic info for headers
|
||||
(if (= fileformat 4)
|
||||
(printhtml) ; html output
|
||||
(printdata)))) ; text output
|
||||
(setf number (min (truncate len) number))
|
||||
(setq fp (open filename :direction :output))
|
||||
(cond
|
||||
(fp (put-head-info)
|
||||
(if (= fileformat 4)
|
||||
(printhtml) ; html output
|
||||
(printdata))) ; text output
|
||||
(t (if (= messages 2)
|
||||
(format t (_ "Error.~%\"~a\" cannot be written.") filename)
|
||||
(format nil (_ "Error.~%\"~a\" cannot be written.") filename))))
|
||||
|
||||
Reference in New Issue
Block a user