<info>
ESM Csound Library
Lib. algorithm: celesta   sco: celesta1
Allan Schindler  1/97
</info>
<tk_interface>


</tk_interface>
<mono>
; ### Eastman Orchestra Library Instrument  c_e_l_e_s_t_a ###
; Function needed:  100
; p6 =  attack time(c. .015-.03)
; p7 attack hardness (.7-1.4)           ; p8 = brightness (.5-1.4)
; p9 = % tremolo(c. .05-.09)            ; p10 = tremolo rate( c. 4. - 6.)
; p11 = flag for duration: if 0,dur.=p3 ; if 1, dur. = detached,short
;     notes; if 2, pedal               
 ; p12 = detuning p-field, mostly for chorusing

instr 36
; Set defaults
	p7 = (p7 = 0 ? 1. : p7)
	p8 = (p8 = 0 ? 1. : p8)
p4 = (p4>0?p4:(abs(p4))/100)  ; for microtones; -800.050 = quarter tone above c
i1 = (p4<15?cpspch(p4):p4)          ; pitch can be given in pch or cps in score
        ;  --- Detuning  module (mostly for use with "chorus" ) ---
  idetunepf = p12
if idetunepf = 0 goto detunedone ;skip all this if detuning set to 0 in score
       idtcount init 0  ; counter
       idtmult =  (idetunepf > 0 ? 1.05946 : .94387) ;1/2 step freqency ratios
  idetune init 1.  ; detuning multiplier for p4 pitch
        icheck = abs(idetunepf)
        icheck = int(icheck)

   dumbloop:
	      idtcount = idtcount + 1   ; increment counter
	      idtmult = (icheck = 0 ? 1 : idtmult)
	      idetune = idetune * idtmult 
   if idtcount < icheck igoto dumbloop
 ; microtonal detuning:
	idtmult = abs(idetunepf)
	idtmult = frac(idtmult)
	idtmult = idtmult * .05496
	idtmult = (idetunepf > 0 ? idtmult : - idtmult)
	idetune = idetune + idtmult
i1 = i1 * idetune 
detunedone:   ; ---end of detuning module -------
i2 = octcps(i1)
i3 = (18-i2)*.1                         ; c4=1.,c3=1.1,c5=.9,etc.
i4 = (i3+1)/2
i5 = ((12.75-i2)*.04*((p7+1)/2))+.46    ; duration is frequency dependent
if p11 > 0 igoto flag
i13 = p3
igoto amp
flag: i13 = (p11=1?i5:((12.75-i2)*.1*((p7+1)/2))+4.4)

amp: p5 = p5*((p7+1)/2)*(i3<1.? (i4+1)/2 :(i3+2)/3)

a1 linseg 0,(1/p7)*p6,1,((2/(p7+1))*.07)-p6,(3/(p7+2))*.5,.1*i5,.2,.15*i5,i4*.1,.25*i5,.05,i13-(.07+(.5*i5)),0,p3,0
a2 linseg 1,p3-.06,1,.06,0
a1 = a1*a2*p5
k2 linseg 1000,p6,0,p3,0     ; used only to avoid turning instr off at outset
k1 rms a1
if k1+k2 > 20 kgoto contin
  turnoff
; Tremolo
contin:
p9 = (p9 = 0 ? .001 : p9)
p10 = (p10 = 0 ? .001 : p10)
p10 = p10*(1/i4)	     ; faster tremolo for higher notes
k3 line 1.15*p10,i13,.85*p10
k4 randi .08*k3,3
k2 oscili p9,k3+k4,100
; Random amplitude deviation
k3 expseg p7*.13,p6,p7*.08,i5-p6,.04
a2 randi k3,50/p7
a1 = a1+(k2+a2)*a1             ; Total amplitude

; ATTACK CHIFF
k2 expseg p7*i4*.33,((p7+1)/2)*(1/i4)*(.6*p6),.001,p3,.001
a5 randi k2,3500/(p7*p7)
; - - -
; 4 partials                             

; Envelopes for the 4 partials
a2 expseg i4*.15*p8,i5*p8*i4*.37,.007
a2 = a2*a1
a3 expseg i4*.11*p8,i5*p8*i4*.27,.005
a3 = a3*a1
a4 expseg i4*.08*p8,i5*p8*i4*.18,.003
a4 = a4*a1
a1 = a1-(a2+a3+a4)
; Frequencies of the partials
if i2 > 8.75 igoto high
i6 = 2.74+((8.75-i2)*.02)*i1   ; pitches a4 to a5       
i7 = 5.4+((8.75-i2)*.1)*i1
i8 = 8.85+((8.75-i2)*.2)*i1
igoto doitnow
high: if i2 > 9.75 igoto higher
i6 = 2.72+((9.75-i2)*.02)*i1   ; a5-a6      
i7 = 5.3+((9.75-i2)*.2)*i1
i8 = 8.6+((9.75-i2)*.3)*i1
igoto doitnow
higher: if i2 > 10.75 igoto highest
i6 = 2.7+((10.75-i2)*.02)*i1   ; a6-a7       
i7 = 5.1+((10.75-i2)*.2)*i1
i8 = 8.3+((10.75-i2)*.3)*i1
i8 = (i8<sr/2?i8:.85*(sr/2))      ; foldover protection
igoto doitnow
highest:
i6 = 2.7-((i2-10.75)*.09)*i1   ; above a7
i6 = (i6<sr/2?i6:2.03*i1)            ; foldover protection
i7 = 5.1-((i2-10.75)*.2)*i1
i7 = (i7<sr/2?i7:.99*i1)             ; foldover protection
i8 = 8.1+((8.75-i2)*.2)*i1
i8 = (i8<sr/2?i8:1.002*i1)            ; foldover protection

doitnow:
a2 oscili a2,i6+(a5*i6),100,.05
a3 oscili a3,i7+(a5*i7),100,.11
a4 oscili a4,i8+(p7*i3*.8*a5*i8),100,.15
a1 oscili a1,i1+(a5*i1),100              
a1 = a1+a2+a3+a4

a1 atone 1.5*a1,.45*i1                      ; removes low difference tones
;Standard out statement
out a1
endin
    
</mono>
<stereo>


</stereo>
<quad>


</quad>
<score>
f100 0 1024 10 1.
  i36 0.000 1.500 8.09 13000 0.018 1.000 1.000 0.089 4.330 1 0
  i36 0.497 1.500 9.08 13000 0.018 1.000 1.000 0.072 4.393 1 0
  i36 0.993 1.500 9.09 13000 0.016 1.000 1.000 0.087 4.474 1 0
  i36 1.487 1.500 9.10 13000 0.016 1.000 1.000 0.076 4.313 1 0
  i36 1.982 1.500 10.00 13000 0.016 1.000 1.000 0.088 4.321 1 0
  i36 2.475 1.500 10.11 13000 0.017 1.000 1.000 0.089 4.312 1 0
  i36 2.981 1.500 11.06 13000 0.016 1.000 1.000 0.087 4.398 1 0
  i36 3.474 1.500 12.01 13000 0.015 1.000 1.000 0.089 4.392 1 0
  i36 3.969 1.500 8.06 13000 0.016 1.000 1.000 0.083 4.405 1 0
  i36 4.966 1.500 10.04 13000 0.016 1.000 1.000 0.077 4.251 1 0
  i36 5.958 1.500 7.02 13000 0.017 1.000 1.000 0.077 4.341 1 0
e

</score>

