1$nyquist plug-in 2$version 4 3$type analyze 4;i18n-hint: Name of effect that labels sounds 5$name (_ "Label Sounds") 6$manpage "Label_Sounds" 7$debugbutton false 8;; As this is a new plug-in (Jan2021), display errors if they occur. 9$debugflags trace 10$author (_ "Steve Daulton") 11$release 3.0.4 12$copyright (_ "GNU General Public License v2.0 or later") 13 14;; Released under terms of the GNU General Public License v2.0 or later: 15;; http://www.gnu.org/licenses/old-licenses/gpl-2.0.html 16;; 17;; For information about writing and modifying Nyquist plug-ins: 18;; https://wiki.audacityteam.org/wiki/Nyquist_Plug-ins_Reference 19 20 21$control threshold (_ "Threshold level (dB)") float "" -30 -100 0 22$control measurement (_ "Threshold measurement") choice (("peak" (_ "Peak level")) 23 ("avg" (_ "Average level")) 24 ("rms" (_ "RMS level"))) 0 25$control sil-dur (_ "Minimum silence duration") time "" 1 0.01 3600 26$control snd-dur (_ "Minimum label interval") time "" 1 0.01 7200 27$control type (_ "Label type") choice (("before" (_ "Point before sound")) 28 ("after" (_ "Point after sound")) 29 ("around" (_ "Region around sounds")) 30 ("between" (_ "Region between sounds"))) 2 31$control pre-offset (_ "Maximum leading silence") time "" 0 0 nil 32$control post-offset (_ "Maximum trailing silence") time "" 0 0 nil 33;i18n-hint: Do not translate '##1' 34$control text (_ "Label text") string "" (_ "Sound ##1") 35 36 37(setf threshold (db-to-linear threshold)) 38(setf max-labels 10000) ;max number of labels to return 39 40(defun format-time (s) 41 ;;; format time in seconds as h m s. 42 ;;; (Only used for error message if selection > 2^31 samples.) 43 (let* ((hh (truncate (/ s 3600))) 44 (mm (truncate (/ s 60)))) 45 ;i18n-hint: hours minutes and seconds. Do not translate "~a". 46 (format nil (_ "~ah ~am ~as") 47 hh (- mm (* hh 60)) (rem (truncate s) 60)))) 48 49(defun parse-label-text (txt) 50 ;;; Special character '#' represents an incremental digit. 51 ;;; Return '(digits num pre-txt post-txt) for 52 ;;; (number-of-digits, initial-value, text-before-number, text-after-number), 53 ;;; or NIL. 54 ;;; 'initial-value' is a positive integer or zero (default). 55 ;;; Only the first instance of #'s are considered 'special'. 56 (let ((hashes 0) 57 (num nil) 58 (negative nil) 59 (pre-txt "") 60 (post-txt "") 61 ch) 62 (dotimes (i (length txt)) 63 (setf ch (char txt i)) 64 (cond 65 ((and (string= post-txt "") (char= ch #\#)) 66 (incf hashes)) 67 ((and (> hashes 0) (string= post-txt "")) 68 (cond 69 ((digit-char-p ch) 70 (if num 71 (setf num (+ (* num 10) (digit-char-p ch))) 72 (setf num (digit-char-p ch)))) 73 ((and (not num)(char= ch #\-)) 74 (setf negative t)) 75 (t (setf post-txt (string ch))))) 76 ((= hashes 0) ;special '#' not yet found 77 (string-append pre-txt (string ch))) 78 (t ;run out of #'s and digit characters. 79 (string-append post-txt (string ch))))) 80 (when negative 81 (setf num (- num))) 82 ;; Replace string literal hash characters. 83 (when (and (> hashes 0) (not num)) 84 (dotimes (i hashes) 85 (string-append pre-txt "#"))) 86 (list hashes num pre-txt post-txt))) 87 88(defun pad (n d) 89 ;;; Return string, int 'n' padded to 'd' digits, or empty string. 90 ;;; Used in formatting label text. 91 (cond 92 (n 93 (let ((negative (minusp n)) 94 (n (format nil "~a" (abs n)))) 95 (while (< (length n) d) 96 (setf n (format nil "0~a" n))) 97 (if negative 98 (format nil "-~a" n) 99 n))) 100 (t ""))) 101 102(defun to-mono (sig) 103 ;;; Coerce sig to mono. 104 (if (arrayp sig) 105 (s-max (s-abs (aref sig 0)) 106 (s-abs (aref sig 1))) 107 sig)) 108 109(defun to-avg-mono (sig) 110 ;;; Average of stereo channels 111 (if (arrayp sig) 112 (mult 0.5 (sum (aref sig 0)(aref sig 1))) 113 sig)) 114 115(defun reduce-srate (sig) 116 ;;; Reduce sample rate to (about) 100 Hz. 117 (let ((ratio (round (/ *sound-srate* 100)))) 118 (cond 119 ((= measurement 0) ;Peak 120 (let ((sig (to-mono sig))) 121 (snd-avg sig ratio ratio OP-PEAK))) 122 ((= measurement 1) ;Average absolute level 123 (let ((sig (to-avg-mono (s-abs sig)))) 124 (snd-avg sig ratio ratio OP-AVERAGE))) 125 (t ;RMS 126 (if (arrayp sig) 127 ;; Stereo RMS is the root mean of all (samples ^ 2) [both channels] 128 (let* ((sig (mult sig sig)) 129 (left-mean-sq (snd-avg (aref sig 0) ratio ratio OP-AVERAGE)) 130 (right-mean-sq (snd-avg (aref sig 1) ratio ratio OP-AVERAGE))) 131 (s-sqrt (mult 0.5 (sum left-mean-sq right-mean-sq)))) 132 (rms sig)))))) 133 134(defun find-sounds (sig selection-start srate) 135 ;;; Return a list of sounds that are at least 'snd-dur' long, 136 ;;; separated by silences of at least 'sil-dur'. 137 (let ((snd-list ()) 138 (sample-count 0) 139 (sil-count 0) 140 (snd-count 0) 141 (snd-start 0) 142 (label-count 0) 143 ;convert min sound duration to samples 144 (snd-dur (* snd-dur srate)) 145 (sil-dur (* sil-dur srate))) 146 ;;Ignore samples before time = 0 147 (when (< selection-start 0) 148 (setf sample-count (truncate (* (abs selection-start) srate))) 149 (dotimes (i sample-count) 150 (snd-fetch sig))) 151 ;;Main loop to find sounds. 152 (do ((val (snd-fetch sig) (snd-fetch sig))) 153 ((not val) snd-list) 154 (cond 155 ((< val threshold) 156 (when (and (>= sil-count sil-dur)(>= snd-count snd-dur)) 157 ;convert sample counts to seconds and push to list. 158 (push (list (/ snd-start srate) 159 (/ (- sample-count sil-count) srate)) 160 snd-list) 161 (incf label-count) 162 (when (= label-count max-labels) 163 (format t (_ "Too many silences detected.~%Only the first 10000 labels added.")) 164 (return-from find-sounds snd-list)) 165 (setf snd-count 0)) ;Pushed to list, so reset sound sample counter. 166 (when (> snd-count 0) ;Sound is shorter than snd-dur, so keep counting. 167 (incf snd-count)) 168 (incf sil-count)) 169 ;; Above threshold. 170 (t (when (= snd-count 0) ;previous sound was push, so this is a new sound. 171 (setf snd-start sample-count)) 172 (setf sil-count 0) 173 (incf snd-count))) 174 (incf sample-count)) 175 ;; Check for final sound 176 (when (> snd-count 0) 177 (push (list (/ snd-start srate) 178 (/ (- sample-count sil-count) srate)) 179 snd-list)) 180 snd-list)) 181 182 183(defun return-labels (snd-list) 184 (setf text (parse-label-text text)) 185 ; Selection may extend before t=0 186 ; Find t=0 relative to selection so we can ensure 187 ; that we don't create hidden labels. 188 (setf t0 (- (get '*selection* 'start))) 189 (setf t1 (- (get '*selection* 'end))) 190 (let ((label-start t0) 191 (label-end t1) 192 (label-text "") 193 (labels ()) 194 (final-sound (if (= type 3) 1 0)) ;type 3 = regions between sounds. 195 ;; Assign variable to parsed label text 196 (digits (first text)) 197 (num (second text)) 198 (pre-txt (third text)) 199 (post-txt (fourth text))) 200 ;snd-list is in reverse chronological order 201 (do ((i (1- (length snd-list)) (1- i))) 202 ((< i final-sound) labels) 203 (case type 204 (3 ;;label silences. 205 (setf start-time (second (nth i snd-list))) 206 (setf end-time (first (nth (1- i) snd-list))) 207 ;don't overlap next sound 208 (setf label-start (min end-time (+ start-time pre-offset))) 209 ;don't overlap previous sound 210 (setf label-end (max start-time (- end-time post-offset))) 211 ;ensure end is not before start 212 (when (< (- label-end label-start) 0) 213 (setf label-start (/ (+ label-end label-start) 2.0)) 214 (setf label-end label-start))) 215 (t ;; labelling sounds 216 (setf start-time (first (nth i snd-list))) 217 (setf end-time (second (nth i snd-list))) 218 ;don't overlap t0 or previous sound. 219 (setf label-start (max t0 label-start (- start-time pre-offset))) 220 (setf label-end (+ end-time post-offset)) 221 ;; Don't overlap following sounds. 222 (when (> i 0) 223 (setf label-end (min label-end (first (nth (1- i) snd-list))))))) 224 (setf label-text (format nil "~a~a~a" 225 pre-txt 226 (pad num digits) 227 post-txt)) 228 (case type 229 (0 (push (list label-start label-text) labels)) ;point label before sound 230 (1 (push (list label-end label-text) labels)) ;point label after sound 231 (2 (push (list label-start label-end label-text) labels)) ;sound region 232 (t (push (list label-start label-end label-text) labels)));silent region 233 ;Earliest allowed start time for next label. 234 (setf label-start end-time) 235 ;num is either an int or nil 236 (when num (incf num))))) 237 238 239;; Bug 2352: Throw error if selection too long for Nyquist. 240(let* ((sel-start (get '*selection* 'start)) 241 (sel-end (get '*selection* 'end)) 242 (dur (- sel-end sel-start)) 243 (samples (* dur *sound-srate*)) 244 (max-samples (1- (power 2 31)))) 245 (if (>= samples max-samples) 246 ;i18n-hint: '~a' will be replaced by a time duration 247 (format nil (_ "Error.~%Selection must be less than ~a.") 248 (format-time (/ max-samples *sound-srate*))) 249 ;; Selection OK, so run the analyzer. 250 (let ((sig (reduce-srate *track*))) 251 (setf *track* nil) 252 (setf snd-list (find-sounds sig sel-start (snd-srate sig))) 253 (cond 254 ((= (length snd-list) 0) 255 (format nil (_ "No sounds found.~%Try lowering the 'Threshold' or reduce 'Minimum sound duration'."))) 256 ((and (= type 3) (= (length snd-list) 1)) 257 (format nil (_ "Labelling regions between sounds requires~%at least two sounds.~%Only one sound detected."))) 258 (t 259 (return-labels snd-list)))))) 260