hedgewars/uLandGenPerlin.pas
author unc0rr
Sat, 08 Mar 2014 13:50:50 +0400
changeset 10184 f87776bd5acd
parent 10183 189afaf2d076
child 10185 007a40cfbb3d
permissions -rw-r--r--
Setup leftX, rightX and topY
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
10181
4708343d5963 Perlin noise generator untweaked, temporarily replacing maze generator
unc0rr
parents:
diff changeset
     1
{$INCLUDE "options.inc"}
4708343d5963 Perlin noise generator untweaked, temporarily replacing maze generator
unc0rr
parents:
diff changeset
     2
4708343d5963 Perlin noise generator untweaked, temporarily replacing maze generator
unc0rr
parents:
diff changeset
     3
unit uLandGenPerlin;
4708343d5963 Perlin noise generator untweaked, temporarily replacing maze generator
unc0rr
parents:
diff changeset
     4
interface
4708343d5963 Perlin noise generator untweaked, temporarily replacing maze generator
unc0rr
parents:
diff changeset
     5
4708343d5963 Perlin noise generator untweaked, temporarily replacing maze generator
unc0rr
parents:
diff changeset
     6
procedure GenPerlin;
4708343d5963 Perlin noise generator untweaked, temporarily replacing maze generator
unc0rr
parents:
diff changeset
     7
4708343d5963 Perlin noise generator untweaked, temporarily replacing maze generator
unc0rr
parents:
diff changeset
     8
implementation
10182
9d34898b22f7 Add randomness
unc0rr
parents: 10181
diff changeset
     9
uses uVariables, uConsts, uRandom, math; // for min()
10181
4708343d5963 Perlin noise generator untweaked, temporarily replacing maze generator
unc0rr
parents:
diff changeset
    10
4708343d5963 Perlin noise generator untweaked, temporarily replacing maze generator
unc0rr
parents:
diff changeset
    11
var fadear: array[byte] of LongInt;
4708343d5963 Perlin noise generator untweaked, temporarily replacing maze generator
unc0rr
parents:
diff changeset
    12
    p: array[0..511] of LongInt;
4708343d5963 Perlin noise generator untweaked, temporarily replacing maze generator
unc0rr
parents:
diff changeset
    13
10183
189afaf2d076 Some tweaks to perlin generator
unc0rr
parents: 10182
diff changeset
    14
function fade(t: LongInt) : LongInt; inline;
10181
4708343d5963 Perlin noise generator untweaked, temporarily replacing maze generator
unc0rr
parents:
diff changeset
    15
var t0, t1: LongInt;
4708343d5963 Perlin noise generator untweaked, temporarily replacing maze generator
unc0rr
parents:
diff changeset
    16
begin
4708343d5963 Perlin noise generator untweaked, temporarily replacing maze generator
unc0rr
parents:
diff changeset
    17
    t0:= fadear[t shr 8];
4708343d5963 Perlin noise generator untweaked, temporarily replacing maze generator
unc0rr
parents:
diff changeset
    18
    t1:= fadear[min(255, t shr 8 + 1)];
4708343d5963 Perlin noise generator untweaked, temporarily replacing maze generator
unc0rr
parents:
diff changeset
    19
4708343d5963 Perlin noise generator untweaked, temporarily replacing maze generator
unc0rr
parents:
diff changeset
    20
    fade:= t0 + ((t and 255) * (t1 - t0) shr 8)
4708343d5963 Perlin noise generator untweaked, temporarily replacing maze generator
unc0rr
parents:
diff changeset
    21
end;
4708343d5963 Perlin noise generator untweaked, temporarily replacing maze generator
unc0rr
parents:
diff changeset
    22
4708343d5963 Perlin noise generator untweaked, temporarily replacing maze generator
unc0rr
parents:
diff changeset
    23
10183
189afaf2d076 Some tweaks to perlin generator
unc0rr
parents: 10182
diff changeset
    24
function lerp(t, a, b: LongInt) : LongInt; inline;
10181
4708343d5963 Perlin noise generator untweaked, temporarily replacing maze generator
unc0rr
parents:
diff changeset
    25
begin
4708343d5963 Perlin noise generator untweaked, temporarily replacing maze generator
unc0rr
parents:
diff changeset
    26
    lerp:= a + (t * (b - a) shr 12)
4708343d5963 Perlin noise generator untweaked, temporarily replacing maze generator
unc0rr
parents:
diff changeset
    27
end;
4708343d5963 Perlin noise generator untweaked, temporarily replacing maze generator
unc0rr
parents:
diff changeset
    28
4708343d5963 Perlin noise generator untweaked, temporarily replacing maze generator
unc0rr
parents:
diff changeset
    29
4708343d5963 Perlin noise generator untweaked, temporarily replacing maze generator
unc0rr
parents:
diff changeset
    30
function grad(hash, x, y, z: LongInt) : LongInt;
4708343d5963 Perlin noise generator untweaked, temporarily replacing maze generator
unc0rr
parents:
diff changeset
    31
var h, v, u: LongInt;
4708343d5963 Perlin noise generator untweaked, temporarily replacing maze generator
unc0rr
parents:
diff changeset
    32
begin
4708343d5963 Perlin noise generator untweaked, temporarily replacing maze generator
unc0rr
parents:
diff changeset
    33
    h:= hash and 15;
4708343d5963 Perlin noise generator untweaked, temporarily replacing maze generator
unc0rr
parents:
diff changeset
    34
    if h < 8 then u:= x else u:= y;
4708343d5963 Perlin noise generator untweaked, temporarily replacing maze generator
unc0rr
parents:
diff changeset
    35
    if h < 4 then v:= y else
4708343d5963 Perlin noise generator untweaked, temporarily replacing maze generator
unc0rr
parents:
diff changeset
    36
        if (h = 12) or (h = 14) then v:= x else v:= z;
4708343d5963 Perlin noise generator untweaked, temporarily replacing maze generator
unc0rr
parents:
diff changeset
    37
4708343d5963 Perlin noise generator untweaked, temporarily replacing maze generator
unc0rr
parents:
diff changeset
    38
    if odd(h) then u:= -u;
4708343d5963 Perlin noise generator untweaked, temporarily replacing maze generator
unc0rr
parents:
diff changeset
    39
    if odd(h shr 1) then v:= -v;
4708343d5963 Perlin noise generator untweaked, temporarily replacing maze generator
unc0rr
parents:
diff changeset
    40
4708343d5963 Perlin noise generator untweaked, temporarily replacing maze generator
unc0rr
parents:
diff changeset
    41
    grad:= u + v
4708343d5963 Perlin noise generator untweaked, temporarily replacing maze generator
unc0rr
parents:
diff changeset
    42
end;
4708343d5963 Perlin noise generator untweaked, temporarily replacing maze generator
unc0rr
parents:
diff changeset
    43
4708343d5963 Perlin noise generator untweaked, temporarily replacing maze generator
unc0rr
parents:
diff changeset
    44
4708343d5963 Perlin noise generator untweaked, temporarily replacing maze generator
unc0rr
parents:
diff changeset
    45
function inoise(x, y, z: LongInt) : LongInt;
4708343d5963 Perlin noise generator untweaked, temporarily replacing maze generator
unc0rr
parents:
diff changeset
    46
const N = $10000;
4708343d5963 Perlin noise generator untweaked, temporarily replacing maze generator
unc0rr
parents:
diff changeset
    47
var xx, yy, zz, u, v, w, A, AA, AB, B, BA, BB: LongInt;
4708343d5963 Perlin noise generator untweaked, temporarily replacing maze generator
unc0rr
parents:
diff changeset
    48
begin
4708343d5963 Perlin noise generator untweaked, temporarily replacing maze generator
unc0rr
parents:
diff changeset
    49
    xx:= (x shr 16) and 255;
4708343d5963 Perlin noise generator untweaked, temporarily replacing maze generator
unc0rr
parents:
diff changeset
    50
    yy:= (y shr 16) and 255;
4708343d5963 Perlin noise generator untweaked, temporarily replacing maze generator
unc0rr
parents:
diff changeset
    51
    zz:= (z shr 16) and 255;
4708343d5963 Perlin noise generator untweaked, temporarily replacing maze generator
unc0rr
parents:
diff changeset
    52
4708343d5963 Perlin noise generator untweaked, temporarily replacing maze generator
unc0rr
parents:
diff changeset
    53
    x:= x and $FFFF;
4708343d5963 Perlin noise generator untweaked, temporarily replacing maze generator
unc0rr
parents:
diff changeset
    54
    y:= y and $FFFF;
4708343d5963 Perlin noise generator untweaked, temporarily replacing maze generator
unc0rr
parents:
diff changeset
    55
    z:= z and $FFFF;
4708343d5963 Perlin noise generator untweaked, temporarily replacing maze generator
unc0rr
parents:
diff changeset
    56
4708343d5963 Perlin noise generator untweaked, temporarily replacing maze generator
unc0rr
parents:
diff changeset
    57
    u:= fade(x);
4708343d5963 Perlin noise generator untweaked, temporarily replacing maze generator
unc0rr
parents:
diff changeset
    58
    v:= fade(y);
4708343d5963 Perlin noise generator untweaked, temporarily replacing maze generator
unc0rr
parents:
diff changeset
    59
    w:= fade(z);
4708343d5963 Perlin noise generator untweaked, temporarily replacing maze generator
unc0rr
parents:
diff changeset
    60
4708343d5963 Perlin noise generator untweaked, temporarily replacing maze generator
unc0rr
parents:
diff changeset
    61
    A:= p[xx    ] + yy; AA:= p[A] + zz; AB:= p[A + 1] + zz;
4708343d5963 Perlin noise generator untweaked, temporarily replacing maze generator
unc0rr
parents:
diff changeset
    62
    B:= p[xx + 1] + yy; BA:= p[B] + zz; BB:= p[B + 1] + zz;
4708343d5963 Perlin noise generator untweaked, temporarily replacing maze generator
unc0rr
parents:
diff changeset
    63
4708343d5963 Perlin noise generator untweaked, temporarily replacing maze generator
unc0rr
parents:
diff changeset
    64
    inoise:=
10184
f87776bd5acd Setup leftX, rightX and topY
unc0rr
parents: 10183
diff changeset
    65
             lerp(w, lerp(v, lerp(u, grad(p[AA  ], x   , y   , z   ),
10181
4708343d5963 Perlin noise generator untweaked, temporarily replacing maze generator
unc0rr
parents:
diff changeset
    66
                                     grad(p[BA  ], x-N , y   , z   )),
4708343d5963 Perlin noise generator untweaked, temporarily replacing maze generator
unc0rr
parents:
diff changeset
    67
                             lerp(u, grad(p[AB  ], x   , y-N , z   ),
4708343d5963 Perlin noise generator untweaked, temporarily replacing maze generator
unc0rr
parents:
diff changeset
    68
                                     grad(p[BB  ], x-N , y-N , z   ))),
4708343d5963 Perlin noise generator untweaked, temporarily replacing maze generator
unc0rr
parents:
diff changeset
    69
                     lerp(v, lerp(u, grad(p[AA+1], x   , y   , z-N ),
4708343d5963 Perlin noise generator untweaked, temporarily replacing maze generator
unc0rr
parents:
diff changeset
    70
                                     grad(p[BA+1], x-N , y   , z-N )),
4708343d5963 Perlin noise generator untweaked, temporarily replacing maze generator
unc0rr
parents:
diff changeset
    71
                             lerp(u, grad(p[AB+1], x   , y-N , z-N ),
4708343d5963 Perlin noise generator untweaked, temporarily replacing maze generator
unc0rr
parents:
diff changeset
    72
                                     grad(p[BB+1], x-N , y-N , z-N ))));
4708343d5963 Perlin noise generator untweaked, temporarily replacing maze generator
unc0rr
parents:
diff changeset
    73
end;
4708343d5963 Perlin noise generator untweaked, temporarily replacing maze generator
unc0rr
parents:
diff changeset
    74
4708343d5963 Perlin noise generator untweaked, temporarily replacing maze generator
unc0rr
parents:
diff changeset
    75
function f(t: double): double;
4708343d5963 Perlin noise generator untweaked, temporarily replacing maze generator
unc0rr
parents:
diff changeset
    76
begin
4708343d5963 Perlin noise generator untweaked, temporarily replacing maze generator
unc0rr
parents:
diff changeset
    77
    f:= t * t * t * (t * (t * 6 - 15) + 10);
4708343d5963 Perlin noise generator untweaked, temporarily replacing maze generator
unc0rr
parents:
diff changeset
    78
end;
4708343d5963 Perlin noise generator untweaked, temporarily replacing maze generator
unc0rr
parents:
diff changeset
    79
10182
9d34898b22f7 Add randomness
unc0rr
parents: 10181
diff changeset
    80
procedure inoise_setup();
9d34898b22f7 Add randomness
unc0rr
parents: 10181
diff changeset
    81
var i, ii, t: LongInt;
9d34898b22f7 Add randomness
unc0rr
parents: 10181
diff changeset
    82
begin
9d34898b22f7 Add randomness
unc0rr
parents: 10181
diff changeset
    83
    for i:= 0 to 254 do
9d34898b22f7 Add randomness
unc0rr
parents: 10181
diff changeset
    84
        p[i]:= i + 1;
9d34898b22f7 Add randomness
unc0rr
parents: 10181
diff changeset
    85
    p[255]:= 0;
10181
4708343d5963 Perlin noise generator untweaked, temporarily replacing maze generator
unc0rr
parents:
diff changeset
    86
10182
9d34898b22f7 Add randomness
unc0rr
parents: 10181
diff changeset
    87
    for i:= 0 to 254 do
9d34898b22f7 Add randomness
unc0rr
parents: 10181
diff changeset
    88
    begin
9d34898b22f7 Add randomness
unc0rr
parents: 10181
diff changeset
    89
        ii:= GetRandom(256 - i) + i;
9d34898b22f7 Add randomness
unc0rr
parents: 10181
diff changeset
    90
        t:= p[i];
9d34898b22f7 Add randomness
unc0rr
parents: 10181
diff changeset
    91
        p[i]:= p[ii];
9d34898b22f7 Add randomness
unc0rr
parents: 10181
diff changeset
    92
        p[ii]:= t
9d34898b22f7 Add randomness
unc0rr
parents: 10181
diff changeset
    93
    end;
9d34898b22f7 Add randomness
unc0rr
parents: 10181
diff changeset
    94
10181
4708343d5963 Perlin noise generator untweaked, temporarily replacing maze generator
unc0rr
parents:
diff changeset
    95
    for i:= 0 to 255 do
10182
9d34898b22f7 Add randomness
unc0rr
parents: 10181
diff changeset
    96
        p[256 + i]:= p[i];
10181
4708343d5963 Perlin noise generator untweaked, temporarily replacing maze generator
unc0rr
parents:
diff changeset
    97
4708343d5963 Perlin noise generator untweaked, temporarily replacing maze generator
unc0rr
parents:
diff changeset
    98
    for i:= 0 to 255 do
4708343d5963 Perlin noise generator untweaked, temporarily replacing maze generator
unc0rr
parents:
diff changeset
    99
        fadear[i]:= trunc($1000 * f(i / 256));
4708343d5963 Perlin noise generator untweaked, temporarily replacing maze generator
unc0rr
parents:
diff changeset
   100
end;
4708343d5963 Perlin noise generator untweaked, temporarily replacing maze generator
unc0rr
parents:
diff changeset
   101
4708343d5963 Perlin noise generator untweaked, temporarily replacing maze generator
unc0rr
parents:
diff changeset
   102
const detail = 120000*3;
4708343d5963 Perlin noise generator untweaked, temporarily replacing maze generator
unc0rr
parents:
diff changeset
   103
    field = 3;
4708343d5963 Perlin noise generator untweaked, temporarily replacing maze generator
unc0rr
parents:
diff changeset
   104
    width = 4096;
4708343d5963 Perlin noise generator untweaked, temporarily replacing maze generator
unc0rr
parents:
diff changeset
   105
    height = 2048;
4708343d5963 Perlin noise generator untweaked, temporarily replacing maze generator
unc0rr
parents:
diff changeset
   106
4708343d5963 Perlin noise generator untweaked, temporarily replacing maze generator
unc0rr
parents:
diff changeset
   107
procedure GenPerlin;
4708343d5963 Perlin noise generator untweaked, temporarily replacing maze generator
unc0rr
parents:
diff changeset
   108
var y, x, di, dj, r: LongInt;
4708343d5963 Perlin noise generator untweaked, temporarily replacing maze generator
unc0rr
parents:
diff changeset
   109
begin
4708343d5963 Perlin noise generator untweaked, temporarily replacing maze generator
unc0rr
parents:
diff changeset
   110
    inoise_setup();
4708343d5963 Perlin noise generator untweaked, temporarily replacing maze generator
unc0rr
parents:
diff changeset
   111
4708343d5963 Perlin noise generator untweaked, temporarily replacing maze generator
unc0rr
parents:
diff changeset
   112
    for y:= 0 to pred(height) do
4708343d5963 Perlin noise generator untweaked, temporarily replacing maze generator
unc0rr
parents:
diff changeset
   113
    begin
4708343d5963 Perlin noise generator untweaked, temporarily replacing maze generator
unc0rr
parents:
diff changeset
   114
        di:= detail * field * y div height;
4708343d5963 Perlin noise generator untweaked, temporarily replacing maze generator
unc0rr
parents:
diff changeset
   115
        for x:= 0 to pred(width) do
4708343d5963 Perlin noise generator untweaked, temporarily replacing maze generator
unc0rr
parents:
diff changeset
   116
        begin
4708343d5963 Perlin noise generator untweaked, temporarily replacing maze generator
unc0rr
parents:
diff changeset
   117
            dj:= detail * field * x div width;
4708343d5963 Perlin noise generator untweaked, temporarily replacing maze generator
unc0rr
parents:
diff changeset
   118
            r:= (abs(inoise(di, dj, detail*field)) + y*4) mod 65536 div 256;
10183
189afaf2d076 Some tweaks to perlin generator
unc0rr
parents: 10182
diff changeset
   119
            r:= r - max(0, abs(x - width div 2) - width * 45 div 100); // fade on edges
189afaf2d076 Some tweaks to perlin generator
unc0rr
parents: 10182
diff changeset
   120
            //r:= r - max(0, - abs(x - width div 2) + width * 2 div 100); // split vertically in the middle
10181
4708343d5963 Perlin noise generator untweaked, temporarily replacing maze generator
unc0rr
parents:
diff changeset
   121
4708343d5963 Perlin noise generator untweaked, temporarily replacing maze generator
unc0rr
parents:
diff changeset
   122
10183
189afaf2d076 Some tweaks to perlin generator
unc0rr
parents: 10182
diff changeset
   123
            //r:= r + (trunc(1000 - sqrt(sqr(x - (width div 2)) * 4 + sqr(y - height * 5 div 4) * 22))) div 600 * 20; // ellipse
189afaf2d076 Some tweaks to perlin generator
unc0rr
parents: 10182
diff changeset
   124
            r:= r + (trunc(1000 - (abs(x - (width div 2)) * 2 + abs(y - height * 5 div 4) * 4))) div 600 * 20; // manhattan length ellipse
10181
4708343d5963 Perlin noise generator untweaked, temporarily replacing maze generator
unc0rr
parents:
diff changeset
   125
4708343d5963 Perlin noise generator untweaked, temporarily replacing maze generator
unc0rr
parents:
diff changeset
   126
            if r < 0 then Land[y, x]:= 0 else Land[y, x]:= lfBasic;
4708343d5963 Perlin noise generator untweaked, temporarily replacing maze generator
unc0rr
parents:
diff changeset
   127
4708343d5963 Perlin noise generator untweaked, temporarily replacing maze generator
unc0rr
parents:
diff changeset
   128
        end;
4708343d5963 Perlin noise generator untweaked, temporarily replacing maze generator
unc0rr
parents:
diff changeset
   129
    end;
10184
f87776bd5acd Setup leftX, rightX and topY
unc0rr
parents: 10183
diff changeset
   130
f87776bd5acd Setup leftX, rightX and topY
unc0rr
parents: 10183
diff changeset
   131
    leftX:= 0;
f87776bd5acd Setup leftX, rightX and topY
unc0rr
parents: 10183
diff changeset
   132
    rightX:= 4095;
f87776bd5acd Setup leftX, rightX and topY
unc0rr
parents: 10183
diff changeset
   133
    topY:= 0;
f87776bd5acd Setup leftX, rightX and topY
unc0rr
parents: 10183
diff changeset
   134
    hasBorder:= false;
10181
4708343d5963 Perlin noise generator untweaked, temporarily replacing maze generator
unc0rr
parents:
diff changeset
   135
end;
4708343d5963 Perlin noise generator untweaked, temporarily replacing maze generator
unc0rr
parents:
diff changeset
   136
4708343d5963 Perlin noise generator untweaked, temporarily replacing maze generator
unc0rr
parents:
diff changeset
   137
end.