; p5  = amplitude (0 -1 ) integer 0 -127 = midi veloc or 1000 - 32000 raw value
; p4 = transposition 
; p6 = detuning (additional transposition, mostly for chorusing)
; p7 = input gen1 function # { if f99 & f98 not used}

COMMENT TSAMPST   inexplicably the character string "tsamp" aborts with m4
instr tsampST

idur = p3
icps = 261.626  ; initial input pitch level for loscil
ibasepitch = 261.626  ; middle C reference input pitch for loscil
p12 = (p12 = 0 ? 2 : p12 ) ; dummy end loop point for loscil
                           ; csound aborts without an end loop value, even
                           ; if no looping is specified
;========get transposition {p4 & p6}
itransp init 1.  
idetune = p4 + p6  ; total pitch offset: transposition (p4) + detuning (p6)
if idetune = 0 goto gottransp ;skip all this if no transposition or detuning
       icount init 0  ; counter
       imult =  (idetune > 0 ? 1.05946 : .94387) ;1/2 step freqency ratios
        icheck = abs(idetune)
        icheck = int(icheck)

     dumbloop:
	      icount = icount + 1   ; increment counter
	      imult = (icheck = 0 ? 1 : imult)
	      itransp = itransp * imult 
     if icount < icheck igoto dumbloop
 ; microtonal transposition &/or detuning:
	imult = abs(idetune)
	imult = frac(imult)
	imult = imult * .05496
	imult = (idetune > 0 ? imult : - imult)
	itransp = itransp + imult
gottransp:
icps = icps * itransp
; ------------------------------------------
; get gen01 audio function number 
ifno = (p7 = 0 ? 1 : p7 )      ; input soundfile function number
; -----------------------------------------------------------
; optional TURN OFF INSTRUMENT when p9 time reached {only a portion of the
; input soundfile, specified in p9,  is used}
if p9 = 0 goto playon
        istoptime = p9   ; 
;	inotedur = ( p3 < istoptime ? p3 : istoptime)
;	inoteoff = inotedur + p2
        itransp = ibasepitch/icps
	istoptime = istoptime * itransp 
	istoptime = istoptime - .005
	inotedur = ( p3 < istoptime ? p3 : istoptime)
        idur = inotedur
	inoteoff = inotedur + p2

        print p2, p4, inotedur, inoteoff  ; print note start time, dur & end time for user
	timout istoptime , p3 , shutdown
	goto playon
		shutdown: 
		turnoff
		kgoto output
playon:
 ; ==============================================================
       ; Determine "peak" amplitude:
	iamp init 0
	iamp = (p5  < 10.1 ? p5  : iamp) ; p5  = multiplier for original soundfile amp.
	iamp = (p5  > 10.1 ? p5/32767 : iamp) ; p5  gives new raw amplitude
	iamp = (iamp = 0 ? 1. : iamp)
a1, a2	loscil	iamp, icps , ifno, ibasepitch , p10, p11, p12
 ; ==============================================================
; FADE OUT and OPTIONAL NEW AMPLITUDE ENVELOPE
	irise = (p14 = 0? .0001 : p14)
	irise = (p14 < 100 ? irise : (p14 - 100)  * idur)
	irise = (p14 < 0 ? abs(p14)  * idur : irise)
	iatss = (p16 = 0  ? 1 : p16)
	idec = (p15 = 0? .0001 : p15)
	idec = (p15 < 100 ? idec : (p15 - 100)  * idur)
	idec = (p15 < 0 ? abs(p15)  * idur : idec)

        idec = (idec > .04 ? idec : .04) ; default decay of .04 to avoid clicks
                               ; if p3 is less than duration of input soundfile
	amp expseg .005, irise, 1., idur - (irise + idec), iatss , idec, .005
	a2 = a2 * amp
        a1 = a1 * amp
; ------------------------------------------
; OPTIONAL BRIGHTNESS -- use with new envelope for cresc & dim.
bright:  ibrightest = p17 + p18
if ibrightest = 0 goto output
kbright init p17
if p18 = 0 goto brightscale
   ip19 = (p19 > 100 ? ((p19 - 100) * idur) - .1 : p19)
   ip19 = (p19 < 0 ? (abs(p19) * idur) - .1 : ip19)
   ip19 = (ip19 = 0 ? (.9*idur) - idec : ip19)

   ip20 init icps
if p20 = 0 igoto gotcf
   ip20 = (p20 < 13.1 ? cpspch(p20) : p20 )
gotcf:
   kbright expseg p17, .1,p17,ip19, p18, idur, p18
brightscale:
      ihp = icps*1.5
        iscale = octcps(ihp)
        iscale = (18.25 - iscale) * .1
        iscale = (iscale < 1. ? iscale : iscale * iscale )
      ihp = ihp * iscale
   ahileft atone .9*a1, ihp
   aloleft tone  .9*a1, ihp
   ahiright atone .9*a2, ihp
   aloright tone  .9*a2, ihp
   a1 balance (kbright*ahileft) + ((2. - kbright)* aloleft), a1
   a2 balance (kbright*ahiright) + ((2. - kbright)* aloright), a2
 ; --------------------------------------------------------
output:

