nyquist.lsp

一个音频的可执行程序。可以导入MP3/WAV格式的文件后

;;;
;;;   ###########################################################
;;;   ### NYQUIST-- A Language for Composition and Synthesis. ###
;;;   ###                                                     ###
;;;   ### Copyright (c) 1994 by Roger B. Dannenberg           ###
;;;   ###########################################################
;;;

;;;   
;;;   Modifications for using Nyquist within Audacity
;;;   by Dominic Mazzoni
;;;

(prog ()
   (setq lppp -12.0) (setq lpp -9.0)  (setq lp -6.0)    (setq lmp -3.0)
   (setq lfff 12.0) (setq lff 9.0)  (setq lf 6.0)    (setq lmf 3.0)
   (setq dB0 1.00)  (setq dB1 1.122) (setq dB10 3.1623)

   (setq s 0.25) (setq sd 0.375) (setq st (/ 0.5 3.0))
   (setq i 0.5)  (setq id 0.75)  (setq it (* st 2.0))
   (setq q 1.0)  (setq qd 1.5)   (setq qt (* st 4.0))
   (setq h 2.0)  (setq hd 3.0)   (setq ht (* st 8.0))
   (setq w 4.0)  (setq wd 6.0)   (setq wt (* st 16.0))
)

(if (not (boundp '*A4-Hertz*))
    (setf *A4-Hertz* 440.0))

; next pitch, for initializations below
; 
(defun np () (incf nyq:next-pitch))

(defun set-pitch-names ()
   (setq no-pitch 116.0)
   ; note: 58.0 is A4 - (C0 - 1) = 69 - (12 - 1)
   (setf nyq:next-pitch (- (hz-to-step *A4-Hertz*) 58.0))

   (setf nyq:pitch-names
    '(c0 (cs0 df0) d0 (ds0 ef0) e0 f0 (fs0 gf0) g0 (gs0 af0) a0
      (as0 bf0) b0
      c1 (cs1 df1) d1 (ds1 ef1) e1 f1 (fs1 gf1) g1 (gs1 af1) a1
      (as1 bf1) b1
      c2 (cs2 df2) d2 (ds2 ef2) e2 f2 (fs2 gf2) g2 (gs2 af2) a2
      (as2 bf2) b2
      c3 (cs3 df3) d3 (ds3 ef3) e3 f3 (fs3 gf3) g3 (gs3 af3) a3
      (as3 bf3) b3
      c4 (cs4 df4) d4 (ds4 ef4) e4 f4 (fs4 gf4) g4 (gs4 af4) a4
      (as4 bf4) b4
      c5 (cs5 df5) d5 (ds5 ef5) e5 f5 (fs5 gf5) g5 (gs5 af5) a5
      (as5 bf5) b5
      c6 (cs6 df6) d6 (ds6 ef6) e6 f6 (fs6 gf6) g6 (gs6 af6) a6
      (as6 bf6) b6
      c7 (cs7 df7) d7 (ds7 ef7) e7 f7 (fs7 gf7) g7 (gs7 af7) a7
      (as7 bf7) b7))

   (dolist (p nyq:pitch-names)
     (cond ((atom p) (set p (np)))
       (t (let ((pitch (np)))
        (dolist (s p) (set s pitch)))))))


(set-pitch-names)

(if (not (boundp '*DEFAULT-SOUND-SRATE*))
  (setf *DEFAULT-SOUND-SRATE* 44100.0))
(if (not (boundp '*DEFAULT-CONTROL-SRATE*))
  (setf *DEFAULT-CONTROL-SRATE* 2205.0))

(setf *environment-variables*
      '(*WARP* *SUSTAIN* *START* *LOUD* *TRANSPOSE* 
    *STOP* *CONTROL-SRATE* *SOUND-SRATE*))

(setfn environment-time car)
(setfn environment-stretch cadr)

; ENVIRONMENT-MAP - map virtual time using an environment
;
;(defun environment-map (env tim)
;  (+ (environment-time env)
;     (* (environment-stretch env) tim)))


(defun nyq:the-environment () (mapcar 'eval *environment-variables*))


;; GLOBAL ENVIRONMENT VARIABLES and their startup values:
(defun nyq:environment-init ()
  (setq *WARP*		'(0.0 1.0 nil))
  (setq *LOUD*	0.0)   ; now in dB
  (setq *TRANSPOSE*	0.0)
  (setq *SUSTAIN*	        1.0)
  (setq *START*       MIN-START-TIME)
  (setq *STOP*        MAX-STOP-TIME)
  (setq *CONTROL-SRATE*  *DEFAULT-CONTROL-SRATE*)
  (setq *SOUND-SRATE* *DEFAULT-SOUND-SRATE*)
  t)				; return nothing in particular

(nyq:environment-init)

(defun get-duration (dur)
  (- (local-to-global (* (get-sustain) dur))
     (setf *rslt* (local-to-global 0))))


(defun get-loud ()
  (cond ((numberp *loud*) *loud*)
    ((soundp *loud*)
     (sref *loud* 0))
    (t
     (error (format t "*LOUD* should be a number or sound: ~A" *LOUD*)))))


(defun get-sustain ()
  (cond ((numberp *SUSTAIN*) *SUSTAIN*)
    ((soundp *SUSTAIN*)
     ;(display "get-sustain: lookup " (local-to-global 0) 0))
     (sref *SUSTAIN* 0))
    (t
     (error (format t "*SUSTAIN* should be a number or sound: ~A" *SUSTAIN*)))))


(defun get-tempo ()
  (slope (snd-inverse (get-warp) (local-to-global 0)
              *control-srate*)))

(defun get-transpose ()
  (cond ((numberp *TRANSPOSE*) *TRANSPOSE*)
    ((soundp *TRANSPOSE*)
     ; (display "get-transpose: lookup " 0)
     ; (format t "samples: ~A~%" (snd-samples *TRANSPOSE* 100))
     (sref *TRANSPOSE* 0))
    (t
     (error (format t "*TRANSPOSE* should be a number or sound: ~A" *TRANSPOSE*)))))


(defun get-warp ()
  (let ((f (warp-function *WARP*)))
    (cond ((null f) (error "Null warp function"))
    (t
     (shift-time (scale-srate f (/ (warp-stretch *WARP*)))
             (- (warp-time *WARP*)))))))


;;;;;;;;;;;;;;;;;;;;;;
;; OSCILATORS
;;;;;;;;;;;;;;;;;;;;;;

(defun build-harmonic (n table-size) (snd-sine 0 n table-size 1))

(setf *SINE-TABLE* (list (build-harmonic 1 2048)
             (hz-to-step 1.0)
             T))
(setf *TABLE* *SINE-TABLE*)


;; AMOSC
;;
(defun amosc (pitch modulation &optional (sound *table*) (phase 0.0))
  (let ((modulation-srate (snd-srate modulation))
    (hz (step-to-hz (+ pitch (get-transpose)))))
    (cond ((> *SOUND-SRATE* modulation-srate)
       (setf modulation (snd-up *SOUND-SRATE* modulation)))
      ((< *SOUND-SRATE* modulation-srate)
       (format t "Warning: down-sampling AM modulation in amosc~%")
       (setf modulation (snd-down *SOUND-SRATE* modulation))))
    (cond ((> hz (/ *SOUND-SRATE* 2))
       (format t "Warning: amosc frequency (~A hz) will alias at current sample rate (~A hz).\n"
           hz *SOUND-SRATE*)))
    (scale-db (get-loud)
      (snd-amosc
    (car sound)	; samples for table
    (cadr sound)	; step represented by table
    *SOUND-SRATE*	; output sample rate
    hz		;  output hz
    (local-to-global 0)	; starting time
    modulation	; modulation
    phase))))	; phase


;; FMOSC
;;
;; modulation rate must be less than or equal to sound-srate, so
;; force resampling and issue a warning if necessary. snd-fmosc can
;; handle upsampling cases internally.
;;
(defun fmosc (pitch modulation &optional (sound *table*) (phase 0.0))
  (let ((modulation-srate (snd-srate modulation))
        (hz (step-to-hz (+ pitch (get-transpose)))))
    (cond ((< *SOUND-SRATE* modulation-srate)
       (format t "Warning: down-sampling FM modulation in fmosc~%")
       (setf modulation (snd-down *SOUND-SRATE* modulation))))
    (cond ((> hz (/ *SOUND-SRATE* 2))
       (format t "Warning: fmosc nominal frequency (~A hz) will alias at current sample rate (~A hz).\n"
           hz *SOUND-SRATE*)))
    (scale-db (get-loud)
      (snd-fmosc 
        (car sound)		; samples for table
        (cadr sound)		; step represented by table
        *SOUND-SRATE*		; output sample rate
        hz			;  output hz
        (local-to-global 0)	; starting time
        modulation		; modulation
        phase))))		; phase


;; BUZZ
;;
;; (ARGUMENTS ("long" "n") ("rate_type" "sr") ("double" "hz")
;;            ("time_type" "t0") ("sound_type" "s_fm"))
;; 
(defun buzz (n pitch modulation)
  (let ((modulation-srate (snd-srate modulation))
        (hz (step-to-hz (+ pitch (get-transpose)))))
    (cond ((< *SOUND-SRATE* modulation-srate)
           (format t "Warning: down-sampling modulation in buzz~%")
           (setf modulation (snd-down *SOUND-SRATE* modulation))))
    (cond ((> hz (/ *SOUND-SRATE* 2))
           (format t "Warning: buzz nominal frequency (~A hz) will alias at current sample rate (~A hz).\n"
                   hz *SOUND-SRATE*)))
    (setf n (min n 1)) ; avoid divide by zero problem
    (scale-db (get-loud)
              (snd-buzz n                   ; number of harmonics
                        *SOUND-SRATE*       ; output sample rate
                        hz                  ; output hz
                        (local-to-global 0) ; starting time
                        modulation))))      ; freq. modulation
                        

;; (HZOSC hz [table [phase]])
;;
;; similar to FMOSC, but without "carrier" frequency parameter
;; also, hz may be a scalar or a sound
;;
(defun hzosc (hz &optional (sound *table*) (phase 0.0))
  (let (hz-srate)
    (cond ((numberp hz)
           (osc (hz-to-step hz) 1.0 sound phase))
          (t
           (setf hz-srate (snd-srate hz))
           (cond ((< *SOUND-SRATE* hz-srate)
                  (format t "Warning: down-sampling hz in hzosc~%")
                  (setf hz (snd-down *SOUND-SRATE* hz))))
           (scale-db (get-loud)
                     (snd-fmosc (car sound) ; samples for table
                                (cadr sound) ; step repr. by table
                                *SOUND-SRATE* ; output sample rate
                                0.0 ; dummy carrier
                                (local-to-global 0) ; starting time
                                hz phase))))))


;; (SIOSC-BREAKPOINTS tab0 t1 tab1 ... tn tabn)
;;   converts times to sample numbers
;; NOTE: time-warping the spectral envelope seems
;; like the wrong thing to do (wouldn't it be better
;; to warp the parameters that control the spectra,
;; or don't warp at all?). Nominally, a note should
;; have a "score" or local time duration equal to the
;; SUSTAIN environment variable. (When sustain is 1.0
;; and no time-warping is in effect, the duration is 1).
;; So, scale all times by
;;		(local-to-global (get-sustain))
;; so that if the final time tn = 1.0, we get a nominal
;; length note.

(defun siosc-breakpoints (breakpoints)
  (display "siosc-breakpoints" breakpoints)
  (prog (sample-count result (last-count 0) time-factor)
    (setf time-factor
      (- (local-to-global (get-sustain))
         (local-to-global 0.0)))
    (setf time-factor (* time-factor *SOUND-SRATE*))
    (cond ((and (listp breakpoints)
        (cdr breakpoints)
        (cddr breakpoints)))
      (t (error "SIOSC table list must have at least 3 elements")))
loop
    (cond ((and (listp breakpoints)
           (soundp (car breakpoints)))
       (push (car breakpoints) result)
       (setf breakpoints (cdr breakpoints)))
      (t
       (error "SIOSC expecting SOUND in table list")))
    (cond ((and breakpoints
        (listp breakpoints)
        (numberp (car breakpoints)))
       (setf sample-count (truncate
        (+ 0.5 (* time-factor (car breakpoints)))))
       (cond ((< sample-count last-count)
          (setf sample-count (1+ last-count))))
       (push sample-count result)
       (setf last-count sample-count)
       (setf breakpoints (cdr breakpoints))
       (cond (breakpoints
          (go loop))))
      (breakpoints
       (error "SIOSC expecting number (time) in table list")))
    (setf result (reverse result))
    (display "siosc-breakpoints" result)
    (return result)))

;; SIOSC -- spectral interpolation oscillator
;;
;; modulation rate must be less than or equal to sound-srate, so
;; force resampling and issue a warning if necessary. snd-fmosc can
;; handle upsampling cases internally.
;;
(defun siosc (pitch modulation breakpoints)
  (let ((modulation-srate (snd-srate modulation))
    (hz (step-to-hz (+ pitch (get-transpose)))))
    (cond ((< *SOUND-SRATE* modulation-srate)
       (format t "Warning: down-sampling FM modulation in siosc~%")
       (setf modulation (snd-down *SOUND-SRATE* modulation))))
    (cond ((> hz (/ *SOUND-SRATE* 2))
       (format t "Warning: siosc nominal frequency (~A hz) will alias at current sample rate (~A hz).\n"
           hz *SOUND-SRATE*)))
     (scale-db (get-loud)
      (snd-siosc 
    (siosc-breakpoints breakpoints)	; tables
    *SOUND-SRATE*		; output sample rate
    hz			;  output hz
    (local-to-global 0)	; starting time
    modulation))))		; modulation


;; LFO -- freq &optional duration sound phase)
;;
;; Default duration is 1.0 sec, default sound is *TABLE*, 
;; default phase is 0.0.
;;
(defun lfo (freq &optional (duration 1.0)
         (sound *SINE-TABLE*) (phase 0.0))
  (let ((d (get-duration duration)))
    (if (minusp d) (setf d 0))
    (cond ((> freq (/ *CONTROL-SRATE* 2))
       (format t "Warning: lfo frequency (~A hz) will alias at current control rate (~A hz).\n"
           freq *CONTROL-SRATE*)))
     (snd-osc
    (car sound)		; samples for table
    (cadr sound)		; step represented by table
    *CONTROL-SRATE*		; output sample rate
    freq			; output hz
    *rslt*			; starting time
    d			; duration
    phase)))		; phase

;; FMLFO -- like LFO but uses frequency modulation
;;
(defun fmlfo (freq &optional (sound *SINE-TABLE*) (phase 0.0))
  (let ()
    (cond ((numberp freq)
           (lfo freq 1.0 sound phase))
          ((soundp freq)
           (cond ((> (snd-srate freq) *CONTROL-SRATE*)
                  (setf freq (force-srate *CONTROL-SRATE* freq))))
           (snd-fmosc (car sound) (cadr sound) *CONTROL-SRATE* 0.0 
                      (local-to-global 0) freq phase))
          (t
           (error "frequency must be a number or sound")))))

;; OSC - table lookup oscillator
;;
(defun osc (pitch &optional (duration 1.0) 
          (sound *TABLE*) (phase 0.0))
  (let ((d (get-duration duration))
    (hz (step-to-hz (+ pitch (get-transpose)))))
    ;(display "osc" *warp* global-start global-stop actual-dur  
    ;         (get-transpose))
    (cond ((> hz (/ *SOUND-SRATE* 2))
       (format t "Warning: osc frequency (~A hz) will alias at current sample rate (~A hz).\n"
           hz *SOUND-SRATE*)))
     (set-logical-stop
     (scale-db (get-loud)
           (snd-osc 
        (car sound)		; samples for table
        (cadr sound)		; step represented by table
        *SOUND-SRATE*		; output sample rate
        hz			;  output hz
        *rslt*			; starting time
        d			; duration
        phase))                 ; phase
     duration)))