mirror of
				https://github.com/cookiengineer/audacity
				synced 2025-11-04 08:04:06 +01:00 
			
		
		
		
	
		
			
				
	
	
		
			382 lines
		
	
	
		
			12 KiB
		
	
	
	
		
			Common Lisp
		
	
	
	
	
	
			
		
		
	
	
			382 lines
		
	
	
		
			12 KiB
		
	
	
	
		
			Common Lisp
		
	
	
	
	
	
$nyquist plug-in
 | 
						|
$version 4
 | 
						|
$type generate
 | 
						|
$name (_ "Rhythm Track")
 | 
						|
$manpage "Rhythm_Track"
 | 
						|
$preview linear
 | 
						|
$action (_ "Generating Rhythm...")
 | 
						|
$author (_ "Dominic Mazzoni")
 | 
						|
$copyright (_ "Released under terms of the GNU General Public License version 2")
 | 
						|
 | 
						|
;; by Dominic Mazzoni, David R. Sky and Steve Daulton.
 | 
						|
;; Drip sound generator by Paul Beach
 | 
						|
 | 
						|
;; 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 action (_ "Action choice") choice (
 | 
						|
   ("Generate" (_ "Generate Track"))
 | 
						|
   ("Help1" (_ "Help Screen 1"))
 | 
						|
   ("Help2" (_ "Help Screen 2"))
 | 
						|
) 0
 | 
						|
$control tempo (_ "Tempo (beats per minute)") real (_ "30 - 300 beats/minute") 120 30 300
 | 
						|
$control timesig (_ "Beats per measure (bar)") int (_ "1 - 20 beats/measure") 4 1 20
 | 
						|
$control swing (_ "Swing amount") float (_ "+/- 1") 0 -1 1
 | 
						|
$control measures (_ "Number of measures (bars)") int (_ "1 - 1000 bars") 16 1 1000
 | 
						|
$control click-track-dur (_ "Optional rhythm track duration (minutes seconds)") string (_ "Whole numbers only") ""  
 | 
						|
 | 
						|
;;control ticklen "Individual beat duration (milliseconds)" int "1 - 100 ms" 10 1 100
 | 
						|
 | 
						|
$control offset (_ "Start time offset (seconds)") real (_ "0 - 30 seconds") 0 0 30
 | 
						|
$control click-type (_ "Beat sound") choice (
 | 
						|
   ("Metronome" (_ "Metronome Tick"))
 | 
						|
   (_ "Ping")
 | 
						|
   (_ "Cowbell")
 | 
						|
   ("ResonantNoise" (_ "Resonant Noise"))
 | 
						|
   ("NoiseClick" (_ "Noise Click"))
 | 
						|
   (_ "Drip")
 | 
						|
) 0
 | 
						|
 | 
						|
;;control q "Noise click resonance - discernable pitch (q)" int "1 - 20" 1 1 20
 | 
						|
 | 
						|
$control high (_ "MIDI pitch of strong beat") int (_ "18 - 116") 84 18 116
 | 
						|
$control low (_ "MIDI pitch of weak beat") int (_ "18 - 116") 80 18 116
 | 
						|
 | 
						|
;; allow q control to be commented out.
 | 
						|
(if (not (boundp 'q))
 | 
						|
    (setf q 10))
 | 
						|
 | 
						|
;; allow ticklen control to be commented out.
 | 
						|
(if (not (boundp 'ticklen))
 | 
						|
    (setf ticklen 10))
 | 
						|
 | 
						|
;; TODO: Hard code tick length (long and short versions)
 | 
						|
;; TODO: add drum sounds
 | 
						|
 | 
						|
 | 
						|
(defun help1 ()
 | 
						|
  (format nil
 | 
						|
(_ "Rhythm Track Generator help - screen 1 of 2
 | 
						|
 | 
						|
Generates a rhythm track at the selected tempo, beats per
 | 
						|
measure, and either number of measures or track duration,
 | 
						|
using the selected sound.
 | 
						|
 | 
						|
'Tempo': number of beats (clicks) per minute.
 | 
						|
 | 
						|
'Beats per measure (bar)': For example, 3/4 time means one
 | 
						|
strong beat then two others to form one bar, repeated
 | 
						|
depending on 'number of measures' or 'rhythm track duration'.
 | 
						|
 | 
						|
'Swing amount': When set to a non-zero amount, alternate
 | 
						|
beats are delayed or advanced to give a swing feel. At
 | 
						|
maximum / minimum settings the rhythm plays with triplet timing.
 | 
						|
 | 
						|
'Optional rhythm track duration': If you enter a value into this
 | 
						|
field, either (minutes seconds - separated by a space), or
 | 
						|
(seconds), the generated rhythm track will be at or slightly
 | 
						|
longer than this duration: the end of the track is extended
 | 
						|
into a whole measure if the entered duration does not
 | 
						|
produce this. Use whole numbers only.
 | 
						|
 | 
						|
If you enter a value into this field, the 'number of measures'
 | 
						|
value will be ignored.
 | 
						|
 | 
						|
To generate rhythm track or view help screen 2,
 | 
						|
restart Rhythm Track and select from 'Action choice'."))) ;end of help1
 | 
						|
 | 
						|
 | 
						|
(defun help2 ()
 | 
						|
  (format nil
 | 
						|
(_ "Rhythm Track Generator help - screen 2 of 2
 | 
						|
 | 
						|
'Start time offset': makes the rhythm track start at a later
 | 
						|
time than the very beginning (zero seconds), maximum
 | 
						|
of 30 seconds.
 | 
						|
 | 
						|
'Beat sound': choose which sound to use for the beats.
 | 
						|
 | 
						|
'MIDI pitch of strong/weak beat': MIDI values indicate
 | 
						|
what pitch to use. C-notes are:
 | 
						|
 | 
						|
24, 36, 48, 60 (middle C), 72, 84, 96, 108.
 | 
						|
C# (C-sharp) above middle C is 61.
 | 
						|
 | 
						|
To generate rhythm track or view help screen 1,
 | 
						|
restart Rhythm Track and select from 'Action choice'."))) ;end of help 2
 | 
						|
 | 
						|
 | 
						|
;Check function: returns 1 on error
 | 
						|
;min and max are allowable min and max values for arg
 | 
						|
(defun check (arg min max)
 | 
						|
  (if (and (>= arg min) (<= arg max)) 0 1))
 | 
						|
 | 
						|
 | 
						|
;Function to convert a string into a list
 | 
						|
(defun string-to-list (string)
 | 
						|
  (read (make-string-input-stream (format nil "(~a)" string))))
 | 
						|
 | 
						|
 | 
						|
(defun round-up (x)
 | 
						|
  (if (> x (truncate x))
 | 
						|
    (truncate (1+ x))
 | 
						|
    (truncate x)))
 | 
						|
 | 
						|
 | 
						|
(defun m-s-to-seconds (mslist)
 | 
						|
  (if (= (length mslist) 1)
 | 
						|
    ;just seconds
 | 
						|
    (first mslist)
 | 
						|
    ;minutes and seconds
 | 
						|
    (+ (* 60 (first mslist))(second mslist))))
 | 
						|
 | 
						|
 | 
						|
;Function to generate drip sound clicks
 | 
						|
;code by Paul Beach www.proviewlandscape.com/liss/
 | 
						|
;stretch-abs function makes this sound more like 'tick' sounds.
 | 
						|
;limit hz to nyquist frequency.
 | 
						|
(defun drip (p) ;p is pitch in hz
 | 
						|
  (let* ((maxhz (/ *sound-srate* 2.1))
 | 
						|
        (hz1 (min maxhz (* 2.40483  p)))
 | 
						|
        (hz2 (min maxhz (* 5.52008  p)))
 | 
						|
        (hz3 (min maxhz (* 8.653  p)))
 | 
						|
        (hz4 (min maxhz (* 11.8  p))))
 | 
						|
    (lp 
 | 
						|
      (stretch-abs 1
 | 
						|
        (mult (exp-dec 0 0.015 0.25) 
 | 
						|
          (sim
 | 
						|
            (mult (hzosc hz1) 0.5)
 | 
						|
            (mult (hzosc hz2)  0.25)
 | 
						|
            (mult (hzosc hz3)  0.125)
 | 
						|
            (mult (hzosc hz4)  0.0625))))
 | 
						|
    440)))
 | 
						|
 | 
						|
 | 
						|
;Function used to normalize noise and tick clicks
 | 
						|
;this function is necessary because filtering 
 | 
						|
;changes amplitude of filtered noise clicks
 | 
						|
(defun normalize (sound)
 | 
						|
  (scale (/ (peak sound ny:all)) sound))
 | 
						|
 | 
						|
 | 
						|
;; Error Checking
 | 
						|
(defun errorcheck ()
 | 
						|
  ; tempo
 | 
						|
  (if (= (check tempo 30 300) 1)
 | 
						|
    (setq error-msg (strcat error-msg (format nil
 | 
						|
(_ "Tempo ~a outside valid range 30 to 300 bpm
 | 
						|
") tempo))))
 | 
						|
 | 
						|
  ;beats per measure
 | 
						|
  (if (= (check timesig 1 20) 1)
 | 
						|
    (setq error-msg (strcat error-msg (format nil
 | 
						|
(_ "Beats per measure ~a outside valid range 1 to 20
 | 
						|
") timesig))))
 | 
						|
 | 
						|
  ;number of measures
 | 
						|
  (if (= (check measures 1 1000) 1)
 | 
						|
    (setq error-msg (strcat error-msg (format nil
 | 
						|
(_ "Number of measures ~a outside valid range 1 to 1000
 | 
						|
") measures))))
 | 
						|
 | 
						|
  ;time start offset
 | 
						|
  (if (= (check offset 0 30) 1)
 | 
						|
    (setq error-msg (strcat error-msg (format nil
 | 
						|
(_ "Time offset ~a outside valid range 0 to 30 seconds
 | 
						|
") offset))))
 | 
						|
 | 
						|
  ; q
 | 
						|
  (if (= (check q 1 20) 1)
 | 
						|
    (setq error-msg (strcat error-msg (format nil
 | 
						|
(_ "Filter quality q ~a outside valid range 1 to 20
 | 
						|
") q))))
 | 
						|
 | 
						|
  ;high MIDI pitch
 | 
						|
  (if (= (check high 18 116) 1)
 | 
						|
    (setq error-msg (strcat error-msg (format nil
 | 
						|
(_ "High MIDI pitch ~a outside valid range 18 to 116
 | 
						|
") high))))
 | 
						|
 | 
						|
  ;low MIDI pitch
 | 
						|
  (if (= (check low 18 116) 1)
 | 
						|
    (setq error-msg (strcat error-msg (format nil
 | 
						|
(_ "Low MIDI pitch ~a outside valid range 18 to 116
 | 
						|
") low))))
 | 
						|
 | 
						|
  ;validate string
 | 
						|
  (if (> (length m-s) 0) ;if at least one item
 | 
						|
    (cond
 | 
						|
      ((or 
 | 
						|
        (> (length m-s) 2) ;there are more than 2 items or
 | 
						|
        (not (integerp (first m-s))) ;first is not an integer or
 | 
						|
        (and (= (length m-s) 2)(not (integerp (second m-s))))) ;second is not an integer
 | 
						|
      (setq error-msg (strcat error-msg (format nil 
 | 
						|
(_ "If used, 'Optional rhythm track duration' must be 
 | 
						|
entered as either one number (seconds), or two 
 | 
						|
numbers (minutes seconds) separated by a space.
 | 
						|
Use whole numbers only.~%")))))
 | 
						|
      ;one or two integers
 | 
						|
      ((and 
 | 
						|
          (= (length m-s) 1) ;one integer and
 | 
						|
          (= (check (first m-s) 0 3660) 1)) ;outside valid range
 | 
						|
        (setq error-msg (strcat error-msg (format nil 
 | 
						|
(_ "~a seconds is outside valid range 0 to 3660~%") (first m-s)))))
 | 
						|
      ;one or two integers
 | 
						|
      ((and
 | 
						|
        (= (length m-s) 2) ;2 integers and
 | 
						|
        (or
 | 
						|
          (= (check (first m-s) 0 60) 1) ;1st is outside valid range or
 | 
						|
          (= (check (second m-s) 0 59) 1))) ;2nd is outside valid range or
 | 
						|
        (setq error-msg (strcat error-msg (format nil 
 | 
						|
(_ "~a is outside valid range 0 to (60 59)~%")
 | 
						|
    m-s))))))) ;end of error checking
 | 
						|
 | 
						|
(defun metronome-tick (hz peak)
 | 
						|
  (let* ((ln 300)
 | 
						|
         (sig-array (make-array ln))
 | 
						|
         (x 1))
 | 
						|
    ;; generate some 'predictable' white noise
 | 
						|
    (dotimes (i ln)
 | 
						|
      (setf x (rem (* 479 x) 997))
 | 
						|
      (setf (aref sig-array i) (- (/ x 500.0) 1)))
 | 
						|
    (setf sig (sim (s-rest-abs 0.2)
 | 
						|
                   (snd-from-array 0 44100 sig-array)))
 | 
						|
    (setf sig
 | 
						|
      (mult (abs-env (pwev 10 (/ ln 44100.0) 2 1 0))
 | 
						|
            (highpass8  (lowpass2 sig (* 2 hz) 6)
 | 
						|
                        hz)))
 | 
						|
    (let ((gain (/ (peak sig 300))))
 | 
						|
      ; The '1.11' factor makes up for gain reduction in 'resample'
 | 
						|
      (mult (abs-env (pwlv 1.11 0.02 1.11 0.05 0 ))
 | 
						|
        (jcrev (mult peak gain sig) 0.01 0.1)))))
 | 
						|
 | 
						|
(defun s-rest-abs (d)
 | 
						|
  (abs-env (s-rest d)))
 | 
						|
 | 
						|
(defun cowbell (hz)
 | 
						|
  (sim
 | 
						|
    (mult (pwev 0.3 0.8 0.0005)
 | 
						|
          (hzosc hz *tri-table*)
 | 
						|
          (hzosc (* hz 3.46) *tri-table*))
 | 
						|
    (mult (pwev 0.7 0.2 0.01)
 | 
						|
          (hzosc (* hz 7.3) *tri-table*)
 | 
						|
          (hzosc (* hz 1.52) *tri-table*))))
 | 
						|
 | 
						|
 | 
						|
(defun get-metronome-tick (hz gain)
 | 
						|
  (resample
 | 
						|
    (sound-srate-abs 44100 (metronome-tick hz gain))
 | 
						|
    *sound-srate*))
 | 
						|
 | 
						|
(defun get-ping (pitch)
 | 
						|
  (stretch-abs ticklen
 | 
						|
    (mult
 | 
						|
      (control-srate-abs *sound-srate* (pwl 0.005 amp 0.995 amp 1))
 | 
						|
      (osc pitch))))
 | 
						|
 | 
						|
(defun get-resonant-noise (pitch)
 | 
						|
  (stretch-abs 0.05 ; 50 milliseconds
 | 
						|
    (mult
 | 
						|
      (control-srate-abs *sound-srate* (pwl 0.05 amp 0.95 amp 1))
 | 
						|
      (normalize (lowpass2 (noise 1) (step-to-hz pitch) 20)))))
 | 
						|
 | 
						|
(defun get-noise-click (pitch)
 | 
						|
  (stretch-abs 0.005
 | 
						|
    (mult
 | 
						|
      (control-srate-abs *sound-srate* (pwl 0.005 amp 0.995 amp 1))
 | 
						|
      (normalize (lowpass2 (noise 1) (step-to-hz pitch) 2)))))
 | 
						|
 | 
						|
(defun get-drip (pitch)
 | 
						|
  (stretch-abs ticklen
 | 
						|
    (mult
 | 
						|
      (control-srate-abs *sound-srate* (pwl 0.005 amp 0.995 amp 1))
 | 
						|
      (normalize (drip (step-to-hz pitch))))))
 | 
						|
 | 
						|
(defun get-cowbell (pitch)
 | 
						|
  (mult 0.8 (cowbell (step-to-hz pitch))))
 | 
						|
 | 
						|
;Function to make click
 | 
						|
(defun click (type accent)
 | 
						|
  (setq pitch (if (= accent 1) high low))
 | 
						|
  (setq amp (if (= accent 1) 0.75 0.5))
 | 
						|
  (case type
 | 
						|
    (0 (get-metronome-tick (step-to-hz pitch) amp))
 | 
						|
    (1 (get-ping pitch))
 | 
						|
    (2 (get-cowbell pitch))
 | 
						|
    (3 (get-resonant-noise pitch))
 | 
						|
    (4 (get-noise-click pitch))
 | 
						|
    (t (get-drip pitch))))
 | 
						|
 | 
						|
 | 
						|
(defun swing-adjust (i val)
 | 
						|
  (* val (/ 3.0) (rem (1+ i) 2)))
 | 
						|
 | 
						|
;Function to make one measure and save it in the global *measure*
 | 
						|
(defun makemeasure ()
 | 
						|
  (setf *measure*
 | 
						|
    (sim
 | 
						|
      (s-rest (* timesig beatlen)) ;required for trailing silence
 | 
						|
      (click click-type 1) ;accented beat
 | 
						|
      (simrep (x (- timesig 1))
 | 
						|
        (at-abs (* beatlen (+ x 1 (swing-adjust x swing)))
 | 
						|
            (cue (click click-type 0))))))) ;unaccented beat
 | 
						|
        
 | 
						|
 | 
						|
(defun make-click-track (measures mdur)
 | 
						|
  (setf *measure* (set-logical-stop (cue *measure*) (* timesig beatlen)))
 | 
						|
  (seqrep (i measures) (cue *measure*)))
 | 
						|
 | 
						|
 | 
						|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 | 
						|
;; START MAIN PROGRAM
 | 
						|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 | 
						|
      
 | 
						|
;view 1 of 2 help screens, or generate rhythm track
 | 
						|
(cond ;'master' cond
 | 
						|
  ((= action 1)(help1)); display help screen 1
 | 
						|
  ((= action 2)(help2)) ; display help screen 2
 | 
						|
  (t ;Run Program
 | 
						|
    (setq len (/ (* 60.0 *sound-srate* timesig measures) tempo))
 | 
						|
    (setq error-msg "") ;initialize error-msg	
 | 
						|
    
 | 
						|
    ;convert minutes-seconds string to a list
 | 
						|
    ;for example, "4 30" becomes (4 30)
 | 
						|
    (setf m-s (string-to-list click-track-dur))
 | 
						|
 | 
						|
    ;run error checks on input values
 | 
						|
    (errorcheck)
 | 
						|
 | 
						|
    (if (= (length error-msg) 0) ;if no errors, generate Rhythm Track
 | 
						|
      (progn
 | 
						|
        ; duration of 1 beat, originally statically 0.01 s
 | 
						|
        (setf ticklen (* (max 1 (min 100 ticklen)) 0.001))
 | 
						|
        (setf beatlen (/ 60.0 tempo))
 | 
						|
        
 | 
						|
        ;call function to make one measure
 | 
						|
        (makemeasure)
 | 
						|
    
 | 
						|
        ;calculate measures from text input (if used)
 | 
						|
        (if m-s (setq measures 
 | 
						|
          (/ (m-s-to-seconds m-s)(* timesig beatlen))))
 | 
						|
 | 
						|
        ;if previewing, restrict number of measures
 | 
						|
        (let ((preview (/ (get '*project* 'preview-duration)
 | 
						|
                          (* timesig beatlen))))
 | 
						|
          (if (not (get '*track* 'view))  ;NIL if preview
 | 
						|
              (setq measures (min preview measures))))
 | 
						|
 | 
						|
        ;round up number of measures
 | 
						|
        (setq measures (round-up measures))
 | 
						|
 | 
						|
        ;add time offset and beatlen of silence to rhythm track,
 | 
						|
        (seq 
 | 
						|
          (s-rest offset)    ;offset
 | 
						|
          (make-click-track measures (* timesig beatlen)))) ;click track
 | 
						|
      ;Else error message
 | 
						|
      (setq error-msg (strcat (format nil
 | 
						|
(_ "Error.~%You have entered at least one invalid value:~%~%")) error-msg)))))
 |