1
0
mirror of https://github.com/cookiengineer/audacity synced 2026-01-12 15:45:54 +01:00

Refactor equalabel.ny to allow longer intervals

Increase maximum interval to 1 hour (also simplifies the code).
This commit is contained in:
Steve Daulton
2016-01-12 12:57:23 +00:00
parent c5943413b9
commit 2b403f158a

View File

@@ -15,75 +15,65 @@
;; This version by Steve Daulton (http://easyspacepro.com) 2016 ;; This version by Steve Daulton (http://easyspacepro.com) 2016
;control mode "Use 'Number of labels' OR 'Label interval'" choice "Number of Labels,Label Interval" 0 ;control mode "Use 'Number of labels' OR 'Label interval'" choice "Number of Labels,Label Interval" 0
;control number "Number of labels" int-text "" 10 1 1000 ;control totalnum "Number of labels" int-text "" 10 1 1000
;control interval "Label interval (seconds)" float-text "" 60 0.001 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 adjust "Adjust label interval to fit length" choice "No,Yes" 0
;control labeltext "Label text" string "" "Label" "" ;control labeltext "Label text" string "" "Label" ""
;control zeros "Minimum number of digits in label" choice "None - text only,1 (before label),2 (before label),3 (before label),1 (after label),2 (after label),3 (after label)" 2 ;control zeros "Minimum number of digits in label" choice "None - text only,1 (before label),2 (before label),3 (before label),1 (after label),2 (after label),3 (after label)" 2
;control labelnum "Begin numbering from" int-text "" 1 0 nil ;control firstnum "Begin numbering from" int-text "" 1 0 nil
(defun make-labels () (defun make-labels ()
(when (and (= mode 1)(= adjust 1)) ;adjust interval to fit "Generate labels at regular intervals"
(setf interval (get-interval))) (setf labels ())
(validate) ;; Get parameters
(let ((labels ())) (case mode
(cond (0 ;Number of Labels
((= mode 0) ;number of labels (setf interval (/ (get-duration 1) totalnum)))
(setf interval (/ (get-duration 1) number)) (1 (setf totalnum (get-interval-count))
(do* ((i 0 (1+ i)) (when (= adjust 1)
(labelnum labelnum (1+ labelnum))) (setf interval (/ (get-duration 1) totalnum)))
((= i number)) (check-number-of-labels)))
(push (make-label (* i interval) labelnum) labels)) ;; Loop for required number of labels
;print what we've done to debug window (do* ((count 0 (1+ count))
(if (= number 1) (time 0 (* count interval)))
(format t "1 label requested.") ((= count totalnum) labels)
(format t "~a labels at intervals of ~a seconds." (push (make-one-label time (+ firstnum count)) labels)))
number interval)))
(t
(setf counter 0)
(do* ((i 0 (1+ i))
(labelnum labelnum (1+ labelnum))
(time 0 (* i interval)))
((>= (round-to-sample time) (get-duration 1)))
(incf counter)
(push (make-label time labelnum) labels))
;print what we've done to debug window
(if (and (= adjust 0)(/= (* counter interval)(get-duration 1)))
(if (= counter 1)
(format t "1 label requested.")
(format t "~a labels at regular intervals of ~a seconds.~%~
Final label at ~a seconds from end of selection."
counter
interval
(- (get-duration 1) (* (1- counter) interval))))
(format t "~a labels at regular intervals of ~a seconds."
counter interval))))
;return labels
labels))
(defun validate () (defun check-number-of-labels ()
(when (= mode 1) ;Label interval "Throw error if excessive number of labels ('Interval' mode only)"
(when (> (get-duration 1) (round-to-sample (* 1000 interval))) (when (> totalnum 1000)
(throw 'err (throw 'err
(format nil "Too many labels.~%~%~ (format nil "Too many labels.~%~%~
Selection length is ~a seconds and~%~ Selection length is ~a seconds and~%~
Label interval is ~a seconds~%~ Label interval is ~a seconds~%~
giving a total of ~a labels.~%~ giving a total of ~a labels.~%~
Maximum number of labels from this effect is 1000.~%~ Maximum number of labels from this effect is 1000.~%~
Please use a shorter selection, or a longer Label interval." Please use a shorter selection, or a longer Label interval."
(trim-trailing-zeros (get-duration 1)) (formatgg (get-duration 1))
(trim-trailing-zeros interval) (formatgg interval)
(if (= adjust 1) (if (= adjust 1)
(round (/ (get-duration 1) interval)) (round (/ (get-duration 1) interval))
(1+ (round (/ (get-duration 1) interval))))))))) (1+ (round (/ (get-duration 1) interval))))))))
(defun round-to-sample (time) (defun get-interval-count ()
"Round time in seconds to nearest sample period." "Number of labels when interval is specified"
(let ((samples (round (* time *sound-srate*)))) (case adjust
(/ samples *sound-srate*))) ;; Interval is user input value
(0 (let ((n (truncate (/ (get-duration 1) interval))))
(if (< (* n interval)(get-duration 1))
(1+ n)
n)))
;; Adjust interval to fit length
(1 (let* ((min-num (truncate (/ (get-duration 1) 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)))))
min-num
max-num)))))
(defun make-label (time num) (defun make-one-label (time num)
"Make a single label" "Make a single label"
(let* ((num-text (format nil "~a" num)) (let* ((num-text (format nil "~a" num))
(non-zero-digits (length num-text))) (non-zero-digits (length num-text)))
@@ -96,26 +86,16 @@
(setf text (format nil "~a~a" labeltext num-text))) (setf text (format nil "~a~a" labeltext num-text)))
(list time text))) (list time text)))
(defun get-interval ()
"Get adjusted interval to fit duration"
(let* ((min-num (truncate (/ (get-duration 1) 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)))))
(/ (get-duration 1) min-num)
(/ (get-duration 1) max-num))))
(defun lasttrackp () (defun lasttrackp ()
"true when processing the final selected track" "true when processing the final selected track"
(let ((index (get '*track* 'index)) (let ((index (get '*track* 'index))
(num (length (get '*selection* 'tracks)))) (num (length (get '*selection* 'tracks))))
(= index num))) (= index num)))
(defun trim-trailing-zeros (num) (defun formatgg (num)
;; sometimes need more precission than "%g". "Similar to float-format %g but more decimal places"
(cond (cond
((/= num (truncate num)) ; not integer ((/= num (truncate num)) ; not integer
(setf *float-format* "%.5f") (setf *float-format* "%.5f")
(let ((numtxt (format nil "~a" num))) (let ((numtxt (format nil "~a" num)))
(do* ((i (1- (length numtxt)) (1- i)) (do* ((i (1- (length numtxt)) (1- i))
@@ -130,9 +110,8 @@
(setf num-before-text (<= zeros 3)) (setf num-before-text (<= zeros 3))
(setf zeros (1+ (rem (1- zeros) 3))) (setf zeros (1+ (rem (1- zeros) 3)))
;; Analyze plug-ins may return text message per track ;; Analyze plug-ins may return text message per track but
;; but we only want error messages once, and we only want ;; we only want error messages once, and only one set of labels.
;; one set of labels.
(if (lasttrackp) (if (lasttrackp)
(catch 'err (make-labels)) (catch 'err (make-labels))
nil) nil)