From 5543dc884a545996df78ab88cb80ce3dca081cd6 Mon Sep 17 00:00:00 2001 From: Steve Daulton Date: Mon, 18 Jun 2018 21:31:54 +0100 Subject: [PATCH] Update Sample Data Export to use file browser --- plug-ins/sample-data-export.ny | 436 ++++++++++++--------------------- 1 file changed, 157 insertions(+), 279 deletions(-) diff --git a/plug-ins/sample-data-export.ny b/plug-ins/sample-data-export.ny index 997ec827a..10f4b4ac8 100644 --- a/plug-ins/sample-data-export.ny +++ b/plug-ins/sample-data-export.ny @@ -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 {

" (_ "Audio data analysis:") "