Apophysis-AV/Flame/RndFlame.pas

{
     Apophysis Copyright (C) 2001-2004 Mark Townsend
     Apophysis Copyright (C) 2005-2006 Ronald Hordijk, Piotr Borys, Peter Sdobnov
     Apophysis Copyright (C) 2007-2008 Piotr Borys, Peter Sdobnov
     
     Apophysis "3D hack" Copyright (C) 2007-2008 Peter Sdobnov
     Apophysis "7X" Copyright (C) 2009-2010 Georg Kiehne
     Apophysis AV "Phoenix Edition" Copyright (C) 2021-2022 Alice V. Koryagina

     This program is free software; you can redistribute it and/or modify
     it under the terms of the GNU General Public License as published by
     the Free Software Foundation; either version 2 of the License, or
     (at your option) any later version.

     This program is distributed in the hope that it will be useful,
     but WITHOUT ANY WARRANTY; without even the implied warranty of
     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
     GNU General Public License for more details.

     You should have received a copy of the GNU General Public License
     along with this program; if not, write to the Free Software
     Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
}
unit RndFlame;

interface

uses
  ControlPoint;

function RandomFlame(SourceCP: TControlPoint = nil; algorithm: integer = 0): TControlPoint;

// AV: made the following public to get rid of duplicated code
procedure SetVariation(cp: TControlPoint);
procedure RandomVariation(cp: TControlPoint);

implementation

uses
  SysUtils, Global, cmap, GradientHlpr, XFormMan, Classes;

///////////////////////////////////////////////////////////////////////////////
// AV: this procedure repeated in the source code 3 times!
(* procedure RGBBlend(a, b: integer; var Palette: TColorMap);
{ Linear blend between to indices of a palette }
var
  c, v: real;
  vrange, range: real;
  i: integer;
begin
  if a = b then
  begin
    Exit;
  end;
  range := b - a;
  vrange := Palette[b mod 256][0] - Palette[a mod 256][0];
  c := Palette[a mod 256][0];
  v := vrange / range;
  for i := (a + 1) to (b - 1) do
  begin
    c := c + v;
    Palette[i mod 256][0] := Round(c);
  end;
  vrange := Palette[b mod 256][1] - Palette[a mod 256][1];
  c := Palette[a mod 256][1];
  v := vrange / range;
  for i := a + 1 to b - 1 do
  begin
    c := c + v;
    Palette[i mod 256][1] := Round(c);
  end;
  vrange := Palette[b mod 256][2] - Palette[a mod 256][2];
  c := Palette[a mod 256][2];
  v := vrange / range;
  for i := a + 1 to b - 1 do
  begin
    c := c + v;
    Palette[i mod 256][2] := Round(c);
  end;
end;  *)

procedure GetGradientFileGradientsNames(const filename: string; var NamesList: TStringList);
var
  i, p: integer;
  Title: string;
  FStrings: TStringList;
begin
  FStrings := TStringList.Create;
  FStrings.LoadFromFile(filename);
  try
    if (Pos('{', FStrings.Text) <> 0) then
    begin
      for i := 0 to FStrings.Count - 1 do
      begin
        p := Pos('{', FStrings[i]);
        if (p <> 0) and (Pos('(3D)', FStrings[i]) = 0) then
        begin
          Title := Trim(Copy(FStrings[i], 1, p - 1));
          if Title <> '' then
            NamesList.Add(Trim(Copy(FStrings[i], 1, p - 1)));
        end;
      end;
    end;
  finally
    FStrings.Free;
  end;
end;

procedure RandomGradient(SourceCP, DestCP: TControlPoint);
var
  tmpGrad: string;
  tmpGrdList: TStringList;
begin
  case randGradient of
    0:
      begin
        cmap_index := Random(NRCMAPS);
        GetCMap(cmap_index, 1, DestCP.cmap);
//        cmap_index := DestCP.cmapindex;
        DestCP.cmapIndex := cmap_index;
      end;
    1:
      begin
        DestCP.cmap := DefaultPalette;
        DestCP.cmapIndex := cmap_index;
      end;
    2:
      if assigned(SourceCP) then begin
        DestCP.cmap := SourceCP.cmap;
        DestCP.cmapIndex := SourceCP.cmapIndex;
      end else begin
        cmap_index := Random(NRCMAPS);
        GetCMap(cmap_index, 1, DestCP.cmap);
        DestCP.cmapIndex := cmap_index;
      end;
    3:
      DestCP.cmap := GradientHelper.RandomGradient;
    4:
      if FileExists(randGradientFile) then
      begin
        tmpGrdList := TStringList.Create;
        GetGradientFileGradientsNames(randGradientFile, tmpGrdList);
        tmpGrad := GetGradient(randGradientFile, tmpGrdList.Strings[random(tmpGrdList.Count)]);
        DestCP.cmap := CreatePalette(tmpGrad);
        tmpGrdList.Free;
      end else
      begin
        cmap_index := Random(NRCMAPS);
        GetCMap(cmap_index, 1, DestCP.cmap);
        DestCP.cmapIndex := cmap_index;
      end;
  end;
end;

{ ****************** Triangle transformations ******************************* }

function transform_affine(const t: TTriangle; const Triangles: TTriangles): boolean;
var
  ra, rb, rc, a, b, c: double;
begin
  Result := True;
  ra := dist(Triangles[-1].y[0], Triangles[-1].x[0],
    Triangles[-1].y[1], Triangles[-1].x[1]);
  rb := dist(Triangles[-1].y[1], Triangles[-1].x[1],
    Triangles[-1].y[2], Triangles[-1].x[2]);
  rc := dist(Triangles[-1].y[2], Triangles[-1].x[2],
    Triangles[-1].y[0], Triangles[-1].x[0]);
  a := dist(t.y[0], t.x[0], t.y[1], t.x[1]);
  b := dist(t.y[1], t.x[1], t.y[2], t.x[2]);
  c := dist(t.y[2], t.x[2], t.y[0], t.x[0]);
  if (a > ra) then
    Result := False
  else if (b > rb) then
    Result := False
  else if (c > rc) then
    Result := False
  else if ((a = ra) and (b = rb) and (c = rc)) then
    Result := False;
end;

function triangle_area(t: TTriangle): double;
var
  base, height: double;
begin
  try
    base := dist(t.x[0], t.y[0], t.x[1], t.y[1]);
    height := line_dist(t.x[2], t.y[2], t.x[1], t.y[1],
      t.x[0], t.y[0]);
    if (base < 1.0) then
      Result := height
    else if (height < 1.0) then
      Result := base
    else
      Result := 0.5 * base * height;
  except on E: EMathError do
      Result := 0;
  end;
end;

{ ************************************************************************** }

procedure RandomVariation(cp: TControlPoint);
{ Randomise variation parameters }
var
  a, b, i, j: integer;
  VarPossible: boolean;
begin
  inc(MainSeed);
  RandSeed := MainSeed;

  VarPossible := false;
  for j := 0 to NRVAR - 1 do
    if Variations[j] then begin // AV: make it faster!
      VarPossible := True;
      break;
    end;
  if not VarPossible then Variations[0] := True; // AV

  for i := 0 to cp.NumXForms - 1 do begin
    for j := 0 to NRVAR - 1 do
      cp.xform[i].SetVariation(j, 0);

    repeat
      a := random(NRVAR);
    until Variations[a];
    repeat
      b := random(NRVAR);
    until Variations[b];

    if (a = b) then begin
      cp.xform[i].SetVariation(a, 1);
    end else begin
      cp.xform[i].SetVariation(a, random);
      cp.xform[i].SetVariation(b, 1 - cp.xform[i].GetVariation(a));
    end;
  end;
end;

///////////////////////////////////////////////////////////////////////////////
procedure SetVariation(cp: TControlPoint);
{ Set the current Variation }
var
  i, j: integer;
begin
  if Variation = vRandom then begin
    RandomVariation(cp);
  end else
    for i := 0 to cp.NumXForms - 1 do  begin
      for j := 0 to NRVAR - 1 do
        cp.xform[i].SetVariation(j, 0);
      cp.xform[i].SetVariation(Variation, 1);
    end;
end;

///////////////////////////////////////////////////////////////////////////////
(* --Z-- hmm, exactly the same function exists in module Main

function TrianglesFromCP(const cp1: TControlPoint; var Triangles: TTriangles): integer;
{ Sets up the triangles from the IFS code }
var
  xforms: integer;
  i, j: integer;
  temp_x, temp_y, xset, yset: double;
  left, top, bottom, right: double;
  a, b, c, d, e, f: double;
begin
  top := 0; bottom := 0; right := 0; left := 0;
  xforms := NumXForms(cp1);
  Result := xforms;
  if not FixedReference then
  begin
    for i := 0 to xforms - 1 do
    begin
      a := cp1.xform[i].c[0][0];
      b := cp1.xform[i].c[0][1];
      c := cp1.xform[i].c[1][0];
      d := cp1.xform[i].c[1][1];
      e := cp1.xform[i].c[2][0];
      f := cp1.xform[i].c[2][1];
      xset := 1.0;
      yset := 1.0;
      for j := 0 to 5 do
      begin
        temp_x := xset * a + yset * c + e;
        temp_y := xset * b + yset * d + f;
        xset := temp_x;
        yset := temp_y;
      end;
      if (i = 0) then
      begin
        left := xset;
        right := xset;
        top := yset;
        bottom := yset;
      end
      else
      begin
        if (xset < left) then left := xset;
        if (xset > right) then right := xset;
        if (yset < top) then top := yset;
        if (yset > bottom) then bottom := yset;
      end;
    end;
    Triangles[-1].x[0] := left;
    Triangles[-1].x[1] := right;
    Triangles[-1].x[2] := right;
    Triangles[-1].y[0] := bottom;
    Triangles[-1].y[1] := bottom;
    Triangles[-1].y[2] := top;
  end
  else
  begin
    Triangles[-1].x[0] := 0; Triangles[-1].y[0] := 0;
    Triangles[-1].x[1] := 1; Triangles[-1].y[1] := 0;
    Triangles[-1].x[2] := 1; Triangles[-1].y[2] := 1.5;
  end;

  for j := 0 to xforms - 1 do
  begin
    a := cp1.xform[j].c[0][0];
    b := cp1.xform[j].c[0][1];
    c := cp1.xform[j].c[1][0];
    d := cp1.xform[j].c[1][1];
    e := cp1.xform[j].c[2][0];
    f := cp1.xform[j].c[2][1];
    for i := 0 to 2 do
    begin
      triangles[j].x[i] := Triangles[-1].x[i] * a + Triangles[-1].y[i] *
        c + e;
      triangles[j].y[i] := Triangles[-1].x[i] * b + Triangles[-1].y[i] *
        d + f;
    end;
  end;
  for i := -1 to xforms - 1 do
    for j := 0 to 2 do
      triangles[i].y[j] := -triangles[i].y[j];
end;
*)

///////////////////////////////////////////////////////////////////////////////
procedure EqualizeWeights(var cp: TControlPoint);
var
  t, i: integer;
begin
  t := cp.NumXForms;
  for i := 0 to t - 1 do
    cp.xform[i].density := 1.0 / t;
end;

///////////////////////////////////////////////////////////////////////////////
procedure NormalizeWeights(var cp: TControlPoint);
var
  i: integer;
  td: double;
begin
  td := 0.0;
  for i := 0 to cp.NumXForms - 1 do
    td := td + cp.xform[i].Density;
  if (td < 0.001) then
    EqualizeWeights(cp)
  else
    for i := 0 to cp.NumXForms - 1 do
      cp.xform[i].Density := cp.xform[i].Density / td;
end;

///////////////////////////////////////////////////////////////////////////////
procedure ComputeWeights(var cp1: TControlPoint; Triangles: TTriangles; t: integer);
{ Caclulates transform weight from triangles }
var
  i: integer;
  total_area: double;
begin
  total_area := 0.0;
  for i := 0 to t - 1 do
  begin
    cp1.xform[i].Density := triangle_area(Triangles[i]);
    total_area := total_area + cp1.xform[i].Density;
  end;
  for i := 0 to t - 1 do
  begin
    cp1.xform[i].Density := cp1.xform[i].Density / total_area;
  end;
  NormalizeWeights(cp1);
end;

///////////////////////////////////////////////////////////////////////////////
(*
procedure RandomWeights(var cp1: TControlPoint);
{ Randomizes xform weights }
var
  i: integer;
begin
  for i := 0 to cp1.NumXForms - 1 do  // AV: was Transforms - 1
    cp1.xform[i].Density := random;
  NormalizeWeights(cp1);
end;
*)
///////////////////////////////////////////////////////////////////////////////
function RandomFlame(SourceCP: TControlPoint; algorithm: integer): TControlPoint;
var
  Min, Max, i, j, rnd: integer;
  Triangles: TTriangles;
  r, s, theta, phi: double;
  cosphi, sintheta, costheta: double;
  skip: boolean;
begin
  if Assigned(SourceCP) then
    Result := SourceCP.clone
  else
    Result := TControlPoint.Create;

  Min := randMinTransforms;
  Max := randMaxTransforms;

  inc(MainSeed);
  RandSeed := MainSeed;
  transforms := random(Max - (Min - 1)) + Min;

  repeat
    try
      inc(MainSeed);
      RandSeed := MainSeed;
      Result.Clear;
      for i := 0 to Transforms - 1 do // AV: set starting non-zero weights...
        Result.xform[i].density := 0.5;
      // AV: we don't really need to randomize the same flame twice...
      //Result.RandomCP(transforms, transforms, false);
      //Result.SetVariation(Variation);  // AV: deprecated!
      SetVariation(Result);  // AV: replaced old method from ControlPoint

      case algorithm of
        1: rnd := 0;
        2: rnd := 7;
        3: rnd := 9;
      else
        if (Variation = 0 {vLinear}) or (Variation = vRandom) then
          rnd := random(10)
        else
          rnd := 9;
      end;
      case rnd of
        0..6:
          begin
            for i := 0 to Transforms - 1 do
            begin
               // AV: useless assignments
              {if Random(10) < 9 then
                Result.xform[i].c[0, 0] := 1
              else
                Result.xform[i].c[0, 0] := -1;
              Result.xform[i].c[0, 1] := 0;
              Result.xform[i].c[1, 0] := 0;
              Result.xform[i].c[1, 1] := 1;
              Result.xform[i].c[2, 0] := 0;
              Result.xform[i].c[2, 1] := 0;
              Result.xform[i].color := 0;
              // AV: this will be done with SetVariation method!
              Result.xform[i].SetVariation(0, 1);
              for j := 1 to NRVAR - 1 do
                Result.xform[i].SetVariation(j, 0); }
              // AV: hundred of useless calculations
              {Result.xform[i].Translate(random * 2 - 1, random * 2 - 1);
              Result.xform[i].Rotate(random * 360);
              if i > 0 then
                Result.xform[i].Scale(random * 0.8 + 0.2)
              else
                Result.xform[i].Scale(random * 0.4 + 0.6); }
              Result.xform[i].symmetry := 0;
              if i > 0 then
                s := random * 0.8 + 0.2
              else
                s := random * 0.4 + 0.6;
              theta := random * 2 * pi;
              sintheta := s * sin(theta);
              costheta := s * cos(theta);
              if Random(10) < 9 then
              begin
                Result.xform[i].c[0, 0] := costheta;
                Result.xform[i].c[1, 0] := sintheta;
              end
              else begin
                Result.xform[i].c[0, 0] := -costheta;
                Result.xform[i].c[1, 0] := -sintheta;
              end;
              Result.xform[i].c[0, 1] := -sintheta;
              Result.xform[i].c[1, 1] := costheta;
              Result.xform[i].c[2, 0] := random * 2 - 1;
              Result.xform[i].c[2, 1] := random * 2 - 1;
              if Random(2) = 0 then
                Result.xform[i].Multiply(Result.xform[i].c,
                                        1, random - 0.5, random - 0.5, 1);

              if Random(2) = 1 then
              begin
              // AV: added post-transforms support!
                theta := 2 * random * pi;
                r := 0.3 + random * 0.7;
                sintheta := r * sin(theta);
                costheta := r * cos(theta);
                Result.xform[i].p[0, 0] := costheta;
                Result.xform[i].p[0, 1] := sintheta;
                Result.xform[i].p[1, 0] := -sintheta;
                Result.xform[i].p[1, 1] := costheta;
                Result.xform[i].p[2,0] := random * 2 - 1;
                Result.xform[i].p[2,1] := random * 2 - 1;
              end;
            end;
            //SetVariation(Result);
          end;
        7, 8:
          begin
          { From the source to Chaos: The Software }
            for i := 0 to Transforms - 1 do begin
              r := random * 2 - 1;
              if ((0 <= r) and (r < 0.2)) then
                r := r + 0.2;
              if ((r > -0.2) and (r <= 0)) then
                r := r - 0.2;
              s := random * 2 - 1;
              if ((0 <= s) and (s < 0.2)) then
                s := s + 0.2;
              if ((s > -0.2) and (s <= 0)) then
                s := s - -0.2;
              theta := PI * random;
              phi := (2 + random) * PI / 4;
              // AV: we don't need to calculate everything twice!
              sintheta := sin(theta);
              costheta := cos(theta);
              cosphi := cos(phi);
              Result.xform[i].c[0][0] := r * costheta;
              Result.xform[i].c[1][0] := s * (costheta * cosphi - sintheta);
              Result.xform[i].c[0][1] := r * sintheta;
              Result.xform[i].c[1][1] := s * (sintheta * cosphi + costheta);
            { the next bit didn't translate so well, so I fudge it}
              Result.xform[i].c[2][0] := random * 2 - 1;
              Result.xform[i].c[2][1] := random * 2 - 1;
            end;

            {  // AV: the following was (or will be) done!
            for i := 0 to NXFORMS-1 do
              Result.xform[i].density := 0;
            for i := 0 to Transforms - 1 do
              Result.xform[i].density := 1 / Transforms;
            SetVariation(Result);
            }
          end;
        9: begin
             {  // AV: the following was (or will be) done!
            for i := 0 to NXFORMS-1 do
              Result.xform[i].density := 0;
            for i := 0 to Transforms - 1 do
              Result.xform[i].density := 1 / Transforms;
             }
             for i := 0 to Transforms - 1 do begin  // AV
                Result.xform[i].RandomizeCoefs(Result.xform[i].c);
                if Random(4) = 1 then
                  Result.xform[i].RandomizeCoefs(Result.xform[i].p);
             end;
          end;
      end; // case
      Result.TrianglesFromCp(Triangles);

      if Random(2) > 0 then
        ComputeWeights(Result, Triangles, transforms)
      else
        EqualizeWeights(Result);
    except on E: EmathError do
      begin
        Continue;
      end;
    end;
    for i := 0 to Transforms - 1 do
      Result.xform[i].color := i / (transforms - 1);
    if Result.xform[0].density = 1 then
      Continue;
    case SymmetryType of
      { Bilateral }
      1: add_symmetry_to_control_point(Result, -1);
      { Rotational }
      2: add_symmetry_to_control_point(Result, SymmetryOrder);
      { Rotational and Reflective }
      3: add_symmetry_to_control_point(Result, -SymmetryOrder);
    end;
    { elimate flames with transforms that aren't affine }
    skip := false;
    for i := 0 to Transforms - 1 do begin
      if not transform_affine(Triangles[i], Triangles) then
        skip := True;
    end;
    if skip then
      continue;
  until not Result.BlowsUP(5000) and (Result.xform[0].density <> 0);

  RandomGradient(SourceCP, Result);

  Result.brightness := defBrightness;
  Result.gamma := defGamma;
  Result.gamma_threshold := defGammaThreshold;
  Result.vibrancy := defVibrancy;
  Result.sample_density := defSampleDensity;
  Result.spatial_oversample := defOversample;
  Result.spatial_filter_radius := defFilterRadius;
  Result.contrast := defContrast;   // AV
  if KeepBackground and assigned(SourceCP) then begin
    Result.background[0] := SourceCP.background[0];
    Result.background[1] := SourceCP.background[1];
    Result.background[2] := SourceCP.background[2];
  end else if (RandBackColor <> 0) then begin   // AV: to set the user's predefined BG
    Result.background[0] := RandBackColor and 255;
    Result.background[1] := RandBackColor shr 8 and 255;
    Result.background[2] := RandBackColor shr 16 and 255;
  end else begin
    Result.background[0] := 0;
    Result.background[1] := 0;
    Result.background[2] := 0;
  end;
  Result.zoom := 0;
  
  Result.xform[Result.NumXForms].Clear;
  Result.xform[Result.NumXForms].symmetry := 1;
end;

end.