From 9fbf91db06a6d4f4b5cd8bb45389a731bb86bf22 Mon Sep 17 00:00:00 2001
From: Richard <q@1bpm.net>
Date: Sun, 13 Apr 2025 18:48:02 +0100
Subject: initial

---
 site/udo/spectral_transforms.udo | 358 +++++++++++++++++++++++++++++++++++++++
 1 file changed, 358 insertions(+)
 create mode 100755 site/udo/spectral_transforms.udo

(limited to 'site/udo/spectral_transforms.udo')

diff --git a/site/udo/spectral_transforms.udo b/site/udo/spectral_transforms.udo
new file mode 100755
index 0000000..7e9424f
--- /dev/null
+++ b/site/udo/spectral_transforms.udo
@@ -0,0 +1,358 @@
+#ifndef UDO_SPECTRALTRANSFORMS
+#define UDO_SPECTRALTRANSFORMS ##
+/*
+	Spectral transforms, mostly recursive using pvsbin
+
+	This file is part of the SONICS UDO collection by Richard Knight 2024
+		License: GPL-2.0-or-later
+		http://1bpm.net
+*/
+
+#include "/wavetables.udo"
+
+/*
+	Validate start and end bins against a f-sig, and check/set common variables
+	If start and end are <= 1, treat them as ratios and calculate accordingly
+
+	istartbin, iendbin, ibin, kportamento, ifnwave _spc_validatebins fsig [, istart=0, iend=1, kportamento=-1, ifnwave=-1]
+
+	istartbin		resulting bin number
+	iendbin			resulting bin number
+	ibin			initial bin to use
+	kportamento		portamento in/out
+	ifnwave			wave f-table in/out
+	fsig			f-sig to validate maximum bin number against
+	istart			start bin number or ratio
+	iend			end bin number or ratio
+*/
+opcode _spc_validatebins, iiiki, fopJj
+	fsig, istart, iend, kportamento, ifnwave xin
+	ioverlap, inumbins, iwinsize, iformat pvsinfo fsig
+
+	if (istart <= 1 && iend <= 1) then ; is ratio
+		istartbin = max(round(inumbins * istart), 1)
+		iendbin = round(inumbins * iend)
+	else ; is absolute bin number
+		istartbin = max(1, istart)
+		iendbin = min(inumbins, iend)
+	endif
+	ibin = istartbin
+	kportamento = (kportamento == -1) ? 0.02 : kportamento
+	ifnwave = (ifnwave == -1) ? gifnSine : ifnwave
+
+	xout istartbin, iendbin, ibin, kportamento, ifnwave
+endop
+
+
+/*
+	Spectral delay
+
+	aout spc_delay fsig, kdeltime, kdeladd [, istart=0, iend=1, kfreqmod=1, kportamento=0.01, ifnwave=-1, ibin=-1]
+	
+	aout		audio output
+	fsig		input signal
+	kdeltime	initial delay time in seconds
+	kdeladd		increment delay by this with each bin increment or decrement
+	istart		absolute bin number or ratio of the start bin, top end bins may be quite low, around a ratio of 0.1
+	iend		absolute bin number or ratio of the end bin
+	kfreqmod	frequency modulation ratio in resynthesis
+	kportamento	portamento time for amp and frequency
+	ifnwave		f-table to use for the oscillator, default is sine
+	ibin		bin tracking used internally, should not be set
+*/
+opcode spc_delay, a, fkkopPJjj
+	fsig, kdeltime, kdeladd, istart, iend, kfreqmod, kportamento, ifnwave, ibin xin
+	if (ibin == -1) then
+		istart, iend, ibin, kportamento, ifnwave _spc_validatebins fsig, istart, iend, kportamento, ifnwave
+	endif
+
+	idirection = (istart < iend) ? 1 : -1
+	kamp, kfreq pvsbin fsig, ibin
+	imaxdelay = 1000
+	aout oscili portk(kamp, kportamento), portk(kfreq, kportamento) * kfreqmod, ifnwave
+	kdel = min:k(imaxdelay, kdeltime + (kdeladd * (((idirection == 1) ? ibin - istart : istart - ibin) + 1)) * 1000)
+	aout vdelay aout, a(kdel), imaxdelay
+
+	if ((idirection == 1 && ibin + 1 < iend) || (idirection == -1 && ibin - 1 >= iend)) then
+		arecurse spc_delay fsig, kdeltime, kdeladd, istart, iend, kfreqmod, kportamento, ifnwave, ibin + idirection
+		aout += arecurse
+	endif
+
+	xout aout
+endop
+
+
+/*
+	Spectral incremental shift
+
+	aout spc_shift fsig, kfreqincr [, istart=0, iend=1, kfreqmod=1, kportamento=0.01, ifnwave=-1, ibin=-1]
+
+	aout		audio output
+	fsig		input signal
+	kfreqincr	frequency increment for each bin, may be positive or negative
+	istart		absolute bin number or ratio of the start bin, top end bins may be quite low, around a ratio of 0.1
+	iend		absolute bin number or ratio of the end bin
+	kfreqmod	frequency modulation ratio in resynthesis
+	kportamento	portamento time for amp and frequency
+	ifnwave		f-table to use for the oscillator, default is sine
+	ibin		bin tracking used internally, should not be set
+*/
+opcode spc_shift, a, fkopPJjj
+	fsig, kfreqincr, istart, iend, kfreqmod, kportamento, ifnwave, ibin xin
+	if (ibin == -1) then
+		istart, iend, ibin, kportamento, ifnwave _spc_validatebins fsig, istart, iend, kportamento, ifnwave
+	endif
+
+	idirection = (istart < iend) ? 1 : -1
+	kamp, kfreq pvsbin fsig, ibin
+	kfreqadd = (((idirection == 1) ? ibin - istart : istart - ibin) + 1) * kfreqincr
+	aout oscili portk(kamp, kportamento), portk(kfreq + kfreqadd, kportamento) * kfreqmod, ifnwave
+
+	if ((idirection == 1 && ibin + 1 < iend) || (idirection == -1 && ibin - 1 >= iend)) then
+		arecurse spc_shift fsig, kfreqincr, istart, iend, kfreqmod, kportamento, ifnwave, ibin + idirection
+		aout += arecurse
+	endif
+
+	xout aout
+endop
+
+
+/*
+	Spectral gate
+
+	aout spc_gate fsig, kthresh [, khold=0, istart=0, iend=1, kfreqmod=1, kportamento=0.01, ifnwave=-1, ibin=-1]
+
+	aout		audio output
+	fsig		input signal
+	kthresh		threshold amplitude for gating
+	khold		hold amplitudes rather than decaying them
+	istart		absolute bin number or ratio of the start bin, top end bins may be quite low, around a ratio of 0.1
+	iend		absolute bin number or ratio of the end bin
+	kfreqmod	frequency modulation ratio in resynthesis
+	kportamento	portamento time for amp and frequency
+	ifnwave		f-table to use for the oscillator, default is sine
+	ibin		bin tracking used internally, should not be set
+*/
+opcode spc_gate, a, fkOopPJjj
+	fsig, kthresh, khold, istart, iend, kfreqmod, kportamento, ifnwave, ibin xin
+	if (ibin == -1) then
+		istart, iend, ibin, kportamento, ifnwave _spc_validatebins fsig, istart, iend, kportamento, ifnwave
+	endif
+
+	idirection = (istart < iend) ? 1 : -1
+	klastamp init 0
+	klastfreq init 0
+	kamp, kfreq pvsbin fsig, ibin
+
+	if (kamp > kthresh) then
+		klastamp = kamp
+		klastfreq = kfreq
+	else
+		kamp = (khold == 1) ? klastamp : 0
+		kfreq = klastfreq
+	endif
+	aout oscili portk(kamp, kportamento), portk(kfreq, kportamento) * kfreqmod, ifnwave
+
+	if ((idirection == 1 && ibin + 1 < iend) || (idirection == -1 && ibin - 1 >= iend)) then
+		arecurse spc_gate fsig, kthresh, khold, istart, iend, kfreqmod, kportamento, ifnwave, ibin + idirection
+		aout += arecurse
+	endif
+
+	xout aout
+endop
+
+
+
+/*
+	Spectral granular resynthesis 1
+	Internal opcode
+*/
+opcode _spc_grain1_inner, a, ikkpopPJJOJjpp
+	ipbuf, ktime, kgraindur, ilayers, istart, iend, kfreqmod, kfreqrand, kdurrand, kpitchrand, kportamento, ifnwave, ibin, ibingrain xin
+	idirection = (istart < iend) ? 1 : -1
+	kchange metro 1 / kgraindur;/ 1
+	if (kchange == 1) then
+		if (kfreqrand > 1) then
+			kfreqrandv random 1 / kfreqrand, kfreqrand
+		elseif (kfreqrand == 1) then
+			kfreqrandv = 1
+		else
+			kfreqrandv random 0.5, 2
+		endif
+
+		if (kdurrand > 1) then
+			kdurrandv random 1 / kdurrand, kdurrand
+		elseif (kdurrand == 1) then
+			kdurrandv = 1
+		else
+			kdurrandv random 0.5, 2
+		endif
+		
+		if (kpitchrand > 1) then
+			kpitchrandv random 1 / kpitchrand, kpitchrand
+		else
+			kpitchrandv = 1
+		endif
+	endif
+	
+	kreadfreq = (1 / kgraindur) * kfreqrandv ;5 + random:k(1, 5) ;random(10, 20) ;10 + random:k(0, 5)
+	kenv = abs:k(oscili:k(1, kreadfreq, gifnHanning, random(0, 1)))
+	areadpos phasor kreadfreq, random(0, 1)
+	
+	kreadtime = ktime + (k(areadpos) * kgraindur * kdurrandv) ;ktime + random(0, 0.6) ;portk(ktime + random:k(0, 0.6), kportamento)
+	fsig pvsbufread kreadtime, ipbuf
+	kamp, kfreq pvsbin fsig, ibin
+	kfreq *= kpitchrandv
+	kamp *= kenv
+
+	aout oscil portk(kamp, kportamento), portk(kfreq, kportamento) * kfreqmod, ifnwave
+	if (ibingrain < ilayers) then
+		arecurse _spc_grain1_inner ipbuf, ktime, kgraindur, ilayers, istart, iend, kfreqmod, kfreqrand, kdurrand, kpitchrand, kportamento, ifnwave, ibin, ibingrain + 1
+		aout += arecurse
+	elseif ((idirection == 1 && ibin + 1 < iend) || (idirection == -1 && ibin - 1 >= iend)) then
+		arecurse _spc_grain1_inner ipbuf, ktime, kgraindur, ilayers, istart, iend, kfreqmod, kfreqrand, kdurrand, kpitchrand, kportamento, ifnwave, ibin + idirection
+		aout += arecurse
+	endif
+	xout aout
+endop
+
+
+/*
+	Spectral granular resynthesis 1
+
+	aout spc_grain1 ifn, ktime, kgraindur [, ifftsize=512, ilayers=1, istart=0, iend=1, kfreqmod=1, kfreqrand=1, kdurrand=1, kpitchrand=0, kportamento=0.01, ifnwave=-1]
+
+	aout		audio output
+	ifn			f-table containing mono source sound
+	ktime		read time in seconds
+	kgraindur	grain duration in seconds
+	ifftsize	fft size for the input
+	ilayers		number of overlapping layers of grains to use
+	istart		absolute bin number or ratio of the start bin, top end bins may be quite low, around a ratio of 0.1
+	iend		absolute bin number or ratio of the end bin
+	kfreqmod	frequency modulation ratio in resynthesis
+	kfreqrand	read frequency random variation ratio
+	kdurrand	grain duration random variation ratio
+	kpitchrand	grain pitch random variation ratio
+	kportamento	portamento time for amp and frequency
+	ifnwave		f-table to use for the oscillator, default is sine
+*/
+opcode spc_grain1, a, ikkjpopPJJOJj
+	ifn, ktime, kgraindur, ifftsize, ilayers, istart, iend, kfreqmod, kfreqrand, kdurrand, kpitchrand, kportamento, ifnwave xin
+	ifftsize = (ifftsize == -1) ? 512 : ifftsize
+	ktimek timeinstk
+	ilen = ftlen(ifn) / ftsr(ifn)
+	ikcycles = ilen * kr
+	kcount init 0
+	if (ktimek == 1) then
+		while (kcount < ikcycles) do
+			apos linseg 0, ilen, ftlen(ifn)
+			asig table3 apos, ifn
+			fsig pvsanal asig, ifftsize, ifftsize/4, ifftsize, 1
+			ipbuf, k_ pvsbuffer fsig, ilen
+			kcount += 1
+		od
+	else
+		istartbin, iendbin, ibin, kportamento, ifnwave _spc_validatebins fsig, istart, iend, kportamento, ifnwave
+		aout _spc_grain1_inner ipbuf, ktime, kgraindur, ilayers, istartbin, iendbin, kfreqmod, kfreqrand, kdurrand, kpitchrand, kportamento, ifnwave, ibin
+	endif
+	xout aout
+endop
+
+/*
+	Alter the phase of FFT values
+	
+	aout spc_phasemash ain, kphasemode, kphasevalue, ifftsize
+
+	aout		audio output
+	ain			audio input
+	kphasemode	phase mode: 0 = multiply phase with kphasevalue; 1 = replace phase with kphasevalue
+	kphasevalue	phase value, between -pi and +pi
+	ifftsize	fft size
+*/
+opcode spc_phasemash, a, akkj
+	ain1, kphasemode, kphasevalue, ifftsize xin
+	ifftsize = (ifftsize == -1) ? 512 : ifftsize
+	ihopsize = ksmps
+	iolaps = (ifftsize / ihopsize)
+	ibw = (sr / ifftsize)
+	kcnt init 0
+	krow init 0
+	kOla1[] init ifftsize 
+	kIn1[] init ifftsize  	 
+	kOut[][] init iolaps, ifftsize
+
+	if (kcnt == ihopsize) then 
+		kdx = 0
+		kWin1[] window kIn1, krow * ihopsize
+		kSpec1[] rfft kWin1
+		kmags1[] mags kSpec1
+		kphs1[] phs kSpec1 ;init lenarray(kmags1) ;phs kSpec1
+		kindex = 0
+		while (kindex < lenarray(kphs1)) do
+			if (kindex > 0) then
+				if (kphasemode == 0) then
+					kphs1[kindex] = kphs1[kindex] * kphasevalue
+				else
+					kphs1[kindex] = kphasevalue
+				endif
+			endif
+			kindex += 1
+		od
+
+		kSpec1 pol2rect kmags1, kphs1
+		kRow[] rifft kSpec1
+		kWin1 window kRow, krow * ihopsize
+		kOut setrow kWin1, krow
+
+		kOla1 = 0   
+		ki = 0
+		until (ki == iolaps) do
+			kRow getrow kOut, ki
+			kOla1 = kOla1 + kRow
+			ki += 1
+		od
+		krow = (krow + 1) % iolaps
+		kcnt = 0
+	endif
+
+	kIn1 shiftin ain1
+	aout shiftout kOla1
+	aouter = aout / iolaps
+	kcnt += ksmps
+	xout aouter
+endop
+
+
+/*
+opcode spc_attack, a, fkOopPJjj
+	fsig, kthresh, khold, istart, iend, kfreqmod, kportamento, ifnwave, ibin xin
+	if (ibin == -1) then
+		istart, iend, ibin, kportamento, ifnwave _spc_validatebins fsig, istart, iend, kportamento, ifnwave
+	endif
+
+	idirection = (istart < iend) ? 1 : -1
+	klastamp init 0
+	klastfreq init 0
+	kamp, kfreq pvsbin fsig, ibin
+
+	if (kamp > kthresh) then
+		klastamp = kamp
+		klastfreq = kfreq
+	else
+		kamp = (khold == 1) ? klastamp : 0
+		kfreq = klastfreq
+	endif
+	aout oscil portk(kamp, kportamento), portk(kfreq, kportamento) * kfreqmod, ifnwave
+
+	if ((idirection == 1 && ibin + 1 < iend) || (idirection == -1 && ibin - 1 >= iend)) then
+		arecurse spc_gate fsig, kthresh, khold, istart, iend, kfreqmod, kportamento, ifnwave, ibin + idirection
+		aout += arecurse
+	endif
+
+	xout aout
+endop
+*/
+
+
+#end
-- 
cgit v1.2.3