From 72fbf1b0f3c52d6bfa831bc34683e73aea33e268 Mon Sep 17 00:00:00 2001 From: Steve Daulton Date: Mon, 22 Oct 2018 18:04:53 +0100 Subject: [PATCH] Update Regular Interval Labels Fixes bug 2014 - Regular Interval Labels fails. Fixes bug 770 - Enh: Create region labels with "Regular Interval Labels" Fixes bug 1298 - Windows: Regular Interval Labels on mutiple tracks produces multiple labels. --- plug-ins/equalabel.ny | 153 ++++++++++++++++++++++-------------------- 1 file changed, 82 insertions(+), 71 deletions(-) diff --git a/plug-ins/equalabel.ny b/plug-ins/equalabel.ny index f99b9f0d2..4a5e76ccb 100644 --- a/plug-ins/equalabel.ny +++ b/plug-ins/equalabel.ny @@ -1,17 +1,20 @@ $nyquist plug-in $version 4 -$type tool +$type tool analyze +$debugbutton false +$debugflags trace $name (_ "Regular Interval Labels") $manpage "Regular_Interval_Labels" $action (_ "Adding equally-spaced labels to the label track...") $author (_ "Steve Daulton") -$release 2.3.0 +$release 2.3.1 $copyright (_ "Released under terms of the GNU General Public License version 2") +;; TODO: Rewrite as an AUD-DO script so as to remove the requirement for an audio selection. + ;; Original version by David R. Sky (http://www.garyallendj.com/davidsky/) 2007. ;; Based on an idea by Sami Jumppanen, with contributions from -;; Alex S.Brown, Dominic Mazzoni, Pierre M.I., Gale Andrews, Steve Daulton. -;; This version by Steve Daulton (http://easyspacepro.com) 2016 +;; Alex S.Brown, Dominic Mazzoni, Pierre M.I., Gale Andrews. ;; Released under terms of the GNU General Public License version 2: ;; http://www.gnu.org/licenses/old-licenses/gpl-2.0.html @@ -20,79 +23,101 @@ $copyright (_ "Released under terms of the GNU General Public License version 2" ;; https://wiki.audacityteam.org/wiki/Nyquist_Plug-ins_Reference -$control mode (_ "Use 'Number of labels' OR 'Label interval'") choice ( - ("Number" (_ "Number of Labels")) - ("Interval" (_ "Label Interval")) -) 0 +;i18n-hint: Refers to the controls 'Number of labels' and 'Label interval'. +$control mode (_ "Create labels based on") choice (("Both" (_ "Number & Interval")) + ("Number" (_ "Number of Labels")) + ("Interval" (_ "Label Interval"))) 0 $control totalnum (_ "Number of labels") int-text "" 10 1 1000 -$control interval (_ "Label interval (seconds)") float-text "" 60 0.001 3600 -$control adjust (_ "Adjust label interval to fit length") choice ( - (_ "No") - (_ "Yes") -) 0 +$control interval (_ "Label interval (seconds)") float-text "" 10 0.001 3600 +$control region (_ "Length of label region (seconds)") float-text "" 0 0 3600 +$control adjust (_ "Adjust label interval to fit length") choice ((_ "No") + (_ "Yes")) 0 $control labeltext (_ "Label text") string "" (_ "Label") -$control zeros (_ "Minimum number of digits in label") choice ( - ("TextOnly" (_ "None - Text Only")) - ("OneBefore" (_ "1 (Before Label)")) - ("TwoBefore" (_ "2 (Before Label)")) - ("ThreeBefore" (_ "3 (Before Label)")) - ("OneAfter" (_ "1 (After Label)")) - ("TwoAfter" (_ "2 (After Label)")) - ("ThreeAfter" (_ "3 (After Label)")) -) 2 +$control zeros (_ "Minimum number of digits in label") choice (("TextOnly" (_ "None - Text Only")) + ("OneBefore" (_ "1 (Before Label)")) + ("TwoBefore" (_ "2 (Before Label)")) + ("ThreeBefore" (_ "3 (Before Label)")) + ("OneAfter" (_ "1 (After Label)")) + ("TwoAfter" (_ "2 (After Label)")) + ("ThreeAfter" (_ "3 (After Label)"))) 2 $control firstnum (_ "Begin numbering from") int-text "" 1 0 nil +$control verbose (_ "Message on completion") choice ((_ "Details") + ("Warnings" (_ "Warnings only")) + (_ "None")) 0 - -(defun make-labels () +(defun make-labels (&aux labels) "Generate labels at regular intervals" - (setf labels ()) ;; Get parameters (case mode - (0 ;Number of Labels - (setf interval (/ (get-duration 1) totalnum))) - (1 (setf totalnum (get-interval-count)) + (1 ;Number + (setf interval + (if (= region 0) + (/ (- (get-duration 1) region) totalnum) + (/ (- (get-duration 1) region) (1- totalnum))))) + (2 ;Interval + (setf totalnum (get-interval-count)) (when (= adjust 1) - (setf interval (/ (get-duration 1) totalnum))) - (check-number-of-labels))) + (setf interval (/ (- (get-duration 1) region) totalnum)))) + (t ;Number and Interval + )) ;; Loop for required number of labels (do* ((count 0 (1+ count)) (time 0 (* count interval))) - ((= count totalnum) labels) - (push (make-one-label time (+ firstnum count)) labels))) + ((= count totalnum)) + (push (make-one-label time (+ firstnum count)) labels)) + (when (and (> region 0)(= mode 2)(= adjust 1)) + (push (make-one-label (- (get-duration 1) region) + (+ firstnum totalnum)) + labels)) + ;; Create confirmation message + (when (< verbose 2) + (message totalnum interval)) + labels) -(defun check-number-of-labels () -"Throw error if excessive number of labels ('Interval' mode only)" - (when (> totalnum 1000) - (throw 'err - (format nil ("Too many labels.~%~%~ - Selection length is ~a seconds and~%~ - Label interval is ~a seconds~%~ - giving a total of ~a labels.~%~ - Maximum number of labels from this effect is 1000.~%~ - Please use a shorter selection, or a longer Label interval.") - (formatgg (get-duration 1)) - (formatgg interval) - (if (= adjust 1) - (round (/ (get-duration 1) interval)) - (1+ (round (/ (get-duration 1) interval)))))))) -(defun get-interval-count () +(defun message (number interval) +"Generate output message in debug window." + (if (> region interval) + (setf msg (format nil (_ "Warning: Overlapping region labels.~%"))) + (setf msg "")) + (cond + ((= verbose 1) ;Warnings only + (format t msg)) + (t (if (> region 0) + ;i18n-hint: Type of label + (setf labeltype (_ "region labels")) + (setf labeltype (_ "point labels"))) + (when (and (> region 0)(= mode 2)(= adjust 1)) + (setf number (1+ number))) + (setf msg + ;i18n-hint: Number of labels produced at specified intervals. + (format nil (_ "~a~a ~a at intervals of ~a seconds.~%") + msg number labeltype interval)) + (if (> region 0) + (format t (_ "~aRegion length = ~a seconds.") + msg region) + (format t msg))))) + + +(defun get-interval-count (&aux dur) "Number of labels when interval is specified" + (setf dur (- (get-duration 1) region)) (case adjust ;; Interval is user input value - (0 (let ((n (truncate (/ (get-duration 1) interval)))) - (if (< (* n interval)(get-duration 1)) + (0 (let ((n (truncate (/ dur interval)))) + (if (< (* n interval) dur) (1+ n) n))) ;; Adjust interval to fit length - (1 (let* ((min-num (truncate (/ (get-duration 1) interval))) + (1 (let* ((min-num (truncate (/ dur interval))) (max-num (1+ min-num))) (if (and (> min-num 0) - (< (abs (- interval (/ (get-duration 1) min-num))) - (abs (- interval (/ (get-duration 1) max-num))))) + (< (abs (- interval (/ dur min-num))) + (abs (- interval (/ dur max-num))))) min-num max-num))))) + (defun make-one-label (time num) "Make a single label" (let* ((num-text (format nil "~a" num)) @@ -104,28 +129,14 @@ $control firstnum (_ "Begin numbering from") int-text "" 1 0 nil (if num-before-text (setf text (format nil "~a~a" num-text labeltext)) (setf text (format nil "~a~a" labeltext num-text))) - (list time text))) + (list time (+ time region) text))) (defun lasttrackp () -"true when processing the final selected track" +"True when processing the final selected track" (let ((index (get '*track* 'index)) (num (length (get '*selection* 'tracks)))) (= index num))) -(defun formatgg (num) -"Similar to float-format %g but more decimal places" - (cond - ((/= num (truncate num)) ; not integer - (setf *float-format* "%.5f") - (let ((numtxt (format nil "~a" num))) - (do* ((i (1- (length numtxt)) (1- i)) - (ch (char numtxt i)(char numtxt i))) - ((char/= ch #\0)) - (setf numtxt (subseq numtxt 0 i))) - (setf *float-format* "%g") - numtxt)) - (t num))) - (setf num-before-text (<= zeros 3)) (setf zeros (1+ (rem (1- zeros) 3))) @@ -133,5 +144,5 @@ $control firstnum (_ "Begin numbering from") int-text "" 1 0 nil ;; Analyze plug-ins may return text message per track but ;; we only want error messages once, and only one set of labels. (if (lasttrackp) - (catch 'err (make-labels)) - nil) + (make-labels) + "") ;No-op