;;; -*- 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 *srate*))))

;;; 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)
(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
   (start
   &key (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)
         ;;;locsig arguments **
         (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) *srate*))
		     (len (/ (+ TWO-PI
				(* numAllpasses
				   (apPhase stiffnessCoefficient wT))
				(opozPhase
				 (+ 1 (* 3 b0)) (+ a1 (* 3 b1)) a1 wT))
			     wT)))
		  (apfloor len wT))))
 
   (let*
       ((beg (floor (* start *srate*)))
	(end (+ beg (floor (* (+ duration release-time-margin)
			      *srate*))))
	(dur (floor (* duration *srate*)))
	(freq (* 440.0 (expt 2.0 (/ (- keyNum 69.0) 12.0))))
	(wT (/ (* two-pi freq) *srate*))
	
	;;look-up parameters in tables (or else use the override value)
	(loudPole
	 (or loudPole
	     (envelope-interp keyNum loudPole-table)))
	(softPole
	 (or softPole
	     (envelope-interp keyNum softPole-table)))
	(loudGain
	 (or loudGain
	     (envelope-interp keyNum loudGain-table)))
	(softGain
	 (or softGain
	     (envelope-interp keyNum softGain-table)))
	(strikePosition
	 (or strikePosition
	     (envelope-interp keyNum strikePosition-table)))
	(detuning2
	 (or detuning2
	     (envelope-interp keyNum detuning2-table)))
	(detuning3
	 (or detuning3
	     (envelope-interp keyNum detuning3-table)))
	(stiffnessCoefficient
	 (or stiffnessCoefficient
	     (envelope-interp keyNum stiffnessCoefficient-table)))
	(singleStringDecayRate
	 (or singleStringDecayRate
	     (envelope-interp keyNum singleStringDecayRate-table)))
	(singleStringDecayRate (* singleStringDecayRateFactor
														singleStringDecayRate))
	(singleStringZero
	 (or singleStringZero
	     (envelope-interp keyNum singleStringZero-table)))
	(singleStringPole
	 (or singleStringPole
	     (envelope-interp keyNum singleStringPole-table)))
	(releaseLoopGain
	 (or releaseLoopGain
	     (envelope-interp keyNum releaseLoopGain-table)))
	(DryTapFiltCoefT60
	 (or DryTapFiltCoefT60
	     (envelope-interp keyNum DryTapFiltCoefT60-table)))
	(DryTapFiltCoefTarget
	 (or DryTapFiltCoefTarget
	     (envelope-interp keyNum DryTapFiltCoefTarget-table)))
	(DryTapFiltCoefCurrent
	 (or DryTapFiltCoefCurrent
	     (envelope-interp keyNum DryTapFiltCoefCurrent-table)))
	(DryTapAmpT60
	 (or DryTapAmpT60
	     (envelope-interp keyNum DryTapAmpT60-table)))
	(sustainPedalLevel
	 (or sustainPedalLevel
	     (envelope-interp keyNum sustainPedalLevel-table)))
	(pedalResonancePole
	 (or pedalResonancePole
	     (envelope-interp keyNum pedalResonancePole-table)))
	(pedalEnvelopeT60
	 (or pedalEnvelopeT60
	     (envelope-interp keyNum pedalEnvelopeT60-table)))
	(soundboardCutoffT60
	 (or soundboardCutoffT60
	     (envelope-interp keyNum soundboardCutoffT60-table)))
	(DryPedalResonanceFactor
	 (or DryPedalResonanceFactor
	     (envelope-interp keyNum DryPedalResonanceFactor-table)))
	(unaCordaGain
	 (or unaCordaGain
	     (envelope-interp keyNum unaCordaGain-table)))
	(detuningFactor
	(if detuningFactor-table
		(envelope-interp keyNum detuningFactor-table)
		detuningFactor))
	(stiffnessFactor
	(if stiffnessFactor-table
		(envelope-interp keyNum stiffnessFactor-table)
		stiffnessFactor))
	
	;;initialize locsig
	(loc (make-locsig :distance distance :degree degree :reverb 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 (/ (* *srate* 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)))
	       )))))))))



#|

(with-sound (:output "thnormal.snd")
  (loop for i from 0 to 7 do
    (p
     (* 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 "thstiff.snd")
  (loop for i from 0 to 7 do
    (p
     (* 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 "thdamped.snd")
  (loop for i from 0 to 7 do
    (p
     (* 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 "thextend.snd")
  (loop for i from 5 to 5 do
    (p
     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)
     )))


|#
