Discussion :

[JP CASSOU]

Petite contrib sans prétention:

Un petit moteur cellulaire 3D à rendu software inspiré du jeu DESCENT, destiné à la visualisation de carrières souterraines

Pré-requis: TBGRABitmap

https://www.grosfichiers.com/FMSVU5pXv3z

Utilisation rapide:
Fichier -> ouvrir le csv dans ./00_Citon_II_FPS

Avancer: A
Reculer: Q
Strafe LR: <-- et -->
Strafe UD: + et -

Souris bouton gauche enfoncé : Point de vue

FPS:



Automap:

[Roland Chastain]

Impressionnant !

Il semblerait qu'il manque un fichier dans le ZIP : dgccdrvue3dutils.inc.

[JP CASSOU]

Impressionnant !

Il semblerait qu'il manque un fichier dans le ZIP : dgccdrvue3dutils.inc.

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
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
 
// dgccdrvue3dutils.inc
// Fonctions utilitaires de dgccadrevue3D.pas
//**********************************************
 
const DEG_TO_RAD   = PI / 180;
function sind(X: double): double;
begin
  Result := sin(X * DEG_TO_RAD);
end;
function cosd(X: double): double;
begin
  Result := cos(X * DEG_TO_RAD);
end;
function tand(X: double): double;
begin
  Result := tan(X * DEG_TO_RAD);
end;
type
  TArrayOfPoint3D = array of TDGCPoint3D;
 
procedure GetQuadUV(const Texture: TBGRABitmap;  const Orientation: TDGCTextureOrientation;  out UV0, UV1, UV2, UV3: TPointF);
var
  W, H: Single;
  procedure setUVx(const P0x, P0y,  P1x, P1y,  P2x, P2y,  P3x, P3y: single);
  begin
    UV0 := PointF(P0x, P0y);
    UV1 := PointF(P1x, P1y);
    UV2 := PointF(P2x, P2y);
    UV3 := PointF(P3x, P3y);
  end;
begin
  W := Texture.Width  - 1;
  H := Texture.Height - 1;
  case Orientation of
    toNormal        : setUVx(0, H,  W, H,  W, 0,  0, 0);
    toRot90         : setUVx(W, H,  W, 0,  0, 0,  0, H);
    toRot180        : setUVx(W, 0,  0, 0,  0, H,  W, H);
    toRot270        : setUVx(0, 0,  0, H,  W, H,  W, 0);
    toMirrorU       : setUVx(W, H,  0, H,  0, 0,  W, 0);
    toMirrorV       : setUVx(0, 0,  W, 0,  W, H,  0, H);
    toRot90MirrorU  : setUVx(0, H,  0, 0,  W, 0,  W, H);   // Rotation 90° puis miroir horizontal U
    toRot90MirrorV  : setUVx(W, 0,  W, H,  0, H,  0, 0);   // Rotation 90° puis miroir vertical V
    toRot270MirrorU : setUVx(W, 0,  W, H,  0, H,  0, 0);   // Rotation 270° puis miroir horizontal U
    toRot270MirrorV : setUVx(0, H,  0, 0,  W, 0,  W, H);   // Rotation 270° puis miroir vertical V
  else
    setUVx(0, H,  W, H,  W, 0,  0, 0);
  end;
end;
 
function InterpolateToNearPlane(const A, B: TDGCPoint3D; const NearZ: Double): TDGCPoint3D;
var
  t: Double;
begin
  if Abs(B.Z - A.Z) < 1E-12 then Exit(A);
  t := (NearZ - A.Z) / (B.Z - A.Z);
  Result := A + (B - A) * t;
  Result.Z := NearZ;
end;
 
function IsInsideNearPlane(const P: TDGCPoint3D; const NearZ: Double): Boolean; inline;
begin
  Result := (P.Z >= NearZ);
end;
 
 
function LerpTexturedCamVertex(const A, B: TDGCTexturedCamVertex; const T: Double): TDGCTexturedCamVertex;
begin
  Result.P := A.P + (B.P - A.P) * T;
  Result.U := A.U + (B.U - A.U) * T;
  Result.V := A.V + (B.V - A.V) * T;
end;
 
function IntersectNearPlaneTextured(const A, B: TDGCTexturedCamVertex; const NearZ: Double): TDGCTexturedCamVertex;
var
  T: Double;
begin
  T := (NearZ - A.P.Z) / (B.P.Z - A.P.Z);
  Result := LerpTexturedCamVertex(A, B, T);
end;
function ClipTexturedPolyNearPlane(const InPoly: TDGCTexturedCamPoly; const NearZ: Double): TDGCTexturedCamPoly;
  procedure AddVertex(const Q: TDGCTexturedCamVertex);
  begin
    if Result.Count <= High(Result.Vtx) then
    begin
      Result.Vtx[Result.Count] := Q;
      Inc(Result.Count);
    end;
  end;
var
  I: Integer;
  S, E: TDGCTexturedCamVertex;
  SIn, EIn: Boolean;
begin
  Result.Count := 0;
  if InPoly.Count <= 0 then Exit;
 
  for I := 0 to InPoly.Count - 1 do
  begin
    S := InPoly.Vtx[I];
 
    if I = InPoly.Count - 1 then E := InPoly.Vtx[0]
                            else E := InPoly.Vtx[I + 1];
 
    SIn := S.P.Z >= NearZ;
    EIn := E.P.Z >= NearZ;
 
    if (SIn and EIn) then
    begin
      AddVertex(E);
    end
    else if (SIn and (not EIn)) then
    begin
      AddVertex(IntersectNearPlaneTextured(S, E, NearZ));
    end
    else if ((not SIn) and EIn) then
    begin
      AddVertex(IntersectNearPlaneTextured(S, E, NearZ));
      AddVertex(E);
    end;
  end;
end;
 
procedure DGCFillTriangleFast(const BMP: TBGRABitmap;
                              const P0, P1, P2: TPoint;
                              const Col: TBGRAPixel);
var
  v0, v1, v2: TPoint;
  y, yStart, yEnd: Integer;
  xStart, xEnd: Integer;
  dx1, dx2, dx3: Double;
  sx, ex: Double;
  ptrLine: PBGRAPixel;
  function BlendPixel(const Src, Dst: TBGRAPixel): TBGRAPixel; inline;
  var
    invA: Integer;
  begin
    invA := 255 - Src.alpha;
 
    Result.red   := (Src.red   * Src.alpha + Dst.red   * invA) div 255;
    Result.green := (Src.green * Src.alpha + Dst.green * invA) div 255;
    Result.blue  := (Src.blue  * Src.alpha + Dst.blue  * invA) div 255;
 
    Result.alpha := Src.alpha + (Dst.alpha * invA) div 255;
  end;
 
 
  procedure FillSpan(Y: Integer; AX1, AX2: Double);
  var
    x: Integer;
    a, invA: Byte;
    dst: PBGRAPixel;
 
  begin
    xStart := Round(AX1);
    xEnd   := Round(AX2);
 
    if xStart > xEnd then DGCSwapInt32(xStart, xEnd);
 
    // clipping horizontal
    if xEnd < 0 then Exit;
    if xStart >= BMP.Width then Exit;
 
    if xStart < 0 then xStart := 0;
    if xEnd >= BMP.Width then xEnd := BMP.Width - 1;
 
    ptrLine := BMP.ScanLine[Y];
 
    // écriture brute
    xStart := Max(xStart, 0);
    xEnd   := Min(xEnd, BMP.Width-1);
    if (Col.alpha < 255) then
    begin
      a    := Col.alpha;
      invA := 255 - a;
 
      for x := xStart to xEnd do
      begin
        dst := @ptrLine[x];
        dst^.red   := ((Col.red   * a + dst^.red   * invA) + 128) shr 8;
        dst^.green := ((Col.green * a + dst^.green * invA) + 128) shr 8;
        dst^.blue  := ((Col.blue  * a + dst^.blue  * invA) + 128) shr 8;
        dst^.alpha := a + ((dst^.alpha * invA + 128) shr 8);
      end;
    end
    else
    begin
      for x := xStart to xEnd do
        ptrLine[x] := Col;
    end;
  end;
begin
  if BMP = nil then Exit;
 
  //if (Col.Alpha = 0) then exit; // Alpha = 0 ? Transparence totale -> On sort direct
  if ((P1.X - P0.X)*(P2.Y - P0.Y) - (P1.Y - P0.Y)*(P2.X - P0.X)) > 0 then Exit;
 
  // tri Y
  v0 := P0; v1 := P1; v2 := P2;
 
  if (v1.Y < v0.Y) then DGCSwapTPoint(v0, v1);
  if (v2.Y < v0.Y) then DGCSwapTPoint(v0, v2);
  if (v2.Y < v1.Y) then DGCSwapTPoint(v1, v2);
 
  // clipping vertical global
  if (v2.Y < 0)           then Exit;
  if (v0.Y >= BMP.Height) then Exit;
 
  // pentes
  if (v1.Y <> v0.Y) then dx1 := (v1.X - v0.X) / (v1.Y - v0.Y) else dx1 := 0;
  if (v2.Y <> v0.Y) then dx2 := (v2.X - v0.X) / (v2.Y - v0.Y) else dx2 := 0;
  if (v2.Y <> v1.Y) then dx3 := (v2.X - v1.X) / (v2.Y - v1.Y) else dx3 := 0;
 
  //========================
  // HAUT
  //========================
  sx := v0.X;
  ex := v0.X;
 
  yStart := Max(v0.Y, 0);
  yEnd   := Min(v1.Y - 1, BMP.Height - 1);
 
  // reposition si clipping vertical
  if (v0.Y < 0) then
  begin
    sx := sx + dx1 * (yStart - v0.Y);
    ex := ex + dx2 * (yStart - v0.Y);
  end;
 
  for y := yStart to yEnd do
  begin
    FillSpan(y, sx, ex);
    sx := sx + dx1;
    ex := ex + dx2;
  end;
 
  //========================
  // BAS
  //========================
  sx := v1.X;
  ex := v0.X + dx2 * (v1.Y - v0.Y);
 
  yStart := Max(v1.Y, 0);
  yEnd   := Min(v2.Y, BMP.Height - 1);
 
  if (v1.Y < 0) then
  begin
    sx := sx + dx3 * (yStart - v1.Y);
    ex := ex + dx2 * (yStart - v1.Y);
  end;
 
  for y := yStart to yEnd do
  begin
    FillSpan(y, sx, ex);
    sx := sx + dx3;
    ex := ex + dx2;
  end;
end;
 
procedure ClipSegmentNearPlaneCam(var P1, P2: TDGCPoint3D; const NearZ: Double; out Visible: Boolean);
var
  A, B, D, I: TDGCPoint3D;
  t: Double;
begin
  Visible := True;
 
  A := P1;
  B := P2;
 
  // segment entièrement derrière
  if (A.Z < NearZ) and (B.Z < NearZ) then
  begin
    Visible := False;
    Exit;
  end;
 
  // segment entièrement devant
  if (A.Z >= NearZ) and (B.Z >= NearZ) then
  begin
    P1 := A;
    P2 := B;
    Exit;
  end;
 
  D := B - A;
 
  if (Abs(D.Z) < 1E-9) then
  begin
    Visible := False;
    Exit;
  end;
  t := (NearZ - A.Z) / D.Z;
  I := A + D * t;
  if (A.Z < NearZ) then A := I  else B := I;
 
  P1 := A;
  P2 := B;
end;
 
 
 
 
function BGRAtoColor(const C: TBGRAPixel): TColor;
begin
  Result := RGBToColor(C.red, C.green, C.blue);
end;
function DGCApplyLighting(const BaseColor: TBGRAPixel; const Intensity: double): TBGRAPixel;
var
  f: double;
begin
  f := EnsureRange(Intensity, 0.0, 1.0);
 
  Result.red   := round(BaseColor.red   * f);
  Result.green := round(BaseColor.green * f);
  Result.blue  := round(BaseColor.blue  * f);
  Result.alpha := BaseColor.alpha;
end;
function DGCIsFrontFaceTriangle(const A, B, C: TPoint; const VisibleFromExter: boolean): boolean;
var
  EWE: Int64;
begin
  EWE := (B.X - A.X)*(C.Y - A.Y) - (B.Y - A.Y)*(C.X - A.X);
  if (VisibleFromExter) then Result := (EWE >= 0)
                        else Result := (EWE <= 0);
end;
 
function DGCIsFrontFaceQuad(const A, B, C, D: TPoint; const VisibleFromExter: boolean): boolean;
begin
  Result := DGCIsFrontFaceTriangle(A, B, C, VisibleFromExter) AND
            DGCIsFrontFaceTriangle(C, D, A, VisibleFromExter);
 
end;
 
function DGCSortByZDepth(Item1, Item2: Pointer): Integer;
var
  E1, E2: ^TDGCPrimitive;
begin
  E1 := Item1;
  E2 := Item2;
 
  if      (E1^.ZOrder < E2^.ZOrder) then Result := 1
  else if (E1^.ZOrder > E2^.ZOrder) then Result := -1
  else     Result := 0;
end;
 
 
 
function RectsIntersect(const A, B: TRect): Boolean;
begin
  Result :=
    (A.Left   < B.Right)  and
    (A.Right  > B.Left)   and
    (A.Top    < B.Bottom) and
    (A.Bottom > B.Top);
end;
 
function IntersectRectsSafe(const A, B: TRect; out R: TRect): Boolean;
begin
  R.Left   := Max(A.Left,   B.Left);
  R.Top    := Max(A.Top,    B.Top);
  R.Right  := Min(A.Right,  B.Right);
  R.Bottom := Min(A.Bottom, B.Bottom);
 
  Result := (R.Left < R.Right) and (R.Top < R.Bottom);
end;

[Roland Chastain]

Merci. J'ai pu compiler le programme et en faire un essai rapide (sous Linux). Tout semble fonctionner. Impressionnant travail (bis).

Le chargement du fichier CSV prend forcément un peu de temps. Ce serait bien d'avoir un indicateur de progression, et que le chargement se fasse dans un fil d'exécution séparé, pour que l'interface ne soit pas gelée.

Question en passant : Pourquoi ne pas mettre le fichier ZIP ici même dans les sources Lazarus, plutôt que sur une page temporaire (dont la présentation est en outre peu satisfaisante) ?

[JP CASSOU]

Merci. J'ai pu compiler le programme et en faire un essai rapide (sous Linux). Tout semble fonctionner. Impressionnant travail (bis).

Le chargement du fichier CSV prend forcément un peu de temps. Ce serait bien d'avoir un indicateur de progression, et que le chargement se fasse dans un fil d'exécution séparé, pour que l'interface ne soit pas gelée.

Question en passant : Pourquoi ne pas mettre le fichier ZIP ici même dans les sources Lazarus, plutôt que sur une page temporaire (dont la présentation est en outre peu satisfaisante) ?

Le fichier manquant était bien présent dans le ZIP, mais avec une graphie différente.

Le chargement du CSV prend un peu de temps : construction du graphe de cellules en O(n**2) Mais je dois mettre un indicateur de progression
J'ai utilisé le vecteur le plus facile pour moi: grosfichiers.com puisque DVP m'envoyait une erreur lors du téléversement du ZIP

Vous pouvez réutiliser ce travail, proposer des améliorations, etc: Licence GPL
Et publier ce ZIP ici

[Roland Chastain]

Le fichier manquant était bien présent dans le ZIP, mais avec une graphie différente.

Effectivement.

J'ai utilisé le vecteur le plus facile pour moi: grosfichiers.com puisque DVP m'envoyait une erreur lors du téléversement du ZIP.

Oui, des fois, ça ne fonctionne pas très bien. Pourtant le fichier n'est pas très gros, surtout en supprimant l'exécutable oublié (?) dans le dossier 00_Citon_II_FPS.

Vous pouvez réutiliser ce travail, proposer des améliorations, etc. Licence GPL. Et publier ce ZIP ici.

Merci pour le partage.

Je pourrais me charger de créer une entrée dans les sources Lazarus, mais je ne saurais pas trop quoi mettre dans la présentation, à part reprendre tel quel votre premier message. Vous ne voudriez pas essayer de faire une petite notice ? Même un simple fichier texte. Je pourrais faire moi-même la mise en forme, si ça ne vous dit rien de le faire.

[JP CASSOU]

Effectivement.



Oui, des fois, ça ne fonctionne pas très bien. Pourtant le fichier n'est pas très gros, surtout en supprimant l'exécutable oublié (?) dans le dossier 00_Citon_II_FPS.



Merci pour le partage.

Je pourrais me charger de créer une entrée dans les sources Lazarus, mais je ne saurais pas trop quoi mettre dans la présentation, à part reprendre tel quel votre premier message. Vous ne voudriez pas essayer de faire une petite notice ? Même un simple fichier texte. Je pourrais faire moi-même la mise en forme, si ça ne vous dit rien de le faire.

Petite notice de présentation de GHTopoDescent:

GHTopoDescent est un visualisateur / navigateur de type DESCENT (jeu vidéo de Parallax Software, 1995) destiné à la spéléologie en carrières souterraines.
Il s'agit d'un moteur 3D basé 'cellules et portails' dans lequel le visiteur peut évoluer en mode 5 degrés de liberté (le roulis a été désactivé en raison de la finalité spéléologique du projet, mais le moteur supporte bien le 6 DoF)

Une "map' est un assemblage de cellules hexahédriques convexes connectées entre elle par des portails.
Les vertex 3D de chaque hexahèdre sont indexés par ses 8 sommets (indexed face set)


Notions utilisées:

- Graphe de cellules (reconstruit au chargement)
- Graphe des cellules proches (recherche BFS)
- Gestion des faces cachées, rendu par portail
- Gestion des collisions (avatar as a sphere) + glissement le long d'une facette
- Navigation clavier/souris
- Mode FPS et orbital (Automap)
- Triggers de cellules: affichage d'une photo, action, signalisation
- Texturing UV 2D avec TBGRABitmap
- Clipping 3D