Autres/audacity
1
0
Fork 0
mirror of https://github.com/cookiengineer/audacity synced 2025-07-30 07:29:29 +02:00
Code Issues Releases Wiki Activity

new version from Steve

Browse Source
This commit is contained in:
v.audacity 2012-07-17 00:29:31 +00:00
parent 15f9695d18
commit cf0869ff85
1 changed files with 218 additions and 323 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -2,22 +2,24 @@
;version 3 ;version 3
;type analyze ;type analyze
;name "Sample Data Export..." ;name "Sample Data Export..."
;action "Processing..." ;action "Analyzing..."
;categories "http://lv2plug.in/ns/lv2core#AnalyserPlugin" ;categories "http://lv2plug.in/ns/lv2core#AnalyserPlugin"
;info "by Steve Daulton. Released under GPL v2" ;info "by Steve Daulton. Released under GPL v2."
;; sample-data-export.ny by Steve Daulton June 2012. ;; sample-data-export.ny by Steve Daulton June 2012.
;; Updated July 16 2012.
;; Released under terms of the GNU General Public License version 2: ;; Released under terms of the GNU General Public License version 2:
;; http://www.gnu.org/licenses/old-licenses/gpl-2.0.html ;; http://www.gnu.org/licenses/old-licenses/gpl-2.0.html
;;
;; For information about writing and modifying Nyquist plug-ins:
;; http://wiki.audacityteam.org/wiki/Nyquist_Plug-ins_Reference
;control help "Show Help File" choice "No,Overview,File Format,Header Text,Output Files,Save Help File" 0
;control number "Limit output to first" string "samples" "100" ;control number "Limit output to first" string "samples" "100"
;control units "Measurement scale" choice "dB,Linear" 0 ;control units "Measurement scale" choice "dB,Linear" 0
;control fileformat "File data format" choice "Sample List (txt),Indexed List (txt),Time Indexed (txt),Data (csv),Web Page (html)" 0 ;control fileformat "File data format" choice "Sample List (txt),Indexed List (txt),Time Indexed (txt),Data (csv),Web Page (html)" 0
;control header "Include header information" choice "None,Minimal,Standard,All" 2 ;control header "Include header information" choice "None,Minimal,Standard,All" 2
;control optext "Optional header text" string "" ;control optext "Optional header text" string ""
;control chan "Channel layout for stereo" choice "Alternate Lines,L Channel First" 1 ;control chan "Channel layout for stereo" choice "L-R on Same Line,Alternate Lines,L Channel First" 0
;control messages "Show messages" choice "Yes,Errors Only,None" 0 ;control messages "Show messages" choice "Yes,Errors Only,None" 0
;control filename "File name" string "" "sample-data" ;control filename "File name" string "" "sample-data"
;control path "Output folder" string "" "Home directory" ;control path "Output folder" string "" "Home directory"
@ -27,16 +29,16 @@
;; 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) ;; (text output with header only)
;; remove the semicolon from the start of the next line: ;; remove the semicolon from the start of the next line:
;(setq LR-prefix 1) ;(setq LR-prefix '("L: " "R: "))
(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)
@ -46,21 +48,21 @@
;;; stereo peak ;;; stereo peak
(defun stereomax (snd) (defun stereomax (snd)
(if (arrayp s) (if (arrayp s)
(max (peak (aref s 0) number)(peak (aref s 1) number)) (max (peak (aref s 0) number)(peak (aref s 1) number))
(peak s number))) (peak s number)))
;;; stereo rms ;;; stereo rms
(defun srms (snd) (defun srms (snd)
(if (arrayp snd) (if (arrayp snd)
(let* ((sql (mult (aref s 0)(aref s 0))) (let* ((sql (mult (aref s 0)(aref s 0)))
(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))) (linear-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))))) (linear-to-db (peak (snd-sqrt avgsq) 1)))))
;;; dc off-set mono ;;; dc off-set mono
@ -75,30 +77,29 @@
;;; compute dc offsets (mono/stereo) ;;; compute dc offsets (mono/stereo)
(defun dc-off (sig) (defun dc-off (sig)
(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 (linear-to-db (abs lin0)) lin1 (linear-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 (linear-to-db (abs lin))))))
(defun checknumber () (defun checknumber ()
(setq number (min number len)) (setq number (min number len))
(if (< number 1) (if (< number 1)
(add-error "No samples selected.")) (add-error "No samples selected."))
(if (> number 1000000) (if (> number 1000000)
(add-error "Too many samples selected.\nSet limit to less than 1 million")) (add-error "Too many samples selected.\nSet limit to less than 1 million"))
(setq number (truncate number))) (setq number (truncate number)))
;;; 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
(defun windowsp () (defun windowsp ()
(char= #\\ *file-separator*)) (char= #\\ *file-separator*))
@ -118,50 +119,58 @@
(defun makefilename (fname ext) (defun makefilename (fname ext)
;; avoid overwriting files ;; avoid overwriting files
(if (and (= owrite 0)(filep fname ext)) (if (and (= owrite 0)(filep fname ext))
(do ((num 1 (1+ num))) (do ((num 1 (1+ num)))
((not (filep fname ext num)) ((not (filep fname ext num))
(format nil "~a~a~a" fname num ext))) (format nil "~a~a~a" fname num ext)))
(strcat fname 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)) (defun snd-get (snd &optional (dB 0))
(if (= dB 0) ; dB scale (if (= dB 0) ; dB scale
(linear-to-db (abs (snd-fetch snd))) (linear-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, (4=html but not used here) ;; fileformat 0=Text List, 1=Indexed List, 2=Time Indexed, 3=CSV,
(defun formatprint (val snd) ;; (4=html but not used here).
;; Optional 'same' [line] argument is either 'true' or 'nil'
(defun formatprint (val snd &optional same)
(case fileformat (case fileformat
(0 (format fp "~a~%" ; text list (0 (format fp "~a~a" ; text list
(snd-get snd units))) (snd-get snd units)
(1 (format fp "~a\t~a~%" ; indexed list (if same "\t" "\n")))
val (snd-get snd units))) (1 (format fp "~a\t~a~a" ; indexed list
(2 (format fp "~a\t~a~%" ; time index val
(/ (1- val) *sound-srate*) (snd-get snd units)
(snd-get snd units))) (if same "\t" "\n")))
(3 (format fp "~a," ; csv (2 (format fp "~a\t~a~a" ; time index
(snd-get snd units))))) (/ (1- val) *sound-srate*)
(snd-get snd units)
(if same "\t" "\n")))
(3 (format fp "~a~a" ; csv
(snd-get snd units)
(if (or (= chan 2) same) "," "\n")))))
;;; Print sample data to file ;;; Print sample data to file
(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 "L "))) (format fp "~a" (first LR-prefix))))
(formatprint n (aref s-in 0)) (if (= chan 0) ; IF 'Same Line' then "True"
;; option to prefix alternate lines with L/R (formatprint n (aref s-in 0) T)
(when LR-prefix (formatprint n (aref s-in 0)))
(unless (or (= header 0)(= fileformat 3)) (when LR-prefix
(format fp "R "))) (unless (or (= header 0)(= fileformat 3))
(formatprint n (aref s-in 1))) (format fp "~a" (second LR-prefix))))
(formatprint n s-in)))) (formatprint n (aref s-in 1)))
(formatprint n s-in))))
;; Print to file ;; Print to file
@ -172,28 +181,28 @@
(2 (format t (normhead))(format fp (normhead))) (2 (format t (normhead))(format fp (normhead)))
(3 (format t (normhead))(format fp (fullhead)))) (3 (format t (normhead))(format fp (fullhead))))
;; Stereo and left channel first ;; Stereo and left channel first
(if (and (arrayp s)(= chan 1)) (if (and (arrayp s)(= chan 2))
(progn (progn
(unless (= header 0) ; Don't print 'channel' if no header (unless (= header 0) ; Don't print 'channel' if no header
(format fp "Left Channel.~%~%")) (format fp "Left Channel.~%~%"))
(print-text (aref s 0)) (print-text (aref s 0))
(if (= header 0) ; Don't print 'channel' if no header (if (= header 0) ; Don't print 'channel' if no header
(format fp "~%") (format fp "~%")
(format fp "~%~%Right Channel.~%~%")) (format fp "~%~%Right Channel.~%~%"))
(print-text (aref s 1)) (print-text (aref s 1))
(close fp) (close fp)
(if (= messages 0) (if (= messages 0)
(format nil "~aData written to:~%~a~a~a" (format nil "~aData written to:~%~a~a~a"
(normhead) path fileseparator filename) (normhead) path fileseparator filename)
(s-rest 0))) (s-rest 0)))
;; mono or alternate ;; mono or alternate
(progn (progn
(print-text s) (print-text s)
(close fp) (close fp)
(if (= messages 0) (if (= messages 0)
(format nil "~aData written to:~%~a~a~a" (format nil "~aData written to:~%~a~a~a"
(normhead) path fileseparator filename) (normhead) path fileseparator filename)
(s-rest 0))))) (s-rest 0)))))
;;; File destination processing ;;; File destination processing
@ -204,198 +213,84 @@
(3 ".csv") (3 ".csv")
(4 ".html") (4 ".html")
(T ".txt"))) (T ".txt")))
; file separator as string
;; file separator as string
(setq fileseparator (format nil "~a" *file-separator*)) (setq fileseparator (format nil "~a" *file-separator*))
;; strip file separator and spaces ;; strip file separator and spaces
(let ((stuff (format nil " ~a" *file-separator*))) (let ((stuff (format nil " ~a" *file-separator*)))
(setq filename (string-left-trim stuff filename)) (setq filename (string-left-trim stuff filename))
(setq path (string-right-trim stuff path))) (setq path (string-right-trim stuff path)))
;; strip file extension if present ;; strip file extension if present
(if (and (>= (length filename)(length FileExt)) (if (and (>= (length filename)(length FileExt))
(string-equal filename FileExt :start1 (- (length filename)(length FileExt)))) (string-equal filename FileExt :start1 (- (length filename)(length FileExt))))
(setq filename (subseq filename 0 (- (length filename)(length FileExt))))) (setq filename (subseq filename 0 (- (length filename)(length FileExt)))))
;; replace ~/ on Linux/Max ;; replace ~/ on Linux/Max
(if (and (>= (length path) 2)(not (windowsp))) (if (and (>= (length path) 2)
(if (string-equal path "~/" :end1 2) (not (windowsp)))
(setq path (strcat (home)(subseq path 1))))) (if (string-equal path "~/" :end1 2)
(setq path (strcat (home)(subseq path 1)))))
;; If path not set use home directory ;; If path not set use home directory
(if (or (string-equal path "Home directory") (if (or (string-equal path "Home directory")
(string-equal path "")) (string-equal path ""))
(setq path (home))) (setq path (home)))
;; 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 (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)))
(string= path realdir)) ;; makefilename or error
;; makefilename or error (setq filename (makefilename filename FileExt))
(setq filename (makefilename filename FileExt)) (add-error (format nil "Output folder \"~a~a\" cannot be accessed."
(add-error (format nil "Output folder \"~a~a\" cannot be accessed." path fileseparator))))
path fileseparator))))
;; check if file is writeable ;; check if file is writeable
(when (= (length err) 0) (when (= (length err) 0)
;Open file for output ;Open file for output
(setq fp (open filename :direction :output)) (setq fp (open filename :direction :output))
;check file is writeable ;check file is writeable
(if (not fp) (if (not fp)
(add-error (format nil "\"~a~a~a\" cannot be written." (add-error (format nil "\"~a~a~a\" cannot be written."
path fileseparator filename))))) path fileseparator filename)))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; Header text
;; HELP FILES ;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun help-page (page)
(case page
(1
"OVERVIEW.
Sample Data Export reads the values of successive
samples from the selected audio and prints to a
file. Additional information may be added as a
'header' at the top of the page.\n
HELP SCREENS:
Select only one track before viewing to avoid
repeated help screens. To run the plug-in set the
help option to \"No\".
Select \"Save Help File\" to write all help screens
to a printable file.\n
LIMIT OUTPUT TO FIRST (maximum number of samples):
Enter a number to limit the number of samples
processed from the selection. The maximum number
of samples is 1 million, but files this large may
be hard to open. The track sample rate indicates
the number of samples per second.\n
LINEAR/dB SCALE:
Sample values may be displayed on a linear scale
+/- 1 (as in the Audacity audio track \"Waveform\"
view) or on a dB scale relative to full scale (as
in the \"Waveform (dB)\" view).")
(2
"FILE FORMAT.\n
Following any header information:\n
SAMPLE LIST: produces a list of sample values.\n
INDEXED LIST: includes the sample number.\n
TIME INDEXED: includes the sample time.
Both types of index are relative to the start of
the selection.\n
DATA (csv): prints the sample values separated
by commas.\n
WEB PAGE (html): produces an HTML 5 document that
contains all of the header information and a table
of sample data with sample number, time, linear
and dB values. Browsers that are not HTML 5
compliant may not display the page correctly.\n
CHANNEL LAYOUT: for text/csv output, stereo tracks
may be printed alternate left/right samples or all
of left channel then all of right channel.")
(3
"OPTIONAL HEADER TEXT:
This is provided for adding notes to the output
file. In text files, use ~~% to start a new line,
in HTML files use <br>.\n
NO HEADER: Prints only the optional header text
(leave blank for none) followed by the sample data.\n
MINIMAL HEADER:
The sample rate.
Units (linear or dB).
Optional header text (leave blank for none).\n
STANDARD HEADER: minimal header plus:
File name.
Number of samples.
Duration (seconds).
Mono/Stereo.\n
FULL HEADER: standard header plus:
peak amplitude linear and dB.
Unweighted rms level (dB).
DC offset.")
(4 (format nil
"OUTPUT FILES.\n
The default output folder is the \"home folder\":
~a
To select a different output folder, enter the
full path name. The output folder must exist.\n
By default, files will not be overwritten. If you
select multiple tracks, they will be saved to
separate files with a number appended to the
name. If you set \"Allow files to be overwritten\"
to \"Yes\", only the last file for multiple tracks
will be retained.\n
A notification message is displayed on completion
indicating the name and location of the file.\n
If the plug-in is used in a Chain (Audacity 2.0.1
or later) it may be useful to disable messages.\n
For text/csv output the file header is shown in
the debug window."
(home)))))
(defun help (page)
(let ((helptext (help-page page)))
(format nil helptext)))
(defun printhelp ()
(do ((page 1 (1+ page)))
((> page 4))
(format fp "~a~%~%~%"(help-page page)))
(close fp)
(format nil "Help file written to:~%~a~a~a"
path fileseparator filename))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Header text ;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun nohead () (defun nohead ()
(if (> (length optext) 0) (if (> (length optext) 0)
(format nil "~a~%~a~%" (format nil "~a~%~a~%"
optext optext
(get 'info 'chan-order)) (get 'info 'chan-order))
"")) ""))
(defun minhead () (defun minhead ()
(format nil (format nil
"Sample Rate: ~a Hz. Sample values on ~a scale.~%~a~%~a" "Sample Rate: ~a Hz. Sample values on ~a scale.~%~a~%~a"
(get 'info 'srate) ; sample rate (get 'info 'srate) ; sample rate
(get 'info 'units) ; units (get 'info 'units) ; units
(get 'info 'chan-order) ; Channel Order (get 'info 'chan-order) ; Channel Order
(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 normhead () (defun normhead ()
(format nil (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 ()
@ -403,25 +298,25 @@ Length processed: ~a samples ~a seconds.~a"
"~a~%Sample Rate: ~a Hz. Sample values on ~a scale. ~a.~%~aLength processed: ~a ~ "~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.~%~ samples, ~a seconds.~%Peak amplitude: ~a (lin) ~a dB. Unweighted rms: ~a dB.~%~
DC offset: ~a~a" DC offset: ~a~a"
filename ; file name filename ; file name
(get 'info 'srate) ; sample rate (get 'info 'srate) ; sample rate
(get 'info 'units) ; units (get 'info 'units) ; units
(get 'info 'channels) ; mono/stereo (get 'info 'channels) ; mono/stereo
(get 'info 'chan-order) ; Channel Order (get 'info 'chan-order) ; Channel Order
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 (linear-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, ~a dB." (format nil "~a linear, ~a dB."
(first vals)(second vals)) (first vals)(second vals))
(format nil "Left: ~a lin, ~a dB | Right: ~a lin, ~a dB." (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) (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
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
@ -540,10 +435,10 @@ ul {
(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))
(format nil "Left: ~a lin, ~a dB | Right: ~a linear, &nbsp;&nbsp;~a dB." (format nil "Left: ~a lin, ~a dB | Right: ~a linear, &nbsp;&nbsp;~a dB."
(first vals)(second vals)(third vals)(fourth vals)))))) (first vals)(second vals)(third vals)(fourth vals))))))
;;; table headings (mono) ;;; table headings (mono)
@ -583,20 +478,20 @@ Daulton (<a href=
;;; html generator ;;; html generator
(defun make-htm (id val1 &optional val2) (defun make-htm (id val1 &optional val2)
(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 (linear-to-db (abs val1)))
(db2 (linear-to-db (abs val2)))) (db2 (linear-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 (linear-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))))
(defun printhtml () (defun printhtml ()
@ -604,69 +499,69 @@ Daulton (<a href=
(format fp (html-head)) (format fp (html-head))
(format fp (doc-head)) (format fp (doc-head))
(if (arrayp s) (if (arrayp s)
(progn (progn
(format fp (table-head-stereo)) (format fp (table-head-stereo))
(do ((i 1 (1+ i))) (do ((i 1 (1+ i)))
((> i number)) ((> i number))
(make-htm i (make-htm i
(snd-fetch (aref s 0)) (snd-fetch (aref s 0))
(snd-fetch (aref s 1))))) (snd-fetch (aref s 1)))))
(progn (progn
(format fp (table-head-mono)) (format fp (table-head-mono))
(do ((i 1 (1+ i))) (do ((i 1 (1+ i)))
((> i number)) ((> i number))
(make-htm i (snd-fetch s))))) (make-htm i (snd-fetch s)))))
(format fp (html-foot)) (format fp (html-foot))
(close fp) (close fp)
(if (= messages 0) (if (= messages 0)
(format nil "~aData written to:~%~a~a~a" (format nil "~aData written to:~%~a~a~a"
(normhead) path fileseparator filename) (normhead) path fileseparator filename)
(s-rest 0))) (s-rest 0)))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; END OF HTML ;; ;; END OF HTML ;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; basic info for headers
(defun put-head-info ()
(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)
"2 channels (stereo)""1 channel (mono)")
'channels)
;; stereo sample order
(putprop 'info
(cond
((and (= fileformat 3)(= chan 0)) ; csv, channel in column
"One column per channel.\n")
((and (= fileformat 3)(= chan 2)) ; csv, channel in row
"One row per channel.\n")
((or (soundp s)(= fileformat 4)) ; mono soundor HTML
"")
((= chan 0) "Left channel then Right channel on same line.\n")
((= chan 1) "Left and right channels on alternate lines.\n")
((= chan 2) "Left channel first then right channel.\n")
(T "Unspecified channel order"))
'chan-order))
;;; get number from string ;;; get number from string
(setq number (read (make-string-input-stream number))) (setq number (read (make-string-input-stream number)))
(if (numberp number) (if (numberp number)
(checknumber) (checknumber)
(add-error (format nil "~a is not a number." number))) (add-error (format nil "~a is not a number." number)))
(case help (filewriter)
(0 (filewriter) (if (> (length err) 0)
(if (> (length err) 0) ;; output error message if enabled
;; output error message if enabled (if (= messages 2)
(unless (= messages 2) (s-rest 0) ; return nul sound
(format nil "Error.~%~a" err)) (format nil "Error.~%~a" err)) ; return errors
;; else print to file ;; else print to file
(progn (progn
;; basic info for headers (put-head-info) ; put basic info for headers
(putprop 'info (truncate *sound-srate*) 'srate) (if (= fileformat 4)
(putprop 'info (if (= units 0) "dB" "linear") 'units) (printhtml) ; html output
(putprop 'info (/ number *sound-srate*) 'duration) (printdata)))) ; text output
(putprop 'info
(if (arrayp s) "2 channels (stereo)""1 channel (mono)")
'channels)
(putprop 'info
(if (arrayp s)
(if (= chan 0)
(if (= fileformat 3)
"Alternate Left/Right samples.\n"
"Left and right channels on alternate lines.\n")
"Left channel first then right channel.\n")
"")
'chan-order)
(if (= fileformat 4)
(printhtml) ; html output
(printdata))))) ; text output
(1 (help 1))
(2 (help 2))
(3 (help 3))
(4 (help 4))
(5 (setq fileformat ".txt")
(setq filename "SampleDataExport_Help")
(filewriter)
(if (> (length err) 0)
(format nil "Error.~%~a" err)
(printhelp))))