lazarus-ccr/examples/noise/perlin1d.dpr

program perlin1d;

{$ifdef fpc}
  {$mode delphi}
{$endif}

uses
  {$ifdef fpc}
  Interfaces, // this includes the LCL widgetset
  {$endif}
  Classes, SysUtils, LResources, Forms, Controls, Graphics, Dialogs, StdCtrls,
  noise;

type

  { TMainWindow }

  TMainWindow = class(TForm)
  private
    { private declarations }
    G1, G2, G3, G4: array of double;
    SelectInterpolation: TComboBox;
    procedure DoPaint(Sender: TObject);
    procedure DoRefresh(Sender: TObject);
    procedure DoPaintGraph(var Graph: array of Double; StartX, StartY, WL, A, NPoints: Integer);
    procedure DoCalculateNoise(var Graph: array of Double; WL, NPoints: Integer);
    function NormalizeNoise(x: Double; Amplitude: Integer): Integer;
  public
    { public declarations }
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
  end;

var
  vMainWindow: TMainWindow;

{ TMainWindow }

procedure TMainWindow.DoPaint(Sender: TObject);
var
  i: Integer;
begin
  SetLength(G1, 20 * 12);
  DoCalculateNoise(G1, 20, 12);
  DoPaintGraph(G1, 25,   25,  20, 250, 12);
  Canvas.TextOut(60, 15, '1st Harmonic');

  SetLength(G2, 10 * 24);
  DoCalculateNoise(G2, 10, 24);
  DoPaintGraph(G2, 325,  25,  10, 125,  24);
  Canvas.TextOut(460, 15, '2nd Harmonic');

  SetLength(G3, 5 * 48);
  DoCalculateNoise(G3, 5, 48);
  DoPaintGraph(G3, 25,  325,  5,  62,  48);
  Canvas.TextOut(60, 315, '3rd Harmonic');

  { The 4th graphic is a the sum of the first 3, using the amplitudes to
   ponderate the values }
  SetLength(G4, 20 * 12);
  for i := 0 to 20 * 12 - 1 do G4[i] := ( G1[i] * 250 + G2[i] * 125 + G3[i] * 62 ) / (250 + 125 + 62);
  DoPaintGraph(G4, 325,  325,  20, 250, 12);
  Canvas.TextOut(460, 315, 'Perlin Noise');
end;

procedure TMainWindow.DoRefresh(Sender: TObject);
begin
  Repaint;
end;

{*******************************************************************
*  TMainWindow.DoCalculateNoise ()
*
*  DESCRIPTION:    Creates a array with a 1D Noise plus interpolation
*
*  PARAMETERS:     Graph   - Array to store the points
*                  WL      - Wavelength in units.
*                            Those are filled with interpolation
*                  NPoints - Number of Noise points to be created
*
*******************************************************************}
procedure TMainWindow.DoCalculateNoise(var Graph: array of Double; WL, NPoints: Integer);
var
  i, j: Integer;
  interpolation: Double;
begin
  for i := 0 to NPoints - 1 do
  begin
    Graph[i * WL] := IntNoise(i);

    if (i = NPoints - 1) then Continue;

    for j := 1 to WL - 1 do
    begin
      case SelectInterpolation.ItemIndex of
       0: interpolation := Linear_Interpolate(IntNoise(i), IntNoise(i + 1), j / WL);
       1: interpolation := Cosine_Interpolate(IntNoise(i), IntNoise(i + 1), j / WL);
      else
        interpolation := Cubic_Interpolate(IntNoise(i - 1), IntNoise(i),
         IntNoise(i + 1), IntNoise(i + 2), j / WL);
      end;

      Graph[i * WL + j] := interpolation;
    end;
  end;
end;

{*******************************************************************
*  TMainWindow.DoPaintGraph ()
*
*  DESCRIPTION:    Draws a graphic that represents a 1D Noise function
*
*  PARAMETERS:     Graph   - Array to store the points
*                  StartX  - Starting X position for the graphic
*                  StartY  - Starting Y position for the graphic
*                  WL      - Wavelength in pixels
*                  A       - Amplitude in pixels
*                  NPoints - Number of points to be drawn
*
*******************************************************************}
procedure TMainWindow.DoPaintGraph(var Graph: array of Double; StartX, StartY, WL, A, NPoints: Integer);
var
  i, j: Integer;
begin
  { Draws rulers }
  Canvas.MoveTo(StartX,       StartY      );
  Canvas.LineTo(StartX,       StartY + 250);
  Canvas.LineTo(StartX + 250, StartY + 250);

  { Draws NPoints points and the interpolation between them }
  for i := 0 to NPoints - 1 do
  begin
    Canvas.Ellipse(i * WL + StartX + 1, NormalizeNoise(Graph[i * WL], A) + StartY + 1,
     i * WL + StartX - 1, NormalizeNoise(Graph[i * WL], A) + StartY - 1);

    if (i = NPoints - 1) then Continue;

    for j := 1 to WL - 1 do
    begin
      Canvas.Pixels[i * WL + StartX + j, NormalizeNoise(Graph[i * WL + j], A) + StartY] := clBlack;
    end;
  end;
end;

function TMainWindow.NormalizeNoise(x: Double; Amplitude: Integer): Integer;
begin
  Result := Round( 125 + x * Amplitude / 2 );
end;

constructor TMainWindow.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);

  Position := poScreenCenter;
  Width := 600;
  Height := 600;
  Caption := 'Perlin Noise 1D';

  OnPaint := DoPaint;

  SelectInterpolation := TComboBox.Create(Self);
  SelectInterpolation.Parent := Self;
  SelectInterpolation.Items.Add('Linear Interpolation');
  SelectInterpolation.Items.Add('Cosine Interpolation');
  SelectInterpolation.Items.Add('Cubic Interpolation');
  SelectInterpolation.Left := 200;
  SelectInterpolation.Width := 200;
  SelectInterpolation.ItemIndex := 0;

  SelectInterpolation.OnChange := DoRefresh;
end;

destructor TMainWindow.Destroy;
begin

  inherited Destroy;
end;

begin
  Application.Initialize;
  Application.CreateForm(TMainWindow, vMainWindow);
  Application.Run;
end.