path: root/site/udo/pvs_tabproc.udo

#ifndef UDO_PVSTABPROC
#define UDO_PVSTABPROC ##
/*
	Frame based PVS processing

	ksmps must be 64 or lower: setksmps(64) can be set in the calling instrument if required

	tpv data tables have the following indexes:
		0: number of channels
		1: amp left
		2: amp right
		3: frequency left
		4: frequency right

	This file is part of the SONICS UDO collection by Richard Knight 2021, 2022, 2024, 2025
		License: GPL-2.0-or-later
		http://1bpm.net
*/

/*
	Make container for processing tables and information
	itpvdata tpv_makecontainer ichannels, inumbins

	itpvdata	tpv information for subsequent opcodes
	ichannels	number of channels to account for
	inumbins	number of frequency bins
*/
opcode tpv_makecontainer, i, ii
	ichannels, inumbins xin
	itpv ftgentmp 0, 0, -5, -2, ichannels
	index = 1
	while (index < 5) do
		if (ichannels == 1 && (index == 2 || index == 4)) then
			ival = 0
		else
			ival ftgentmp 0, 0, -inumbins, -2, 0
		endif
		tabw_i ival, index, itpv
		index += 1
	od
	xout itpv
endop

/*
	Shorthand to get tpv data items
	ichannels, isize, ifnampL, ifnampR, ifnfreqL, ifnfreqR tpv_get itpvdata
	
	ichannels	number of channels
	isize		bin size
	ifnampL		left amp table
	ifnampR		right amp table
	ifnfreqL	left freq table
	ifnfreqR	right freq table
	iptvdata	tpv data table
*/
opcode tpv_get, iiiiii, i
	itpvdata xin
	ifnAmpL = tab_i(1, itpvdata)
	xout tab_i(0, itpvdata), ftlen(ifnAmpL), ifnAmpL, tab_i(2, itpvdata), tab_i(3, itpvdata), tab_i(4, itpvdata)
endop

/*
	Analyse f-signal to table (mono)
	kready, itpvdata tpv_anal fsrc

	fsrc		source f-signal
	kready		done trigger
	iptvdata	tpv analysis data
*/
opcode tpv_anal, ki, f
	fsrc xin
	ioverlap, inumbins, iwinsize, iformat pvsinfo fsrc
	itpvdata tpv_makecontainer 1, inumbins
	kready pvsftw fsrc, tab_i(1, itpvdata), tab_i(3, itpvdata)
	xout kready, itpvdata
endop

/*
	Analyse f-signal to table (stereo)
	kready, itpvdata tpv_anal fsrcL, fsrcR

	fsrcL		source f-signal left
	fsrcR		source f-signal right
	kready		done trigger
	iptvdata	tpv analysis stream handles for use in other opcodes
*/
opcode tpv_anal, ki, ff
	fsrcL, fsrcR xin
	ioverlap, inumbins, iwinsize, iformat pvsinfo fsrcL
	itpvdata tpv_makecontainer 2, inumbins
	kreadyL pvsftw fsrcL, tab_i(1, itpvdata), tab_i(3, itpvdata)
	kreadyR pvsftw fsrcR, tab_i(2, itpvdata), tab_i(4, itpvdata)
	xout (kreadyL & kreadyR), itpvdata
endop

/*
	Reform tpv data (mono). Input and output f-signals must be the same.

	foutM tpv_resynth itpvdata, foutM

	itpvdata 	tpv analysis stream handles
	foutM		f-signal to write to
*/
opcode tpv_resynth, f, if
	itpvdata, foutM xin
	pvsftr foutM, tab_i(1, itpvdata), tab_i(3, itpvdata)
	xout foutM
endop

/*
	Reform tpv data (stereo). Input and output f-signals must be the same.
	foutL, foutR tpv_resynth itpvdata, foutL, foutR

	itpvdata 	tpv analysis stream handles
	foutL		f-signal to write to left
	foutR		f-signal to write to right
*/
opcode tpv_resynth, ff, iff
	itpvdata, foutL, foutR xin
	pvsftr foutL, tab_i(1, itpvdata), tab_i(3, itpvdata)
	pvsftr foutR, tab_i(2, itpvdata), tab_i(4, itpvdata)
	xout foutL, foutR
endop

/*
	Smear frames
	tpv_smear kready, itpvdata, imaxframes, kframes, kavgfreqs, kincludeoriginal

	kready				done trigger from tpv_anal
	itpvdata			tpv analysis stream handles
	imaxframes			maximum frames for smearage
	kframes				frames of smearage to apply
	kavgfreqs			average frequencies as well as smearing amplitudes (bool)
	kincludeoriginal	include the original frame in output
*/
opcode tpv_smear, 0, kijJOP
	kready, itpvdata, imaxframes, kframes, kavgfreqs, kincludeoriginal xin
	imaxframes = (imaxframes == -1) ? 8 : imaxframes
	kframes = (kframes < 1 || kframes > imaxframes) ? imaxframes: kframes
	ichans, isize, ifnampL, ifnampR, ifnfreqL, ifnfreqR tpv_get itpvdata
	itpvtemps ftgentmp 0, 0, -imaxframes, -2, 0
	index = 0
	while (index < imaxframes) do
		tabw_i(tpv_makecontainer(ichans, isize), index, itpvtemps)
		index += 1
	od
	kindexframew init 0

	if (kready == 1) then
		ktpvfnw = tab:k(kindexframew, itpvtemps)
		tablecopy tablekt:k(1, ktpvfnw), ifnampL
		tablecopy tablekt:k(3, ktpvfnw), ifnfreqL
		if (ichans == 2) then
			tablecopy tablekt:k(2, ktpvfnw), ifnampR
			tablecopy tablekt:k(4, ktpvfnw), ifnfreqR
		endif

		kindexframer = (kindexframew - 1 < 0) ? imaxframes - 1 : kindexframew - 1
		kframescale = 1 / kframes
		kindex = 0
		while (kindex < isize) do
			kampL = (kincludeoriginal == 1) ? tab:k(kindex, ifnampL) : 0
			kfreqL = (kincludeoriginal == 1) ? tab:k(kindex, ifnfreqL) : 0
			if (ichans == 2) then
				kampR = (kincludeoriginal == 1) ? tab:k(kindex, ifnampR) : 0
				kfreqR = (kincludeoriginal == 1) ? tab:k(kindex, ifnfreqR) : 0
			endif
			kindexframeabs = 0
			while (kindexframeabs < kframes) do
				kcurscale = (kframescale * (kframes - kindexframeabs))
				ktpvframe tab kindexframer, itpvtemps
				;kampL = (kampL + tablekt:k(kindex, ktpvframe)) * 0.5
				kampL += tablekt:k(kindex, tablekt:k(1, ktpvframe)) * kcurscale
				if (kavgfreqs == 1) then
					kfreqL = (kfreqL + tablekt:k(kindex, tablekt:k(3, ktpvframe))) * 0.5

				endif
				if (ichans == 2) then
					kampR += tablekt:k(kindex, tablekt:k(2, ktpvframe)) * kcurscale
					if (kavgfreqs == 1) then
						kfreqR = (kfreqR + tablekt:k(kindex, tablekt:k(4, ktpvframe))) * 0.5
					endif
				endif
				kindexframer = (kindexframer - 1 < 0) ? imaxframes - 1 : kindexframer - 1
				kindexframeabs += 1
			od

			tabw kampL, kindex, ifnampL
			if (kavgfreqs == 1) then
				tabw kfreqL, kindex, ifnfreqL
			endif
			if (ichans == 2) then
				tabw kampR, kindex, ifnampR
				if (kavgfreqs == 1) then
					tabw kfreqR, kindex, ifnfreqR
				endif
			endif
			kindex += 1
		od
		if (kindexframew + 1 < imaxframes) then
			kindexframew += 1
		else
			kindexframew = 0
		endif
	endif
endop

/*
	Wrap spectrum
	tpv_wrap kready, itpvdata, kwrapstart

	kready			done trigger from tpv_anal
	itpvdata		tpv analysis stream handles
	kwrapAmpBin		start bin for amplitude wrapping
	kwrapFreqBin	start bin for frequency wrapping
*/
opcode tpv_wrap, 0, kikk
	kready, itpvdata, kwrapAmpBin, kwrapFreqBin xin
	ichans, isize, ifnampL, ifnampR, ifnfreqL, ifnfreqR tpv_get itpvdata
	itpvdatatemp tpv_makecontainer ichans, isize
	i_, i_, ifnampLtemp, ifnampRtemp, ifnfreqLtemp, ifnfreqRtemp tpv_get itpvdatatemp

	if (kready == 1) then
		tablecopy ifnampLtemp, ifnampL
		tablecopy ifnfreqLtemp, ifnfreqL
		if (ichans == 2) then
			tablecopy ifnampRtemp, ifnampR
			tablecopy ifnfreqRtemp, ifnfreqR
		endif

		kindex = 0
		while (kindex < isize) do
			kwrapAmpIndexW = (kwrapAmpBin + kindex) % isize
			kwrapFreqIndexW = (kwrapFreqBin + kindex) % isize

			tabw tab:k(kindex, ifnampLtemp), kwrapAmpIndexW, ifnampL
			tabw tab:k(kindex, ifnfreqLtemp), kwrapFreqIndexW, ifnfreqL

			if (ichans == 2) then
				tabw tab:k(kindex, ifnampRtemp), kwrapAmpIndexW, ifnampR
				tabw tab:k(kindex, ifnfreqRtemp), kwrapFreqIndexW, ifnfreqR
			endif
			kindex += 1
		od
	endif
endop

/*
	Set random bin amplitudes to 0. Ported from pvtool
	tpv_bubble kready, itpvdata, kchance, kstereounique

	kready			done trigger from tpv_anal
	itpvdata		tpv analysis stream handles
	kchance			chance of applying bin amplitude, between 0 and 1
	kstereounique	whether to apply the effect channel independently
*/
opcode tpv_bubble, 0, kikP
	kready, itpvdata, kchance, kstereounique xin
	ichans, isize, ifnampL, ifnampR, ifnfreqL, ifnfreqR tpv_get itpvdata
	kreplacement init 0
	if (kready == 1) then
		kindex = 0
		while (kindex < isize) do
			kapplyL = (random:k(0, 1) <= kchance) ? 1 : 0
			if (ichans == 1) then
				if (kapplyL == 1) then
					tabw 0, kindex, ifnampL
				endif
			else
				if (kstereounique == 0) then
					if (kapplyL == 1) then
						tabw kreplacement, kindex, ifnampL
						tabw kreplacement, kindex, ifnampR
					endif
				else
					if (kapplyL == 1) then
						tabw kreplacement, kindex, ifnampL
					endif
					if (random:k(0, 1) <= kchance) then
						tabw kreplacement, kindex, ifnampR
					endif
				endif
			endif
			kindex += 1
		od
	endif
	
endop

/*
	Swap spectrum areas
	tpv_swap kready, itpvdata, kampStart, kampLength, kampTarget, kfreqStart, kfreqLength, kfreqTarget [, kwrapmode = 1]

	kready			done trigger from tpv_anal
	itpvdata		tpv analysis stream handles
	kampStart		bin start for amplitude
	kampLength		bins length for amplitude
	kampTarget		bin target start for amplitude
	kfreqStart		bin start for frequency
	kfreqLength		bins length for frequency
	kfreqTarget		bin target start for frequency
	kwrapmode		wrap mode: 0 = limit; 1 = wrap
*/
opcode tpv_swap, 0, kikOkkOkP
	kready, itpvdata, kampStart, kampLength, kampTarget, kfreqStart, kfreqLength, kfreqTarget, kwrapmode xin
	ichans, isize, ifnampL, ifnampR, ifnfreqL, ifnfreqR tpv_get itpvdata
	itpvdatatemp tpv_makecontainer ichans, isize
	i_, i_, ifnampLtemp, ifnampRtemp, ifnfreqLtemp, ifnfreqRtemp tpv_get itpvdatatemp

	kampLength = (kampLength == 0) ? isize : kampLength
	kfreqLength = (kfreqLength == 0) ? isize : kfreqLength

	if (kready == 1) then
		tablecopy ifnampLtemp, ifnampL
		tablecopy ifnfreqLtemp, ifnfreqL
		if (ichans == 2) then
			tablecopy ifnampRtemp, ifnampR
			tablecopy ifnfreqRtemp, ifnfreqR
		endif

		kampStartW = min:k(kampStart, kampTarget)
		kampTargetW = max:k(kampStart, kampTarget)
		kfreqStartW = min:k(kfreqStart, kfreqTarget)
		kfreqTargetW = max:k(kfreqStart, kfreqTarget)

		kindex = 0
		while (kindex < isize) do
			if (kwrapmode == 1) then
				kampStartW = kampStartW % isize
				kampEndW = (kampStartW + kampLength) % isize
				kampTargetW = (kampTargetW + kindex) % isize

				kfreqStartW = kfreqStartW % isize
				kfreqEndW = (kfreqStartW + kfreqLength) % isize
				kfreqTargetW = (kfreqTargetW + kindex) % isize
			else
				kampStartW = (kampStartW >= isize) ? isize - 1 : kampStart
				kampEnd = kampStartW + kampLength
				kampEndW = (kampEnd >= isize) ? isize - 1 : kampEnd
				kampTargetW = (kampTargetW + kindex >= isize) ? isize - 1 : kampTargetW + kindex

				kfreqStartW = (kfreqStartW >= isize) ? isize - 1 : kfreqStart
				kfreqEnd = kfreqStartW + kfreqLength
				kfreqEndW = (kfreqEnd >= isize) ? isize - 1 : kfreqEnd
				kfreqTargetW = (kfreqTargetW + kindex >= isize) ? isize - 1 : kfreqTargetW + kindex
			endif

			if (kindex >= kampStartW && kindex < kampEndW) then
				tabw tab:k(kindex, ifnampLtemp), kampTargetW, ifnampL
				tabw tab:k(kampTargetW, ifnampLtemp), kindex, ifnampL
				if (ichans == 2) then
					tabw tab:k(kindex, ifnampRtemp), kampTargetW, ifnampR
					tabw tab:k(kampTargetW, ifnampRtemp), kindex, ifnampR
				endif
			endif

			if (kindex >= kfreqStartW && kindex < kfreqEndW) then
				tabw tab:k(kindex, ifnfreqLtemp), kfreqTargetW, ifnfreqL
				tabw tab:k(kfreqTargetW, ifnfreqLtemp), kindex, ifnfreqL
				if (ichans == 2) then
					tabw tab:k(kindex, ifnfreqRtemp), kfreqTargetW, ifnfreqR
					tabw tab:k(kfreqTargetW, ifnfreqRtemp), kindex, ifnfreqR
				endif
			endif
			kindex += 1
		od
	endif
endop

/*
	Invert spectrum
	tpv_invert kready, itpvdata, [kinvertamp, kinvertfreq]

	kready		done trigger from tpv_anal
	itpvdata	tpv analysis stream handles
	kinvertamp	whether to invert amp or not (1 or 0)
	kinvertfreq	whether to invert frequency or not (1 or 0)
*/
opcode tpv_invert, 0, kiPP
	kready, itpvdata, kinvertamp, kinvertfreq xin
	ichans, isize, ifnampL, ifnampR, ifnfreqL, ifnfreqR tpv_get itpvdata
	if (kready == 1) then
		kindex = 0
		while (kindex < isize) do
			if (kinvertamp == 1) then
				tabw tab:k(isize-kindex, ifnampL), kindex, ifnampL
			endif

			if (kinvertfreq == 1) then
				tabw tab:k(isize-kindex, ifnfreqL), kindex, ifnfreqL
			endif

			if (ichans == 2) then
				if (kinvertamp == 1) then
					tabw tab:k(isize-kindex, ifnampR), kindex, ifnampR
				endif
		
				if (kinvertfreq == 1) then
					tabw tab:k(isize-kindex, ifnfreqR), kindex, ifnfreqR
				endif
			endif

			kindex += 1
		od
	endif
endop

/*
	Filter bins with a ftable mask
	tpv_binfilter kready, itpvdata, ifnamps

	kready		done trigger from tpv_anal
	itpvdata	tpv analysis stream handles
	ifnamps		ftable containing amplitude values per bin
*/
opcode tpv_binfilter, 0, kii
	kready, itpvdata, ifnamps xin
	ichans, isize, ifnampL, ifnampR, ifnfreqL, ifnfreqR tpv_get itpvdata
	if (kready == 1) then
		kindex = 0
		while (kindex < isize) do
			tabw tab:k(kindex, ifnampL) * tab:k(kindex, ifnamps), kindex, ifnampL
			
			if (ichans == 2) then
				tabw tab:k(kindex, ifnampR) * tab:k(kindex, ifnamps), kindex, ifnampR
			endif
			kindex += 1
		od
	endif
endop

/*
	Allow bins over or below a certain threshold; a spectral gate
	tpv_threshold kready, itpvdata, kthreshold, kabove

	kready		done trigger from tpv_anal
	itpvdata	tpv analysis stream handles
	kthreshold	amplitude threshold to apply
	kabove		above or below threshold will be let through the gate (1 = above, 0 = below)
*/
opcode tpv_threshold, 0, kikO 
	kready, itpvdata, kthresh, kabove xin
	ichans, isize, ifnampL, ifnampR, ifnfreqL, ifnfreqR tpv_get itpvdata
	if (kready == 1) then
		kindex = 0
		while (kindex < isize) do

			kvalL tab kindex, ifnampL
			if ((kabove == 0 && kvalL < kthresh) || (kabove == 1 && kvalL > kthresh)) then
				tabw 0, kindex, ifnampL
				tabw 0, kindex, ifnfreqL
			endif
			
			if (ichans == 2) then
				kvalR tab kindex, ifnampR
				if ((kabove == 0 && kvalR < kthresh) || (kabove == 1 && kvalR > kthresh)) then
					tabw 0, kindex, ifnampR
					tabw 0, kindex, ifnfreqR
				endif
			endif
			
			kindex += 1
		od
	endif
endop

/*
	Scramble amplitude and/or frequency
	tpv_scramble kready, itpvdata, kstepratio, kdoamp, kdofreq

	kready		done trigger from tpv_anal
	itpvdata	tpv analysis stream handles
	kstepratio	partitioning ratio
	kdoamp		scramble amplitudes (bool)
	kdofreq		scramble frequencies (bool)
*/
opcode tpv_scramble, 0, kiJPP
	kready, itpvdata, kstepratio, kdoamp, kdofreq xin
	ichans, isize, ifnampL, ifnampR, ifnfreqL, ifnfreqR tpv_get itpvdata
	kstep = (kstepratio == -1) ? 1 : max:k(round:k(kstepratio * isize), 1)
	if (kready == 1) then
		kindex = 0
		while (kindex < isize) do
			kdest = int:k(random:k(kstep, isize)) - kstep
			kindex2 = 0
			while (kindex2 < kstep) do
				
				if (kdoamp == 1) then
					kval table kindex+kindex2, ifnampL, 0, 0, 1
					kcurrentval table kdest+kindex2, ifnampL, 0, 0, 1
					tablew (kval+kcurrentval)/2, kdest+kindex2, ifnampL, 0, 0, 1
					if (ichans == 2) then
						kval table kindex+kindex2, ifnampR, 0, 0, 1
						kcurrentval table kdest+kindex2, ifnampR, 0, 0, 1
						tablew (kval+kcurrentval)/2, kdest+kindex2, ifnampR, 0, 0, 1
					endif
				endif

				if (kdofreq == 1) then
					kval table kindex+kindex2, ifnfreqL, 0, 0, 1
					kcurrentval table kdest+kindex2, ifnfreqL, 0, 0, 1
					tablew (kval+kcurrentval)/2, kdest+kindex2, ifnfreqL, 0, 0, 1
					if (ichans == 2) then
						kval table kindex+kindex2, ifnfreqR, 0, 0, 1
						kcurrentval table kdest+kindex2, ifnfreqR, 0, 0, 1
						tablew (kval+kcurrentval)/2, kdest+kindex2, ifnfreqR, 0, 0, 1
					endif
				endif
				kindex2 += 1
			od
			kindex += kstep
		od
	endif
endop




opcode tpv_freeze1, 0, kikPPP
	kready, itpvdata, kfreeze, kfreezeamp, kfreezefreq, kcrossfade xin
	ichans, isize, ifnampL, ifnampR, ifnfreqL, ifnfreqR tpv_get itpvdata
	itpvtemp tpv_makecontainer ichans, isize
	i_, i_, ifnampLtemp, ifnampRtemp, ifnfreqLtemp, ifnfreqRtemp tpv_get itpvtemp

	if (kready == 1) then
		kindex = 0
		while (kindex < isize) do
			if (kfreeze >= 0) then
				kamount min kfreeze-1, 1
				
				if (kfreezeamp == 1) then
					if (kcrossfade == 1) then
						tabw ((1-kamount)*tab:k(kindex, ifnampL) + (kamount * tab:k(kindex, ifnampLtemp))), kindex, ifnampL
						if (ichans == 2) then
							tabw ((1-kamount)*tab:k(kindex, ifnampR) + (kamount * tab:k(kindex, ifnampRtemp))), kindex, ifnampR
						endif
					else 
						tabw tab:k(kindex, ifnampLtemp), kindex, ifnampL
						if (ichans == 2) then
							tabw tab:k(kindex, ifnampRtemp), kindex, ifnampR
						endif
					endif
				endif
				
				if (kfreezefreq == 1) then
					if (kcrossfade == 1) then
						tabw ((1-kamount)*tab:k(kindex, ifnfreqL) + (kamount * tab:k(kindex, ifnfreqLtemp))), kindex, ifnfreqL
						if (ichans == 2) then
							tabw ((1-kamount)*tab:k(kindex, ifnfreqR) + (kamount * tab:k(kindex, ifnfreqRtemp))), kindex, ifnfreqR
						endif
					else
						tabw tab:k(kindex, ifnfreqLtemp), kindex, ifnfreqL
						if (ichans == 2) then
							tabw tab:k(kindex, ifnfreqRtemp), kindex, ifnfreqR
						endif
					endif
				endif

			else
				tabw tab:k(kindex, ifnampL), kindex, ifnampLtemp			
				tabw tab:k(kindex, ifnfreqL), kindex, ifnfreqLtemp

				if (ichans == 2) then
					tabw tab:k(kindex, ifnampR), kindex, ifnampRtemp
					tabw tab:k(kindex, ifnfreqR), kindex, ifnfreqRtemp
				endif
			endif
			kindex += 1
		od
	endif
endop



opcode tpv_average, 0, kikPPO
	kready, itpvdata, kmax, kavgamp, kavgfreq, ktrig xin
	ichans, isize, ifnampL, ifnampR, ifnfreqL, ifnfreqR tpv_get itpvdata
	itpvtemp tpv_makecontainer ichans, isize
	i_, i_, ifnampLtemp, ifnampRtemp, ifnfreqLtemp, ifnfreqRtemp tpv_get itpvtemp

	kcount init 1
	if (kready == 1) then
		kindex = 0
		while (kindex < isize) do

			; store to average
			tabw tab:k(kindex, ifnampL), kindex, ifnampLtemp
			tabw tab:k(kindex, ifnfreqL), kindex, ifnfreqLtemp

			; read average
			if (kavgamp == 1) then
				tabw tab:k(kindex, ifnampLtemp) / kcount, kindex, ifnampL
			endif

			if (kavgfreq == 1) then
				tabw tab:k(kindex, ifnfreqLtemp) / kcount, kindex, ifnfreqL
			endif

			if (ichans == 2) then

				; store to average
				tabw tab:k(kindex, ifnampR), kindex, ifnampRtemp
				tabw tab:k(kindex, ifnfreqR), kindex, ifnfreqRtemp

				; read average
				if (kavgamp == 1) then
					tabw tab:k(kindex, ifnampRtemp) / kcount, kindex, ifnampR
				endif

				if (kavgfreq == 1) then
					tabw tab:k(kindex, ifnfreqRtemp) / kcount, kindex, ifnfreqR
				endif
			endif

			kindex += 1
		od

		if (kcount >= kmax || ktrig == 1) then			
			kindex = 0
			while (kindex < isize) do
				
				; empty
				tabw 0, kindex, ifnampLtemp
				tabw 0, kindex, ifnfreqLtemp

				if (ichans == 2) then
					tabw 0, kindex, ifnampRtemp
					tabw 0, kindex, ifnfreqRtemp
				endif

				kindex += 1
			od
			kcount = 1
		else
			kcount += 1
		endif
	endif
endop

#end