hedgewars/uLandGenPerlin.pas
author Wuzzy <Wuzzy2@mail.ru>
Thu, 10 Oct 2019 00:40:39 +0200
changeset 15463 19e987301674
parent 15160 c0ae9f4f9589
permissions -rw-r--r--
Mutant: Add message for excess teams
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
10189
875607ce793d - Rework FillLand
unc0rr
parents: 10188
diff changeset
     9
uses uVariables
875607ce793d - Rework FillLand
unc0rr
parents: 10188
diff changeset
    10
    , uConsts
875607ce793d - Rework FillLand
unc0rr
parents: 10188
diff changeset
    11
    , uRandom
875607ce793d - Rework FillLand
unc0rr
parents: 10188
diff changeset
    12
    , uLandOutline // FillLand
10479
31afb7cdff69 hookup perlin
nemo
parents: 10391
diff changeset
    13
    , uUtils
10189
875607ce793d - Rework FillLand
unc0rr
parents: 10188
diff changeset
    14
    ;
10181
4708343d5963 Perlin noise generator untweaked, temporarily replacing maze generator
unc0rr
parents:
diff changeset
    15
10188
e8f2dbabd01b as suggested, precompute to avoid use of double
nemo
parents: 10187
diff changeset
    16
var p: array[0..511] of LongInt;
e8f2dbabd01b as suggested, precompute to avoid use of double
nemo
parents: 10187
diff changeset
    17
10510
9329dab04490 some whitespace fixes
sheepluva
parents: 10494
diff changeset
    18
const fadear: array[byte] of LongInt =
10188
e8f2dbabd01b as suggested, precompute to avoid use of double
nemo
parents: 10187
diff changeset
    19
(0, 0, 0, 0, 0, 0, 0, 0, 1, 1, 2, 3, 3, 4, 6, 7, 9, 10, 12,
e8f2dbabd01b as suggested, precompute to avoid use of double
nemo
parents: 10187
diff changeset
    20
14, 17, 19, 22, 25, 29, 32, 36, 40, 45, 49, 54, 60, 65, 71,
e8f2dbabd01b as suggested, precompute to avoid use of double
nemo
parents: 10187
diff changeset
    21
77, 84, 91, 98, 105, 113, 121, 130, 139, 148, 158, 167, 178,
e8f2dbabd01b as suggested, precompute to avoid use of double
nemo
parents: 10187
diff changeset
    22
188, 199, 211, 222, 234, 247, 259, 273, 286, 300, 314, 329, 344,
e8f2dbabd01b as suggested, precompute to avoid use of double
nemo
parents: 10187
diff changeset
    23
359, 374, 390, 407, 424, 441, 458, 476, 494, 512, 531, 550,
e8f2dbabd01b as suggested, precompute to avoid use of double
nemo
parents: 10187
diff changeset
    24
570, 589, 609, 630, 651, 672, 693, 715, 737, 759, 782, 805, 828,
e8f2dbabd01b as suggested, precompute to avoid use of double
nemo
parents: 10187
diff changeset
    25
851, 875, 899, 923, 948, 973, 998, 1023, 1049, 1074, 1100, 1127,
e8f2dbabd01b as suggested, precompute to avoid use of double
nemo
parents: 10187
diff changeset
    26
1153, 1180, 1207, 1234, 1261, 1289, 1316, 1344, 1372, 1400, 1429,
e8f2dbabd01b as suggested, precompute to avoid use of double
nemo
parents: 10187
diff changeset
    27
1457, 1486, 1515, 1543, 1572, 1602, 1631, 1660, 1690, 1719, 1749,
e8f2dbabd01b as suggested, precompute to avoid use of double
nemo
parents: 10187
diff changeset
    28
1778, 1808, 1838, 1868, 1898, 1928, 1958, 1988, 2018, 2048, 2077,
e8f2dbabd01b as suggested, precompute to avoid use of double
nemo
parents: 10187
diff changeset
    29
2107, 2137, 2167, 2197, 2227, 2257, 2287, 2317, 2346, 2376, 2405,
e8f2dbabd01b as suggested, precompute to avoid use of double
nemo
parents: 10187
diff changeset
    30
2435, 2464, 2493, 2523, 2552, 2580, 2609, 2638, 2666, 2695, 2723,
e8f2dbabd01b as suggested, precompute to avoid use of double
nemo
parents: 10187
diff changeset
    31
2751, 2779, 2806, 2834, 2861, 2888, 2915, 2942, 2968, 2995, 3021,
e8f2dbabd01b as suggested, precompute to avoid use of double
nemo
parents: 10187
diff changeset
    32
3046, 3072, 3097, 3122, 3147, 3172, 3196, 3220, 3244, 3267, 3290,
e8f2dbabd01b as suggested, precompute to avoid use of double
nemo
parents: 10187
diff changeset
    33
3313, 3336, 3358, 3380, 3402, 3423, 3444, 3465, 3486, 3506, 3525,
e8f2dbabd01b as suggested, precompute to avoid use of double
nemo
parents: 10187
diff changeset
    34
3545, 3564, 3583, 3601, 3619, 3637, 3654, 3672, 3688, 3705, 3721,
e8f2dbabd01b as suggested, precompute to avoid use of double
nemo
parents: 10187
diff changeset
    35
3736, 3751, 3766, 3781, 3795, 3809, 3822, 3836, 3848, 3861, 3873,
e8f2dbabd01b as suggested, precompute to avoid use of double
nemo
parents: 10187
diff changeset
    36
3884, 3896, 3907, 3917, 3928, 3937, 3947, 3956, 3965, 3974, 3982,
e8f2dbabd01b as suggested, precompute to avoid use of double
nemo
parents: 10187
diff changeset
    37
3990, 3997, 4004, 4011, 4018, 4024, 4030, 4035, 4041, 4046, 4050,
e8f2dbabd01b as suggested, precompute to avoid use of double
nemo
parents: 10187
diff changeset
    38
4055, 4059, 4063, 4066, 4070, 4073, 4076, 4078, 4081, 4083, 4085,
e8f2dbabd01b as suggested, precompute to avoid use of double
nemo
parents: 10187
diff changeset
    39
4086, 4088, 4089, 4091, 4092, 4092, 4093, 4094, 4094, 4095, 4095,
e8f2dbabd01b as suggested, precompute to avoid use of double
nemo
parents: 10187
diff changeset
    40
4095, 4095, 4095, 4095, 4095);
10181
4708343d5963 Perlin noise generator untweaked, temporarily replacing maze generator
unc0rr
parents:
diff changeset
    41
10183
189afaf2d076 Some tweaks to perlin generator
unc0rr
parents: 10182
diff changeset
    42
function fade(t: LongInt) : LongInt; inline;
10181
4708343d5963 Perlin noise generator untweaked, temporarily replacing maze generator
unc0rr
parents:
diff changeset
    43
var t0, t1: LongInt;
4708343d5963 Perlin noise generator untweaked, temporarily replacing maze generator
unc0rr
parents:
diff changeset
    44
begin
4708343d5963 Perlin noise generator untweaked, temporarily replacing maze generator
unc0rr
parents:
diff changeset
    45
    t0:= fadear[t shr 8];
10189
875607ce793d - Rework FillLand
unc0rr
parents: 10188
diff changeset
    46
10510
9329dab04490 some whitespace fixes
sheepluva
parents: 10494
diff changeset
    47
    if t0 = fadear[255] then
10189
875607ce793d - Rework FillLand
unc0rr
parents: 10188
diff changeset
    48
        t1:= t0
875607ce793d - Rework FillLand
unc0rr
parents: 10188
diff changeset
    49
    else
875607ce793d - Rework FillLand
unc0rr
parents: 10188
diff changeset
    50
        t1:= fadear[t shr 8 + 1];
10181
4708343d5963 Perlin noise generator untweaked, temporarily replacing maze generator
unc0rr
parents:
diff changeset
    51
4708343d5963 Perlin noise generator untweaked, temporarily replacing maze generator
unc0rr
parents:
diff changeset
    52
    fade:= t0 + ((t and 255) * (t1 - t0) shr 8)
4708343d5963 Perlin noise generator untweaked, temporarily replacing maze generator
unc0rr
parents:
diff changeset
    53
end;
4708343d5963 Perlin noise generator untweaked, temporarily replacing maze generator
unc0rr
parents:
diff changeset
    54
4708343d5963 Perlin noise generator untweaked, temporarily replacing maze generator
unc0rr
parents:
diff changeset
    55
10183
189afaf2d076 Some tweaks to perlin generator
unc0rr
parents: 10182
diff changeset
    56
function lerp(t, a, b: LongInt) : LongInt; inline;
10181
4708343d5963 Perlin noise generator untweaked, temporarily replacing maze generator
unc0rr
parents:
diff changeset
    57
begin
10494
0eb97cf4c78e Fix warnings given by 32-bit fpc
unC0Rr
parents: 10492
diff changeset
    58
    lerp:= a + ((Int64(b) - a) * t shr 12)
10181
4708343d5963 Perlin noise generator untweaked, temporarily replacing maze generator
unc0rr
parents:
diff changeset
    59
end;
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
10188
e8f2dbabd01b as suggested, precompute to avoid use of double
nemo
parents: 10187
diff changeset
    62
function grad(hash, x, y: LongInt) : LongInt; inline;
10181
4708343d5963 Perlin noise generator untweaked, temporarily replacing maze generator
unc0rr
parents:
diff changeset
    63
var h, v, u: LongInt;
4708343d5963 Perlin noise generator untweaked, temporarily replacing maze generator
unc0rr
parents:
diff changeset
    64
begin
4708343d5963 Perlin noise generator untweaked, temporarily replacing maze generator
unc0rr
parents:
diff changeset
    65
    h:= hash and 15;
4708343d5963 Perlin noise generator untweaked, temporarily replacing maze generator
unc0rr
parents:
diff changeset
    66
    if h < 8 then u:= x else u:= y;
4708343d5963 Perlin noise generator untweaked, temporarily replacing maze generator
unc0rr
parents:
diff changeset
    67
    if h < 4 then v:= y else
10185
007a40cfbb3d Strip Z axis from calculations
unc0rr
parents: 10184
diff changeset
    68
        if (h = 12) or (h = 14) then v:= x else v:= 0;
10181
4708343d5963 Perlin noise generator untweaked, temporarily replacing maze generator
unc0rr
parents:
diff changeset
    69
10185
007a40cfbb3d Strip Z axis from calculations
unc0rr
parents: 10184
diff changeset
    70
    if (h and 1) <> 0 then u:= -u;
007a40cfbb3d Strip Z axis from calculations
unc0rr
parents: 10184
diff changeset
    71
    if (h and 2) <> 0 then v:= -v;
10181
4708343d5963 Perlin noise generator untweaked, temporarily replacing maze generator
unc0rr
parents:
diff changeset
    72
4708343d5963 Perlin noise generator untweaked, temporarily replacing maze generator
unc0rr
parents:
diff changeset
    73
    grad:= u + v
4708343d5963 Perlin noise generator untweaked, temporarily replacing maze generator
unc0rr
parents:
diff changeset
    74
end;
4708343d5963 Perlin noise generator untweaked, temporarily replacing maze generator
unc0rr
parents:
diff changeset
    75
4708343d5963 Perlin noise generator untweaked, temporarily replacing maze generator
unc0rr
parents:
diff changeset
    76
10188
e8f2dbabd01b as suggested, precompute to avoid use of double
nemo
parents: 10187
diff changeset
    77
function inoise(x, y: LongInt) : LongInt; inline;
10181
4708343d5963 Perlin noise generator untweaked, temporarily replacing maze generator
unc0rr
parents:
diff changeset
    78
const N = $10000;
10185
007a40cfbb3d Strip Z axis from calculations
unc0rr
parents: 10184
diff changeset
    79
var xx, yy, u, v, A, AA, AB, B, BA, BB: LongInt;
10181
4708343d5963 Perlin noise generator untweaked, temporarily replacing maze generator
unc0rr
parents:
diff changeset
    80
begin
4708343d5963 Perlin noise generator untweaked, temporarily replacing maze generator
unc0rr
parents:
diff changeset
    81
    xx:= (x shr 16) and 255;
4708343d5963 Perlin noise generator untweaked, temporarily replacing maze generator
unc0rr
parents:
diff changeset
    82
    yy:= (y shr 16) and 255;
4708343d5963 Perlin noise generator untweaked, temporarily replacing maze generator
unc0rr
parents:
diff changeset
    83
4708343d5963 Perlin noise generator untweaked, temporarily replacing maze generator
unc0rr
parents:
diff changeset
    84
    x:= x and $FFFF;
4708343d5963 Perlin noise generator untweaked, temporarily replacing maze generator
unc0rr
parents:
diff changeset
    85
    y:= y and $FFFF;
4708343d5963 Perlin noise generator untweaked, temporarily replacing maze generator
unc0rr
parents:
diff changeset
    86
4708343d5963 Perlin noise generator untweaked, temporarily replacing maze generator
unc0rr
parents:
diff changeset
    87
    u:= fade(x);
4708343d5963 Perlin noise generator untweaked, temporarily replacing maze generator
unc0rr
parents:
diff changeset
    88
    v:= fade(y);
4708343d5963 Perlin noise generator untweaked, temporarily replacing maze generator
unc0rr
parents:
diff changeset
    89
10185
007a40cfbb3d Strip Z axis from calculations
unc0rr
parents: 10184
diff changeset
    90
    A:= p[xx    ] + yy; AA:= p[A]; AB:= p[A + 1];
007a40cfbb3d Strip Z axis from calculations
unc0rr
parents: 10184
diff changeset
    91
    B:= p[xx + 1] + yy; BA:= p[B]; BB:= p[B + 1];
10181
4708343d5963 Perlin noise generator untweaked, temporarily replacing maze generator
unc0rr
parents:
diff changeset
    92
4708343d5963 Perlin noise generator untweaked, temporarily replacing maze generator
unc0rr
parents:
diff changeset
    93
    inoise:=
10185
007a40cfbb3d Strip Z axis from calculations
unc0rr
parents: 10184
diff changeset
    94
            lerp(v, lerp(u, grad(p[AA  ], x   , y  ),
007a40cfbb3d Strip Z axis from calculations
unc0rr
parents: 10184
diff changeset
    95
                            grad(p[BA  ], x-N , y  )),
007a40cfbb3d Strip Z axis from calculations
unc0rr
parents: 10184
diff changeset
    96
                    lerp(u, grad(p[AB  ], x   , y-N),
007a40cfbb3d Strip Z axis from calculations
unc0rr
parents: 10184
diff changeset
    97
                            grad(p[BB  ], x-N , y-N)));
10181
4708343d5963 Perlin noise generator untweaked, temporarily replacing maze generator
unc0rr
parents:
diff changeset
    98
end;
4708343d5963 Perlin noise generator untweaked, temporarily replacing maze generator
unc0rr
parents:
diff changeset
    99
10182
9d34898b22f7 Add randomness
unc0rr
parents: 10181
diff changeset
   100
procedure inoise_setup();
10494
0eb97cf4c78e Fix warnings given by 32-bit fpc
unC0Rr
parents: 10492
diff changeset
   101
var i, ii, t: Longword;
10182
9d34898b22f7 Add randomness
unc0rr
parents: 10181
diff changeset
   102
begin
9d34898b22f7 Add randomness
unc0rr
parents: 10181
diff changeset
   103
    for i:= 0 to 254 do
9d34898b22f7 Add randomness
unc0rr
parents: 10181
diff changeset
   104
        p[i]:= i + 1;
9d34898b22f7 Add randomness
unc0rr
parents: 10181
diff changeset
   105
    p[255]:= 0;
10181
4708343d5963 Perlin noise generator untweaked, temporarily replacing maze generator
unc0rr
parents:
diff changeset
   106
10182
9d34898b22f7 Add randomness
unc0rr
parents: 10181
diff changeset
   107
    for i:= 0 to 254 do
9d34898b22f7 Add randomness
unc0rr
parents: 10181
diff changeset
   108
    begin
9d34898b22f7 Add randomness
unc0rr
parents: 10181
diff changeset
   109
        ii:= GetRandom(256 - i) + i;
9d34898b22f7 Add randomness
unc0rr
parents: 10181
diff changeset
   110
        t:= p[i];
9d34898b22f7 Add randomness
unc0rr
parents: 10181
diff changeset
   111
        p[i]:= p[ii];
9d34898b22f7 Add randomness
unc0rr
parents: 10181
diff changeset
   112
        p[ii]:= t
9d34898b22f7 Add randomness
unc0rr
parents: 10181
diff changeset
   113
    end;
9d34898b22f7 Add randomness
unc0rr
parents: 10181
diff changeset
   114
10181
4708343d5963 Perlin noise generator untweaked, temporarily replacing maze generator
unc0rr
parents:
diff changeset
   115
    for i:= 0 to 255 do
10182
9d34898b22f7 Add randomness
unc0rr
parents: 10181
diff changeset
   116
        p[256 + i]:= p[i];
10181
4708343d5963 Perlin noise generator untweaked, temporarily replacing maze generator
unc0rr
parents:
diff changeset
   117
end;
4708343d5963 Perlin noise generator untweaked, temporarily replacing maze generator
unc0rr
parents:
diff changeset
   118
10479
31afb7cdff69 hookup perlin
nemo
parents: 10391
diff changeset
   119
const width = 4096;
31afb7cdff69 hookup perlin
nemo
parents: 10391
diff changeset
   120
      height = 2048;
31afb7cdff69 hookup perlin
nemo
parents: 10391
diff changeset
   121
      minY = 500;
10190
e4f81f6d428c Tweaks and tweaks
unc0rr
parents: 10189
diff changeset
   122
10249
b47ac2c19de3 get rid of fpc warnings/hints
sheepluva
parents: 10199
diff changeset
   123
    //bottomPlateHeight = 90;
b47ac2c19de3 get rid of fpc warnings/hints
sheepluva
parents: 10199
diff changeset
   124
    //bottomPlateMargin = 1200;
10190
e4f81f6d428c Tweaks and tweaks
unc0rr
parents: 10189
diff changeset
   125
    margin = 200;
10181
4708343d5963 Perlin noise generator untweaked, temporarily replacing maze generator
unc0rr
parents:
diff changeset
   126
4708343d5963 Perlin noise generator untweaked, temporarily replacing maze generator
unc0rr
parents:
diff changeset
   127
procedure GenPerlin;
10702
528d899443ab should fix perlin gen on 32 bit
nemo
parents: 10510
diff changeset
   128
var y, x, di, dj, r, param1, param2, rCutoff, detail: LongInt;
528d899443ab should fix perlin gen on 32 bit
nemo
parents: 10510
diff changeset
   129
var df: Int64;
10181
4708343d5963 Perlin noise generator untweaked, temporarily replacing maze generator
unc0rr
parents:
diff changeset
   130
begin
10391
ce3ccc45d790 Add separate option for perlin gen
unc0rr
parents: 10386
diff changeset
   131
    param1:= cTemplateFilter div 3;
ce3ccc45d790 Add separate option for perlin gen
unc0rr
parents: 10386
diff changeset
   132
    param2:= cTemplateFilter mod 3;
10491
c92955fa8b67 flip slider for perlin
nemo
parents: 10479
diff changeset
   133
    rCutoff:= min(max((26-cFeatureSize)*4,15),85);
c92955fa8b67 flip slider for perlin
nemo
parents: 10479
diff changeset
   134
    detail:= (26-cFeatureSize)*16000+50000; // feature size is a slider from 1-25 at present. flip it for perlin
10391
ce3ccc45d790 Add separate option for perlin gen
unc0rr
parents: 10386
diff changeset
   135
ce3ccc45d790 Add separate option for perlin gen
unc0rr
parents: 10386
diff changeset
   136
    df:= detail * (6 - param2 * 2);
ce3ccc45d790 Add separate option for perlin gen
unc0rr
parents: 10386
diff changeset
   137
15016
bea068dd9356 Calculate max. recommended hog count for perlin maps
Wuzzy <Wuzzy2@mail.ru>
parents: 10702
diff changeset
   138
    // Calculate estimate for max. hedgehog count
bea068dd9356 Calculate max. recommended hog count for perlin maps
Wuzzy <Wuzzy2@mail.ru>
parents: 10702
diff changeset
   139
    // Tunnels
bea068dd9356 Calculate max. recommended hog count for perlin maps
Wuzzy <Wuzzy2@mail.ru>
parents: 10702
diff changeset
   140
    if param1 = 0 then
bea068dd9356 Calculate max. recommended hog count for perlin maps
Wuzzy <Wuzzy2@mail.ru>
parents: 10702
diff changeset
   141
        begin
bea068dd9356 Calculate max. recommended hog count for perlin maps
Wuzzy <Wuzzy2@mail.ru>
parents: 10702
diff changeset
   142
        // Small tunnels
bea068dd9356 Calculate max. recommended hog count for perlin maps
Wuzzy <Wuzzy2@mail.ru>
parents: 10702
diff changeset
   143
        if param2 = 0 then
bea068dd9356 Calculate max. recommended hog count for perlin maps
Wuzzy <Wuzzy2@mail.ru>
parents: 10702
diff changeset
   144
            // 12..24
bea068dd9356 Calculate max. recommended hog count for perlin maps
Wuzzy <Wuzzy2@mail.ru>
parents: 10702
diff changeset
   145
            MaxHedgehogs:= 12 + 1 * (cFeatureSize - 1)
bea068dd9356 Calculate max. recommended hog count for perlin maps
Wuzzy <Wuzzy2@mail.ru>
parents: 10702
diff changeset
   146
        // Medium tunnels
bea068dd9356 Calculate max. recommended hog count for perlin maps
Wuzzy <Wuzzy2@mail.ru>
parents: 10702
diff changeset
   147
        else if param2 = 1 then
bea068dd9356 Calculate max. recommended hog count for perlin maps
Wuzzy <Wuzzy2@mail.ru>
parents: 10702
diff changeset
   148
            // 14..24
bea068dd9356 Calculate max. recommended hog count for perlin maps
Wuzzy <Wuzzy2@mail.ru>
parents: 10702
diff changeset
   149
            MaxHedgehogs:= 14 + max(0, 1 * (cFeatureSize - 3))
bea068dd9356 Calculate max. recommended hog count for perlin maps
Wuzzy <Wuzzy2@mail.ru>
parents: 10702
diff changeset
   150
        // Large tunnels
bea068dd9356 Calculate max. recommended hog count for perlin maps
Wuzzy <Wuzzy2@mail.ru>
parents: 10702
diff changeset
   151
        else if param2 = 2 then
bea068dd9356 Calculate max. recommended hog count for perlin maps
Wuzzy <Wuzzy2@mail.ru>
parents: 10702
diff changeset
   152
            // 16..24
bea068dd9356 Calculate max. recommended hog count for perlin maps
Wuzzy <Wuzzy2@mail.ru>
parents: 10702
diff changeset
   153
            MaxHedgehogs:= 16 + max(0, 1 * (cFeatureSize - 5));
bea068dd9356 Calculate max. recommended hog count for perlin maps
Wuzzy <Wuzzy2@mail.ru>
parents: 10702
diff changeset
   154
        if MaxHedgehogs > 24 then
bea068dd9356 Calculate max. recommended hog count for perlin maps
Wuzzy <Wuzzy2@mail.ru>
parents: 10702
diff changeset
   155
            MaxHedgehogs:= 24;
bea068dd9356 Calculate max. recommended hog count for perlin maps
Wuzzy <Wuzzy2@mail.ru>
parents: 10702
diff changeset
   156
        end
bea068dd9356 Calculate max. recommended hog count for perlin maps
Wuzzy <Wuzzy2@mail.ru>
parents: 10702
diff changeset
   157
    // Islands
bea068dd9356 Calculate max. recommended hog count for perlin maps
Wuzzy <Wuzzy2@mail.ru>
parents: 10702
diff changeset
   158
    else if (param1 = 1) and (cFeatureSize <= 25) then
bea068dd9356 Calculate max. recommended hog count for perlin maps
Wuzzy <Wuzzy2@mail.ru>
parents: 10702
diff changeset
   159
        // Small islands
bea068dd9356 Calculate max. recommended hog count for perlin maps
Wuzzy <Wuzzy2@mail.ru>
parents: 10702
diff changeset
   160
        if param2 = 0 then
bea068dd9356 Calculate max. recommended hog count for perlin maps
Wuzzy <Wuzzy2@mail.ru>
parents: 10702
diff changeset
   161
            // 64..32
bea068dd9356 Calculate max. recommended hog count for perlin maps
Wuzzy <Wuzzy2@mail.ru>
parents: 10702
diff changeset
   162
            MaxHedgehogs:= 32 + ((((25 - (cFeatureSize-1))*1000000) div 24) * 32) div 1000000
bea068dd9356 Calculate max. recommended hog count for perlin maps
Wuzzy <Wuzzy2@mail.ru>
parents: 10702
diff changeset
   163
        // Medium islands
bea068dd9356 Calculate max. recommended hog count for perlin maps
Wuzzy <Wuzzy2@mail.ru>
parents: 10702
diff changeset
   164
        else if param2 = 1 then
bea068dd9356 Calculate max. recommended hog count for perlin maps
Wuzzy <Wuzzy2@mail.ru>
parents: 10702
diff changeset
   165
            // 56..28
bea068dd9356 Calculate max. recommended hog count for perlin maps
Wuzzy <Wuzzy2@mail.ru>
parents: 10702
diff changeset
   166
            MaxHedgehogs:= 28 + ((((25 - (cFeatureSize-1))*1000000) div 24) * 28) div 1000000
bea068dd9356 Calculate max. recommended hog count for perlin maps
Wuzzy <Wuzzy2@mail.ru>
parents: 10702
diff changeset
   167
        // Large islands
bea068dd9356 Calculate max. recommended hog count for perlin maps
Wuzzy <Wuzzy2@mail.ru>
parents: 10702
diff changeset
   168
        else if param2 = 2 then
bea068dd9356 Calculate max. recommended hog count for perlin maps
Wuzzy <Wuzzy2@mail.ru>
parents: 10702
diff changeset
   169
            // 48..24
bea068dd9356 Calculate max. recommended hog count for perlin maps
Wuzzy <Wuzzy2@mail.ru>
parents: 10702
diff changeset
   170
            MaxHedgehogs:= 24 + ((((25 - (cFeatureSize-1))*1000000) div 24) * 24) div 1000000;
bea068dd9356 Calculate max. recommended hog count for perlin maps
Wuzzy <Wuzzy2@mail.ru>
parents: 10702
diff changeset
   171
    // We only want even numbers
bea068dd9356 Calculate max. recommended hog count for perlin maps
Wuzzy <Wuzzy2@mail.ru>
parents: 10702
diff changeset
   172
    if (MaxHedgehogs > 0) and ((MaxHedgehogs mod 2) = 1) then
bea068dd9356 Calculate max. recommended hog count for perlin maps
Wuzzy <Wuzzy2@mail.ru>
parents: 10702
diff changeset
   173
        MaxHedgehogs:= MaxHedgehogs - 1;
bea068dd9356 Calculate max. recommended hog count for perlin maps
Wuzzy <Wuzzy2@mail.ru>
parents: 10702
diff changeset
   174
10181
4708343d5963 Perlin noise generator untweaked, temporarily replacing maze generator
unc0rr
parents:
diff changeset
   175
    inoise_setup();
4708343d5963 Perlin noise generator untweaked, temporarily replacing maze generator
unc0rr
parents:
diff changeset
   176
10190
e4f81f6d428c Tweaks and tweaks
unc0rr
parents: 10189
diff changeset
   177
    for y:= minY to pred(height) do
10181
4708343d5963 Perlin noise generator untweaked, temporarily replacing maze generator
unc0rr
parents:
diff changeset
   178
    begin
10188
e8f2dbabd01b as suggested, precompute to avoid use of double
nemo
parents: 10187
diff changeset
   179
        di:= df * y div height;
10181
4708343d5963 Perlin noise generator untweaked, temporarily replacing maze generator
unc0rr
parents:
diff changeset
   180
        for x:= 0 to pred(width) do
4708343d5963 Perlin noise generator untweaked, temporarily replacing maze generator
unc0rr
parents:
diff changeset
   181
        begin
10188
e8f2dbabd01b as suggested, precompute to avoid use of double
nemo
parents: 10187
diff changeset
   182
            dj:= df * x div width;
10192
bb1310c4bd79 Feel free to revert this one, was just screwing around with stuff from before. I kinda like it and figured committing it was the easiest way for you to look at it. http://m8y.org/hw/perlin.png
nemo
parents: 10191
diff changeset
   183
10386
c9e38f8d4f94 Smooth perlin's outline
unc0rr
parents: 10249
diff changeset
   184
            r:= ((abs(inoise(di, dj)) + y*4) mod 65536 - (height - y) * 8) div 256;
10192
bb1310c4bd79 Feel free to revert this one, was just screwing around with stuff from before. I kinda like it and figured committing it was the easiest way for you to look at it. http://m8y.org/hw/perlin.png
nemo
parents: 10191
diff changeset
   185
bb1310c4bd79 Feel free to revert this one, was just screwing around with stuff from before. I kinda like it and figured committing it was the easiest way for you to look at it. http://m8y.org/hw/perlin.png
nemo
parents: 10191
diff changeset
   186
            //r:= (abs(inoise(di, dj))) shr 8 and $ff;
10190
e4f81f6d428c Tweaks and tweaks
unc0rr
parents: 10189
diff changeset
   187
            if (x < margin) or (x > width - margin) then r:= r - abs(x - width div 2) + width div 2 - margin; // fade on edges
10181
4708343d5963 Perlin noise generator untweaked, temporarily replacing maze generator
unc0rr
parents:
diff changeset
   188
10190
e4f81f6d428c Tweaks and tweaks
unc0rr
parents: 10189
diff changeset
   189
            //r:= r - max(0, - abs(x - width div 2) + width * 2 div 100); // split vertically in the middle
10183
189afaf2d076 Some tweaks to perlin generator
unc0rr
parents: 10182
diff changeset
   190
            //r:= r + (trunc(1000 - sqrt(sqr(x - (width div 2)) * 4 + sqr(y - height * 5 div 4) * 22))) div 600 * 20; // ellipse
10190
e4f81f6d428c Tweaks and tweaks
unc0rr
parents: 10189
diff changeset
   191
            //r:= r + 1 - ((abs(x - (width div 2)) + abs(y - height) * 2)) div 32; // manhattan length ellipse
10187
0d506346c1f0 Experiment: enforce a plate at bottom so the map generated is more connected
unc0rr
parents: 10186
diff changeset
   192
10190
e4f81f6d428c Tweaks and tweaks
unc0rr
parents: 10189
diff changeset
   193
            {
10187
0d506346c1f0 Experiment: enforce a plate at bottom so the map generated is more connected
unc0rr
parents: 10186
diff changeset
   194
            if (y > height - bottomPlateHeight) and (x > bottomPlateMargin) and (x + bottomPlateMargin < width) then
0d506346c1f0 Experiment: enforce a plate at bottom so the map generated is more connected
unc0rr
parents: 10186
diff changeset
   195
            begin
10190
e4f81f6d428c Tweaks and tweaks
unc0rr
parents: 10189
diff changeset
   196
                dy:= (y - height + bottomPlateHeight);
10187
0d506346c1f0 Experiment: enforce a plate at bottom so the map generated is more connected
unc0rr
parents: 10186
diff changeset
   197
                r:= r + dy;
10181
4708343d5963 Perlin noise generator untweaked, temporarily replacing maze generator
unc0rr
parents:
diff changeset
   198
10187
0d506346c1f0 Experiment: enforce a plate at bottom so the map generated is more connected
unc0rr
parents: 10186
diff changeset
   199
                if x < bottomPlateMargin + bottomPlateHeight then
10190
e4f81f6d428c Tweaks and tweaks
unc0rr
parents: 10189
diff changeset
   200
                    r:= r + (x - bottomPlateMargin - bottomPlateHeight)
10187
0d506346c1f0 Experiment: enforce a plate at bottom so the map generated is more connected
unc0rr
parents: 10186
diff changeset
   201
                else
0d506346c1f0 Experiment: enforce a plate at bottom so the map generated is more connected
unc0rr
parents: 10186
diff changeset
   202
                if x + bottomPlateMargin + bottomPlateHeight > width then
10190
e4f81f6d428c Tweaks and tweaks
unc0rr
parents: 10189
diff changeset
   203
                    r:= r - (x - width + bottomPlateMargin + bottomPlateHeight);
10187
0d506346c1f0 Experiment: enforce a plate at bottom so the map generated is more connected
unc0rr
parents: 10186
diff changeset
   204
            end;
10190
e4f81f6d428c Tweaks and tweaks
unc0rr
parents: 10189
diff changeset
   205
            }
10192
bb1310c4bd79 Feel free to revert this one, was just screwing around with stuff from before. I kinda like it and figured committing it was the easiest way for you to look at it. http://m8y.org/hw/perlin.png
nemo
parents: 10191
diff changeset
   206
10492
0cf3b2762606 lfObjMask is only used when flood filling
nemo
parents: 10491
diff changeset
   207
            if r < rCutoff then
0cf3b2762606 lfObjMask is only used when flood filling
nemo
parents: 10491
diff changeset
   208
                Land[y, x]:= 0
0cf3b2762606 lfObjMask is only used when flood filling
nemo
parents: 10491
diff changeset
   209
            else if param1 = 0 then
0cf3b2762606 lfObjMask is only used when flood filling
nemo
parents: 10491
diff changeset
   210
                Land[y, x]:= lfObjMask
0cf3b2762606 lfObjMask is only used when flood filling
nemo
parents: 10491
diff changeset
   211
            else
10510
9329dab04490 some whitespace fixes
sheepluva
parents: 10494
diff changeset
   212
                Land[y, x]:= lfBasic
10181
4708343d5963 Perlin noise generator untweaked, temporarily replacing maze generator
unc0rr
parents:
diff changeset
   213
        end;
4708343d5963 Perlin noise generator untweaked, temporarily replacing maze generator
unc0rr
parents:
diff changeset
   214
    end;
10184
f87776bd5acd Setup leftX, rightX and topY
unc0rr
parents: 10183
diff changeset
   215
10391
ce3ccc45d790 Add separate option for perlin gen
unc0rr
parents: 10386
diff changeset
   216
    if param1 = 0 then
ce3ccc45d790 Add separate option for perlin gen
unc0rr
parents: 10386
diff changeset
   217
        begin
ce3ccc45d790 Add separate option for perlin gen
unc0rr
parents: 10386
diff changeset
   218
        for x:= 0 to width do
ce3ccc45d790 Add separate option for perlin gen
unc0rr
parents: 10386
diff changeset
   219
            if Land[height - 1, x] = lfObjMask then FillLand(x, height - 1, 0, lfBasic);
10190
e4f81f6d428c Tweaks and tweaks
unc0rr
parents: 10189
diff changeset
   220
10391
ce3ccc45d790 Add separate option for perlin gen
unc0rr
parents: 10386
diff changeset
   221
        // strip all lfObjMask pixels
ce3ccc45d790 Add separate option for perlin gen
unc0rr
parents: 10386
diff changeset
   222
        for y:= minY to LAND_HEIGHT - 1 do
ce3ccc45d790 Add separate option for perlin gen
unc0rr
parents: 10386
diff changeset
   223
            for x:= 0 to LAND_WIDTH - 1 do
ce3ccc45d790 Add separate option for perlin gen
unc0rr
parents: 10386
diff changeset
   224
                if Land[y, x] = lfObjMask then
ce3ccc45d790 Add separate option for perlin gen
unc0rr
parents: 10386
diff changeset
   225
                    Land[y, x]:= 0;
ce3ccc45d790 Add separate option for perlin gen
unc0rr
parents: 10386
diff changeset
   226
        end;
10189
875607ce793d - Rework FillLand
unc0rr
parents: 10188
diff changeset
   227
15160
c0ae9f4f9589 Perlin maps: Initialize playWidth and playHeight
Wuzzy <Wuzzy2@mail.ru>
parents: 15016
diff changeset
   228
    playWidth:= width;
c0ae9f4f9589 Perlin maps: Initialize playWidth and playHeight
Wuzzy <Wuzzy2@mail.ru>
parents: 15016
diff changeset
   229
    playHeight:= height;
10184
f87776bd5acd Setup leftX, rightX and topY
unc0rr
parents: 10183
diff changeset
   230
    leftX:= 0;
15160
c0ae9f4f9589 Perlin maps: Initialize playWidth and playHeight
Wuzzy <Wuzzy2@mail.ru>
parents: 15016
diff changeset
   231
    rightX:= playWidth - 1;
10184
f87776bd5acd Setup leftX, rightX and topY
unc0rr
parents: 10183
diff changeset
   232
    topY:= 0;
f87776bd5acd Setup leftX, rightX and topY
unc0rr
parents: 10183
diff changeset
   233
    hasBorder:= false;
10181
4708343d5963 Perlin noise generator untweaked, temporarily replacing maze generator
unc0rr
parents:
diff changeset
   234
end;
4708343d5963 Perlin noise generator untweaked, temporarily replacing maze generator
unc0rr
parents:
diff changeset
   235
4708343d5963 Perlin noise generator untweaked, temporarily replacing maze generator
unc0rr
parents:
diff changeset
   236
end.