Carver Explorer

**code_glitch** · 12-04-2012, 08:34 PM

Aside from the font, thats some good work indeed

**SilverWarior** · 13-04-2012, 12:34 AM

I see that you are using Perlin Noise for texture generation. Would you mind sharing sorce code for it so I can do some comparison with my Perlin Noise like algorithm that I made for myself? Mostly I would just like to do some speed comparison bethween them.

**Carver413** · 13-04-2012, 02:24 AM

Actually that is not perlin noise, I don't have a good working perlin. if you want a fast perlin then your going to have to cheat like everone else. there are many different methods out there if you take the time to dig around a bit. I'm not really doing much with perlin right now so I haven't really perused it myself this. try this http://drilian.com/category/developm...ural-textures/ and see if there are some better ideas for you

**Carver413** · 13-04-2012, 02:48 AM

Glscene also contains some perlin stuff maybe you should browse thru that as well

**paul_nicholls** · 13-04-2012, 03:05 AM

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

Code:

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** · 13-04-2012, 03:58 AM

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** · 13-04-2012, 04:08 AM

Originally Posted by paul_nicholls

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

Code:

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** · 13-04-2012, 06:48 AM

@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.

**Darkhog** · 29-05-2013, 08:48 AM

Originally Posted by paul_nicholls

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).

**paul_nicholls** · 30-05-2013, 05:22 AM

Originally Posted by Darkhog

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).

Hi Darkhog, to be honest, I don't know...but I assume that is the case

cheers,
Paul

Thread: Carver Explorer

Thread Tools

Display

Hybrid View

Bookmarks

Bookmarks

Posting Permissions