sgstream/soundgen.lua

--[[--

Copyright (C)2023-2024 Kimapr

Permission is hereby granted, free of charge, to any person obtaining
a copy of this software and associated documentation files (the
"Software"), to deal in the Software without restriction, including
without limitation the rights to use, copy, modify, merge, publish,
distribute, sublicense, and/or sell copies of the Software, and to
permit persons to whom the Software is furnished to do so, subject
to the following conditions:

The above copyright notice and this permission notice shall be included
in all copies or substantial portions of the Software.

THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY
KIND, EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE
WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE
LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION
OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION
WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.

--]]--

local smt={}
smt.__index=smt
smt.proto=smt

local function round(x)
	return math.floor(x+.5)
end

function smt:bounds_and(a,b,c,...)
	if not a or not b then return false end
	local mi,ma
	mi=math.max(a[1],b[1])
	ma=math.min(a[2],b[2])
	if ma-mi<=0 then return false end
	if c then
		return self:bounds_and({mi,ma},c,...)
	end
	return {mi,ma}
end

function smt:bounds_or(a,b,c,...)
	local mi,ma=math.min(a[1],b[1]),math.max(a[2],b[2])
	if not a then return b end
	if not b then return a end
	if c then
		return self:bounds_or({mi,ma},c,...)
	end
	return {mi,ma}
end

function smt:new(fn,bounds)
	local obj={}
	obj.bounds=bounds
	if obj.bounds==nil then
		obj.bounds={-math.huge,math.huge}
	end
	obj.sample=fn
	return setmetatable(obj,self.proto)
end

function smt:sine()
	return self:new(function(self,t)
		return math.sin(t*math.pi*2)
	end)
end

function smt:square()
	return self:new(function(self,t)
		return (t%1)<=0.5 and -1 or 1
	end)
end

function smt:sawtooth()
	return self:new(function(self,t)
		return (t%1)*2-1
	end)
end

function smt:triangle()
	return self:new(function(self,t)
		--return ((t%1)<=0.5 and (t*2)%1 or 1-(t*2)%1)*2-1 -- sounds cool and glitchy but wrong
		local a=t%1
		if a>0.5 then
			return (1-(a*2-1))*2-1
		end
		return (a*2)*2-1
	end)
end

function smt:noise(y,z,x)
	return self:new(function(self,t)
		return love.math.noise(t,y,z,x)*2-1
	end)
end

function smt:silence(a)
	a=a or 0
	return smt:new(function()return a end)
end

local function rated_bounds(bounds,rate)
	local mi,ma=bounds[1],bounds[2]
	mi,ma=mi*rate,ma*rate
	mi,ma=round(mi),round(ma)-1
	return mi,ma
end

local function prefi(y)
	return math.min(1,math.max(-1,y))
end

function smt:compile(rate,bits,alt)
	rate=rate or 44100
	bits=bits or 16
	local bounds=self.bounds
	local mi,ma=rated_bounds(bounds,rate)
	if alt then
		bounds=self:bounds_and(bounds,alt.bounds)
		local mi,ma=rated_bounds(bounds,rate)
		local sdata=love.sound.newSoundData(ma-mi+1,rate,bits,2)
		for x=mi,ma do
			local x=x+mi
			sdata:setSample(x*2,prefi(self:sample(x/rate+0.5/rate)))
			sdata:setSample(x*2+1,prefi(alt:sample(x/rate+0.5/rate)))
		end
		return sdata
	end
	local sdata=love.sound.newSoundData(ma-mi+1,rate,bits,1)
	for x=mi,ma do
		local xx=x-mi
		sdata:setSample(xx,prefi(self:sample(x/rate+0.5/rate)))
	end
	return sdata
end

function smt:phase(p)
	local bb=self.bounds
	if bb then
		bb={bb[1]-p,bb[2]-p}
	end
	return self:new(function(obj,t)
		return self:sample(t+p)
	end,bb)
end

function smt:amp(a)
	return self:new(function(obj,t)
		return self:sample(t)*a
	end,self.bounds)
end

function smt:freq(f)
	local bb=self.bounds
	if bb then
		bb={bb[1]/f,bb[2]/f}
		if bb[2]<bb[1] then
			bb={bb[2],bb[1]}
		end
	end
	return self:new(function(obj,t)
		return self:sample(t*f)
	end,bb)
end

function smt:clamp(mi,ma,extend)
	local bounds = self:bounds_and(self.bounds,{mi,ma})
	return self:new(function(nself,t)
		if t<mi or t>ma then return 0 end
		return self.sample(self,t)
	end,extend and {mi,ma} or bounds or (mi<self.bounds[1]
		and {self.bounds[1],self.bounds[1]}
		or {self.bounds[2],self.bounds[2]}))
end

function smt:loop()
	if self.bounds[2]-self.bounds[1] == math.huge then
		return self
	end
	local mi,ma = self.bounds[1],self.bounds[2]
	return smt:new(function(_,t)
		return self:sample((t-mi)%ma+mi)
	end)
end

function smt.am(car,mod,mi,ma)
	return car:new(function(self,t)
		return car:sample(t)*((mod:sample(t)*0.5+0.5)*(ma-mi)+mi)
	end,car:bounds_and(car.bounds,mod.bounds))
end

function smt.pm(car,mod,mi,ma)
	assert(car.bounds
		and car.bounds[1]==-math.huge
		and car.bounds[2]==math.huge,
		"infinite carrier expected")
	mod=mod:add(mod:silence())
	return car:new(function(self,t)
		return car:sample(t+((mod:sample(t)*0.5+0.5)*(ma-mi)+mi))
	end,car.bounds)
end

function smt:add(a,b,...)
	if self.sample then
		return self.proto:add(self,a,b,...)
	end
	if not b then
		if not a then return self:silence() end
		return a
	end
	local ls={a,b,...}
	local bbs={}
	for k,v in ipairs(ls) do
		bbs[k]=v.bounds
	end
	return self:new(function(self,t)
		local r=0
		for k=1,#ls do
			local v = ls[k]
			r=r+v:sample(t)
		end
		return r
	end,a:bounds_or(unpack(bbs)))
end

do
  local fwav=smt:sine():phase(0.75):freq(0.25)
  fwav=fwav:clamp(0,1)
  fwav=fwav:add(smt:silence(-1):clamp(-math.huge,0))
  function smt.fade(wave,ma,mi)
    local ff=fwav:freq(1/(mi-ma)):phase(-ma)
    return wave:am(ff,1,-1)
  end
end

function smt:reverb(times,dist,mul)
	return self:new(function(_,t)
		local s = 0
		for n=0,times-1 do
			local tt = t-n*dist
			if tt>=self.bounds[1] and tt<=self.bounds[2] then
				s = s + self:sample(t-n*dist)*(mul^n)
			end
		end
		return s
	end,{self.bounds[1],self.bounds[2]+times*dist})
end

function smt.fm(car,mod,rate,mi,ma) -- TODO
	local cframe,cache=0,{}
	return smt.new(function(self,t)
	end,mod.bounds)
end

return smt