;;; -*- Mode: Lisp; Syntax: Common-lisp; Package: COMMON-MUSIC; Base: 10 -*-

(defconstant NUMBER-OF-STIFFNESS-ALLPASSES 8)
(defconstant LONGITUDINAL-MODE-CUTOFF-KEYNUM 29)
(defconstant LONGITUDINAL-MODE-STIFFNESS-COEFFICIENT -.5)
(defconstant GOLDEN-MEAN .618)
(defconstant LOOP-GAIN-ENV-T60 .05)
(defconstant LOOP-GAIN-DEFAULT .9999)
(defconstant NSTRINGS 3)


;;keyNum indexed parameter tables
;;these should all be &key variable defaults for p instrument

(defvar default-loudPole-table
  '(36 .8 60 .85 84 .7 96 .6 108 .5))

(defvar default-softPole-table
  '(36 .93 60 .9 84 .9 96 .8 108 .8))

(defvar default-loudGain-table
  '(21.000 0.700 36.000 0.700 48.000 0.700 60.000 0.650 72.000 0.650 84.000 0.650 87.006 0.681 88.070 0.444 90.653 0.606 95.515 0.731 99.770 0.775 101.897 0.794 104.024 0.800 105.695 0.806))

(defvar default-softGain-table
  '(21 .25 108 .25))

(defvar default-strikePosition-table
  '(21.000 0.140 23.884 0.139 36.000 0.128 56.756 0.129 57.765 0.130 59.000 0.130 60.000 0.128 61.000 0.128 62.000 0.129 66.128 0.129 69.000 0.128 72.000 0.128 73.000 0.128 79.000 0.128 80.000 0.128 96.000 0.128 99.000 0.128))

(defvar default-detuning2-table
  '(22.017 -0.090 23.744 -0.090 36.000 -0.080 48.055 -0.113 60.000 -0.135 67.264 -0.160 72.000 -0.200 84.054 -0.301 96.148 -0.383 108 -0.383))

(defvar 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 0.020 83.984 0.034 96.000 0.034 99.766 0.034))

(defvar default-stiffnessCoefficient-table
  '(21.000 -0.920 24.000 -0.900 36.000 -0.700 48.000 -0.250 60.000 -0.100 75.179 -0.040 82.986 -0.040 92.240 -0.040 96.000 -0.040 99.000 .2 108.000 .5))

(defvar default-singleStringDecayRate-table
  '(21.678 -2.895 24.000 -3.000 36.000 -4.641 41.953 -5.867 48.173 -7.113 53.818 -8.016 59.693 -8.875 66.605 -9.434 73.056 -10.035 78.931 -10.293 84.000 -12.185))

(defvar default-singleStringZero-table
  '(21.000 -0.300 24.466 -0.117 28.763 -0.047 36.000 -0.030 48.000 -0.020 60.000 -0.010 72.000 -0.010 84.000 -0.010 96.000 -0.010))

(defvar default-singleStringPole-table
  '(21.000 0 24.466 0 28.763 0 36.000 0 108 0))

(defvar default-releaseLoopGain-table
  '(21.643 0.739 24.000 0.800 36.000 0.880 48.000 0.910 60.000 0.940 72.000 0.965 84.000 0.987 88.99 .987 89.0 1.0 108 1.0))

(defvar default-DryTapFiltCoefT60-table
  '(36 .35 60 .25 108 .15))

(defvar default-DryTapFiltCoefTarget-table
  '(36 -.8 60 -.5 84 -.4 108 -.1))

(defvar default-DryTapFiltCoefCurrent-table
  '(0 0 200 0))

(defvar default-DryTapAmpT60-table
  '(36 .55 60 .5 108 .45))

(defvar default-sustainPedalLevel-table
  '(21.000 0.250 24.000 0.250 36.000 0.200 48.000 0.125 60.000 0.075 72.000 0.050 84.000 0.030 96.000 0.010 99.000 0.010))

(defvar default-pedalResonancePole-table
  '(20.841 0.534 21.794 0.518 33.222 0.386 45.127 0.148 55.445 -0.065 69.255 -0.409 82.905 -0.729 95.763 -0.869 106.398 -0.861))

(defvar default-pedalEnvelopeT60-table
  '(21.0 7.5 108.0 7.5))

(defvar default-soundboardCutoffT60-table
  '(21.0 .25 108.0 .25))

(defvar default-DryPedalResonanceFactor-table
  '(21.0 .5 108.0 .5))


(defvar default-unaCordaGain-table
  '(21 1.0  24 .4 29 .1 29.1 .95 108 .95))




;; converts T60 values to suitable :rate values for expseg
(defun In-T60 (T60)
  (- 1.0 (expt 0.001 (/ 1.0 T60 sampling-rate))))

;;; expseg (like musickit asymp)
(def-clm-struct expsegstr currentValue targetValue rate)
(defun make-expseg (&key (currentValue 0.0) (targetValue 0.0) (rate .5))
  (make-expsegstr
   :currentValue currentValue :targetValue targetValue :rate rate))
(defmacro expseg (f)
  `(let ((cv (expsegstr-currentValue ,f)))
     (setf (expsegstr-currentValue ,f)
	   (+ cv (* (- (expsegstr-targetValue ,f) cv) (expsegstr-rate ,f))))))


(def-clm-struct simpfilt a0 a1 a2 b0 b1 b2 x1 x2 y1 y2)

;;; signal controlled one-pole lowpass filter
(defun make-one-pole-swept (&key (y1 0.0)) (make-simpfilt :y1 y1))
(defmacro one-pole-swept (f input coef)
  `(let* ((coef ,coef)
	  (output (- (* (1+ coef) ,input) (* coef (simpfilt-y1 ,f)))))
     (setf (simpfilt-y1 ,f) output)))

;;; one-pole allpass filter
(defun make-one-pole-allpass (coef &key (x1 0.0) (y1 0.0))
  (make-simpfilt :a0 coef :x1 x1 :y1 y1))
(defmacro one-pole-allpass (f input)
  `(let* ((input ,input)
	  (output (+ (* (simpfilt-a0 ,f) (- input (simpfilt-y1 ,f)))
		     (simpfilt-x1 ,f))))
     (setf (simpfilt-x1 ,f) input
	   (simpfilt-y1 ,f) output)))


;;; one-pole-one-zero filter:  y(n) = a0 x(n) + a1 x(n-1) - b0 y(n-1)
(defun make-one-pole-one-zero (a0 a1 b1 &key (x1 0.0) (y1 0.0))
  (make-simpfilt :a0 a0 :a1 a1 :b1 b1 :x1 x1 :y1 y1))
(defmacro one-pole-one-zero (f input)
  `(let* ((input ,input)
	  (output (- (+ (* (simpfilt-a0 ,f) input)
			(* (simpfilt-a1 ,f) (simpfilt-x1 ,f)))
		     (* (simpfilt-b1 ,f) (simpfilt-y1 ,f)))))
     (setf (simpfilt-x1 ,f) input
	   (simpfilt-y1 ,f) output)))

;;;very special noise generator
(def-clm-struct noisestr (noise-seed INTEGER))
(defun make-noise (&key (noise-seed 16383))
  (make-noisestr :noise-seed noise-seed))
(defmacro noise (r amp)
  `(let
       ((seed (+ (* (noisestr-noise-seed ,r) 1103515245)
		 12345)))
     (setf (noisestr-noise-seed ,r) seed)
     (* ,amp (- (* (mod (/ seed
			   65536) 65536) 0.0000305185) 1.0))))


;;;delay line unit generator with length 0 capabilities...
(defun make-delay0 (len)
  (cond ((> len 0) (make-delay len))
	((= len 0) nil)
	(t (clm-print "can't handle that much stiffness on current pitch") nil)))
(defmacro delay0 (f input)
  `(let ((input ,input))
     (if ,f (delay ,f input) input)))



(definstrument (p :language :c :c-options "-c -O3")
  (&key
   (start 0.0)
   (duration 1.0)
   (keyNum 60.0) ;;middleC=60: can use fractional part to detune
   (strike-velocity 0.5) ;;corresponding normalized velocities (range: 0.0--1.0)
   (pedal-down nil) ;;set to t for sustain pedal down...pedal-down-times not yet impl.
   (release-time-margin 0.75) ;;extra compute time allowed beyond duration
   (amp .5) ;;amp scale of noise inputs...
   
   ;;slider controls
   (detuningFactor 1.0)
   (detuningFactor-table '())
   (stiffnessFactor 1.0)
   (stiffnessFactor-table '())
   (pedalPresenceFactor .3)
   (longitudinalMode 10.5)
   (StrikePositionInvFac -0.9)
   (singleStringDecayRateFactor 1.0)
;;;	 (degree 0.0)
;;;	 (distance 1.0)
;;;	 (reverb-amount 0.01)
   
   ;; parameter tables indexed by keyNum
   ;; NB: you can override the loudPole-table by directly setting :loudPole to a value
   loudPole
   (loudPole-table default-loudPole-table)
   softPole
   (softPole-table default-softPole-table)
   loudGain
   (loudGain-table default-loudGain-table)
   softGain
   (softGain-table default-softGain-table)
   strikePosition (strikePosition-table default-strikePosition-table)
   detuning2
   (detuning2-table default-detuning2-table)
   detuning3
   (detuning3-table default-detuning3-table)
   stiffnessCoefficient
   (stiffnessCoefficient-table default-stiffnessCoefficient-table)
   singleStringDecayRate
   (singleStringDecayRate-table default-singleStringDecayRate-table)
   singleStringZero
   (singleStringZero-table default-singleStringZero-table)
   singleStringPole
   (singleStringPole-table default-singleStringPole-table)
   releaseLoopGain
   (releaseLoopGain-table default-releaseLoopGain-table)
   DryTapFiltCoefT60
   (DryTapFiltCoefT60-table default-DryTapFiltCoefT60-table)
   DryTapFiltCoefTarget
   (DryTapFiltCoefTarget-table default-DryTapFiltCoefTarget-table)
   DryTapFiltCoefCurrent
   (DryTapFiltCoefCurrent-table default-DryTapFiltCoefCurrent-table)
   DryTapAmpT60
   (DryTapAmpT60-table default-DryTapAmpT60-table)
   sustainPedalLevel
   (sustainPedalLevel-table default-sustainPedalLevel-table)
   pedalResonancePole
   (pedalResonancePole-table default-pedalResonancePole-table)
   pedalEnvelopeT60
   (pedalEnvelopeT60-table default-pedalEnvelopeT60-table)
   soundboardCutoffT60
   (soundboardCutoffT60-table default-soundboardCutoffT60-table)
   DryPedalResonanceFactor
   (DryPedalResonanceFactor-table default-DryPedalResonanceFactor-table)
   unaCordaGain
   (unaCordaGain-table default-unaCordaGain-table)
   )

  (labels
      ((apPhase (a1 wT)
		(atan (* (- (* a1 a1) 1.0) (sin wT))
		      (+ (* 2.0 a1) (*(+ (* a1 a1) 1.0) (cos wT)))))
       (opozPhase (b0 b1 a1 wT)
		  (let ((s (sin wT))
			(c (cos wT)))
		    (atan (- (* a1 s (+ b0 (* b1 c))) (* b1 s (+ 1 (* a1 c))))
			  (+ (* (+ b0 (* b1 c)) (+ 1 (* a1 c))) (* b1 s a1 s)))))
       (get-allpass-coef (samp-frac wT)
			 (let ((ta (tan (- (* samp-frac wT))))
			       (c (cos wT))
			       (s (sin wT)))
			   (/ (+ (- ta) (* (signum ta)
					   (sqrt (* (1+ (* ta ta)) (* s s)))))
			      (- (* c ta) s))))
       (apfloor (len wT)
		(multiple-value-bind
		    (len-int len-frac) (floor len)
		  (if (< len-frac GOLDEN-MEAN)
		      (let () (decf len-int)(incf len-frac)))
		  (and (< len-frac GOLDEN-MEAN)
		       (> len-int 0)
		       (let () (decf len-int)(incf len-frac)))
		  (values len-int (get-allpass-coef len-frac wT))))
       (tune-piano (frequency stiffnessCoefficient numAllpasses b0 b1 a1)
		   (let*
		       ((wT (/ (* frequency TWO-PI) sampling-rate))
			(len (/ (+ TWO-PI
				   (* numAllpasses
				      (apPhase stiffnessCoefficient wT))
				   (opozPhase
				    (+ 1 (* 3 b0)) (+ a1 (* 3 b1)) a1 wT))
				wT)))
		     (apfloor len wT))))
    
    (let*
	((beg (floor (* start sampling-rate)))
	 (end (+ beg (floor (* (+ duration release-time-margin)
			       sampling-rate))))
	 (dur (floor (* duration sampling-rate)))
	 (freq (* 440.0 (expt 2.0 (/ (- keyNum 69.0) 12.0))))
	 (wT (/ (* two-pi freq) sampling-rate))
	 
	 ;;look-up parameters in tables (or else use the override value)
	 (loudPole
	  (or loudPole
	      (list-interp keyNum loudPole-table)))
	 (softPole
	  (or softPole
	      (list-interp keyNum softPole-table)))
	 (loudGain
	  (or loudGain
	      (list-interp keyNum loudGain-table)))
	 (softGain
	  (or softGain
	      (list-interp keyNum softGain-table)))
	 (strikePosition
	  (or strikePosition
	      (list-interp keyNum strikePosition-table)))
	 (detuning2
	  (or detuning2
	      (list-interp keyNum detuning2-table)))
	 (detuning3
	  (or detuning3
	      (list-interp keyNum detuning3-table)))
	 (stiffnessCoefficient
	  (or stiffnessCoefficient
	      (list-interp keyNum stiffnessCoefficient-table)))
	 (singleStringDecayRate
	  (or singleStringDecayRate
	      (list-interp keyNum singleStringDecayRate-table)))
	 (singleStringDecayRate (* singleStringDecayRateFactor
				   singleStringDecayRate))
	 (singleStringZero
	  (or singleStringZero
	      (list-interp keyNum singleStringZero-table)))
	 (singleStringPole
	  (or singleStringPole
	      (list-interp keyNum singleStringPole-table)))
	 (releaseLoopGain
	  (or releaseLoopGain
	      (list-interp keyNum releaseLoopGain-table)))
	 (DryTapFiltCoefT60
	  (or DryTapFiltCoefT60
	      (list-interp keyNum DryTapFiltCoefT60-table)))
	 (DryTapFiltCoefTarget
	  (or DryTapFiltCoefTarget
	      (list-interp keyNum DryTapFiltCoefTarget-table)))
	 (DryTapFiltCoefCurrent
	  (or DryTapFiltCoefCurrent
	      (list-interp keyNum DryTapFiltCoefCurrent-table)))
	 (DryTapAmpT60
	  (or DryTapAmpT60
	      (list-interp keyNum DryTapAmpT60-table)))
	 (sustainPedalLevel
	  (or sustainPedalLevel
	      (list-interp keyNum sustainPedalLevel-table)))
	 (pedalResonancePole
	  (or pedalResonancePole
	      (list-interp keyNum pedalResonancePole-table)))
	 (pedalEnvelopeT60
	  (or pedalEnvelopeT60
	      (list-interp keyNum pedalEnvelopeT60-table)))
	 (soundboardCutoffT60
	  (or soundboardCutoffT60
	      (list-interp keyNum soundboardCutoffT60-table)))
	 (DryPedalResonanceFactor
	  (or DryPedalResonanceFactor
	      (list-interp keyNum DryPedalResonanceFactor-table)))
	 (unaCordaGain
	  (or unaCordaGain
	      (list-interp keyNum unaCordaGain-table)))
	 (detuningFactor
	  (if detuningFactor-table
	      (list-interp keyNum detuningFactor-table)
	    detuningFactor))
	 (stiffnessFactor
	  (if stiffnessFactor-table
	      (list-interp keyNum stiffnessFactor-table)
	    stiffnessFactor))
	 
	 ;;initialize locsig
;;;	 (loc (make-locsig :distance distance :degree degree :revscale reverb-amount))

	 ;;initialize soundboard impulse response elements
	 (dryTap-one-pole-one-zero
	  (make-one-pole-one-zero 1.0 0.0 0.0))
	 (dryTap-coef-expseg
	  (make-expseg
	   :currentValue DryTapFiltCoefCurrent
	   :targetValue DryTapFiltCoefTarget
	   :rate (In-T60 DryTapFiltCoefT60)))
	 (dryTap-one-pole-swept
	  (make-one-pole-swept))
	 (dryTap-amp-expseg
	  (make-expseg
	   :currentValue 1.0
	   :targetValue 0.0
	   :rate (In-T60 DryTapAmpT60)))
	 
	 ;;initialize open-string resonance elements		
	 (wetTap-one-pole-one-zero
	  (make-one-pole-one-zero
	   (- 1.0 (* (signum pedalResonancePole) pedalResonancePole))
	   0.0
	   (- pedalResonancePole)))
	 (wetTap-coef-expseg
	  (make-expseg
	   :currentValue 0.0
	   :targetValue -.5
	   :rate (In-T60 pedalEnvelopeT60)))
	 (wetTap-one-pole-swept
	  (make-one-pole-swept))
	 (wetTap-amp-expseg
	  (make-expseg
	   :currentValue (* sustainPedalLevel
			    pedalPresenceFactor
			    (if pedal-down 1.0 DryPedalResonanceFactor))
	   :targetValue 0.0
	   :rate (In-T60 pedalEnvelopeT60)))
	 (sb-cutoff-rate
	  (In-T60 soundboardCutoffT60))
	 
	 ;;initialize velocity-dependent piano hammer filter elements
	 (hammerPole
	  (+ softPole (* (- loudPole softPole) strike-velocity)))
	 (hammerGain
	  (+ softGain (* (- loudGain softGain) strike-velocity)))
	 (hammer-one-pole1
	  (make-one-pole (* 1.0 (- 1.0 hammerPole)) (- hammerPole)))
	 (hammer-one-pole2
	  (make-one-pole (* 1.0 (- 1.0 hammerPole)) (- hammerPole)))
	 (hammer-one-pole3
	  (make-one-pole (* 1.0 (- 1.0 hammerPole)) (- hammerPole)))
	 (hammer-one-pole4
	  (make-one-pole (* 1.0 (- 1.0 hammerPole)) (- hammerPole)))
	 
	 ;;strike position comb filter delay length
	 (agraffe-len (/ (* sampling-rate strikePosition) freq)))
      (multiple-value-bind
	  (dlen1 apcoef1) (apfloor agraffe-len wT)
	(let*
	    ((agraffe-delay1 (make-delay0 dlen1))
	     (agraffe-tuning-ap1 (make-one-pole-allpass apcoef1))
	     
	     ;;compute coefficients for and initialize the coupling filter
	     ;;taking L=g(1 - bz^-1)/(1-b), and computing Hb = -(1-L)/(2-L)
	     (attenuationPerPeriod
	      (expt 10.0 (/ singleStringDecayRate freq 20.0)))
	     (g attenuationPerPeriod)  ;;DC gain
	     (b singleStringZero)
	     (a singleStringPole)
	     (ctemp (+ 1 (- b) g (- (* a g))
		       (* NSTRINGS (+ 1 (- b) (- g) (* a g)))))

	     (cfb0 (/ (* 2 (+ -1 b g (- (* a g)))) ctemp))
	     (cfb1 (/ (* 2 (+ a (- (* a b)) (- (* b g)) (* a b g))) ctemp))
	     (cfa1 (/ (+ (- a) (* a b) (- (* b g)) (* a b g)
			 (* NSTRINGS (+ (- a) (* a b) (* b g) (- (* a b g)))))
		      ctemp))
	     (couplingFilter (make-one-pole-one-zero cfb0 cfb1 cfa1))
	     
	     ;;determine string tunings (and longitudinal modes, if present)
	     (freq1
	      (if (<= keyNum LONGITUDINAL-MODE-CUTOFF-KEYNUM)
		  (* freq longitudinalMode) freq))
	     (freq2 (+ freq (* detuning2 detuningFactor)))
	     (freq3 (+ freq (* detuning3 detuningFactor)))
	     
	     ;;scale stiffness coefficients, if desired
	     (stiffnessCoefficient
	      (if (> stiffnessFactor 1.0)
		  (- stiffnessCoefficient
		     (* (1+ stiffnessCoefficient)
			(1- stiffnessFactor)))
		(* stiffnessCoefficient stiffnessFactor)))
	     (stiffnessCoefficientL
	      (if (<= keyNum LONGITUDINAL-MODE-CUTOFF-KEYNUM)
		  LONGITUDINAL-MODE-STIFFNESS-COEFFICIENT
		stiffnessCoefficient)))
	  
	  ;;initialize the coupled-string elements
	  (multiple-value-bind
	      (delayLength1 tuningCoefficient1)
	      (tune-piano
	       freq1 stiffnessCoefficientL
	       NUMBER-OF-STIFFNESS-ALLPASSES
	       cfb0 cfb1 cfa1)
	    (multiple-value-bind
		(delayLength2 tuningCoefficient2)
		(tune-piano
		 freq2 stiffnessCoefficient
		 NUMBER-OF-STIFFNESS-ALLPASSES
		 cfb0 cfb1 cfa1)
	      (multiple-value-bind
		  (delayLength3 tuningCoefficient3)
		  (tune-piano
		   freq3 stiffnessCoefficient
		   NUMBER-OF-STIFFNESS-ALLPASSES
		   cfb0 cfb1 cfa1)
		(let*
		    ((string1-delay
		      (make-delay0 (1- delayLength1)))
		     (string1-tuning-ap
		      (make-one-pole-allpass tuningCoefficient1))
		     (string1-stiffness-ap1
		      (make-one-pole-allpass stiffnessCoefficientL))
		     (string1-stiffness-ap2
		      (make-one-pole-allpass stiffnessCoefficientL))
		     (string1-stiffness-ap3
		      (make-one-pole-allpass stiffnessCoefficientL))
		     (string1-stiffness-ap4
		      (make-one-pole-allpass stiffnessCoefficientL))
		     (string1-stiffness-ap5
		      (make-one-pole-allpass stiffnessCoefficientL))
		     (string1-stiffness-ap6
		      (make-one-pole-allpass stiffnessCoefficientL))
		     (string1-stiffness-ap7
		      (make-one-pole-allpass stiffnessCoefficientL))
		     (string1-stiffness-ap8
		      (make-one-pole-allpass stiffnessCoefficientL))
		     
		     (string2-delay
		      (make-delay0 (1- delayLength2)))
		     (string2-tuning-ap
		      (make-one-pole-allpass tuningCoefficient2))
		     (string2-stiffness-ap1
		      (make-one-pole-allpass stiffnessCoefficient))
		     (string2-stiffness-ap2
		      (make-one-pole-allpass stiffnessCoefficient))
		     (string2-stiffness-ap3
		      (make-one-pole-allpass stiffnessCoefficient))
		     (string2-stiffness-ap4
		      (make-one-pole-allpass stiffnessCoefficient))
		     (string2-stiffness-ap5
		      (make-one-pole-allpass stiffnessCoefficient))
		     (string2-stiffness-ap6
		      (make-one-pole-allpass stiffnessCoefficient))
		     (string2-stiffness-ap7
		      (make-one-pole-allpass stiffnessCoefficient))
		     (string2-stiffness-ap8
		      (make-one-pole-allpass stiffnessCoefficient))
		     
		     (string3-delay
		      (make-delay0 (1- delayLength3)))
		     (string3-tuning-ap
		      (make-one-pole-allpass tuningCoefficient3))
		     (string3-stiffness-ap1
		      (make-one-pole-allpass stiffnessCoefficient))
		     (string3-stiffness-ap2
		      (make-one-pole-allpass stiffnessCoefficient))
		     (string3-stiffness-ap3
		      (make-one-pole-allpass stiffnessCoefficient))
		     (string3-stiffness-ap4
		      (make-one-pole-allpass stiffnessCoefficient))
		     (string3-stiffness-ap5
		      (make-one-pole-allpass stiffnessCoefficient))
		     (string3-stiffness-ap6
		      (make-one-pole-allpass stiffnessCoefficient))
		     (string3-stiffness-ap7
		      (make-one-pole-allpass stiffnessCoefficient))
		     (string3-stiffness-ap8
		      (make-one-pole-allpass stiffnessCoefficient))
		     
		     ;;initialize loop-gain envelope
		     (loop-gain-expseg
		      (make-expseg
		       :currentValue LOOP-GAIN-DEFAULT
		       :targetValue releaseLoopGain
		       :rate (In-T60 LOOP-GAIN-ENV-T60)))
		     
		     (dryTap 0.0)
		     (openStrings 0.0)
		     (combedExcitationSignal 0.0)
		     (adelOut 0.0)
		     (adelIn 0.0)
		     (totalTap 0.0)
		     (loop-gain LOOP-GAIN-DEFAULT)
		     (is-release-time nil)
		     (string1-junction-input 0.0)
		     (string2-junction-input 0.0)
		     (string3-junction-input 0.0)
		     (couplingFilter-input 0.0)
		     (couplingFilter-output 0.0)
		     (sampCount 0)
		     (noi (make-noise)))
		  (run
		   (loop
		    for i from beg to end
		    do
		    (cond
		     (is-release-time
		      (setf loop-gain (expseg loop-gain-expseg)))
		     ((= sampCount dur)
		      (setf
		       is-release-time t
		       (expsegstr-rate dryTap-amp-expseg) sb-cutoff-rate
		       (expsegstr-rate wetTap-amp-expseg) sb-cutoff-rate)))
		    
		    (setf
		     dryTap
		     (* (expseg
			 dryTap-amp-expseg)
			(one-pole-swept
			 dryTap-one-pole-swept
			 (one-pole-one-zero
			  dryTap-one-pole-one-zero
			  (noise noi amp))
			 (expseg
			  dryTap-coef-expseg)))
		     
		     openStrings
		     (* (expseg
			 wetTap-amp-expseg)
			(one-pole-swept
			 wetTap-one-pole-swept
			 (one-pole-one-zero
			  wetTap-one-pole-one-zero
			  (noise noi amp))
			 (expseg
			  wetTap-coef-expseg)))
		     
		     totalTap
		     (+ dryTap openStrings)
		     
		     adelIn
		     (one-pole
		      hammer-one-pole1
		      (one-pole
		       hammer-one-pole2
		       (one-pole
			hammer-one-pole3
			(one-pole
			 hammer-one-pole4
			 totalTap ))))
		     
		     
		     combedExcitationSignal
		     (* hammerGain
			(+ adelOut
			   (* adelIn StrikePositionInvFac)))
		     
		     adelOut
		     (one-pole-allpass
		      agraffe-tuning-ap1
		      (delay0
		       agraffe-delay1
		       adelIn))
		     
		     string1-junction-input
		     (+ (* unaCordaGain combedExcitationSignal)
			(* loop-gain
			   (delay0
			    string1-delay
			    (one-pole-allpass
			     string1-tuning-ap
			     (one-pole-allpass
			      string1-stiffness-ap1
			      (one-pole-allpass
			       string1-stiffness-ap2
			       (one-pole-allpass
				string1-stiffness-ap3
				(one-pole-allpass
				 string1-stiffness-ap4
				 (one-pole-allpass
				  string1-stiffness-ap5
				  (one-pole-allpass
				   string1-stiffness-ap6
				   (one-pole-allpass
				    string1-stiffness-ap7
				    (one-pole-allpass
				     string1-stiffness-ap8
				     (+ couplingFilter-output
					string1-junction-input)))))))))))))
		     
		     string2-junction-input
		     (+ combedExcitationSignal
			(* loop-gain
			   (delay0
			    string2-delay
			    (one-pole-allpass
			     string2-tuning-ap
			     (one-pole-allpass
			      string2-stiffness-ap1
			      (one-pole-allpass
			       string2-stiffness-ap2
			       (one-pole-allpass
				string2-stiffness-ap3
				(one-pole-allpass
				 string2-stiffness-ap4
				 (one-pole-allpass
				  string2-stiffness-ap5
				  (one-pole-allpass
				   string2-stiffness-ap6
				   (one-pole-allpass
				    string2-stiffness-ap7
				    (one-pole-allpass
				     string2-stiffness-ap8
				     (+ couplingFilter-output
					string2-junction-input)))))))))))))
		     
		     string3-junction-input
		     (+ combedExcitationSignal
			(* loop-gain
			   (delay0
			    string3-delay
			    (one-pole-allpass
			     string3-tuning-ap
			     (one-pole-allpass
			      string3-stiffness-ap1
			      (one-pole-allpass
			       string3-stiffness-ap2
			       (one-pole-allpass
				string3-stiffness-ap3
				(one-pole-allpass
				 string3-stiffness-ap4
				 (one-pole-allpass
				  string3-stiffness-ap5
				  (one-pole-allpass
				   string3-stiffness-ap6
				   (one-pole-allpass
				    string3-stiffness-ap7
				    (one-pole-allpass
				     string3-stiffness-ap8
				     (+ couplingFilter-output
					string3-junction-input)))))))))))))
		     
		     couplingFilter-input
		     (+ string1-junction-input
			string2-junction-input
			string3-junction-input)
		     
		     couplingFilter-output
		     (one-pole-one-zero
		      couplingFilter
		      couplingFilter-input))
;;;		    (locsig loc i couplingFilter-input)
		    (outa i couplingFilter-input)
		    (incf sampCount)))
		  (end-run))))))))))



#|

(with-sound (:output (truename "~/thnormal.snd"))
	    (loop for i from 0 to 7 do
		  (p
		   :start (* i .5)
		   :duration .5
		   :keyNum (+ 24 (* 12 i))
		   :strike-velocity .5
					;0 to 1, 0 is softest played note, 1 is loud note
		   :amp .4
					;overall volume level
		   :DryPedalResonanceFactor .25
					;0 no open string resonance
					;1.0 is about full resonance of dampers raised
					;can be greater than 1.0
		   )))

(with-sound (:output (truename "~/thstiff.snd"))
	    (loop for i from 0 to 7 do
		  (p
		   :start (* i .5)
		   :duration .5
		   :keyNum (+ 24 (* 12 i))
		   :strike-velocity .5
					;0 to 1, 0 is softest played note, 1 is loud note
		   :amp .4
					;overall volume level
		   :DryPedalResonanceFactor .25
					;0 no open string resonance
					;1.0 is about full resonance of dampers raised
					;can be greater than 1.0

		   ;;modification to do detunedness
		   :detuningFactor-table '(24 5 36 7.0 48 7.5 60 12.0 72 20
					      84 30 96 100 108 300)
					;scales the above detuning values
					;  so 1.0 is nominal detuning
					;  0.0 is exactly in tune (no two stage decay...)
					;  > 1.0 is out of tune...

		   ;;modification to do stiffness
		   :stiffnessFactor-table '(21 1.5 24 1.5 36 1.5 48 1.5 60 1.4
					       72 1.3 84 1.2 96 1.0 108 1.0)
					;0.0 to 1.0 is less stiff, 1.0 to 2.0 is more stiff...
		   )))

(with-sound (:output (truename "~/thdamped.snd"))
	    (loop for i from 0 to 7 do
		  (p
		   :start (* i .5)
		   :duration .5
		   :keyNum (+ 24 (* 12 i))
		   :strike-velocity .5
					;0 to 1, 0 is softest played note, 1 is loud note
		   :amp .4
					;overall volume level
		   :DryPedalResonanceFactor .25
					;0 no open string resonance
					;1.0 is about full resonance of dampers raised
					;can be greater than 1.0

		   ;;modifications to do damped sounds
		   :singleStringDecayRate-table '(21 -5 24.000 -5.000 36.000 -5.4
						     41.953 -5.867 48.173 -7.113 53.818 -8.016
						     59.693 -8.875 66.605 -9.434 73.056 -10.035
						     78.931 -10.293 84.000 -12.185)
		   :singleStringPole-table '(21 .8 24 0.7  36.000 .6 48 .5 60 .3
						84 .1 96 .03 108 .03)
		   :stiffnessCoefficient-table '(21.000 -0.920 24.000 -0.900 36.000 -0.700
							48.000 -0.250 60.000 -0.100 75.179 -0.040
							82.986 -0.040 92.240 .3 96.000 .5
							99.000 .7 108.000 .7)
					;these are the actual allpass coefficients modified here
					;to allow dampedness at hig freqs
		   )))

(with-sound (:output (truename "~/thextend.snd"))
	    (loop for i from 5 to 5 do
		  (p
		   :start 0
		   :duration 10
		   :keyNum (+ 24 (* 12 i))
		   :strike-velocity .5
					;0 to 1, 0 is softest played note, 1 is loud note
		   :amp .4
					;overall volume level
		   :DryPedalResonanceFactor .25
					;0 no open string resonance
					;1.0 is about full resonance of dampers raised
					;can be greater than 1.0

		   ;;modification for long duration notes
		   :singleStringDecayRateFactor 1/10
					;scales attenuation rate (1/2 means twice as long duration)
		   )))


|#