Du kan inte välja fler än 25 ämnen Ämnen måste starta med en bokstav eller siffra, kan innehålla bindestreck ('-') och vara max 35 tecken långa.

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514
  1. ;;; CLM piano.ins (Scott Van Duyne) translated to Snd/Scheme
  2. (provide 'snd-piano.scm)
  3. (if (provided? 'snd)
  4. (require snd-ws.scm)
  5. (require sndlib-ws.scm))
  6. (require snd-env.scm)
  7. ;;; see generators.scm for the old scheme versions of one-pole-all-pass, pnoise, one-pole-swept, and expseg
  8. ;; converts t60 values to suitable :rate values for expseg
  9. (define (In-t60 t60) (- 1.0 (expt 0.001 (/ 1.0 t60 *clm-srate*))))
  10. (define number-of-stiffness-allpasses 8)
  11. (define longitudinal-mode-cutoff-keynum 29)
  12. (define longitudinal-mode-stiffness-coefficient -.5)
  13. (define loop-gain-env-t60 (In-t60 .05))
  14. (define loop-gain-default .9999)
  15. (define nstrings 3)
  16. (define two-pi (* 2 pi))
  17. ;;keyNum indexed parameter tables
  18. ;;these should all be &key variable defaults for p instrument
  19. (define default-loudPole-table '(36 .8 60 .85 84 .7 96 .6 108 .5))
  20. (define default-softPole-table '(36 .93 60 .9 84 .9 96 .8 108 .8))
  21. (define default-loudGain-table '(21.000 0.700 36.000 0.700 48.000 0.700 60.000 0.650 72.000 0.650
  22. 84.000 0.650 87.006 0.681 88.070 0.444 90.653 0.606 95.515 0.731
  23. 99.770 0.775 101.897 0.794 104.024 0.800 105.695 0.806))
  24. (define default-softGain-table '(21 .25 108 .25))
  25. (define default-strikePosition-table '(21.000 0.140 23.884 0.139 36.000 0.128 56.756 0.129 57.765 0.130
  26. 59.000 0.130 60.000 0.128 61.000 0.128 62.000 0.129 66.128 0.129
  27. 69.000 0.128 72.000 0.128 73.000 0.128 79.000 0.128 80.000 0.128
  28. 96.000 0.128 99.000 0.128))
  29. (define default-detuning2-table '(22.017 -0.090 23.744 -0.090 36.000 -0.080 48.055 -0.113 60.000 -0.135
  30. 67.264 -0.160 72.000 -0.200 84.054 -0.301 96.148 -0.383 108 -0.383))
  31. (define default-detuning3-table '(21.435 0.027 23.317 0.043 36.000 0.030 48.000 0.030 60.000 0.030 72.000
  32. 0.020 83.984 0.034 96.000 0.034 99.766 0.034))
  33. (define default-stiffnessCoefficient-table '(21.000 -0.920 24.000 -0.900 36.000 -0.700 48.000 -0.250 60.000
  34. -0.100 75.179 -0.040 82.986 -0.040 92.240 -0.040 96.000 -0.040
  35. 99.000 .2 108.000 .5))
  36. (define default-singleStringDecayRate-table '(21.678 -2.895 24.000 -3.000 36.000 -4.641 41.953 -5.867 48.173
  37. -7.113 53.818 -8.016 59.693 -8.875 66.605 -9.434 73.056 -10.035
  38. 78.931 -10.293 84.000 -12.185))
  39. (define default-singleStringZero-table '(21.000 -0.300 24.466 -0.117 28.763 -0.047 36.000 -0.030 48.000 -0.020
  40. 60.000 -0.010 72.000 -0.010 84.000 -0.010 96.000 -0.010))
  41. (define default-singleStringPole-table '(21.000 0 24.466 0 28.763 0 36.000 0 108 0))
  42. (define default-releaseLoopGain-table '(21.643 0.739 24.000 0.800 36.000 0.880 48.000 0.910 60.000 0.940
  43. 72.000 0.965 84.000 0.987 88.99 .987 89.0 1.0 108 1.0))
  44. (define default-DryTapFiltCoeft60-table '(36 .35 60 .25 108 .15))
  45. (define default-DryTapFiltCoefTarget-table '(36 -.8 60 -.5 84 -.4 108 -.1))
  46. (define default-DryTapFiltCoefCurrent-table '(0 0 200 0))
  47. (define default-DryTapAmpt60-table '(36 .55 60 .5 108 .45))
  48. (define default-sustainPedalLevel-table '(21.000 0.250 24.000 0.250 36.000 0.200 48.000 0.125 60.000 0.075
  49. 72.000 0.050 84.000 0.030 96.000 0.010 99.000 0.010))
  50. (define default-pedalResonancePole-table '(20.841 0.534 21.794 0.518 33.222 0.386 45.127 0.148 55.445 -0.065
  51. 69.255 -0.409 82.905 -0.729 95.763 -0.869 106.398 -0.861))
  52. (define default-pedalEnvelopet60-table '(21.0 7.5 108.0 7.5))
  53. (define default-soundboardCutofft60-table '(21.0 .25 108.0 .25))
  54. (define default-DryPedalResonanceFactor-table '(21.0 .5 108.0 .5))
  55. (define default-unaCordaGain-table '(21 1.0 24 .4 29 .1 29.1 .95 108 .95))
  56. (definstrument (p start (duration 1.0)
  57. (keyNum 60.0) ; middleC=60: can use fractional part to detune
  58. (strike-velocity 0.5) ; corresponding normalized velocities (range: 0.0--1.0)
  59. pedal-down ; set to #t for sustain pedal down...pedal-down-times not yet implemented
  60. (release-time-margin 0.75) ; extra compute time allowed beyond duration
  61. (amp .5) ; amp scale of noise inputs...
  62. ;;slider controls
  63. (detuningFactor 1.0)
  64. (detuningFactor-table ())
  65. (stiffnessFactor 1.0)
  66. (stiffnessFactor-table ())
  67. (pedalPresenceFactor .3)
  68. (longitudinalMode 10.5)
  69. (StrikePositionInvFac -0.9)
  70. (singleStringDecayRateFactor 1.0)
  71. ;; parameter tables indexed by keyNum
  72. ;; you can override the loudPole-table by directly setting :loudPole to a value
  73. loudPole
  74. (loudPole-table default-loudPole-table)
  75. softPole
  76. (softPole-table default-softPole-table)
  77. loudGain
  78. (loudGain-table default-loudGain-table)
  79. softGain
  80. (softGain-table default-softGain-table)
  81. strikePosition (strikePosition-table default-strikePosition-table)
  82. detuning2
  83. (detuning2-table default-detuning2-table)
  84. detuning3
  85. (detuning3-table default-detuning3-table)
  86. stiffnessCoefficient
  87. (stiffnessCoefficient-table default-stiffnessCoefficient-table)
  88. singleStringDecayRate
  89. (singleStringDecayRate-table default-singleStringDecayRate-table)
  90. singleStringZero
  91. (singleStringZero-table default-singleStringZero-table)
  92. singleStringPole
  93. (singleStringPole-table default-singleStringPole-table)
  94. releaseLoopGain
  95. (releaseLoopGain-table default-releaseLoopGain-table)
  96. DryTapFiltCoeft60
  97. (DryTapFiltCoeft60-table default-DryTapFiltCoeft60-table)
  98. DryTapFiltCoefTarget
  99. (DryTapFiltCoefTarget-table default-DryTapFiltCoefTarget-table)
  100. DryTapFiltCoefCurrent
  101. (DryTapFiltCoefCurrent-table default-DryTapFiltCoefCurrent-table)
  102. DryTapAmpt60
  103. (DryTapAmpt60-table default-DryTapAmpt60-table)
  104. sustainPedalLevel
  105. (sustainPedalLevel-table default-sustainPedalLevel-table)
  106. pedalResonancePole
  107. (pedalResonancePole-table default-pedalResonancePole-table)
  108. pedalEnvelopet60
  109. (pedalEnvelopet60-table default-pedalEnvelopet60-table)
  110. soundboardCutofft60
  111. (soundboardCutofft60-table default-soundboardCutofft60-table)
  112. DryPedalResonanceFactor
  113. (DryPedalResonanceFactor-table default-DryPedalResonanceFactor-table)
  114. unaCordaGain
  115. (unaCordaGain-table default-unaCordaGain-table))
  116. (define (make-one-pole-one-zero a0 a1 b1)
  117. (list (make-one-zero a0 a1)
  118. (make-one-pole 1.0 b1)))
  119. (define (signum n)
  120. ;; in CL this returns 1.0 if n is float
  121. (if (positive? n) 1
  122. (if (zero? n) 0
  123. -1)))
  124. (define apfloor
  125. (let ((golden-mean .618))
  126. (define (get-allpass-coef samp-frac wT)
  127. (let ((ta (tan (- (* samp-frac wT))))
  128. (c (cos wT))
  129. (s (sin wT)))
  130. (/ (- (* (signum ta)
  131. (sqrt (* (+ 1 (* ta ta)) s s))) ta) ; is the (* s s) correct? it's in the original
  132. (- (* c ta) s))))
  133. (lambda (len wT)
  134. (let* ((len-int (floor len))
  135. (len-frac (- len len-int)))
  136. (if (< len-frac golden-mean)
  137. (begin
  138. (set! len-int (- len-int 1))
  139. (set! len-frac (+ len-frac 1.0))))
  140. (if (and (< len-frac golden-mean)
  141. (> len-int 0))
  142. (begin
  143. (set! len-int (- len-int 1))
  144. (set! len-frac (+ len-frac 1.0))))
  145. (list len-int (get-allpass-coef len-frac wT))))))
  146. (define (tune-piano frequency stiffnessCoefficient numAllpasses b0 b1 a1)
  147. (define (apPhase a1 wT)
  148. (atan (* (- (* a1 a1) 1.0)
  149. (sin wT))
  150. (+ (* 2.0 a1)
  151. (* (+ (* a1 a1) 1.0)
  152. (cos wT)))))
  153. (define (opozPhase b0 b1 a1 wT)
  154. (let ((s (sin wT))
  155. (c (cos wT)))
  156. (atan (- (* a1 s (+ b0 (* b1 c)))
  157. (* b1 s (+ 1 (* a1 c))))
  158. (+ (* (+ b0 (* b1 c))
  159. (+ 1 (* a1 c)))
  160. (* b1 s a1 s)))))
  161. (let* ((wT (/ (* frequency two-pi) *clm-srate*))
  162. (len (/ (+ two-pi
  163. (* numAllpasses
  164. (apPhase stiffnessCoefficient wT))
  165. (opozPhase (+ 1 (* 3 b0)) (+ a1 (* 3 b1)) a1 wT))
  166. wT)))
  167. (apfloor len wT)))
  168. (let (;;look-up parameters in tables (or else use the override value)
  169. (loudPole (or loudPole (envelope-interp keyNum loudPole-table)))
  170. (softPole (or softPole (envelope-interp keyNum softPole-table)))
  171. (loudGain (or loudGain (envelope-interp keyNum loudGain-table)))
  172. (softGain (or softGain (envelope-interp keyNum softGain-table)))
  173. (strikePosition (or strikePosition (envelope-interp keyNum strikePosition-table)))
  174. (detuning2 (or detuning2 (envelope-interp keyNum detuning2-table)))
  175. (detuning3 (or detuning3 (envelope-interp keyNum detuning3-table)))
  176. (stiffnessCoefficient (or stiffnessCoefficient (envelope-interp keyNum stiffnessCoefficient-table)))
  177. (singleStringDecayRate-1 (or singleStringDecayRate (envelope-interp keyNum singleStringDecayRate-table)))
  178. (singleStringZero (or singleStringZero (envelope-interp keyNum singleStringZero-table)))
  179. (singleStringPole (or singleStringPole (envelope-interp keyNum singleStringPole-table)))
  180. (releaseLoopGain (or releaseLoopGain (envelope-interp keyNum releaseLoopGain-table)))
  181. (DryTapFiltCoeft60 (In-t60 (or DryTapFiltCoeft60 (envelope-interp keyNum DryTapFiltCoeft60-table))))
  182. (DryTapFiltCoefTarget (or DryTapFiltCoefTarget (envelope-interp keyNum DryTapFiltCoefTarget-table)))
  183. (DryTapFiltCoefCurrent (or DryTapFiltCoefCurrent (envelope-interp keyNum DryTapFiltCoefCurrent-table)))
  184. (DryTapAmpt60 (In-t60 (or DryTapAmpt60 (envelope-interp keyNum DryTapAmpt60-table))))
  185. (sustainPedalLevel (or sustainPedalLevel (envelope-interp keyNum sustainPedalLevel-table)))
  186. (pedalResonancePole (or pedalResonancePole (envelope-interp keyNum pedalResonancePole-table)))
  187. (pedalEnvelopet60 (In-t60 (or pedalEnvelopet60 (envelope-interp keyNum pedalEnvelopet60-table))))
  188. (soundboardCutofft60 (or soundboardCutofft60 (envelope-interp keyNum soundboardCutofft60-table)))
  189. (DryPedalResonanceFactor (or DryPedalResonanceFactor (envelope-interp keyNum DryPedalResonanceFactor-table)))
  190. (unaCordaGain (or unaCordaGain (envelope-interp keyNum unaCordaGain-table)))
  191. (detuningFactor (if (null? detuningFactor-table) (envelope-interp keyNum detuningFactor-table) detuningFactor))
  192. (stiffnessFactor (if (null? stiffnessFactor-table) (envelope-interp keyNum stiffnessFactor-table) stiffnessFactor))
  193. (dryTap-one-pole-one-zero-pair (make-one-pole-one-zero 1.0 0.0 0.0))
  194. (dryTap-one-pole-swept 0.0)
  195. (wetTap-one-pole-swept 0.0)
  196. (beg (seconds->samples start))
  197. (dur (seconds->samples duration))
  198. (freq (* 440.0 (expt 2.0 (/ (- keyNum 69.0) 12.0)))))
  199. (let((end (+ beg dur (seconds->samples release-time-margin)))
  200. (release-time (+ beg dur))
  201. (wT (/ (* two-pi freq) *clm-srate*))
  202. ;;strike position comb filter delay length
  203. (agraffe-len (/ (* *clm-srate* strikePosition) freq))
  204. (singleStringDecayRate (* singleStringDecayRateFactor singleStringDecayRate-1)))
  205. (let (;;initialize soundboard impulse response elements
  206. ;;initialize open-string resonance elements
  207. (wetTap-one-pole-one-zero-pair (make-one-pole-one-zero (- 1.0 (* (signum pedalResonancePole) pedalResonancePole)) 0.0 (- pedalResonancePole)))
  208. (sb-cutoff-rate (In-t60 soundboardCutofft60))
  209. ;;initialize velocity-dependent piano hammer filter elements
  210. (hammerPole (+ softPole (* (- loudPole softPole) strike-velocity)))
  211. (hammerGain (+ softGain (* (- loudGain softGain) strike-velocity)))
  212. (vals (apfloor agraffe-len wT))
  213. (attenuationPerPeriod (expt 10.0 (/ singleStringDecayRate freq 20.0))))
  214. (let ((dlen1 (car vals))
  215. (apcoef1 (cadr vals))
  216. ;;compute coefficients for and initialize the coupling filter
  217. ;; taking L=g(1 - bz^-1)/(1-b), and computing Hb = -(1-L)/(2-L)
  218. (g attenuationPerPeriod) ;;DC gain
  219. (b singleStringZero)
  220. (a singleStringPole)
  221. ;;determine string tunings (and longitudinal modes, if present)
  222. (freq1 (if (<= keyNum longitudinal-mode-cutoff-keynum) (* freq longitudinalMode) freq))
  223. (freq2 (+ freq (* detuning2 detuningFactor)))
  224. (freq3 (+ freq (* detuning3 detuningFactor)))
  225. ;;scale stiffness coefficients, if desired
  226. (stiffnessCoefficient (if (> stiffnessFactor 1.0)
  227. (- stiffnessCoefficient
  228. (* (+ 1 stiffnessCoefficient)
  229. (- stiffnessFactor 1)))
  230. (* stiffnessCoefficient stiffnessFactor))))
  231. (let ((ctemp (- (+ 1 g (* nstrings (- (+ 1 (* a g)) b g))) b (* a g)))
  232. (stiffnessCoefficientL (if (<= keyNum longitudinal-mode-cutoff-keynum)
  233. longitudinal-mode-stiffness-coefficient
  234. stiffnessCoefficient)))
  235. (let ((cfb0 (/ (* 2 (- (+ -1 b g) (* a g))) ctemp))
  236. (cfb1 (/ (* 2 (- (+ a (* a b g)) (* a b) (* b g))) ctemp))
  237. (cfa1 (/ (- (+ (* a b) (* a b g) (* nstrings (- (* b (+ a g)) a (* a b g)))) a (* b g)) ctemp))
  238. (agraffe-delay1 (make-delay dlen1))
  239. (agraffe-tuning-ap1 (make-one-pole-all-pass 1 apcoef1)))
  240. (let ((couplingFilter-pair (make-one-pole-one-zero cfb0 cfb1 cfa1))
  241. ;;initialize the coupled-string elements
  242. (vals1 (tune-piano freq1 stiffnessCoefficientL number-of-stiffness-allpasses cfb0 cfb1 cfa1))
  243. (vals2 (tune-piano freq2 stiffnessCoefficient number-of-stiffness-allpasses cfb0 cfb1 cfa1))
  244. (vals3 (tune-piano freq3 stiffnessCoefficient number-of-stiffness-allpasses cfb0 cfb1 cfa1)))
  245. (let ((delayLength1 (car vals1))
  246. (tuningCoefficient1 (cadr vals1))
  247. (delayLength2 (car vals2))
  248. (tuningCoefficient2 (cadr vals2))
  249. (delayLength3 (car vals3))
  250. (tuningCoefficient3 (cadr vals3))
  251. (interp 0.0)
  252. (dryTap-rx 0.0)
  253. (wetTap-rx 0.0))
  254. (define piano-loop
  255. (let ((dryTap0 (car dryTap-one-pole-one-zero-pair))
  256. (dryTap1 (cadr dryTap-one-pole-one-zero-pair))
  257. (wetTap0 (car wetTap-one-pole-one-zero-pair))
  258. (wetTap1 (cadr wetTap-one-pole-one-zero-pair))
  259. (op1 (make-one-pole (- 1.0 hammerPole) (- hammerPole)))
  260. (op2 (make-one-pole (- 1.0 hammerPole) (- hammerPole)))
  261. (op3 (make-one-pole (- 1.0 hammerPole) (- hammerPole)))
  262. (op4 (make-one-pole (- 1.0 hammerPole) (- hammerPole)))
  263. (cou0 (car couplingFilter-pair))
  264. (cou1 (cadr couplingFilter-pair))
  265. (string1-delay (make-delay (- delayLength1 1)))
  266. (string1-tuning-ap (make-one-pole-all-pass 1 tuningCoefficient1))
  267. (string1-stiffness-ap (make-one-pole-all-pass 8 stiffnessCoefficientL))
  268. (string2-delay (make-delay (- delayLength2 1)))
  269. (string2-tuning-ap (make-one-pole-all-pass 1 tuningCoefficient2))
  270. (string2-stiffness-ap (make-one-pole-all-pass 8 stiffnessCoefficient))
  271. (string3-delay (make-delay (- delayLength3 1)))
  272. (string3-tuning-ap (make-one-pole-all-pass 1 tuningCoefficient3))
  273. (string3-stiffness-ap (make-one-pole-all-pass 8 stiffnessCoefficient))
  274. ;;initialize loop-gain envelope
  275. (loop-gain loop-gain-default)
  276. (loop-gain-ry (* releaseLoopGain loop-gain-env-t60))
  277. (loop-gain-rx (- 1.0 loop-gain-env-t60))
  278. (dry-coef (* 1.0 DryTapFiltCoefCurrent))
  279. (dry-coef-ry (* DryTapFiltCoefTarget DryTapFiltCoeft60))
  280. (dry-coef-rx (- 1.0 DryTapFiltCoeft60))
  281. (wet-coef 0.0)
  282. (wet-coef-ry (* -0.5 pedalEnvelopet60))
  283. (wet-coef-rx (- 1.0 pedalEnvelopet60))
  284. (dryTap 0.0)
  285. (dryTap-x 1.0)
  286. (openStrings 0.0)
  287. (wetTap-x (* sustainPedalLevel pedalPresenceFactor (if pedal-down 1.0 DryPedalResonanceFactor)))
  288. (combedExcitationSignal 0.0)
  289. (adelOut 0.0)
  290. (adelIn 0.0)
  291. (totalTap 0.0)
  292. (string1-junction-input 0.0)
  293. (string2-junction-input 0.0)
  294. (string3-junction-input 0.0)
  295. (couplingFilter-input 0.0)
  296. (couplingFilter-output 0.0)
  297. (temp1 0.0)
  298. ;; (pn-gen 16383)
  299. (pnoise (int-vector 16383)))
  300. (lambda (beg end)
  301. (do ((i beg (+ i 1)))
  302. ((= i end))
  303. (set! loop-gain (+ (* interp (+ loop-gain-ry (* loop-gain-rx loop-gain)))
  304. (* (- 1.0 interp) loop-gain-default)))
  305. (set! temp1 (one-zero dryTap0 (one-pole dryTap1 (piano-noise pnoise amp))))
  306. (set! dry-coef (+ dry-coef-ry (* dry-coef-rx dry-coef)))
  307. (set! dryTap-one-pole-swept (- (* (+ 1.0 dry-coef) temp1) (* dry-coef dryTap-one-pole-swept)))
  308. (set! dryTap-x (* dryTap-x dryTap-rx))
  309. (set! dryTap (* dryTap-x dryTap-one-pole-swept))
  310. (set! temp1 (one-zero wetTap0 (one-pole wetTap1 (piano-noise pnoise amp))))
  311. (set! wet-coef (+ wet-coef-ry (* wet-coef-rx wet-coef)))
  312. (set! wetTap-one-pole-swept (- (* (+ 1.0 wet-coef) temp1) (* wet-coef wetTap-one-pole-swept)))
  313. (set! wetTap-x (* wetTap-x wetTap-rx))
  314. (set! openStrings (* wetTap-x wetTap-one-pole-swept))
  315. (set! totalTap (+ dryTap openStrings))
  316. (set! adelIn (one-pole op1 (one-pole op2 (one-pole op3 (one-pole op4 totalTap)))))
  317. (set! combedExcitationSignal (* hammerGain (+ adelOut (* adelIn StrikePositionInvFac))))
  318. (set! adelOut (one-pole-all-pass agraffe-tuning-ap1 (delay agraffe-delay1 adelIn)))
  319. (set! string1-junction-input
  320. (+ (* unaCordaGain combedExcitationSignal)
  321. (* loop-gain
  322. (delay string1-delay
  323. (one-pole-all-pass string1-tuning-ap
  324. (one-pole-all-pass string1-stiffness-ap
  325. (+ string1-junction-input couplingFilter-output)))))))
  326. (set! string2-junction-input
  327. (+ combedExcitationSignal
  328. (* loop-gain
  329. (delay string2-delay
  330. (one-pole-all-pass string2-tuning-ap
  331. (one-pole-all-pass string2-stiffness-ap
  332. (+ string2-junction-input couplingFilter-output)))))))
  333. (set! string3-junction-input
  334. (+ combedExcitationSignal
  335. (* loop-gain
  336. (delay string3-delay
  337. (one-pole-all-pass string3-tuning-ap
  338. (one-pole-all-pass string3-stiffness-ap
  339. (+ string3-junction-input couplingFilter-output)))))))
  340. (set! couplingFilter-input (+ string1-junction-input string2-junction-input string3-junction-input))
  341. (set! couplingFilter-output (one-zero cou0 (one-pole cou1 couplingFilter-input)))
  342. (outa i couplingFilter-input)))))
  343. (set! dryTap-rx (- 1.0 DryTapAmpt60))
  344. (set! wetTap-rx (- 1.0 pedalEnvelopet60))
  345. (piano-loop beg release-time)
  346. (set! dryTap-rx (- 1.0 sb-cutoff-rate))
  347. (set! wetTap-rx dryTap-rx)
  348. (set! interp 1.0)
  349. (piano-loop release-time end))))))))))
  350. #|
  351. (with-sound ()
  352. (do ((i 0 (+ i 1))) ((= i 8))
  353. (p
  354. (* i .5)
  355. :duration .5
  356. :keyNum (+ 24 (* 12 i))
  357. :strike-velocity .5
  358. ;0 to 1, 0 is softest played note, 1 is loud note
  359. :amp .4
  360. ;overall volume level
  361. :DryPedalResonanceFactor .25
  362. ;0 no open string resonance
  363. ;1.0 is about full resonance of dampers raised
  364. ;can be greater than 1.0
  365. )))
  366. (with-sound ()
  367. (do ((i 0 (+ i 1))) ((= i 8))
  368. (p
  369. (* i .5)
  370. :duration .5
  371. :keyNum (+ 24 (* 12 i))
  372. :strike-velocity .5
  373. ;0 to 1, 0 is softest played note, 1 is loud note
  374. :amp .4
  375. ;overall volume level
  376. :DryPedalResonanceFactor .25
  377. ;0 no open string resonance
  378. ;1.0 is about full resonance of dampers raised
  379. ;can be greater than 1.0
  380. ;;modification to do detunedness
  381. :detuningFactor-table '(24 5 36 7.0 48 7.5 60 12.0 72 20
  382. 84 30 96 100 108 300)
  383. ;scales the above detuning values
  384. ; so 1.0 is nominal detuning
  385. ; 0.0 is exactly in tune (no two stage decay...)
  386. ; > 1.0 is out of tune...
  387. ;;modification to do stiffness
  388. :stiffnessFactor-table '(21 1.5 24 1.5 36 1.5 48 1.5 60 1.4
  389. 72 1.3 84 1.2 96 1.0 108 1.0)
  390. ;0.0 to 1.0 is less stiff, 1.0 to 2.0 is more stiff...
  391. )))
  392. (with-sound ()
  393. (do ((i 0 (+ i 1))) ((= i 8))
  394. (p
  395. (* i .5)
  396. :duration .5
  397. :keyNum (+ 24 (* 12 i))
  398. :strike-velocity .5
  399. ;0 to 1, 0 is softest played note, 1 is loud note
  400. :amp .4
  401. ;overall volume level
  402. :DryPedalResonanceFactor .25
  403. ;0 no open string resonance
  404. ;1.0 is about full resonance of dampers raised
  405. ;can be greater than 1.0
  406. ;;modifications to do damped sounds
  407. :singleStringDecayRate-table '(21 -5 24.000 -5.000 36.000 -5.4
  408. 41.953 -5.867 48.173 -7.113 53.818 -8.016
  409. 59.693 -8.875 66.605 -9.434 73.056 -10.035
  410. 78.931 -10.293 84.000 -12.185)
  411. :singleStringPole-table '(21 .8 24 0.7 36.000 .6 48 .5 60 .3
  412. 84 .1 96 .03 108 .03)
  413. :stiffnessCoefficient-table '(21.000 -0.920 24.000 -0.900 36.000 -0.700
  414. 48.000 -0.250 60.000 -0.100 75.179 -0.040
  415. 82.986 -0.040 92.240 .3 96.000 .5
  416. 99.000 .7 108.000 .7)
  417. ;these are the actual allpass coefficients modified here
  418. ;to allow dampedness at high freqs
  419. )))
  420. (let ((i 5))
  421. (with-sound ()
  422. (p
  423. 0
  424. :duration 5
  425. :keyNum (+ 24 (* 12 i))
  426. :strike-velocity .5
  427. ;0 to 1, 0 is softest played note, 1 is loud note
  428. :amp .4
  429. ;overall volume level
  430. :DryPedalResonanceFactor .25
  431. ;0 no open string resonance
  432. ;1.0 is about full resonance of dampers raised
  433. ;can be greater than 1.0
  434. ;;modification for long duration notes
  435. :singleStringDecayRateFactor 1/10
  436. ;scales attenuation rate (1/2 means twice as long duration)
  437. )))
  438. |#