Bonjour,

Je suis preneur de vos critiques et/ou suggestions sur mon algo personnalisé du Diamant-Carré pour créer des mondes.

L'idée c'est de créer des images qui pourraient être plaquées sur une sphère en 3D.

Ce code est la juste pour le fun, rien de commercial derrière.

Nom : Heightmap.png Affichages : 152 Taille : 252,2 Ko

Voici la routine de base :
Code : Sélectionner tout - Visualiser dans une fenêtre à part
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
 
procedure TForm1.Button4Click(Sender: TObject);
const
  LX = 1024;
  MX = 512;
  DX = 32;
  LY = 512;
var
  x, y, z, n, bloc: integer;
  tg, td, th, tb, tf: TPoint;
  hmap: array[0..LY, 0..LX - 1] of byte;
begin
  // Défini de façon aléatoire le niveau par défaut du monde.
  n := Random(256);
 
  // Initialise la carte de hauteur avec le niveau par défaut.
  for y := 0 to high(hmap) do
    for x := 0 to high(hmap[y]) do
      hmap[y, x] := n;
 
  // Initialise les 4 points du départ de l'algo Diamant-Carré.
  hmap[0, 0]   := Random(256);
  hmap[0, MX]  := Random(256);
  hmap[LY, 0]  := Random(256);
  hmap[LY, MX] := Random(256);
 
  // La taille du bloc de départ correspond a la maitié de la largeur du monde.
  bloc := MX;
 
  // Algo Diamant-Carré.
  while bloc > 1 do
  begin
    z := bloc div 2;
 
    // Boucle du carré
    y := z;
    while y < LY do
    begin
      x := z;
 
      while x < LX do
      begin
        {
           G-----D
           |     |
           |  F  |
           |     |
           H-----B
        }
 
        tf := ControlePosition(y, x);
        tg := ControlePosition(y - z, x - z);
        td := ControlePosition(y - z, x + z);
        th := ControlePosition(y + z, x - z);
        tb := ControlePosition(y + z, x + z);
 
        hmap[tf.Y, tf.X] := Limitation(((hmap[tg.Y, tg.X] + hmap[td.Y, td.X] + hmap[th.Y, th.X] + hmap[tb.Y, tb.X]) div 4) + Randomrange(-z, z));
 
        Inc(x, bloc);
      end;
 
      Inc(y, bloc);
    end;
 
    // Boucle du diamant
    y := z;
    while y < LY do
    begin
      x := z;
 
      while x < LX do
      begin
        {
           / H \
          /     \
         G   F   D
          \     /
           \ B /
        }
 
        // 1 - Début
        tf := ControlePosition(y, x - z);
        tg := ControlePosition(y, x - bloc);
        td := ControlePosition(y, x);
        th := ControlePosition(y - z, x - z);
        tb := ControlePosition(y + z, x - z);
 
        hmap[tf.Y, tf.X] := Limitation(((hmap[tg.Y, tg.X] + hmap[td.Y, td.X] + hmap[th.Y, th.X] + hmap[tb.Y, tb.X]) div 4) + Randomrange(-z, z));
        // 1 - Fin
 
        //2 - Début
        tf := ControlePosition(y - z, x);
        tg := ControlePosition(y - z, x - z);
        td := ControlePosition(y - z, x + z);
        th := ControlePosition(y - bloc, x);
        tb := ControlePosition(y, x);
 
        hmap[tf.Y, tf.X] := Limitation(((hmap[tg.Y, tg.X] + hmap[td.Y, td.X] + hmap[th.Y, th.X] + hmap[tb.Y, tb.X]) div 4) + Randomrange(-z, z));
        // 2 - Fin
 
        Inc(x, bloc);
      end;
 
      Inc(y, bloc);
    end;
 
    bloc := z;
  end;
end;
La routine qui m'assure de la cohérence des coordonnées :
Code : Sélectionner tout - Visualiser dans une fenêtre à part
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
 
 
function TForm1.ControlePosition(const y, x: integer): TPoint;
begin
  Result.Y := y;
  Result.X := (LX + x) mod LX;
 
  if Result.Y < 0 then
  begin
    Result.Y := ABS(y);
    Result.X := (LX + (LX - x)) mod LX;
  end;
 
  if Result.Y > LY then
  begin
    Result.Y := (LY - (y - LY));
    Result.X := (LX + (LX - x)) mod LX;
  end;
end;
La routine qui m'assure que je reste bien dans les limites de ma palette de couleurs :
Code : Sélectionner tout - Visualiser dans une fenêtre à part
1
2
3
4
5
6
 
 
function TForm1.Limitation(const AValue: integer): byte;
begin
  Result := Max(Min(AValue, 255), 0);
end;
J'ai ausi créé une routine de lissage :
Code : Sélectionner tout - Visualiser dans une fenêtre à part
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
 
procedure TForm1.LissageCarte;
var
  x, y, z: integer;
  P1, P2, P3, P4, P5, P6, P7, P8, P9: TPoint;
begin
  for y := 0 to high(hmap) do
    for x := 0 to high(hmap[y]) do
    begin
      P1 := ControlePosition(y - 1, x - 1);
      P2 := ControlePosition(y - 1, x);
      P3 := ControlePosition(y - 1, x + 1);
      P4 := ControlePosition(y, x - 1);
      P5 := ControlePosition(y, x);
      P6 := ControlePosition(y, x + 1);
      P7 := ControlePosition(y + 1, x - 1);
      P8 := ControlePosition(y + 1, x);
      P9 := ControlePosition(y + 1, x + 1);
 
      z := (hmap[P1.Y, P1.X] + hmap[P2.Y, P2.X] + hmap[P3.Y, P3.X] + hmap[P4.Y, P4.X] + hmap[P5.Y, P5.X] + hmap[P6.Y, P6.X] + hmap[P7.Y, P7.X] + hmap[P8.Y, P8.X] + hmap[P9.Y, P9.X]) div 9;
 
      hmap[y, x] := Limitation(z);
    end;
end;
Merci d'avance de vos participations pour améliorer les routines ou bien pour les optimiser !