引言

最近比较好奇乐器它是怎么发声的,比如为什么钢琴听起来就是钢琴而不是别的呢?于是最近就用Common Lisp合成器框架玩玩?
本文章使用let-plus,anaphora,alexandria库用于改善编码环境,主要逻辑是一步一步搓的。
本文章并不涉及商用,只是本人从物理直觉出发设计的,适合理解物理原理,或者当作Lisp宏设计教程。

初次尝试

音高十二平均律

先从音调开始搓,国际标准A4音为440赫兹,根据十二平均律,每个音符cdefgab”是按照比值来算距离的。差值是全全半全全全半是隔2(1/6)”是隔2(1/12)。其中隔音的两个音符之间还有一个半音,比如c和d中间的半音也可用c#来表示,其中#表示升高半音
而字母后的数字相差一就是差一个八度,也就是隔12个半音,比如A5A4的两倍。
那我们就写一个函数传入抽象符号,让它吐出频率吧。

;;定义半音
(defparameter *half-pitch* (expt 2 (/ 12)))

(defun pitch-freq (pitch number)
  (let* ((order (load-time-value '(c c# d d# e f f# g g# a a# b)))
	 (delt  (+ (- (position pitch order :test #'string=)
		      (position 'A    order :test #'string=))
		   (* 12 (- number 4)))))
    (* 440 (expt *half-pitch* delt))))

正弦波振幅频率变换

声波我们就用正弦波吧,这样可以直接用标准库的。正弦波就要涉及两种变换方式,一种是变换值域也就是振幅的,另一种是变换ω也就是改变频率的。也就是A*sin(ωt)

(defparameter *pi* 3.14159265358979)
(defparameter *tau* (* 2 *pi*))

(defun wave-fn-convert (scale omega-factor wave-fn)
  (lambda (time)
    (* scale (funcall wave-fn (* omega-factor time)))))

(defun frequence (freq wave-fn)
  (wave-fn-convert 1 (* *tau* freq) wave-fn))

(defun scale (scale wave-fn)
  (wave-fn-convert scale 1 wave-fn))

这里我们使用闭包,生成新的闭包函数来表示变换后的波形。
说起来这个tau是我看一个科普视频提到的,是表示2pi,他们的理念是如果公式直接用tau会更加简洁,那么我们试试吧。

写入pcm文件

write-pcm

写入pcm文件比较简单,实际上pcm保存的就是采样值,我们只要直接算出来就行,这里用16bit梯度的。

(defun write-pcm (float stream)
  (let ((num (ldb (byte 16 0) (floor (* 32767 float)))))
    (write-byte (ldb (byte 8 0) num) stream)
    (write-byte (ldb (byte 8 8) num) stream)))

生成wav

这里我们每秒采样44100

(with-open-file (stream "test.pcm" :direction :output :if-exists :supersede
				   :element-type '(unsigned-byte 8))
  (let* ((sampling 44100)
	 (time 1))
    (loop with wave-fn = (frequence 440 #'sin)
	  with split-num = (* sampling time)
	  for i from 1 upto split-num
	  for s = (funcall wave-fn (/ i sampling))
	  do (write-pcm s stream))))

生成出的pcm文件还并不能直接播放,我们可以用工具转为wav文件

ffmpeg -f s16le -ar 44100 -ac 1 -i test.pcm output.wav

-f s16le s有符号,16bit,le小端存储。
-ar 44100 我们的采样率
-ac 1 一个声道,生成时就是按照一个声道生成的。

紧接着再播放wav就有声音了。(博客园并不支持音频文件上传只能打压缩包了)
output.zip

泛音阻尼音色

播放之后就会发现非常刺耳朵。这就回到开头的问题,什么决定了钢琴的音色
泛音,弹钢琴时会发出多不同频率波的叠加,那就很自然的写出波的叠加,实际上就是对应每一个xf(x)加在一块。

(defun wave-fn+ (&rest functions)
  (lambda (time)
    (loop for func in functions
	  sum (funcall func time))))

阻尼运动

现在可以了吗?并没有,因为钢琴的在弹的时候最开始是非常响亮的,之后逐渐变小。说明光是正弦波是没什么用的,那什么函数是随x衰减的呢?如果学过物理学,应该第一个想起exp(-kx),这个在阻尼运动中非常常见,弹乐器何尝不是一种阻尼运动?这样我们可以写一个让信号逐渐减小到0的函数。

(defun decay (k)
  (lambda (time)
    (if (> time 0.005)
	(exp (- (/ (* *tau* (- time 0.005)) k)))
	(* 40000 (* time time)))))

等等,这个40000*time*time是什么意思呢?如果把数值瞬间提高1,就相当于扬声器在很短时间内动了,那么会发出频率很大“哒”的声响。所以我们需要一个函数从0快速过渡到1,我让担任这个工作,也可以是其他函数。40000*0.005*0.005=1,然后再看exp(2pi*(t-0.005)*k)t=0.005时这个函数也等于1,换句话说就是找两个分段函数,保持在分界线上也要连续,这样保证扬声器的发音。

泛音叠加

那么这两者怎么结合呢?实际上就是对于每一个xf(x)乘在一块。于是

(defun wave-fn* (&rest functions)
  (lambda (time)
    (loop with res = 1
	  for func in functions
	  do (setf res (* res (funcall func time)))
	  finally (return res))))

钢琴的泛音是在基础音的基础上叠加了基础音整数倍频率的波。为了模拟泛音于是我们写出以下这个非常美观的代码。

(defun proportions (numbers &optional (scale 1))
  (let ((sum (apply #'+ numbers)))
    (loop for num in numbers
	  collect (* scale (/ num sum)))))
;;归一化这样就不用手动算权重了

(defun overtone (wave-fn &rest weights)
  (let ((weights (proportions weights)))
    (apply #'wave-fn+
	   (loop for w in weights
		 for i = 1 then (1+ i)
		 collect (wave-fn-convert w i wave-fn)))))
;;根据泛音的权重生成叠加波。

这样我们就能用(overtone #'sin 5 4 3 2 1)这样的代码快速生成权重为“5,4,3,2,1”频率倍数为“1,2,3,4,5”泛音了。

(defun base-freq (freq)
  (let ((order '(1 1# 2 2# 3 4 4# 5 5# 6 6# 7)))
    (lambda (pitch &optional (octave 0))
      (* freq (expt *half-pitch*
		    (+ (* octave 12)
		       (position pitch order :test #'eql)))))))

设计基于某个频率生成简谱音调的函数。
再写入文件

(with-open-file (stream "test.pcm" :direction :output :if-exists :supersede
				   :element-type '(unsigned-byte 8))
  (let* ((base (base-freq (pitch-freq 'c 4)))
	 (wave-fn (overtone #'sin 1000 300 200 250 100 50 10))
	 (sampling 44100)
	 (freq-list
	   (loop for i in '((4 1) (4 2) (3 2) (2 2) (2 2) (1 2) (5 1) (5 1) (6 1))
		 collect (apply base (ensure-list i))))
	 (time-list '(0.4 0.4 0.8 0.4 0.4 0.8 0.3 0.1 1.2)))
    (loop for freq in freq-list
	  for time in time-list
	  do (loop with wave-fn = (wave-fn* (frequence freq wave-fn) (decay time))
		   with split-num = (* sampling time)
		   for i from 1 upto split-num
		   for s = (funcall wave-fn (/ i sampling))
		   do (write-pcm s stream)))))

output2.zip

第一次迭代

初版框架的局限

我上网一搜,原来乐器的泛音消失的比较快,基础音留的时间比较长。再加上这个框架只能播放一个音符,突然切换会导致扬声器突变,而且乐器弹完一个音再弹下一个音上一个音还没结束,应该有那种余音袅袅的感觉。所以我们要重新设计。
解决这个同时存在音符的问题,我们就不能用闭包大法了,虽然闭包大法是真爽。因为我们需要知道每个波的振幅,要不然累加容易让数值超过1。所以这回我们用结构体去写。

结构体重构合成器

(defstruct wave
  (scale 1) (omega 1) fn envelope)
;;朋友告诉我原来之前写的阻尼运动,是包络(envelope)的一种
;;scale保存振幅,omega间接表示频率(2πf),fn保存波函数

(defstruct wave-signal
  start-time wave freq)
;;用来保存生成的信号,start-time表示开始时间,wave为wave结构体,freq表示演奏频率。

(defstruct instrument wave-list)
;;乐器抽象为可以发射很多波的东西

make-instrument-signals

紧接着我们写如何让学期发射波,就是根据频率,和开始时间生成一大堆wave-signal

(defun make-instrument-signals (instrument start-time freq)
  (loop for wave in (instrument-wave-list instrument)
	collect (make-wave-signal :start-time start-time
				  :wave wave
				  :freq freq)))

这里使用开始时间是为了保证计算时每个波都是从它们自己的时间轴零点处开始的。

compute

紧接着写如何根据时间和wave-signal-list算出当前的值

(defun compute (time end-time wave-signals)
  (loop with sum = 0.0
	with scale-sum = 50
	for sig in wave-signals
	for start-time = (wave-signal-start-time sig)
	if (and (>= time start-time) (<= (- time start-time) end-time))
	  do (let* ((wave (wave-signal-wave sig))
		    (delt (- time start-time))
		    (scale (* (wave-scale wave) (funcall (wave-envelope wave) delt))))
	       (incf scale-sum (abs scale))
	       (with-slots (omega fn) wave
		 (incf sum
		       (* scale (funcall fn (* omega *tau* (wave-signal-freq sig) delt))))))
	finally (return (/ sum scale-sum))))

这里的end-time用于优化的,可以传入一个最大持续时间保证在这之后这个波并不会有声音了。这里我用了一个私人的技巧,因为我不太想每次都去算权重问题去归一化,于是我就把当前振幅的绝对值都加起来,再把当前值算出来,用当前值除以(所有振幅相加+50),这个50也可以是别的正整数,不能为0否则声音就不会降低了,相当于环境音。

定义一个乐器

(defparameter *instrument1*
  (make-instrument
   :wave-list (list (make-wave :scale 1000 :omega 1 :fn #'sin :envelope (decay 2))
		    (make-wave :scale 200  :omega 2 :fn #'sin :envelope (decay 1.5))
		    (make-wave :scale 20   :omega 3 :fn #'sin :envelope (decay 1.2))
		    (make-wave :scale 5    :omega 4 :fn #'sin :envelope (decay 0.75))
		    (make-wave :scale 1    :omega 5 :fn #'sin :envelope (decay 0.25)))))

这样我们就能叠加多个音符了,但是写谱太麻烦了,有没有更加无脑的方式呢?于是我就想设计一个dsl,能直接写简谱的那种。我是这样设计的。

设计简谱****dsl

我们这里用哈希表来保存dslLisp代码的函数表,这相当于一种可以自由增加和修改的局部宏

(defparameter *sheet-table* (make-hash-table))

(defstruct sheet-status
  freq-list time-list wave-signals (total-time 0))
;;用来存每个音符的频率和时间间隔,波信号和总时间。

with-sheet-music

我们需要一个来加入我们的dsl语法,在编译期展开。
我们可以预想一下有这么一种语法

(&sheet (4 1) - - % (5 0) (3 -1))

其中(4 1)中4表示音符,1表示高一个八度-表示延长,%表示小节,语法树还是S表达式于是我们可以这样写dsl入口。

(defmacro with-sheet-music ((wave-signals-binding total-time-binding)
			    sheet &body body)
  (let+ (((&with-gensyms status))
	 ((&labels -> (tree)
	    (if (and tree (listp tree))
		(destructuring-bind (name . args) tree
		  (aif (gethash name *sheet-table*)
               ;;传入status符号让dsl语法处理status,第二个参数才是参数列表
		       (-> (funcall it (list status) args)) ;;递归再展开,这样可以设计多层转换。
		       (cons name
			     (loop for a in args collect (-> a))))) ;;如果找不到就说明已经是CL语法了,则不用再转换
		tree))))
    `(let ((,status (make-sheet-status)))
       ,(-> sheet)
       (let ((,wave-signals-binding (sheet-status-wave-signals ,status))
	     (,total-time-binding   (sheet-status-total-time ,status)))
	 ,@body))))

这里的sheet用来写我们的语法。通过局部定义一个函数->dsl代码根据哈希表里面的函数表展开为CL代码。
同时设计一个定义语法展开器的语法,用来定义我们dslCL语法的转换函数。

;;这里我们用let-plus库中的lambda+,可以自动拆链表
(defmacro defsheet-expansion (name lambda-list &body body)
  `(setf (gethash ',name *sheet-table*)
	 (lambda+ ,lambda-list ,@body)))

设计&sheet语法

(defsheet-expansion &sheet ((status) ((time base) &rest pitches))
  (let+ (((&with-gensyms time-sym base-sym))) ;;时间间隔和基准调
    `(let ((,time-sym ,time)
	   (,base-sym (base-freq ,base)))
       ,(loop for p in pitches
	      with times = 0 ;;时间间隔的倍数
	      for not-first = nil then t
	      if (listp p) ;;如果是链表说明这是一个音符
		collect `(funcall ,base-sym ,@p) into freq-l ;;生成音符频率代码
		and when not-first ;;第一个音符从零时间开始
		      collect `(* ,time-sym ,times) into time-l ;;生成时间间隔代码
	      end
	      and do (setf times 1)
	      else ;;否则它就和时间间隔有关
		do (ecase p
		     (- (setf times (+ times 1))) ;;延长
		     (_ (setf times (/ times 2))) ;;间隔变为1/2
		     (+ (setf times (* times 1.5))) ;;间隔变为3/2
		     (& (setf times 0)) ;;时间间隔设置为0,用来处理和弦
		     (% nil) ;;小节线,什么都不做
		     (%- (setf times (+ times 1)))) ;;小节加延长用于紧凑书写
	      finally (return
			`(progn (appendf (sheet-status-freq-list ,status) (list ,@freq-l))
				(appendf (sheet-status-time-list ,status) (list ,@time-l)))))))) ;;最后合并到sheet-status中

设计多乐器处理

我一看我手中的谱子是my soul它分左右手弹的,所以我们只设计单乐器有点不行。所以我们再设计一个可以多乐器

(defun merge-sheet-status (sheet-status1 sheet-status2)
  (make-sheet-status :freq-list (append (sheet-status-freq-list sheet-status1)
					(sheet-status-freq-list sheet-status2))
		     :time-list (append (sheet-status-time-list sheet-status1)
					(sheet-status-time-list sheet-status2))
		     :wave-signals (append (sheet-status-wave-signals sheet-status1)
					   (sheet-status-wave-signals sheet-status2))
		     :total-time (max (sheet-status-total-time sheet-status1) ;;多个乐器哪个用时最长时间轴就用哪个
				      (sheet-status-total-time sheet-status2))))
;;用来合并乐器生成sheet-status。

(defsheet-expansion &with-instrument ((status) ((instrument) &rest body))
  (let+ (((&with-gensyms instrument-sym)))
    `(setf ,status ;;将内部处理出来的结果再合并
	   (merge-sheet-status
	    ,status
	    (let ((,instrument-sym ,instrument)
		  (,status (make-sheet-status))) ;;这里用let把status重新绑定,使得body里面再处理status处理的就是这个子语法里面的了
	      ,@body
	      (with-slots (freq-list time-list total-time wave-signals) ,status
		(setf total-time (apply #'+ time-list))
		(appendf wave-signals
			 (loop for freq in freq-list
			       for time in time-list
			       for sum = time then (+ sum time)
			       append (make-instrument-signals ,instrument-sym
							       (- sum time) freq)))) ;;根据乐器生成波信号
	      ,status)))))

这样就设计成可以多乐器,甚至单乐器中还能写多个简谱,用来应对换基准调的情况。
然后呢?半首my soul送给观众姥爷(因为太多了抄不动了)。

(defun noise (phase)
  (declare (ignore phase))
  (- (random 2.0) 1.0))
;;简单模拟噪音

(defparameter *hihat*
  (make-instrument
   :wave-list (list
               (make-wave :scale 800 :omega 1 :fn #'noise
                          :envelope (lambda (time) (exp (- (* 100 time))))))))
;;模拟踩镲乐器

(time
 (with-open-file (stream "test.pcm" :direction :output :if-exists :supersede
				    :element-type '(unsigned-byte 8))
   (let* ((sampling 44100))
     (with-sheet-music (wave-signal-list total-time)
       (progn
	 (&with-instrument
	  (*instrument1*)
	  (&sheet (0.4 (pitch-freq 'c 4))
	 	  (4 1) (4 2) (3 2) - % (2 2) (2 2) & (5 1) (1 2) - %
	 	  (5 1) + _ (5 1) _ _ (6 1) - - % (5 1) _ (6 1) _ (4 1) - - %
	 	  (4 1) (4 2) (3 2) - % (2 2) (2 2) & (5 1) (1 2) - %
	 	  (5 1) + _ (5 1) _ _ (6 1) - - % (0) (4 1) (5 1) (6 1) %
	 	  (1 2) (4 2) (3 2) - % (2 2) (2 2) & (5 1) (1 2) - %
	 	  (5 1) + _ (5 1) _ _ (6 1) - - % (5 1) _ (6 1) _ (4 1) - (2 1) %
	 	  (4 1) (5 1) & (1 1) - (6 1) %- (2 1) (4 1) (5 1) %
	 	  (6 1) (5 1) & (1 1) - (0) (4 1) - - - % (0))
	  (&sheet (0.4 (pitch-freq 'g 4))
	 	  (1) (1 1) (7) - % (6) (6) & (2) (5) - % (2) + _ (2) _ _ (3) - - %
	 	  (2) _ (3) _ (1) - - % (1) (1 1) (7) - % (6) (6) & (2) (5) - %
	 	  (2) + _ (2) _ _ (3) - - % (0) (1) (2) (3) % (0)))
	 (&with-instrument
	  (*instrument1*)
	  (&sheet (0.4 (pitch-freq 'c 4))
	 	  (0) (6 -2) (4 -1) (2) %- (1 -1) (5 -1) (1) %- (4 -2) (1 -1) (6 -1) %-
	 	  (2 -2) (6 -2) (2 -1) % (4 -1) (6 -2) (4 -1) (2) %- (1 -1) (5 -1) (1)
	 	  %- (2 -2) (6 -2) (2 -1) (4 -1) - - (2 -2) %- (6 -2) (4 -1) (2) %-
	 	  (1 -1) (5 -1) (1) %- (4 -2) (1 -1) (6 -1) %- (2 -2) (6 -2) (2 -1) %-
	 	  (5 -2) (2 -1) (5 -1) %- (6 -2) (2 -1) (6 -1) %- (4 -2) (1 -1)
	 	  (4 -1) %- - - - (0))
	  (&sheet (0.4 (pitch-freq 'g 4))
	 	  (0) (4 -2) (1 -1) (4 -1) %- (5 -2) (2 -1) (5 -1) %- (1 -2) (5 -2)
	 	  (1 -1) %- (6 -3) (3 -2) (6 -2) % (1 -1) (4 -2) (1 -1) (4 -1) %-
	 	  (5 -2) (2 -1) (5 -1) %- (1 -2) (5 -2) (1 -1) % (3 -1) - - (1 -1) %
	 	  (0)))
	 (&with-instrument
	  (*hihat*)
	  (&sheet (0.4 (pitch-freq 'f 4))
		  (1) - - - % (1) - - - % (1) - - - % (1) - - - % (1) - - - %
		  (1) - - - % (1) - - - % (1) - - - % (1) - - - % (1) - - - %
		  (1) - - - % (1) - - - % (1) - - - % (1) - - - % (1) - - - %
		  (1) - - - % (1) - - - % (1) - - - % (1) - - - % (1) - - - %)))
       (loop repeat 1000 do (write-pcm 0 stream))
       (loop with split-num = (* sampling total-time)
	     for i from 1 upto split-num
	     for s = (compute (/ i sampling) 3 wave-signal-list)
	     do (write-pcm s stream))))))

output3.zip

性能优化

生成时间好慢啊,在我这里它生成了80多秒,但是文件才30多秒。

而且这个时间还不是线性增长的,如果音符越多,时间会多出更多。看了很久我才注意到,罪魁祸首是sin函数,sin函数如果传一个很大的值,它就要精确去算,这样才能去掉整周期数。但是回看我们的框架,波方程的sin几乎就是绑定在一块的sin(2πfx)。所以我们直接帮标准库去掉那个吧。

(declaim (inline sin-2pi))

(defun sin-2pi (x)
  (declare (single-float x)
	   (optimize (speed 3) (debug 0)))
  (the single-float
       (sin (* (the single-float *tau*)
	       (the single-float (nth-value 1 (truncate x)))))))

我们直接定义sin-2pi(x)表示sin(2πx),这样x的整数位就是周期数,而小数位就是需要计算的sin值。

超出框架的鼓

这个框架还是有问题,因为这个是能写弹奏的乐器,像鼓这种东西真是很超标,它的震动频率居然随时间变化。
鼓在框架中真是叛逆,于是我苦思冥想,在我随便写的时候想到一个方法。

(flet ((make-wave (power freq-factor decay-k)
	 (lambda (freq time)
	   (* power
	      (sin-2pi (* freq time))
	      (decay decay-k)))))
  (let ((waves (list (make-wave 1000 1 2)
		     (make-wave 100  2 1)
		     (make-wave 10   3 0.5))))
    (defun piano ()
      ...)))

在这里先用flet描述一个波怎么生成,然后在let中通过改变参数生成不同的闭包函数这样就表示了乐器。

definstrument的诞生

但是直接写这种fletlet代码多少看着还是麻烦,所以我们对它进行抽象。

(defmacro definstrument ((wave-binding wave-lambda-list &rest waves-args)
			 (abbrev abbrev-lambda-list &body abbrev-body)
			 name lambda-list &body body)
  `(flet ((,abbrev ,wave-lambda-list
	    (lambda ,abbrev-lambda-list ,@abbrev-body)))
     (let ((,wave-binding
	     (list ,@(loop for w in waves-args
			   collect `(,abbrev ,@w)))))
       (defun ,name ,lambda-list ,@body))))

这里参数有些多,我写的时候也是斟酌了许久,比如flet绑定时用abbrev而参数却用wave-lambda-list,而wave-binding却跑到let上了,看着比较别扭。
这么写的原因是想让wave-lambda-listwaves-args对齐。

(definstrument (waves (power freq-factor decay-k)
		      (1000   1          2)
		      (100    2          1)
		      (10     3          0.5))
    (make-wave (freq time)
	       (* power
		  (sin-2pi (* freq time))
		  (decay decay-k)))
  piano (freq time)
  (loop for w in waves
	sum (funcall w freq time)))

definstrument-auto

紧接着我们就很容易注意到body里面往往就是把波根据参数累加起来。所以我们还能再抽象。

(defmacro definstrument-auto (name &body ((wave-lambda-list &rest waves-args)
					  (abbrev-lambda-list &body abbrev-body)))
  (let+ (((&with-gensyms wave-binding abbrev it result)))
    `(definstrument (,wave-binding ,wave-lambda-list ,@waves-args)

(,abbrev ,abbrev-lambda-list ,@abbrev-body)
       ,name ,abbrev-lambda-list
       (loop with ,result = (make-wave-info)
	     for ,it in ,wave-binding
	     do (incf ,result (funcall ,it ,@abbrev-lambda-list))
	     finally (return ,result)))))

我们直接去掉wave-bindingabbrev,结果自动累加,defun的参数和每个波的参数一样。

给definstrument-auto升级

由于这里我们只是计算出每个波在某时刻的值了,没有其他的信息,所以我们可以再开一个结构体。

(defstruct wave-info
  (power 0) (value 0))

(defun wave-info+ (info1 info2)
  (make-wave-info :power (+ (wave-info-power info1)
			    (wave-info-power info2))
		  :value (+ (wave-info-value info1)
			    (wave-info-value info2))))

这里我们要振幅(抽象成能量)和波此刻值的信息。然后再让definstrument-auto支持这个结构体的叠加。

(defmacro definstrument-auto (name &body ((wave-lambda-list &rest waves-args)
					  (abbrev-lambda-list &body abbrev-body)))
  (let+ (((&with-gensyms wave-binding abbrev it result)))
    `(definstrument (,wave-binding ,wave-lambda-list ,@waves-args)
	 (,abbrev ,abbrev-lambda-list ,@abbrev-body)
       ,name ,abbrev-lambda-list
       (loop with ,result = (make-wave-info)
	     for ,it in ,wave-binding
	     do (setf ,result
		      (wave-info+ ,result
				  (funcall ,it ,@abbrev-lambda-list)))
	     finally (return ,result)))))

&wave-info辅助

因为我们计算出来的结果往往是互相依赖的,计算完power你就需要用power去再计算value,最后再用make-wave-info返回结构体。

(let* ((power (* power (exp-decay time continuous-time decay-k)))
       (value (* power (sin-2pi (* freq freq-factor time)))))
  (make-wave-info :power power :value value))

这样中间就会开一些变量,同样我们也能抽象出来。

(defmacro &wave-info (&body clause)
  `(let* ,(loop for (var expr) in clause
		collect `(,var ,expr))
     (make-wave-info ,@(loop for (var nil) in clause
			     append `(,(intern (symbol-name var) :keyword)
				      ,var)))))

钢琴再定义

此时我们定义钢琴的代码就变成了

(defun exp-decay (time k)
  (cond
    ((< time 0.005) (* 40000 time time))
    (t (exp (- (* (- time 0.005) k))))))
;;修改了一下函数名

(definstrument-auto piano
    ((power freq-factor decay-k)
     (10000 1           5)
     (1000  2           10)
     (100   3           15)
     (10    4           20))
  ((freq time)
   (&wave-info (power (* power (exp-decay time decay-k)))
	       (value (* power (sin-2pi (* freq freq-factor time)))))))

这个宏我觉得非常好,这样我们看powerfreq-factor等等就像看表格一样,然后再往下看又是每个波怎么处理的逻辑。
实际上这就是我们不假设波的什么信息一定固定,我们只是提供一个“算子”用来算乐器,但是里面算什么就可以随便了。另外definstrument要留着,因为definstrument-auto假定了波合成只需要powervalue两个信息,到目前为止是没错的,留着definstrument是为了应对特殊情况。

鼓的定义

鼓它的频率是从某一个值衰减到固有频率的,可以理解为f0*(exp(-k*t)+1),所以计算某一时刻的值就没有那么简单了,钢琴的频率不会变所以使用频率时间就能得到相位。但是鼓是会变的,所以这里要用积分去运算。
相位公式为f0*(t+(exp(-k*t)-1)/k)
则鼓的代码就出来了

(definstrument-auto kick
    ((power base-freq drop-speed decay)
     (50000 100       0.25       10)
     (25000 159       0.5        15))
  ((time)
   (let ((x (* base-freq
	       (+ (/ (1- (exp (- (* drop-speed time))))
		     (- drop-speed))
		  time))))
     (&wave-info (power (* power (exp-decay time decay)))
		 (value (* power (sin-2pi x)))))))

未完待续

目前代码还没有写完整,本人还在验证采样循环do-sampling和改进的with-sheet-music的设计,由于设计框架需要比较长的时间检验,所以先写到这里,而且此篇文章已经够长了。


原文地址: https://www.cveoy.top/t/topic/qHAf 著作权归作者所有。请勿转载和采集!

免费AI点我,无需注册和登录