mirror of
https://github.com/cookiengineer/audacity
synced 2025-11-04 08:04:06 +01:00
137 lines
4.8 KiB
Common Lisp
137 lines
4.8 KiB
Common Lisp
$nyquist plug-in
|
|
$version 4
|
|
$type tool
|
|
$name (_ "Regular Interval Labels")
|
|
$manpage "Regular_Interval_Labels"
|
|
$action (_ "Adding equally-spaced labels to the label track...")
|
|
$author (_ "Steve Daulton")
|
|
$copyright (_ "Released under terms of the GNU General Public License version 2")
|
|
|
|
;; 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
|
|
|
|
;; 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:
|
|
;; 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
|
|
$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 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 firstnum (_ "Begin numbering from") int-text "" 1 0 nil
|
|
|
|
|
|
(defun make-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))
|
|
(when (= adjust 1)
|
|
(setf interval (/ (get-duration 1) totalnum)))
|
|
(check-number-of-labels)))
|
|
;; 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)))
|
|
|
|
(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 ()
|
|
"Number of labels when interval is specified"
|
|
(case adjust
|
|
;; 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-one-label (time num)
|
|
"Make a single label"
|
|
(let* ((num-text (format nil "~a" num))
|
|
(non-zero-digits (length num-text)))
|
|
(if (= zeros 0)
|
|
(setf num-text "")
|
|
(dotimes (i (max 0 (- zeros non-zero-digits)))
|
|
(setf num-text (format nil "~a~a" "0" num-text))))
|
|
(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)))
|
|
|
|
(defun lasttrackp ()
|
|
"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)))
|
|
|
|
;; 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)
|