unit dgen_noise;

interface

uses
  dcolors,
  dvector2i,
  dvector2f,
  dscreenbuffer,
  dtexture2d_generator;

type
TRandomGen = class(TMonoGen)
  Seed: Integer;
  Width, Height: Integer;
  function GetMono(const V: TVec2f): Single; override;
end;

TTexRand1f = class(TTexGen1f)
  FSeed: Integer;
  FCache: TScreenBuffer;
  constructor Create(Seed: Integer);
  function Get(const V: TVec2f): Single; override;
end;

function Noise1f(Seed: Integer = 0): TTexRand1f;
function Noise(Seed: Integer = 0; Width: Integer = 512; Height: Integer = 512): TRandomGen;
function DefaultNoise1f: TTexRand1f;
function DefaultNoise: TRandomGen;

implementation

function Hash32Shift(Key: Integer): Integer;
begin
  {Key := not Key + (Key shl 15);
  Key := Key xor (Key shr 12);
  Key := Key + (Key shl 2);
  Key := Key xor (Key shr 4);
  Key := Key * 2057;
  Key := Key xor (Key shr 16);
  hash32shift := Key;}
  Result := not Key + (Key shl 15);
end;

function GetRandom2i(X, Y, Seed: Integer): Single; inline;
begin
  Result := Hash32Shift(Seed + Hash32Shift(X + Hash32Shift(Y)));
end;

function GetRandom2f(const V: TVec2f; Seed: Integer): Single; inline;
var
  FracX, FracY: Double;
  X1, Y1, X2, Y2: Integer;
begin
  Writeln('in');
  FracX := Frac(V.X);
  FracY := Frac(V.Y);
  Writeln('2');
  
  X1 := (Trunc(V.X) + Noise.Width)  mod Noise.Width;
  Y1 := (Trunc(V.Y) + Noise.Height) mod Noise.Height;
  Writeln('3');
  
  X2 := (X1 + Noise.Width  - 1) mod Noise.Width;
  Y2 := (Y1 + Noise.Height - 1) mod Noise.Height;

  Result :=          FracX       * FracY       * GetRandom2i(X1, Y1, Seed);
  Result := Result + FracX       * (1 - FracY) * GetRandom2i(X1, Y2, Seed);
  Result := Result + (1 - FracX) * FracY       * GetRandom2i(X2, Y1, Seed);
  Result := Result + (1 - FracX) * (1 - FracY) * GetRandom2i(X2, Y2, Seed);
  Writeln('out');
end;

function TRandomGen.GetMono(const V: TVec2f): Single;
var
  FracX, FracY: Double;
  Corrected: TVec2i;
  X1, Y1, X2, Y2: Integer;
begin
  FracX := Frac(V.X);
  FracY := Frac(V.Y);

  if V.X >= 0 then
    Corrected.X := Trunc(V.X - FracX)
  else
    Corrected.X := Trunc(V.X - FracX);
  if V.Y >= 0 then
    Corrected.Y := Trunc(V.Y - FracY)
  else
    Corrected.Y := Trunc(V.Y - FracY);
  
  X1 := (Corrected.X) mod Cache.Width;
  Y1 := (Corrected.Y) mod Cache.Height;
  if X1 < 0 then
    X1 := X1 + Cache.Width;
  if Y1 < 0 then
    Y1 := Y1 + Cache.Height;
  
  X2 := (X1 + Cache.Width  - 1) mod Cache.Width;
  Y2 := (Y1 + Cache.Height - 1) mod Cache.Height;

  Result :=          FracX       * FracY       * GetRed(Cache[X1, Y1]) / 255;
  Result := Result + FracX       * (1 - FracY) * GetRed(Cache[X1, Y2]) / 255;
  Result := Result + (1 - FracX) * FracY       * GetRed(Cache[X2, Y1]) / 255;
  Result := Result + (1 - FracX) * (1 - FracY) * GetRed(Cache[X2, Y2]) / 255;
end;

constructor TTexRand1f.Create(Seed: Integer);
var
  X, Y: Integer;
begin
  inherited Create;
  FSeed := Seed;
  FCache := TScreenBuffer.Create(512, 512);
  for X := 0 to FCache.Width - 1 do
    for Y := 0 to FCache.Height - 1 do
      FCache[X, Y] := RGBA(Random(256), Random(256), Random(256));
end;

function TTexRand1f.Get(const V: TVec2f): Single;
var
  FracX, FracY: Double;
  Corrected: TVec2i;
  X1, Y1, X2, Y2: Integer;
begin
  FracX := Frac(V.X);
  FracY := Frac(V.Y);

  if V.X >= 0 then
    Corrected.X := Trunc(V.X - FracX)
  else
    Corrected.X := Trunc(V.X - FracX);
  if V.Y >= 0 then
    Corrected.Y := Trunc(V.Y - FracY)
  else
    Corrected.Y := Trunc(V.Y - FracY);
  
  X1 := (Corrected.X) mod FCache.Width;
  Y1 := (Corrected.Y) mod FCache.Height;
  if X1 < 0 then
    X1 := X1 + FCache.Width;
  if Y1 < 0 then
    Y1 := Y1 + FCache.Height;
  
  X2 := (X1 + FCache.Width  - 1) mod FCache.Width;
  Y2 := (Y1 + FCache.Height - 1) mod FCache.Height;

  Result :=          FracX       * FracY       * GetRed(FCache[X1, Y1]) / 255;
  Result := Result + FracX       * (1 - FracY) * GetRed(FCache[X1, Y2]) / 255;
  Result := Result + (1 - FracX) * FracY       * GetRed(FCache[X2, Y1]) / 255;
  Result := Result + (1 - FracX) * (1 - FracY) * GetRed(FCache[X2, Y2]) / 255;
//  Result := GetRandom2f(V, FSeed);
end;

function Noise1f(Seed: Integer = 0): TTexRand1f;
begin
  Result := TTexRand1f.Create(Seed);
end;

function Noise(Seed: Integer = 0; Width: Integer = 512; Height: Integer = 512): TRandomGen;
var
  X, Y: Integer;
begin
  Result := TRandomGen.Create;
  Result.Seed := Seed;
  Result.Width := Width;
  Result.Height := Height;
  Result.Cache := TScreenBuffer.Create(Width, Height);
  for X := 0 to Width - 1 do
    for Y := 0 to Height - 1 do
      Result.Cache[X, Y] := RGBA(Random(256), Random(256), Random(256));
end;

var
  GlobalNoise1f: TTexRand1f = nil;
  GlobalNoise: TRandomGen = nil;

function DefaultNoise1f: TTexRand1f;
begin
  Result := GlobalNoise1f;
end;

function DefaultNoise: TRandomGen;
begin
  Result := GlobalNoise;
end;

initialization
  GlobalNoise1f := Noise1f(0);
  GlobalNoise := Noise(0);
finalization
  GlobalNoise.Free;
  GlobalNoise1f.Free;
end.
