mirror of
https://github.com/cookiengineer/audacity
synced 2025-06-14 07:10:24 +02:00
new version from Steve
This commit is contained in:
v.audacity
parent
15f9695d18
commit
cf0869ff85
@ -2,22 +2,24 @@
|
||||
;version 3
|
||||
;type analyze
|
||||
;name "Sample Data Export..."
|
||||
;action "Processing..."
|
||||
;action "Analyzing..."
|
||||
;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.
|
||||
;; Updated July 16 2012.
|
||||
;; Released under terms of the GNU General Public License version 2:
|
||||
;; 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 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 header "Include header information" choice "None,Minimal,Standard,All" 2
|
||||
;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 filename "File name" string "" "sample-data"
|
||||
;control path "Output folder" string "" "Home directory"
|
||||
@ -27,16 +29,16 @@
|
||||
;; 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 1)
|
||||
;(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 default-filename "sample-data") ; default filename
|
||||
(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) "")
|
||||
(setq number "100")) ; default=100
|
||||
(setq number "100")) ; default=100
|
||||
|
||||
|
||||
(defun add-error (e-string)
|
||||
@ -46,21 +48,21 @@
|
||||
;;; stereo peak
|
||||
(defun stereomax (snd)
|
||||
(if (arrayp s)
|
||||
(max (peak (aref s 0) number)(peak (aref s 1) number))
|
||||
(peak s number)))
|
||||
(max (peak (aref s 0) number)(peak (aref s 1) number))
|
||||
(peak s 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)))
|
||||
(avgsq (mult 0.5 (sum sql sqr)))
|
||||
(avgsq (snd-avg avgsq number number op-average)))
|
||||
(linear-to-db (peak (snd-sqrt avgsq) 1)))
|
||||
(let* ((sndsq (mult snd snd))
|
||||
(avgsq (snd-avg sndsq number number op-average)))
|
||||
(linear-to-db (peak (snd-sqrt avgsq) 1)))))
|
||||
(let* ((sql (mult (aref s 0)(aref s 0)))
|
||||
(sqr (mult (aref s 1)(aref s 1)))
|
||||
(avgsq (mult 0.5 (sum sql sqr)))
|
||||
(avgsq (snd-avg avgsq number number op-average)))
|
||||
(linear-to-db (peak (snd-sqrt avgsq) 1)))
|
||||
(let* ((sndsq (mult snd snd))
|
||||
(avgsq (snd-avg sndsq number number op-average)))
|
||||
(linear-to-db (peak (snd-sqrt avgsq) 1)))))
|
||||
|
||||
|
||||
;;; dc off-set mono
|
||||
@ -75,30 +77,29 @@
|
||||
;;; compute dc offsets (mono/stereo)
|
||||
(defun dc-off (sig)
|
||||
(if (arrayp sig)
|
||||
(let ((lin0 (dc-off-mon (aref sig 0) number))
|
||||
(lin1 (dc-off-mon (aref sig 1) number)))
|
||||
(list lin0 (linear-to-db (abs lin0)) lin1 (linear-to-db (abs lin1))))
|
||||
(let ((lin (dc-off-mon sig number)))
|
||||
(list lin (linear-to-db (abs lin))))))
|
||||
(let ((lin0 (dc-off-mon (aref sig 0) number))
|
||||
(lin1 (dc-off-mon (aref sig 1) number)))
|
||||
(list lin0 (linear-to-db (abs lin0)) lin1 (linear-to-db (abs lin1))))
|
||||
(let ((lin (dc-off-mon sig number)))
|
||||
(list lin (linear-to-db (abs lin))))))
|
||||
|
||||
|
||||
(defun checknumber ()
|
||||
(setq number (min number len))
|
||||
(if (< number 1)
|
||||
(add-error "No samples selected."))
|
||||
(add-error "No samples selected."))
|
||||
(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)))
|
||||
|
||||
|
||||
;;; home directory
|
||||
(defun home ()
|
||||
(if (windowsp)
|
||||
(get-env "UserProfile") ; Windows
|
||||
(get-env "HOME"))) ; Mac / Linux
|
||||
(get-env "UserProfile") ; Windows
|
||||
(get-env "HOME"))) ; Mac / Linux
|
||||
|
||||
|
||||
|
||||
;;; Check if Windows
|
||||
(defun windowsp ()
|
||||
(char= #\\ *file-separator*))
|
||||
@ -118,50 +119,58 @@
|
||||
(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)))
|
||||
(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
|
||||
(defun snd-get (snd &optional (dB 0))
|
||||
(if (= dB 0) ; dB scale
|
||||
(linear-to-db (abs (snd-fetch snd)))
|
||||
(snd-fetch snd))) ; linear scale
|
||||
(if (= dB 0) ; dB scale
|
||||
(linear-to-db (abs (snd-fetch snd)))
|
||||
(snd-fetch snd))) ; linear scale
|
||||
|
||||
|
||||
;; fileformat 0=Text List, 1=Indexed List, 2=Time Indexed, 3=CSV, (4=html but not used here)
|
||||
(defun formatprint (val snd)
|
||||
;; fileformat 0=Text List, 1=Indexed List, 2=Time Indexed, 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~%" ; text list
|
||||
(snd-get snd units)))
|
||||
(1 (format fp "~a\t~a~%" ; indexed list
|
||||
val (snd-get snd units)))
|
||||
(2 (format fp "~a\t~a~%" ; time index
|
||||
(/ (1- val) *sound-srate*)
|
||||
(snd-get snd units)))
|
||||
(3 (format fp "~a," ; csv
|
||||
(snd-get snd units)))))
|
||||
(0 (format fp "~a~a" ; text list
|
||||
(snd-get snd units)
|
||||
(if same "\t" "\n")))
|
||||
(1 (format fp "~a\t~a~a" ; indexed list
|
||||
val
|
||||
(snd-get snd units)
|
||||
(if same "\t" "\n")))
|
||||
(2 (format fp "~a\t~a~a" ; time index
|
||||
(/ (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
|
||||
(defun print-text (s-in)
|
||||
(do ((n 1 (1+ n)))
|
||||
((> n number))
|
||||
(if (arrayp s-in) ; Stereo (alternate lines)
|
||||
(progn
|
||||
;; option to prefix alternate lines with L/R
|
||||
(when LR-prefix
|
||||
(unless (or (= header 0)(= fileformat 3))
|
||||
(format fp "L ")))
|
||||
(formatprint n (aref s-in 0))
|
||||
;; option to prefix alternate lines with L/R
|
||||
(when LR-prefix
|
||||
(unless (or (= header 0)(= fileformat 3))
|
||||
(format fp "R ")))
|
||||
(formatprint n (aref s-in 1)))
|
||||
(formatprint n s-in))))
|
||||
(if (arrayp s-in) ; Stereo (alternate lines)
|
||||
(progn
|
||||
;; 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)))
|
||||
(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))))
|
||||
|
||||
|
||||
;; Print to file
|
||||
@ -172,28 +181,28 @@
|
||||
(2 (format t (normhead))(format fp (normhead)))
|
||||
(3 (format t (normhead))(format fp (fullhead))))
|
||||
;; Stereo and left channel first
|
||||
(if (and (arrayp s)(= chan 1))
|
||||
(progn
|
||||
(unless (= header 0) ; Don't print 'channel' if no header
|
||||
(format fp "Left Channel.~%~%"))
|
||||
(print-text (aref s 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)
|
||||
(s-rest 0)))
|
||||
;; mono or alternate
|
||||
(progn
|
||||
(print-text s)
|
||||
(close fp)
|
||||
(if (= messages 0)
|
||||
(format nil "~aData written to:~%~a~a~a"
|
||||
(normhead) path fileseparator filename)
|
||||
(s-rest 0)))))
|
||||
(if (and (arrayp s)(= chan 2))
|
||||
(progn
|
||||
(unless (= header 0) ; Don't print 'channel' if no header
|
||||
(format fp "Left Channel.~%~%"))
|
||||
(print-text (aref s 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)
|
||||
(s-rest 0)))
|
||||
;; mono or alternate
|
||||
(progn
|
||||
(print-text s)
|
||||
(close fp)
|
||||
(if (= messages 0)
|
||||
(format nil "~aData written to:~%~a~a~a"
|
||||
(normhead) path fileseparator filename)
|
||||
(s-rest 0)))))
|
||||
|
||||
|
||||
;;; File destination processing
|
||||
@ -204,198 +213,84 @@
|
||||
(3 ".csv")
|
||||
(4 ".html")
|
||||
(T ".txt")))
|
||||
|
||||
;; file separator as string
|
||||
; 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 (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
|
||||
|
||||
(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
|
||||
(and (or (windowsp) ; case insensitive
|
||||
(macp)) ; assume case insensitive
|
||||
(string-equal path realdir))
|
||||
(string= path realdir))
|
||||
;; makefilename or error
|
||||
(setq filename (makefilename filename FileExt))
|
||||
(add-error (format nil "Output folder \"~a~a\" cannot be accessed."
|
||||
path fileseparator))))
|
||||
(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)))))
|
||||
(add-error (format nil "\"~a~a~a\" cannot be written."
|
||||
path fileseparator filename)))))
|
||||
|
||||
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
;; 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 ;;
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
;;; Header text
|
||||
|
||||
(defun nohead ()
|
||||
(if (> (length optext) 0)
|
||||
(format nil "~a~%~a~%"
|
||||
optext
|
||||
(get 'info 'chan-order))
|
||||
""))
|
||||
(format nil "~a~%~a~%"
|
||||
optext
|
||||
(get 'info 'chan-order))
|
||||
""))
|
||||
|
||||
|
||||
(defun minhead ()
|
||||
(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
|
||||
(if (> (length optext)0)
|
||||
(format nil "~a~%~%~%" optext) ; optional text
|
||||
(format nil "~%~%")))) ; no optional text
|
||||
(get 'info 'srate) ; sample rate
|
||||
(get 'info 'units) ; units
|
||||
(get 'info 'chan-order) ; Channel Order
|
||||
(if (> (length optext) 0)
|
||||
(format nil "~a~%~%~%" optext) ; optional text
|
||||
(format nil "~%")))) ; no optional text
|
||||
|
||||
|
||||
(defun normhead ()
|
||||
(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)
|
||||
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
|
||||
(format nil "~%~a~%~%~%" optext) ; optional text
|
||||
(format nil "~%~%~%")))) ; no optional text
|
||||
|
||||
|
||||
(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 ~
|
||||
samples, ~a seconds.~%Peak amplitude: ~a (lin) ~a dB. Unweighted rms: ~a dB.~%~
|
||||
DC offset: ~a~a"
|
||||
filename ; file name
|
||||
(get 'info 'srate) ; sample rate
|
||||
(get 'info 'units) ; units
|
||||
(get 'info 'channels) ; mono/stereo
|
||||
(get 'info 'chan-order) ; Channel Order
|
||||
number ; number of samples
|
||||
(get 'info 'duration) ; duration (seconds)
|
||||
(setq smax (stereomax s)) ; peak amplitude linear
|
||||
(linear-to-db smax) ; peak amplitude dB
|
||||
(srms s) ; rms
|
||||
(let ((vals (dc-off s))) ; DC offset
|
||||
filename ; file name
|
||||
(get 'info 'srate) ; sample rate
|
||||
(get 'info 'units) ; units
|
||||
(get 'info 'channels) ; mono/stereo
|
||||
(get 'info 'chan-order) ; Channel Order
|
||||
number ; number of samples
|
||||
(get 'info 'duration) ; duration (seconds)
|
||||
(setq smax (stereomax s)) ; peak amplitude linear
|
||||
(linear-to-db smax) ; peak amplitude dB
|
||||
(srms s) ; rms
|
||||
(let ((vals (dc-off s))) ; DC offset
|
||||
(if (= (length vals) 2) ; mono
|
||||
(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))))
|
||||
(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))))
|
||||
(if (> (length optext)0)
|
||||
(format nil "~%~a~%~%~%" optext) ; optional text
|
||||
(format nil "~%~%~%")))) ; no optional text
|
||||
(format nil "~%~a~%~%~%" optext) ; optional text
|
||||
(format nil "~%~%~%")))) ; no optional text
|
||||
|
||||
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
@ -540,10 +435,10 @@ ul {
|
||||
(srms s) ; rms
|
||||
(let ((vals (dc-off s))) ; DC offset
|
||||
(if (= (length vals) 2) ; mono
|
||||
(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))))))
|
||||
(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))))))
|
||||
|
||||
|
||||
;;; table headings (mono)
|
||||
@ -583,20 +478,20 @@ Daulton (<a href=
|
||||
;;; html generator
|
||||
(defun make-htm (id val1 &optional val2)
|
||||
(if val2
|
||||
;; stereo
|
||||
(let ((time (/ (1- id) *sound-srate*))
|
||||
(db1 (linear-to-db (abs val1)))
|
||||
(db2 (linear-to-db (abs val2))))
|
||||
(format fp
|
||||
"<tr>~%<td>~a</td>~%<td>~a</td>~%<td>~a</td>~%<td>~a</td>~%~
|
||||
<td>~a</td>~%<td>~a</td>~%</tr>~%"
|
||||
id time val1 val2 db1 db2))
|
||||
;; mono
|
||||
(let ((time (/ (1- id) *sound-srate*))
|
||||
(db (linear-to-db (abs val1))))
|
||||
(format fp
|
||||
"<tr>~%<td>~a</td>~%<td>~a</td>~%<td>~a</td>~%<td>~a</td>~%</tr>~%"
|
||||
id time val1 db))))
|
||||
;; stereo
|
||||
(let ((time (/ (1- id) *sound-srate*))
|
||||
(db1 (linear-to-db (abs val1)))
|
||||
(db2 (linear-to-db (abs val2))))
|
||||
(format fp
|
||||
"<tr>~%<td>~a</td>~%<td>~a</td>~%<td>~a</td>~%<td>~a</td>~%~
|
||||
<td>~a</td>~%<td>~a</td>~%</tr>~%"
|
||||
id time val1 val2 db1 db2))
|
||||
;; mono
|
||||
(let ((time (/ (1- id) *sound-srate*))
|
||||
(db (linear-to-db (abs val1))))
|
||||
(format fp
|
||||
"<tr>~%<td>~a</td>~%<td>~a</td>~%<td>~a</td>~%<td>~a</td>~%</tr>~%"
|
||||
id time val1 db))))
|
||||
|
||||
|
||||
(defun printhtml ()
|
||||
@ -604,69 +499,69 @@ Daulton (<a href=
|
||||
(format fp (html-head))
|
||||
(format fp (doc-head))
|
||||
(if (arrayp s)
|
||||
(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)))))
|
||||
(progn
|
||||
(format fp (table-head-mono))
|
||||
(do ((i 1 (1+ i)))
|
||||
((> i number))
|
||||
(make-htm i (snd-fetch s)))))
|
||||
(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)))))
|
||||
(progn
|
||||
(format fp (table-head-mono))
|
||||
(do ((i 1 (1+ i)))
|
||||
((> i number))
|
||||
(make-htm i (snd-fetch s)))))
|
||||
(format fp (html-foot))
|
||||
(close fp)
|
||||
(if (= messages 0)
|
||||
(format nil "~aData written to:~%~a~a~a"
|
||||
(normhead) path fileseparator filename)
|
||||
(s-rest 0)))
|
||||
(format nil "~aData written to:~%~a~a~a"
|
||||
(normhead) path fileseparator filename)
|
||||
(s-rest 0)))
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
;; 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
|
||||
(setq number (read (make-string-input-stream number)))
|
||||
(if (numberp number)
|
||||
(checknumber)
|
||||
(add-error (format nil "~a is not a number." number)))
|
||||
(checknumber)
|
||||
(add-error (format nil "~a is not a number." number)))
|
||||
|
||||
(case help
|
||||
(0 (filewriter)
|
||||
(if (> (length err) 0)
|
||||
;; output error message if enabled
|
||||
(unless (= messages 2)
|
||||
(format nil "Error.~%~a" err))
|
||||
;; else print to file
|
||||
(progn
|
||||
;; basic info for headers
|
||||
(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)
|
||||
(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))))
|
||||
(filewriter)
|
||||
(if (> (length err) 0)
|
||||
;; output error message if enabled
|
||||
(if (= messages 2)
|
||||
(s-rest 0) ; return nul sound
|
||||
(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
|
||||
|
||||
Loading…
x
Reference in New Issue
Block a user