Navigation

Inscrivez-vous gratuitement
pour pouvoir participer, suivre les réponses en temps réel, voter pour les messages, poser vos propres questions et recevoir la newsletter

Codes sources à télécharger Delphi Discussion :

Petite simulation d'herbe


Sujet :

Codes sources à télécharger Delphi

  1. #1
    Membre émérite
    Petite simulation d'herbe
    Bonjour,

    Je vous propose une petite démonstration pour simuler de l'herbe en 3D avec Firemonkey. Le composant TGBEGrass fourni dans le source fait partie d'un petit ensemble de composants 3D que je prépare. Ce qui est intéressant dans cet exemple est le fait que je joue avec les propriétés texte du TMesh.Data.Points, TMesh.Data.TexCoordinates et TMesh.Data.TriangleIndices pour créer mon propre maillage et jouer à plaquer la texture comme je le souhaite.

    Dans TMesh.Data.Points, on va placer les coordonnées sur les 3 axes de chaque sommet de notre maillage. Par exemple :
    Code :Sélectionner tout -Visualiser dans une fenêtre à part
    self.Data.Points := '-1 -1 0,  1 -1 0,  -1 1 0,  1 1 0';

    Pour générer un plan carré.

    Grâce à TMesh.Data.TexCoordinates, nous allons pouvoir indiquer pour chaque sommet du maillage quelle est le point correspondant de la texture
    Code :Sélectionner tout -Visualiser dans une fenêtre à part
    self.Data.TexCoordinates := '0.0 0.0, 1 0, 0.0 1, 1 1';

    Dans cet exemple, on indique simplement que le premier sommet du maillage correspond le pixel x=0 et y=0 de la texture, le deuxième sommet correspond au pixel x=largeur de la texture (en effet, les nombres indiqués représentent le pourcentage de la largeur ou de la hauteur de la texture) et y = 0.

    Enfin, grâce à TMesh.Data.TriangleIndices, on indique comment relier nos sommets pour générer les triangles du maillage.
    Code :Sélectionner tout -Visualiser dans une fenêtre à part
     self.Data.TriangleIndices := '0 1 2 ,2 1 3';

    Dans cet exemple, le maillage sera constitué de 2 triangles : le premier reliant les sommets 0, 1 et 2, le second reliant les sommets 2, 1 et 3. Nous obtenons au final un simple rectangle avec une texture appliquée de la même manière qu'un TPlane mais nous l'avons généré manuellement. Je fournirai prochainement un autre exemple utilisant cette méthode pour générer un Cubemap où l'on verra plus en détails comment affiner le plaquage de la texture sur notre TMesh.

    Dans le OnRender, on joue ensuite sur la position en X des deux sommets situés en haut du rectangle afin de simuler un petit effet de vent. Comme cela est fait dans le OnRender, il faut que le programme utilisant le composant force le rendu de la scène régulièrement.

    Vous constaterez certainement un défaut d'affichage. Cela est dû à une mauvaise gestion de la transparence dans FMX. Pour tenter de pallier à ce problème j'ai mis la propriété ZWrite du composant TGBEGrass à false ce qui provoque des artéfacts sur la notion de profondeur...



    Les sources du composant et du projet exemple sont dans le zip joint :
    Mon site - Mes tutoriels - GitHub - N'oubliez pas de consulter les FAQ Delphi et les cours et tutoriels Delphi

  2. #2
    Expert éminent sénior
    ah c'est cool

    c'est simple et ça rend bien, bien joué
    Developpez.com: Mes articles, forum FlashPascal
    Entreprise: Execute SARL
    Le Store Excute Store

  3. #3
    Rédacteur/Modérateur

    Bonjour,

    Ah il ne s'agit que de cette herbe là, dommage, je m'attendais à un truc illicite
    Néanmoins superbe mais je ne vais pas mettre le doigt dans l'engrenage de la 3D alors que rien que la 2D me fait aller dans beaucoup de directions.
    En tout cas je garde le truc dans un coin de ma tête (il sera toujours temps de m'y mettre un jour)
    Bravo joli rendu à quand des choses comme
    https://dms.licdn.com/playback/C4E05...05o-tjWQ_QaV1s ?
    La seule chose absolue dans un monde comme le nôtre, c'est l'humour. » Albert Einstein

    Delphi installés : D3,D7,D2010,XE4,XE7,D10 (Tokyo, Rio, Sidney) et peut être quelques autres
    SGBD : Firebird 2.5, 3, SQLite
    générateurs Etats : FastReport, Rave, QuickReport
    OS : Window Vista, Windows 10, Ubuntu, Androïd

  4. #4
    Membre émérite
    Cela me rappelle un cours que j'avais donné à la fin des années 90 à Météo France. Je faisais comprendre la notion d'objet sous Delphi 5 en faisant pousser de l'herbe (licite). Ceci dit c'est du bon travail.

  5. #5
    Membre émérite
    Ah oui, j'étais dans mon truc et je n'avais même pas pensé à l'interprétation illicite que l'on pouvait faire de l'herbe

    @Serge
    Joli rendu mais après il faut apprendre les shaders et se mettre sérieusement aux maths. Voici un exemple que je trouve magnifique de shader pour représenter la mer : https://www.shadertoy.com/view/Ms2SD1
    Mon site - Mes tutoriels - GitHub - N'oubliez pas de consulter les FAQ Delphi et les cours et tutoriels Delphi

  6. #6
    Expert éminent sénior
    et les shaders ça tourne sans soucis sous Delphi

    https://github.com/tothpaul/Delphi/tree/master/3D

    j'en parle ici
    Developpez.com: Mes articles, forum FlashPascal
    Entreprise: Execute SARL
    Le Store Excute Store

  7. #7
    Membre expérimenté
    Citation Envoyé par gbegreg Voir le message
    Ah oui, j'étais dans mon truc et je n'avais même pas pensé à l'interprétation illicite que l'on pouvait faire de l'herbe
    J'dois avouer que je m'attendais à un truc moins vert et plus psychédélique en voyant le titre de ton post, mais c'est pas ma faute, c'est à cause de Netflix (suis en visionnant de Familly Business en ce moment).
    (d'un autre côté, à part m'étouffer, j'sais pas si ça fait vraiment voir des trucs psychédéliques, après tout c'est pas du LSD)

    Ceci dit, bravo pour cet exemple, ça rend vraiment bien.

  8. #8
    Membre expérimenté
    Citation Envoyé par gbegreg Voir le message
    Voici un exemple que je trouve magnifique de shader pour représenter la mer : https://www.shadertoy.com/view/Ms2SD1
    Impressionnant .... ça m'épate toujours de voir tout ce qu'on peut faire avec 3 lignes de code dans un shader :o

  9. #9
    Membre émérite
    Bon voici une version plus touffue (on passe de 200 à 400 objets TGBEGrass instanciés), plus colorée (3 textures au lieu d'une seule) et avec une animation pour se déplacer un peu au dessus de la petite prairie. En revanche, les défauts de profondeur se font plus nettement sentir :


    Mon site - Mes tutoriels - GitHub - N'oubliez pas de consulter les FAQ Delphi et les cours et tutoriels Delphi

  10. #10
    Membre émérite
    Citation Envoyé par Paul TOTH Voir le message
    et les shaders ça tourne sans soucis sous Delphi

    https://github.com/tothpaul/Delphi/tree/master/3D

    j'en parle ici
    Oui Paul, j'avais déjà vu ton code. Je n'ai pas eu le temps d'approfondir le sujet et je crains que de se lancer dans les shaders, ça soit très chronophage...
    Mon site - Mes tutoriels - GitHub - N'oubliez pas de consulter les FAQ Delphi et les cours et tutoriels Delphi

  11. #11
    Expert éminent sénior
    pour le problème de transparence, tu ne peux pas éviter de gérer l'ordre d'affichage quand la transparence est en jeu

    une approche possible est l'usage d'un BSP Tree
    http://tothpaul.free.fr/sources.php?dprgrp.bsp

    l'idée est simple, tu construits un arbre binaire qui va placer les éléments "à droite" ou "à gauche" d'un autre. Idéalement avec 3 plans, tu as un plan racine, un plan qui se trouve d'un côté, et l'autre de l'autre. Dans la procédure de rendu, tu regardes de quel côté du plan racine tu te trouves pour savoir quel côté il faut dessiner en premier. Au final, chaque branche sera un plan racine qui possède lui-même des plans avants et arrières.

    dans l'exemple ci-dessus c'est utilisé pour faire en rendu sans ZBuffer, le plan le plus éloigné étant dessiné le premier, et le plus proche en dernier (algorithme du peintre)...comme le point de vue change au cours du temps, il serait trop consommateur de temps que de recalculer à chaque fois l'ordre des plans, le BSP Tree réparti les plans dans cet arbre binaire pour lequel il suffit pour chaque noeud de savoir de quel côté du plan on se trouve.
    Developpez.com: Mes articles, forum FlashPascal
    Entreprise: Execute SARL
    Le Store Excute Store

  12. #12
    Expert éminent sénior
    je n'ai pas résisté à la tentation

    voici une version qui exploite le BSP Tree

    (il faut récupérer le projet au dessus, je ne mets que le code de la fiche principale)

    première modification, au lieu de créer des TMesh, j'utilise TDummy.OnRender et Context.DrawPrimitives pour dessiner chaque élément à partir d'une variable unique (en fait 3) qui décrit le rectangle. Le calcul du vent se fait en fonction du temps et non du framerate (sinon il dépend de la puissance de la machine)

    les DEFINE
    WIND : active ou pas le vent
    GRASS: active mon code ou remets l'ancien (pour comparaison)
    USE_BSPTREE: utilise le BSP Tree ou désactive simplement le ZBuffer (comme le code original)
    DRAW_BOX: affiche un carré rouge autour de chaque texture (à des fin de debug)
    COLOR_FACES: donne une couleur unie à chaque face en fonction de son orientation avant/arrière dans le BSP Tree (à des fin de debug)

    pour le BSP TREE
    - j'ai réduit le nombre de texture car je trouve que c'est trop chargé avec le BSP TREE
    - BuildBSPTree crée l'arbre binaire des faces les unes par rapport aux autres
    - quand deux faces se croisent, un nouvel élément est créé (fuite mémoire car je ne gère pas sa libération) et la face est coupée en deux (cf DRAW_BOX pour le visualiser)
    - quand on active le vent, il peut y avoir des défauts d'affichage car la face est déformée et le BSPTree n'est donc plus forcément respecté...il faudrait mieux calculer la découpe en gardant le plan de coupe initial; cf RenderNode et le calcul en fonction de X1 et X2, il faut que les points centraux restent à leur place.

    en mode debug je vous conseille de réduire le nombre d'élément sinon ça devient vite illisible





    en mode debug, les liens rouge et bleu (en commentaire dans le code) permettent de voir (plus ou moins) l'arbre binaire, et on remarque qu'un face est coupée en deux dans le prolongement de celle d'en face

    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
    366
    367
    368
    369
    370
    371
    372
    373
    374
    375
    376
    377
    378
    379
    380
    381
    382
    383
    384
    385
    386
    387
    388
    389
    390
    391
    392
    393
    394
    395
    396
    397
    398
    399
    400
    401
    402
    403
    404
    405
    406
    407
    408
    409
    410
    411
    412
    413
    414
    415
    416
    417
    418
    419
    420
    421
    422
    423
    424
    425
    426
    427
    428
    429
    430
    431
    432
    433
    434
    435
    436
    437
    438
    439
    440
    441
    442
    443
    444
    445
    446
    447
    448
     
    unit principale;
     
    interface
     
    {$DEFINE WIND}
     
    {$DEFINE GRASS}
    {$DEFINE USE_BSPTREE}
     
    {.$DEFINE DRAW_BOX}
    {.$DEFINE COLOR_FACES}
     
    uses
    {$IFDEF MSWINDOWS}
      Winapi.Windows,
    {$ENDIF}
      System.SysUtils, System.Types, System.UITypes, System.Classes, System.Variants, System.Math,
      FMX.Types, FMX.Controls, FMX.Forms, FMX.Graphics, FMX.Dialogs,
      FMX.Viewport3D, System.Math.Vectors, FMX.MaterialSources, FMX.Controls3D,
      FMX.Objects3D, GBEGrass, System.Threading, FMX.Types3D, FMX.Ani,
      FMX.Controls.Presentation, FMX.StdCtrls, FMX.Objects;
     
    type
      PGrass = ^TGrass;
      TGrass = record
        Position : TPoint3D;
        RotationY: Single;
        Texture  : TMaterialSource;
        Ticks    : Single;
        Next     : PGrass;
        X1, X2   : Single;
        Right    : PGrass;
        Left     : PGrass;
        procedure GetPoint(Side: Integer; var P: TPoint3D);
        procedure GetLine(var A, B: TPoint3D);
        function GetSide(G: PGrass; Side: Integer): Single;
        function DoSplit(V1, V2: Single): PGrass;
        function Origin: TPoint3D;
      end;
     
      TfPrincipale = class(TForm)
        Viewport3D: TViewport3D;
        TextureMaterialSource: TTextureMaterialSource;
        Dummy: TDummy;
        FloatAnimation: TFloatAnimation;
        FloatAnimation1: TFloatAnimation;
        FloatAnimation2: TFloatAnimation;
        TextureMaterialSource1: TTextureMaterialSource;
        TextureMaterialSource2: TTextureMaterialSource;
        FloatAnimation3: TFloatAnimation;
        ColorMaterialSource1: TColorMaterialSource;
        ColorMaterialSource2: TColorMaterialSource;
        procedure FormCreate(Sender: TObject);
        procedure FloatAnimationProcess(Sender: TObject);
        procedure DummyRender(Sender: TObject; Context: TContext3D);
      private
        { Déclarations privées }
        Grass: TArray<TGrass>;
        ZSort: TList;
        QuadDeclarion: TVertexDeclaration;
        Matrix: TMatrix3D;
        Tree: PGrass;
        Ticks: Single;
        function BuildBSPTree(Tree: PGrass): PGrass;
        function GetBestBSPNode(var Tree: PGrass): PGrass;
        procedure RenderBSPTree(Context: TContext3D; Node: PGrass);
        procedure RenderNode(Context: TContext3D; Node: PGrass);
      public
        { Déclarations publiques }
      end;
     
    var
      fPrincipale: TfPrincipale;
     
    implementation
     
    {$R *.fmx}
     
    const
      QuadSize = 2.5;
    var
    {   0---1
        |   |
        3---2
    }
      QuadVertices: array[0..3, 0..4] of Single = (
        ({ xyz: }-QuadSize, -QuadSize, 0, { uv: } 0, 0),
        ({ xyz: }+QuadSize, -QuadSize, 0, { uv: } 1, 0),
        ({ xyz: }+QuadSize, +QuadSize, 0, { uv: } 1, 1),
        ({ xyz: }-QuadSize, +QuadSize, 0, { uv: } 0, 1)
      );
     
      QuadIndices: array[0..1, 0..2] of Word = (
        (0, 1, 2),
        (2, 3, 0)
      );
     
     
    function TfPrincipale.BuildBSPTree(Tree: PGrass): PGrass;
    var
      L1, L2: PGrass;
      Next: PGrass;
      v1,v2: Single;
    begin
      if Tree = nil then
        Exit(nil);
     
      // Trouver le noeuds pour lequel il y a autant d'enfants à droite qu'à gauche avec
      // le minimum de "split" (quand deux faces se croisent et qu'il n'est pas possible de les ordonner)
      Result := GetBestBSPNode(Tree);
     
      l1 := nil; // right list
      l2 := nil; // left list
     
      while Tree<>nil do
      begin
        Next := Tree.Next;
     
        v1 := Result.GetSide(Tree, -1);
        v2 := Result.GetSide(Tree, +1);
     
        if (v1<=0) and (v2<=0) then
        begin
          Tree.Next := l1;
          l1 := Tree; // add wall to Right list
        end else
        if (v1>=0) and (v2>=0) then
        begin
          Tree.Next := l2;
          l2 := Tree; // add wall to Left list
        end else
        if (v1<0) then
        begin
          Tree.Next := l1;
          l1 := Tree; // add partial wall to Right list
          Tree := Tree.DoSplit(-v1, v2); // cut wall
          Tree.Next := l2;
          l2 := Tree; // add other part to Left list
        end else begin
          Tree.Next := l2;
          l2 := Tree; // add partial wall to Left list
          Tree := Tree.DoSplit(v1, -v2); // cut wall
          Tree.Next:=l1;
          l1 := Tree; // add other part to Right list
        end;
     
        Tree := Next; // next wall in the list
      end;
     
      Result.Right := BuildBSPTree(l2);
      Result.Left := BuildBSPTree(l1);
    end;
     
    function TfPrincipale.GetBestBSPNode(var Tree: PGrass): PGrass;
    var
      i, j: PGrass;
      Best : Integer;
      v1, v2: Single;
      Count: Integer;
      Split: Integer;
      MaxSplit: Integer;
    begin
      Best := MaxInt;
      MaxSplit := MaxInt;
      i := Tree;
      Result := nil;
      while i <> nil do
      begin
        Count := 0;
        Split := 0;
        j := Tree;
        while j <> nil do
        begin
          if j <> i then
          begin
            v1 := i.GetSide(j, -1);
            v2 := i.GetSide(j, +1);
            if (v1 <= 0) and (v2 <= 0) then
              Inc(Count)
            else
            if (v1 > 0) and (v2 > 0) then
              Dec(Count)
            else begin
              Inc(Split);
              Inc(Count);
            end;
          end;
          j := j.Next;
        end;
        Count := Abs(Count);
        if (Count < Best) or ((Count = Best) and (Split < MaxSplit)) then
        begin
          Best := Count;
          MaxSplit := Split;
          Result := i;
        end;
        i := i.Next;
      end;
     
      if Result = nil then
        Result := Tree;
     
      if Result = Tree then
        Tree := Result.Next
      else begin
        i := Tree;
        while i.Next <> Result do
          i := i.Next;
        i.Next := Result.Next;
      end;
     
    end;
     
    procedure TfPrincipale.RenderBSPTree(Context: TContext3D; Node: PGrass);
    var
      A, B, C: TPoint3D;
      Side: Single;
      DeltaX: Single;
    begin
      if Node = nil then
        Exit;
     
      Node.GetLine(A, B);
     
      A := A * Matrix;
      B := B * Matrix;
     
      C := TPoint3D.Create(0, 0, -20); // DesignCamera
     
      Side := (A.Z - B.Z) * (A.X - C.X) - (A.X - B.X) * (A.Z - C.Z);
     
      if Side < 0 then
        RenderBSPTree(Context, Node.Right)
      else
        RenderBSPTree(Context, Node.Left);
     
      {$IFDEF COLOR_FACES}
      if Side <= 0 then
        Node.Texture := ColorMaterialSource1 // TextureMaterialSource
      else
        Node.Texture := ColorMaterialSource2; // TextureMaterialSource1;
      {$ENDIF}
     
      RenderNode(Context, Node);
     
    //  Context.SetMatrix(Matrix);
    //  if Node.Left <> nil then
    //  begin
    //    Context.DrawLine(Node.Origin, Node.Left.Origin, 1, TAlphaColorRec.Red);
    //  end;
    //  if Node.Right <> nil then
    //  begin
    //    Context.DrawLine(Node.Origin, Node.Right.Origin, 1, TAlphaColorRec.Blue);
    //  end;
     
      if Side < 0 then
        RenderBSPTree(Context, Node.Left)
      else
        RenderBSPTree(Context, Node.Right);
    end;
     
    procedure TfPrincipale.RenderNode(Context: TContext3D; Node: PGrass);
    var
      DeltaX: Single;
    begin
    // Appliquer la déformation
      DeltaX := {$IFDEF WIND}Sin(Ticks + Node.Ticks){$ELSE}0{$ENDIF};
    //    AllocConsole;
    //    WriteLn('Ticks = ', Ticks:0:2, ' DeltaX = ', DeltaX:0:2);
      QuadVertices[0, 0] := Node.X1 + QuadSize / 3 * DeltaX;
      QuadVertices[0, 3] := (Node.X1 + QuadSize) / (2 * QuadSize);
      QuadVertices[1, 0] := Node.X2 + QuadSize / 3 * DeltaX;
      QuadVertices[1, 3] := (Node.X2 + QuadSize) / (2 * QuadSize);
      QuadVertices[2, 0] := Node.X2;
      QuadVertices[2, 3] := QuadVertices[1, 3];
      QuadVertices[3, 0] := Node.X1;
      QuadVertices[3, 3] := QuadVertices[0, 3];
    // Positionner dans l'espace
      Context.SetMatrix(TMatrix3D.CreateTranslation(Node.Position)
                      * TMatrix3D.CreateRotationY(Node.RotationY)
                      * Matrix);
      // dessiner un carré
      Context.DrawPrimitives(
        TPrimitivesKind.Triangles,
        @QuadVertices,
        @QuadIndices,
        QuadDeclarion,
        5 * SizeOf(Single), // x, y, z, u, v
        4,                  // 4 Vertices
        Sizeof(Word),
        6,                  // 6 Points (2 triangles)
        Node.Texture.Material,
        1
      );
      {$IFDEF DRAW_BOX}
      Context.DrawRect(
        TPoint3D.Create(QuadVertices[2,0],QuadVertices[0,1],QuadVertices[0,2]),
        TPoint3D.Create(QuadVertices[3,0],QuadVertices[2,1],QuadVertices[2,2]),
        1,
        TAlphaColorRec.Red
      );
      {$ENDIF}
    end;
     
    procedure TfPrincipale.DummyRender(Sender: TObject; Context: TContext3D);
    var
      Index: Integer;
      Iter : PGrass;
      DeltaX: Single;
    begin
      Ticks := Time() * 500000;
      // dessiner les deux faces
      Context.PushContextStates;
      Context.SetContextState(TContextState.csAllFace);
    {$IFNDEF USE_BSPTREE}
      Context.SetContextState(TContextState.csZWriteOff);
    {$ENDIF}
      Matrix := Context.CurrentMatrix;
      {$IFDEF USE_BSPTREE}
      RenderBSPTree(Context, Tree);
      {$ELSE}
      for Index := 0 to Length(Grass) - 1 do
      begin
        RenderNode(Context, @Grass[Index]);
      end;
      {$ENDIF}
     
      Context.PopContextStates;
    end;
     
    procedure TfPrincipale.FloatAnimationProcess(Sender: TObject);
    begin
      dummy.Repaint; // Permet de forcer le OnRender
    end;
     
    procedure TfPrincipale.FormCreate(Sender: TObject);
    var
      i : integer;
    begin
      SetLength(QuadDeclarion, 2);
      QuadDeclarion[0].Format := TVertexFormat.Vertex;
      QuadDeclarion[0].Offset := 0;
      QuadDeclarion[1].Format := TVertexFormat.TexCoord0;
      QuadDeclarion[1].Offset := 3 * SizeOf(Single);
     
      randomize;
    {$IFDEF GRASS}
      Dummy.OnRender := DummyRender; // ajout pour que ça fonctionne en copiant le code
      SetLength(Grass, 300);
      for i := 0 to Length(Grass) - 1 do
      begin
        Grass[i].X1 := - QuadSize;
        Grass[i].X2 := + QuadSize;
        Grass[i].Position.x := 30 * (Random() - 0.5);
        Grass[i].Position.y := 0;
        Grass[i].Position.z := 30 * (Random() - 0.5);
        Grass[i].RotationY := Random() * 2*PI;
        if i mod 30 = 0 then
          Grass[i].Texture := TextureMaterialSource
        else begin
          if i mod 15 = 0 then
            Grass[i].Texture := TextureMaterialSource1
          else
            Grass[i].Texture := TextureMaterialSource2;
        end;
        Grass[i].Ticks := Random(360);
      {$IFDEF USE_BSPTREE}
        if i > 0 then
          Grass[i - 1].Next := @Grass[i];
      {$ENDIF}
      end;
      {$IFDEF USE_BSPTREE}
      Tree := BuildBSPTree(@Grass[0]);
      {$ENDIF}
    {$ELSE}
      for i := 0 to 399 do  // On crée 200 TGBEGrass
      begin
        with TGBEGrass.Create(nil) do
        begin
          position.x := random(30)-15; // Un peu d'aléatoire pour les placer
          position.z := random(30)-15;
          rotationangle.Y := random(360);
          if i mod 30 = 0 then MaterialSource := TextureMaterialSource1
          else
          begin
            if i mod 15 = 0 then MaterialSource := TextureMaterialSource
            else MaterialSource := TextureMaterialSource2; // On affecte la texture
          end;
          zwrite := false;  // Pas terrible mais seul suterfuge pour pallier le problème de transparence
          width := 5;
          height := 5;
          depth := 0;
          parent := dummy;
          temps := random(1000)/1000;
        end;
      end;
    {$ENDIF}
    end;
     
    { TGrass }
     
    function TGrass.DoSplit(V1, V2: Single): PGrass;
    begin
      New(Result);
      Result.Position := Self.Position;
      Result.RotationY := Self.RotationY;
      Result.Texture := Self.Texture;
      Result.Ticks := Self.Ticks;
      Result.X2 := Self.X2;
      Result.X1 := (X2 * V1 + X1 * V2)/(V1 + V2);
      Self.X2 := Result.X1;
    end;
     
    procedure TGrass.GetLine(var A, B: TPoint3D);
    begin
      GetPoint(-1, A);
      GetPoint(+1, B);
    end;
     
    procedure TGrass.GetPoint(Side: Integer; var P: TPoint3D);
    begin
      if Side < 0 then
        P.X := X1
      else
        P.X := x2;
      P.Y := 0;
      P.Z := 0;
      P := P * TMatrix3D.CreateTranslation(Position)
             * TMatrix3D.CreateRotationY(RotationY);
    end;
     
    function TGrass.GetSide(G: PGrass; Side: Integer): Single;
    var
      A, B, C: TPoint3D;
    begin
      GetLine(A, B);
      G.GetPoint(Side, C);
      Result := (A.Z - B.Z) * (A.X - C.X) - (A.X - B.X) * (A.Z - C.Z);
    end;
     
     
    function TGrass.Origin: TPoint3D;
    begin
      Result := Position * TMatrix3D.CreateRotationY(RotationY);
    end;
     
    end.
    Developpez.com: Mes articles, forum FlashPascal
    Entreprise: Execute SARL
    Le Store Excute Store

  13. #13
    Membre éprouvé
    Bonjour,

    tout comme Guillemouze je suis surpris du résultat avec le peu de code !!
    c'est vraiment bluffant. Bravo !

    J'ai tenté le code de Paul Toth mais dès que j'active "{$DEFINE GRASS}" je n'ai plus que le fond à l'écran
    j'ai même tenté de réduire le nombre de brins
    Code :Sélectionner tout -Visualiser dans une fenêtre à part
    1
    2
    {$IFDEF GRASS}
      SetLength(Grass, 30);
    mais sans succès
    une idée ?

    Cordialement,
    @+

  14. #14
    Expert éminent sénior
    Citation Envoyé par Cirec Voir le message
    Bonjour,

    tout comme Guillemouze je suis surpris du résultat avec le peu de code !!
    c'est vraiment bluffant. Bravo !

    J'ai tenté le code de Paul Toth mais dès que j'active "{$DEFINE GRASS}" je n'ai plus que le fond à l'écran
    j'ai même tenté de réduire le nombre de brins
    Code :Sélectionner tout -Visualiser dans une fenêtre à part
    1
    2
    {$IFDEF GRASS}
      SetLength(Grass, 30);
    mais sans succès
    une idée ?

    Cordialement,
    @+
    haha, en effet, j'ai ajouté 2 ColoredTexture pour le debug, et un FloatAnimation, dont on peut ignorer les erreurs

    par contre, il faut lier Dummy.OnRender à la méthode DummyRender

    EDIT: j'ai modifié le code ci-dessus pour ajouter cette affectation par code (ça évitera les questions en double pour ceux qui n'aurait pas lu ce message)
    Developpez.com: Mes articles, forum FlashPascal
    Entreprise: Execute SARL
    Le Store Excute Store

  15. #15
    Membre émérite
    Citation Envoyé par Paul TOTH Voir le message
    je n'ai pas résisté à la tentation
    Tant mieux pour nous

    Félicitations : c'est déjà mieux effectivement.
    Mon site - Mes tutoriels - GitHub - N'oubliez pas de consulter les FAQ Delphi et les cours et tutoriels Delphi

  16. #16
    Membre éprouvé
    Citation Envoyé par Paul TOTH Voir le message
    haha, en effet, j'ai ajouté 2 ColoredTexture pour le debug, et un FloatAnimation, dont on peut ignorer les erreurs

    par contre, il faut lier Dummy.OnRender à la méthode DummyRender

    EDIT: j'ai modifié le code ci-dessus pour ajouter cette affectation par code (ça évitera les questions en double pour ceux qui n'aurait pas lu ce message)
    hahaha effectivement ça va mieux
    mais j'ai compilé le code en ligne de commande et j'ai pas eut d'avertissement à ce sujet !!
    à part le fichier *.res manquant et les variables déclarées et non utilisées rien.

    mais fournir le *.fmx aurait été plus simple
    d'autant que maintenant l'utilisation du mode debug "DRAW_BOX & COLOR_FACES" provoque une violation d'accès (logique tu me diras )

    j'y ai cru au "y a qu'a copier .."

    je vais donc le charger dans l'IDE et tenter la modif.
    [EDIT] c'est bon tout fonctionne bien que je ne sois pas certain du FloatAnimation

    Cordialement,
    @+

  17. #17
    Expert éminent sénior
    Citation Envoyé par Cirec Voir le message
    hahaha effectivement ça va mieux
    mais j'ai compilé le code en ligne de commande et j'ai pas eut d'avertissement à ce sujet !!
    à part le fichier *.res manquant et les variables déclarées et non utilisées rien.

    mais fournir le *.fmx aurait été plus simple
    d'autant que maintenant l'utilisation du mode debug "DRAW_BOX & COLOR_FACES" provoque une violation d'accès (logique tu me diras )

    j'y ai cru au "y a qu'a copier .."

    je vais donc le charger dans l'IDE et tenter la modif.
    [EDIT] c'est bon tout fonctionne bien que je ne sois pas certain du FloatAnimation

    Cordialement,
    @+
    le FloatAnimation, c'était juste une animation de 0 à 360° sur TDummy pour voir la scène sous tous les angles (en désactivant les deux existants), donc rien d'important.

    pour COLOR_FACES il suffit de poser deux TColorMaterialSource en choisissant deux couleurs différentes, ils auront directement le bon nom
    Developpez.com: Mes articles, forum FlashPascal
    Entreprise: Execute SARL
    Le Store Excute Store

  18. #18
    Expert éminent sénior
    au passage le BSP Tree peu aussi être utilisé pour optimiser l'affichage, en effet, si on détermine que la caméra tourne le dos à une face, on sait automatiquement que toutes les faces qui sont derrière celle-ci sont invisibles à l'écran et qu'il est inutile de les dessiner.
    Developpez.com: Mes articles, forum FlashPascal
    Entreprise: Execute SARL
    Le Store Excute Store

###raw>template_hook.ano_emploi###