Carver Explorer

[paul_nicholls]

Here is my Perlin Noise unit I made up around 2006 - not sure how fast it is?

Unit PerlinNoiseUnit;

Interface

{$R-}
{$Q-}

Const
  _B = $100;
  BM = $ff;

  N = $1000;

Type
    TPerlinNoise = Class
    Private
        P : Array[0..(_B+_B+2)-1] Of Integer;
        G1: Array[0..(_B+_B+2)-1] Of Double;
    Public
        Constructor Create(Seed: Integer);

        Procedure InitNoise(Seed: Integer);
        Function Noise1d(x: Double): Double;
        Function Noise2d(x,y: Double): Double;
        Function Noise3d(x,y,z: Double): Double;

        Function PerlinNoise1d(x: Double;
                               Persistence: Single = 0.25;
                               Frequency: Single = 1;
                               Octaves: Integer = 4): Double;
        Function PerlinNoise2d(x,y: Double;
                               Persistence: Single = 0.25;
                               Frequency: Single = 1;
                               Octaves: Integer = 4): Double;
        Function PerlinNoise3d(x,y,z: Double;
                               Persistence: Single = 0.25;
                               Frequency: Single = 1;
                               Octaves: Integer = 4): Double;
    End;

Implementation

Uses
    SysUtils;

Function TPerlinNoise.Noise1d(x: Double): Double;
Var
  bx0,bx1: Integer;
  rx0,sx,t,u,v: Double;
Begin
  t := x+N;
  bx0 := Trunc(t) And BM;
  bx1 := (bx0+1) And BM;
  rx0 := t-Trunc(t);

  sx := (rx0*rx0*(3.0-2.0*rx0));

  u := G1[P[bx0]];
  v := G1[P[bx1]];

  Result := u+sx*(v-u);
End;

Function TPerlinNoise.Noise2d(x,y: Double): Double;
Var
  bx0,bx1,by0,by1: Integer;
  i,j: Integer;
  rx0,ry0: Double;
  sx,sy: Double;
  a,b,t,u,v: Double;
Begin
  t := x+N;
  bx0 := Trunc(t) And BM;
  bx1 := (bx0+1) And BM;
  rx0 := t-Trunc(t);

  t := y+N;
  by0 := Trunc(t) And BM;
  by1 := (by0+1) And BM;
  ry0 := t-Trunc(t);

  i := P[bx0];
  j := P[bx1];

  sx := (rx0*rx0*(3.0-2.0*rx0));
  sy := (ry0*ry0*(3.0-2.0*ry0));

  u := G1[P[i+by0]];
  v := G1[P[j+by0]];
  a := u+sx*(v-u);

  u := G1[P[i+by1]];
  v := G1[P[j+by1]];
  b := u+sx*(v-u);

  Result := a+sy*(b-a);
End;

Function TPerlinNoise.Noise3d(x,y,z: Double): Double;
Var
  bx0,bx1,by0,by1,bz0,bz1: Integer;
  i,j,k,l: Integer;
  rx0,ry0,rz0: Double;
  sx,sy,sz: Double;
  a,b,c,d,t,u,v: Double;
Begin
  t := x+N;
  bx0 := Trunc(t) And BM;
  bx1 := (bx0+1) And BM;
  rx0 := t-Trunc(t);

  t := y+N;
  by0 := Trunc(t) And BM;
  by1 := (by0+1) And BM;
  ry0 := t-Trunc(t);

  t := z+N;
  bz0 := Trunc(t) And BM;
  bz1 := (bz0+1) And BM;
  rz0 := t-Trunc(t);

  i := P[bx0];
  j := P[bx1];

  k := P[i+by0];
  l := P[j+by0];
  i := P[i+by1];
  j := P[j+by1];

  sx := (rx0*rx0*(3.0-2.0*rx0));
  sy := (ry0*ry0*(3.0-2.0*ry0));
  sz := (rz0*rz0*(3.0-2.0*rz0));

  u := G1[P[k+bz0]];
  v := G1[P[l+bz0]];
  a := u+sx*(v-u);

  u := G1[P[i+bz0]];
  v := G1[P[j+bz0]];
  b := u+sx*(v-u);

  c := a+sy*(b-a);

  u := G1[P[k+bz1]];
  v := G1[P[l+bz1]];
  a := u+sx*(v-u);

  u := G1[P[i+bz1]];
  v := G1[P[j+bz1]];
  b := u+sx*(v-u);

  d := a+sy*(b-a);

  Result := c+sz*(d-c);
End;

constructor TPerlinNoise.Create(Seed: Integer);
Begin
  inherited Create;

  InitNoise(Seed);
End;

procedure TPerlinNoise.InitNoise(Seed: Integer);
Var
  i,j: Integer;
Begin
  RandSeed := Seed;

  For i := 0 to _B - 1 Do
  Begin
    P[i] := i;
    G1[i] := 2*Random-1;
  End;

  For i := 0 to _B - 1 Do
  Begin
    j := Random(_B);
    P[i] := P[i] xor P[j];
    P[j] := P[j] xor P[i];
    P[i] := P[i] xor P[j];
  End;

  For i := 0 to _B+2 - 1 Do
  Begin
    P[_B+i] := P[i];
    G1[_B+i] := G1[i];
  End
End;

Function TPerlinNoise.PerlinNoise1d(x: Double;
                                    Persistence: Single = 0.25;
                                    Frequency: Single = 1;
                                    Octaves: Integer = 4): Double;
Var
    i: Integer;
    p,s: Double;
Begin
    Result := 0;
    s := Frequency;
    p := 1;
    For i := 0 to Octaves - 1 Do
    Begin
        Result := Result + p * Noise1d(x * s);
        s := s * 2;
        p := p * Persistence;
    End;
End;

Function TPerlinNoise.PerlinNoise2d(x,y: Double;
                                    Persistence: Single = 0.25;
                                    Frequency: Single = 1;
                                    Octaves: Integer = 4): Double;
Var
    i: Integer;
    p,s: Double;
Begin
    Result := 0;
    s := Frequency;
    p := 1;
    For i := 0 to Octaves - 1 Do
    Begin
        Result := Result + p * Noise2d(x * s,y * s);
        s := s * 2;
        p := p * Persistence;
    End;
End;

Function TPerlinNoise.PerlinNoise3d(x,y,z: Double;
                                    Persistence: Single = 0.25;
                                    Frequency: Single = 1;
                                    Octaves: Integer = 4): Double;
Var
    i: Integer;
    p,s: Double;
Begin
    Result := 0;
    s := Frequency;
    p := 1;
    For i := 0 to Octaves - 1 Do
    Begin
        Result := Result + p * Noise3d(x * s,y * s,z * s);
        s := s * 2;
        p := p * Persistence;
    End;
End;

End.

[Carver413]

This looks very nice Paul, I'll have to play around with it a bit and see what kind of trouble I can get into

[pitfiend]

Here is my Perlin Noise unit I made up around 2006 - not sure how fast it is?

Unit PerlinNoiseUnit;

Interface

{$R-}
{$Q-}

Const
  _B = $100;
  BM = $ff;

  N = $1000;

Type
    TPerlinNoise = Class
    Private
        P : Array[0..(_B+_B+2)-1] Of Integer;
        G1: Array[0..(_B+_B+2)-1] Of Double;
    Public
        Constructor Create(Seed: Integer);

        Procedure InitNoise(Seed: Integer);
        Function Noise1d(x: Double): Double;
        Function Noise2d(x,y: Double): Double;
        Function Noise3d(x,y,z: Double): Double;

        Function PerlinNoise1d(x: Double;
                               Persistence: Single = 0.25;
                               Frequency: Single = 1;
                               Octaves: Integer = 4): Double;
        Function PerlinNoise2d(x,y: Double;
                               Persistence: Single = 0.25;
                               Frequency: Single = 1;
                               Octaves: Integer = 4): Double;
        Function PerlinNoise3d(x,y,z: Double;
                               Persistence: Single = 0.25;
                               Frequency: Single = 1;
                               Octaves: Integer = 4): Double;
    End;

Implementation

Uses
    SysUtils;

Function TPerlinNoise.Noise1d(x: Double): Double;
Var
  bx0,bx1: Integer;
  rx0,sx,t,u,v: Double;
Begin
  t := x+N;
  bx0 := Trunc(t) And BM;
  bx1 := (bx0+1) And BM;
  rx0 := t-Trunc(t);

  sx := (rx0*rx0*(3.0-2.0*rx0));

  u := G1[P[bx0]];
  v := G1[P[bx1]];

  Result := u+sx*(v-u);
End;

Function TPerlinNoise.Noise2d(x,y: Double): Double;
Var
  bx0,bx1,by0,by1: Integer;
  i,j: Integer;
  rx0,ry0: Double;
  sx,sy: Double;
  a,b,t,u,v: Double;
Begin
  t := x+N;
  bx0 := Trunc(t) And BM;
  bx1 := (bx0+1) And BM;
  rx0 := t-Trunc(t);

  t := y+N;
  by0 := Trunc(t) And BM;
  by1 := (by0+1) And BM;
  ry0 := t-Trunc(t);

  i := P[bx0];
  j := P[bx1];

  sx := (rx0*rx0*(3.0-2.0*rx0));
  sy := (ry0*ry0*(3.0-2.0*ry0));

  u := G1[P[i+by0]];
  v := G1[P[j+by0]];
  a := u+sx*(v-u);

  u := G1[P[i+by1]];
  v := G1[P[j+by1]];
  b := u+sx*(v-u);

  Result := a+sy*(b-a);
End;

Function TPerlinNoise.Noise3d(x,y,z: Double): Double;
Var
  bx0,bx1,by0,by1,bz0,bz1: Integer;
  i,j,k,l: Integer;
  rx0,ry0,rz0: Double;
  sx,sy,sz: Double;
  a,b,c,d,t,u,v: Double;
Begin
  t := x+N;
  bx0 := Trunc(t) And BM;
  bx1 := (bx0+1) And BM;
  rx0 := t-Trunc(t);

  t := y+N;
  by0 := Trunc(t) And BM;
  by1 := (by0+1) And BM;
  ry0 := t-Trunc(t);

  t := z+N;
  bz0 := Trunc(t) And BM;
  bz1 := (bz0+1) And BM;
  rz0 := t-Trunc(t);

  i := P[bx0];
  j := P[bx1];

  k := P[i+by0];
  l := P[j+by0];
  i := P[i+by1];
  j := P[j+by1];

  sx := (rx0*rx0*(3.0-2.0*rx0));
  sy := (ry0*ry0*(3.0-2.0*ry0));
  sz := (rz0*rz0*(3.0-2.0*rz0));

  u := G1[P[k+bz0]];
  v := G1[P[l+bz0]];
  a := u+sx*(v-u);

  u := G1[P[i+bz0]];
  v := G1[P[j+bz0]];
  b := u+sx*(v-u);

  c := a+sy*(b-a);

  u := G1[P[k+bz1]];
  v := G1[P[l+bz1]];
  a := u+sx*(v-u);

  u := G1[P[i+bz1]];
  v := G1[P[j+bz1]];
  b := u+sx*(v-u);

  d := a+sy*(b-a);

  Result := c+sz*(d-c);
End;

constructor TPerlinNoise.Create(Seed: Integer);
Begin
  inherited Create;

  InitNoise(Seed);
End;

procedure TPerlinNoise.InitNoise(Seed: Integer);
Var
  i,j: Integer;
Begin
  RandSeed := Seed;

  For i := 0 to _B - 1 Do
  Begin
    P[i] := i;
    G1[i] := 2*Random-1;
  End;

  For i := 0 to _B - 1 Do
  Begin
    j := Random(_B);
    P[i] := P[i] xor P[j];
    P[j] := P[j] xor P[i];
    P[i] := P[i] xor P[j];
  End;

  For i := 0 to _B+2 - 1 Do
  Begin
    P[_B+i] := P[i];
    G1[_B+i] := G1[i];
  End
End;

Function TPerlinNoise.PerlinNoise1d(x: Double;
                                    Persistence: Single = 0.25;
                                    Frequency: Single = 1;
                                    Octaves: Integer = 4): Double;
Var
    i: Integer;
    p,s: Double;
Begin
    Result := 0;
    s := Frequency;
    p := 1;
    For i := 0 to Octaves - 1 Do
    Begin
        Result := Result + p * Noise1d(x * s);
        s := s * 2;
        p := p * Persistence;
    End;
End;

Function TPerlinNoise.PerlinNoise2d(x,y: Double;
                                    Persistence: Single = 0.25;
                                    Frequency: Single = 1;
                                    Octaves: Integer = 4): Double;
Var
    i: Integer;
    p,s: Double;
Begin
    Result := 0;
    s := Frequency;
    p := 1;
    For i := 0 to Octaves - 1 Do
    Begin
        Result := Result + p * Noise2d(x * s,y * s);
        s := s * 2;
        p := p * Persistence;
    End;
End;

Function TPerlinNoise.PerlinNoise3d(x,y,z: Double;
                                    Persistence: Single = 0.25;
                                    Frequency: Single = 1;
                                    Octaves: Integer = 4): Double;
Var
    i: Integer;
    p,s: Double;
Begin
    Result := 0;
    s := Frequency;
    p := 1;
    For i := 0 to Octaves - 1 Do
    Begin
        Result := Result + p * Noise3d(x * s,y * s,z * s);
        s := s * 2;
        p := p * Persistence;
    End;
End;

End.

I think you can improve speed if you use a type cast to integer (t as integer) instead of that trunc(t) function. Also you can remove the sysutils unit as it seems your code didn't use anything from it. Random and RandSeed are declared in the implicit system unit.

[SilverWarior]

@Paul
Thank you for that. Where were you when I was asking about this in next thread: http://www.pascalgamedevelopment.com...eneration-code
I will test it when I get home. It also gave me solution for improving my own algorithm for some capability that I need.

@Carver431
That site seems verry good. I will take some time reading trough but it will have to wait after the competition.

[Carver413]

@Paul That site seems verry good. I will take some time reading trough but it will have to wait after the competition.

to pull off a good texture rendering system you will need much more then just perlin noise and if your not careful your system could become very bloated and unmanageable rather quickly. my approach may not be the fastest solution but it extremely flexible most effects are applied as nodes and are very small they can often be chained together so the output of one becomes the input for the next. all drawing functions are effected by these nodes, even text rendering. scripting in most cases does not have a big impact but provides a nice interface to fine tune these effects. property editors require alot of extra work and generally preform poorly. my scripting mechanic's is not design for speed but flexibility, modular design. scripting expansion nodes are stack in the same way that the drawing nodes are. each node can have as many commands as needed and and new data types. in this way we can group them together in a way that makes since. and we can include as much or as little as we want. further more the scripting provides many input/output methods. you can export data in a similar xml fashion, only more readable. you can input/output lists of variables in a less orderly fashion. the scripting in the Explorer is for the most part is intended to be a set up language, not intended to handle time critical tasks. by the time this project is finish I will have implemented a chunk library so that if we decide to pre render some of our assets they could be stored there until they are no longer needed.

[SilverWarior]

Yes I know that I will ned much more than just perlin noise. That's why I'm already developing my algorithm in a way that it will easily alow me to do some postprocessing or even do some preprocessing for each of the layers wich are then used in creation of the final texture. But like stated a few post higher I doubt I could do this by the end of competition. I do have a lot of other owrk on my entry wich still needs to be done. Hence I havent completly decided wich graphic engine will I use. For now I work on the core of the game.

[Carver413]

@Paul
your perlin is very nice, thank you so much
I have implemented as a variable so I could set the seed from a script as well as share it with other functions. still need to play with it some more before I get it all figured out. now I just need to figure out how to make wood grains with it.

[SilverWarior]

I just need to figure out how to make wood grains with it.

I think next page might come in handy for this as it shows example of how to make wood like textures.
http://freespace.virgin.net/hugo.eli...s/m_perlin.htm

Look at the bottom of the page

[paul_nicholls]

@Paul
your perlin is very nice, thank you so much
I have implemented as a variable so I could set the seed from a script as well as share it with other functions. still need to play with it some more before I get it all figured out. now I just need to figure out how to make wood grains with it.

Glad I could help mate

[Darkhog]

Here is my Perlin Noise unit I made up around 2006 - not sure how fast it is?
snip

X/Y/Z in functions Noise1D/2D/3D are offset from (0,0,0), right? I'm asking because I'm looking into making "infinite" game using chunks scheme (perlin noise is for world generation).