src/game/g_gfx.pas

   1 (* Copyright (C)  DooM 2D:Forever Developers
   2  *
   3  * This program is free software: you can redistribute it and/or modify
   4  * it under the terms of the GNU General Public License as published by
   5  * the Free Software Foundation, either version 3 of the License, or
   6  * (at your option) any later version.
   7  *
   8  * This program is distributed in the hope that it will be useful,
   9  * but WITHOUT ANY WARRANTY; without even the implied warranty of
  10  * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  11  * GNU General Public License for more details.
  12  *
  13  * You should have received a copy of the GNU General Public License
  14  * along with this program.  If not, see <http://www.gnu.org/licenses/>.
  15  *)
  16 {$INCLUDE ../shared/a_modes.inc}
  17 unit g_gfx;
  18
  19 interface
  20
  21 uses
  22   e_log, g_textures;
  23
  24 const
  25   BLOOD_NORMAL = 0;
  26   BLOOD_SPARKS = 1;
  27
  28   ONCEANIM_NONE  = 0;
  29   ONCEANIM_SMOKE = 1;
  30
  31   MARK_FREE     = 0;
  32   MARK_WALL     = 1;
  33   MARK_WATER    = 2;
  34   MARK_ACID     = 4;
  35   MARK_LIFTDOWN = 8;
  36   MARK_LIFTUP   = 16;
  37   MARK_DOOR     = 32;
  38   MARK_LIFTLEFT  = 64;
  39   MARK_LIFTRIGHT = 128;
  40   MARK_BLOCKED  = MARK_WALL or MARK_DOOR;
  41   MARK_LIQUID   = MARK_WATER or MARK_ACID;
  42   MARK_LIFT     = MARK_LIFTDOWN or MARK_LIFTUP or MARK_LIFTLEFT or MARK_LIFTRIGHT;
  43
  44
  45 procedure g_GFX_Init ();
  46 procedure g_GFX_Free ();
  47
  48 procedure g_GFX_Blood (fX, fY: Integer; count: Word; vx, vy: Integer;
  49                        devX, devY: Word; cr, cg, cb: Byte; kind: Byte=BLOOD_NORMAL);
  50 procedure g_GFX_Spark (fX, fY: Integer; count: Word; angle: SmallInt; devX, devY: Byte);
  51 procedure g_GFX_Water (fX, fY: Integer; count: Word; fVelX, fVelY: Single; devX, devY, color: Byte;
  52                        simple: Boolean=false; cr: Byte=0; cg: Byte=0; cb: Byte=0);
  53 procedure g_GFX_SimpleWater (fX, fY: Integer; count: Word; fVelX, fVelY: Single; defColor, cr, cg, cb: Byte);
  54 procedure g_GFX_Bubbles (fX, fY: Integer; count: Word; devX, devY: Byte);
  55
  56 procedure g_GFX_SetMax (count: Integer);
  57 function  g_GFX_GetMax (): Integer;
  58
  59 procedure g_GFX_OnceAnim (X, Y: Integer; Anim: TAnimation; AnimType: Byte = 0);
  60
  61 procedure g_Mark (x, y, Width, Height: Integer; t: Byte; st: Boolean=true);
  62
  63 procedure g_GFX_Update ();
  64 procedure g_GFX_Draw ();
  65
  66
  67 var
  68   gpart_dbg_enabled: Boolean = true;
  69   gpart_dbg_phys_enabled: Boolean = true;
  70
  71
  72 implementation
  73
  74 uses
  75   g_map, g_panel, g_basic, Math, e_graphics, GL, GLExt,
  76   g_options, g_console, SysUtils, g_triggers, MAPDEF,
  77   g_game, g_language, g_net, utils, xprofiler;
  78
  79
  80 const
  81   Unknown = Integer($7fffffff);
  82
  83
  84 type
  85   TPartType = (Blood, Spark, Bubbles, Water);
  86   TPartState = (Free, Normal, Stuck, Sleeping);
  87   TFloorType = (Wall, LiquidIn, LiquidOut);
  88     // Wall: floorY is just before floor
  89     // LiquidIn: floorY is liquid *start* (i.e. just in a liquid)
  90     // LiquidOut: floorY is liquid *end* (i.e. just out of a liquid)
  91   TEnvType = (EAir, ELiquid, EWall); // where particle is now
  92
  93   // note: this MUST be record, so we can keep it in
  94   // dynamic array and has sequential memory access pattern
  95   PParticle = ^TParticle;
  96   TParticle = record
  97     x, y: Integer;
  98     velX, velY: Single;
  99     accelX, accelY: Single;
 100     state: TPartState;
 101     particleType: TPartType;
 102     red, green, blue: Byte;
 103     alpha: Byte;
 104     time, liveTime: Word;
 105     stickDX: Integer; // STATE_STICK: -1,1: stuck to a wall; 0: stuck to ceiling
 106     justSticked: Boolean; // not used
 107     floorY: Integer; // actually, floor-1; `Unknown`: unknown
 108     floorType: TFloorType;
 109     env: TEnvType; // where particle is now
 110     ceilingY: Integer; // actually, ceiling+1; `Unknown`: unknown
 111     wallEndY: Integer; // if we stuck to a wall, this is where wall ends
 112
 113     //k8: sorry, i have to emulate virtual methods this way, 'cause i haet `Object`
 114     procedure thinkerBloodAndWater ();
 115     procedure thinkerSpark ();
 116     procedure thinkerBubble ();
 117
 118     procedure findFloor (force: Boolean=false); // this updates `floorY` if forced or Unknown
 119     procedure findCeiling (force: Boolean=false); // this updates `ceilingY` if forced or Unknown
 120
 121     procedure freeze (); inline; // remove velocities and acceleration
 122     procedure sleep (); inline; // switch to sleep mode
 123
 124     function checkAirStreams (): Boolean; // `true`: affected by air stream
 125
 126     function alive (): Boolean; inline;
 127     procedure die (); inline;
 128     procedure think (); inline;
 129   end;
 130
 131   TOnceAnim = record
 132     AnimType:   Byte;
 133     x, y:       Integer;
 134     Animation:  TAnimation;
 135   end;
 136
 137
 138 var
 139   Particles: array of TParticle = nil;
 140   OnceAnims: array of TOnceAnim = nil;
 141   MaxParticles: Integer = 0;
 142   CurrentParticle: Integer = 0;
 143   // awakeMap has one bit for each map grid cell; on g_Mark,
 144   // corresponding bits will be set, and in `think()` all particles
 145   // in marked cells will be awaken
 146   awakeMap: packed array of LongWord = nil;
 147   awakeMapH: Integer = -1;
 148   awakeMapW: Integer = -1;
 149   awakeMinX, awakeMinY: Integer;
 150   awakeDirty: Boolean = false;
 151
 152
 153 // ////////////////////////////////////////////////////////////////////////// //
 154 // HACK! using mapgrid
 155 procedure awmClear (); inline;
 156 begin
 157   if awakeDirty and (awakeMapW > 0) then
 158   begin
 159     FillDWord(awakeMap[0], Length(awakeMap), 0);
 160     awakeDirty := false;
 161   end;
 162 end;
 163
 164
 165 procedure awmSetup ();
 166 begin
 167   assert(mapGrid <> nil);
 168   awakeMapW := (mapGrid.gridWidth+mapGrid.tileSize-1) div mapGrid.tileSize;
 169   awakeMapW := (awakeMapW+31) div 32; // LongWord has 32 bits ;-)
 170   awakeMapH := (mapGrid.gridHeight+mapGrid.tileSize-1) div mapGrid.tileSize;
 171   awakeMinX := mapGrid.gridX0;
 172   awakeMinY := mapGrid.gridY0;
 173   SetLength(awakeMap, awakeMapW*awakeMapH);
 174   {$IF DEFINED(D2F_DEBUG)}
 175   e_LogWritefln('particle awake map: %sx%s (for grid of size %sx%s)', [awakeMapW, awakeMapH, mapGrid.gridWidth, mapGrid.gridHeight]);
 176   {$ENDIF}
 177   awakeDirty := true;
 178   awmClear();
 179 end;
 180
 181
 182 function awmIsSet (x, y: Integer): Boolean; inline;
 183 begin
 184   x := (x-awakeMinX) div mapGrid.tileSize;
 185   y := (y-awakeMinY) div mapGrid.tileSize;
 186   if (x >= 0) and (y >= 0) and (x div 32 < awakeMapW) and (y < awakeMapH) then
 187   begin
 188     {$IF DEFINED(D2F_DEBUG)}
 189     assert(y*awakeMapW+x div 32 < Length(awakeMap));
 190     {$ENDIF}
 191     result := ((awakeMap[y*awakeMapW+x div 32] and (LongWord(1) shl (x mod 32))) <> 0);
 192   end
 193   else
 194   begin
 195     result := false;
 196   end;
 197 end;
 198
 199
 200 procedure awmSet (x, y: Integer); inline;
 201 var
 202   v: PLongWord;
 203 begin
 204   x := (x-awakeMinX) div mapGrid.tileSize;
 205   y := (y-awakeMinY) div mapGrid.tileSize;
 206   if (x >= 0) and (y >= 0) and (x div 32 < awakeMapW) and (y < awakeMapH) then
 207   begin
 208     {$IF DEFINED(D2F_DEBUG)}
 209     assert(y*awakeMapW+x div 32 < Length(awakeMap));
 210     {$ENDIF}
 211     v := @awakeMap[y*awakeMapW+x div 32];
 212     v^ := v^ or (LongWord(1) shl (x mod 32));
 213     awakeDirty := true;
 214   end;
 215 end;
 216
 217
 218 // ////////////////////////////////////////////////////////////////////////// //
 219 function TParticle.alive (): Boolean; inline; begin result := (state <> TPartState.Free); end;
 220 procedure TParticle.die (); inline; begin state := TPartState.Free; end;
 221
 222 // remove velocities and acceleration
 223 procedure TParticle.freeze (); inline;
 224 begin
 225   // stop right there, you criminal scum!
 226   velX := 0;
 227   velY := 0;
 228   accelX := 0;
 229   accelY := 0;
 230 end;
 231
 232
 233 // `true`: affected by air stream
 234 function TParticle.checkAirStreams (): Boolean;
 235 var
 236   pan: TPanel;
 237 begin
 238   pan := g_Map_PanelAtPoint(x, y, GridTagLift);
 239   result := (pan <> nil);
 240   if result then
 241   begin
 242     if ((pan.PanelType and PANEL_LIFTUP) <> 0) then
 243     begin
 244       if (velY > -4-Random(3)) then velY -= 0.8;
 245       if (abs(velX) > 0.1) then velX -= velX/10.0;
 246       velX += (Random-Random)*0.2;
 247       accelY := 0.15;
 248     end
 249     else if ((pan.PanelType and PANEL_LIFTLEFT) <> 0) then
 250     begin
 251       if (velX > -8-Random(3)) then velX -= 0.8;
 252       accelY := 0.15;
 253     end
 254     else if ((pan.PanelType and PANEL_LIFTRIGHT) <> 0) then
 255     begin
 256       if (velX < 8+Random(3)) then velX += 0.8;
 257       accelY := 0.15;
 258     end
 259     else
 260     begin
 261       result := false;
 262     end;
 263     // awake
 264     if result and (state = TPartState.Sleeping) then state := TPartState.Normal;
 265   end;
 266 end;
 267
 268
 269 // switch to sleep mode
 270 procedure TParticle.sleep (); inline;
 271 begin
 272   if not checkAirStreams() then
 273   begin
 274     state := TPartState.Sleeping;
 275     freeze();
 276   end;
 277 end;
 278
 279
 280 procedure TParticle.findFloor (force: Boolean=false);
 281 var
 282   ex: Integer;
 283   pan: TPanel;
 284 begin
 285   if (not force) and (floorY <> Unknown) then exit;
 286   // stuck in the wall? rescan, 'cause it can be mplat
 287   if (env = TEnvType.EWall) then
 288   begin
 289     pan := g_Map_PanelAtPoint(x, y, (GridTagObstacle or GridTagLiquid));
 290     if (pan <> nil) then
 291     begin
 292       // either in a wall, or in a liquid
 293       if ((pan.tag and GridTagObstacle) <> 0) then
 294       begin
 295         // we are in the wall, wtf?!
 296         floorY := y;
 297         env := TEnvType.EWall;
 298         floorType := TFloorType.Wall;
 299         state := TPartState.Sleeping; // anyway
 300         exit;
 301       end;
 302       // we are in liquid, trace to liquid end
 303       env := TEnvType.ELiquid;
 304     end;
 305   end;
 306   // are we in a liquid?
 307   if (env = TEnvType.ELiquid) then
 308   begin
 309     // trace out of the liquid
 310     //env := TEnvType.ELiquid;
 311     floorType := TFloorType.LiquidOut;
 312     //e_LogWritefln('tracing out of a liquid; floorY=%s; y=%s', [floorY, y]);
 313     mapGrid.traceOrthoRayWhileIn(ex, floorY, x, y, x, g_Map_MaxY, GridTagLiquid);
 314     floorY += 1; // so `floorY` is just out of a liquid
 315     //e_LogWritefln('  traced out of a liquid; floorY=%s; y=%s', [floorY, y]);
 316   end
 317   else
 318   begin
 319     // in the air
 320     assert(env = TEnvType.EAir);
 321     //env := TEnvType.EAir;
 322     pan := g_Map_traceToNearest(x, y, x, g_Map_MaxY, (GridTagObstacle or GridTagLiquid), @ex, @floorY);
 323     if (pan <> nil) then
 324     begin
 325       // wall or liquid
 326       if ((pan.tag and GridTagObstacle) <> 0) then
 327       begin
 328         // wall
 329         floorType := TFloorType.Wall;
 330       end
 331       else
 332       begin
 333         // liquid
 334         floorType := TFloorType.LiquidIn; // entering liquid
 335         floorY += 1; // so `floorY` is just in a liquid
 336       end;
 337     end
 338     else
 339     begin
 340       // out of the level; assume wall, but it doesn't really matter
 341       floorType := TFloorType.Wall;
 342       floorY := g_Map_MaxY+2;
 343     end;
 344   end;
 345 end;
 346
 347
 348 procedure TParticle.findCeiling (force: Boolean=false);
 349 var
 350   ex: Integer;
 351 begin
 352   if (not force) and (ceilingY <> Unknown) then exit;
 353   if (nil = g_Map_traceToNearest(x, y, x, g_Map_MinY, GridTagObstacle, @ex, @ceilingY)) then
 354   begin
 355     ceilingY := g_Map_MinY-2;
 356   end;
 357 end;
 358
 359
 360 procedure TParticle.think (); inline;
 361   procedure awake ();
 362   begin
 363     state := TPartState.Normal;
 364     floorY := Unknown;
 365     ceilingY := Unknown;
 366     wallEndY := Unknown;
 367     if (velY = 0) then velY := 0.1;
 368     if (accelY = 0) then accelY := 0.5;
 369   end;
 370
 371 begin
 372   // awake sleeping particle, if necessary
 373   if awakeDirty then
 374   begin
 375     case state of
 376       TPartState.Sleeping, TPartState.Stuck:
 377         if awmIsSet(x, y) then awake();
 378       else
 379         if (env = TEnvType.EWall) and awmIsSet(x, y) then awake();
 380     end;
 381   end;
 382   case particleType of
 383     TPartType.Blood, TPartType.Water: thinkerBloodAndWater();
 384     TPartType.Spark: thinkerSpark();
 385     TPartType.Bubbles: thinkerBubble();
 386   end;
 387 end;
 388
 389
 390 // ////////////////////////////////////////////////////////////////////////// //
 391 procedure TParticle.thinkerBloodAndWater ();
 392   procedure stickToCeiling ();
 393   begin
 394     state := TPartState.Stuck;
 395     stickDX := 0;
 396     freeze();
 397     ceilingY := y; // yep
 398   end;
 399
 400   procedure stickToWall (dx: Integer);
 401   var
 402     ex: Integer;
 403   begin
 404     state := TPartState.Stuck;
 405     if (dX > 0) then stickDX := 1 else stickDX := -1;
 406     freeze();
 407     // find next floor transition
 408     findFloor();
 409     // find `wallEndY`
 410     mapGrid.traceOrthoRayWhileIn(ex, wallEndY, x+stickDX, y, x+stickDX, floorY+1, (GridTagWall or GridTagDoor or GridTagStep));
 411   end;
 412
 413   procedure hitAFloor ();
 414   begin
 415     state := TPartState.Sleeping; // we aren't moving anymore
 416     freeze();
 417     floorY := y; // yep
 418     floorType := TFloorType.Wall; // yep
 419   end;
 420
 421   // `true`: didn't, get outa thinker
 422   function drip (): Boolean;
 423   begin
 424     case particleType of
 425       TPartType.Blood: result := (Random(200) = 100);
 426       TPartType.Water: result := (Random(30) = 15);
 427       else raise Exception.Create('internal error in particle engine: drip');
 428     end;
 429     if result then
 430     begin
 431       velY := 0.5;
 432       accelY := 0.15;
 433       // if we're falling from ceiling, switch to normal mode
 434       if (state = TPartState.Stuck) and (stickDX = 0) then state := TPartState.Normal;
 435     end;
 436   end;
 437
 438   // switch to freefall mode
 439   procedure freefall ();
 440   begin
 441     state := TPartState.Normal;
 442     velY := 0.5;
 443     accelY := 0.15;
 444   end;
 445
 446   procedure applyGravity (inLiquid: Boolean);
 447   begin
 448     state := TPartState.Normal;
 449     if inLiquid then
 450     begin
 451       velY := 0.5;
 452       accelY := 0.15;
 453     end
 454     else
 455     begin
 456       velY := 0.8;
 457       accelY := 0.5;
 458     end;
 459   end;
 460
 461 label
 462   _done, _gravityagain, _stuckagain;
 463 var
 464   pan: TPanel;
 465   dX, dY: SmallInt;
 466   ex, ey: Integer;
 467   checkEnv: Boolean;
 468   floorJustTraced: Boolean;
 469 begin
 470   if not gpart_dbg_phys_enabled then goto _done;
 471
 472   if gAdvBlood then
 473   begin
 474     // still check for air streams when sleeping (no)
 475     if (state = TPartState.Sleeping) then begin {checkAirStreams();} goto _done; end; // so blood will dissolve
 476
 477     // process stuck particles
 478     if (state = TPartState.Stuck) then
 479     begin
 480       // stuck to a ceiling?
 481       if (stickDX = 0) then
 482       begin
 483         // yeah, stuck to a ceiling
 484         assert(ceilingY <> Unknown);
 485         // dropped from a ceiling?
 486         if (y > ceilingY) then
 487         begin
 488           // yep
 489           velY := 0.5;
 490           accelY := 0.15;
 491           state := TPartState.Normal;
 492         end
 493         else
 494         begin
 495           // otherwise, try to drip
 496           if drip() then goto _done;
 497         end;
 498       end
 499       else
 500       begin
 501         // stuck to a wall
 502         if (wallEndY = Unknown) then
 503         begin
 504           // this can happen if mplat was moved out; find new `wallEndY`
 505           findFloor(true); // force trace, just in case
 506           if (floorType = TFloorType.LiquidOut) then env := TEnvType.ELiquid else env := TEnvType.EAir;
 507           mapGrid.traceOrthoRayWhileIn(ex, wallEndY, x+stickDX, y, x+stickDX, floorY+1, (GridTagWall or GridTagDoor or GridTagStep));
 508         end;
 509        _stuckagain:
 510         // floor transition?
 511         if (wallEndY <= floorY) and (y >= floorY) then
 512         begin
 513           y := floorY;
 514           case floorType of
 515             TFloorType.Wall: // hit the ground
 516               begin
 517                 // check if our ground wasn't moved since the last scan
 518                 findFloor(true); // force trace
 519                 if (y = floorY) then
 520                 begin
 521                   sleep();
 522                   goto _done; // nothing to do anymore
 523                 end;
 524                 // otherwise, do it again
 525                 goto _stuckagain;
 526               end;
 527             TFloorType.LiquidIn: // entering the liquid
 528               begin
 529                 // rescan, so we'll know when we'll exit the liquid
 530                 findFloor(true); // force rescan
 531               end;
 532             TFloorType.LiquidOut: // exiting the liquid
 533               begin
 534                 // rescan, so we'll know when we'll enter something interesting
 535                 findFloor(true); // force rescan
 536                 if (floorType = TFloorType.Wall) and (floorY = y) then begin sleep(); goto _done; end;
 537               end;
 538           end;
 539         end;
 540         // wall transition?
 541         if (floorY <= wallEndY) and (y >= wallEndY) then
 542         begin
 543           // just unstuck from the wall, switch to freefall mode
 544           y := wallEndY;
 545           freefall();
 546         end
 547         else
 548         begin
 549           // otherwise, try to drip
 550           if drip() then goto _done;
 551         end;
 552       end;
 553       // nope, process as usual
 554     end;
 555
 556     // it is important to have it here
 557     dX := round(velX);
 558     dY := round(velY);
 559
 560     if (state = TPartState.Normal) then checkAirStreams();
 561
 562     // gravity, if not stuck
 563     if (state <> TPartState.Stuck) and (abs(velX) < 0.1) and (abs(velY) < 0.1) then
 564     begin
 565       floorJustTraced := (floorY = Unknown);
 566       if floorJustTraced then findFloor();
 567      _gravityagain:
 568       // floor transition?
 569       if (y = floorY) then
 570       begin
 571         case floorType of
 572           TFloorType.Wall: // hit the ground
 573             begin
 574               // check if our ground wasn't moved since the last scan
 575               if not floorJustTraced then
 576               begin
 577                 findFloor(true); // force trace
 578                 if (floorType = TFloorType.LiquidOut) then env := TEnvType.ELiquid else env := TEnvType.EAir;
 579                 if (y <> floorY) then goto _gravityagain;
 580               end;
 581               // otherwise, nothing to do
 582             end;
 583           TFloorType.LiquidIn: // entering the liquid
 584             begin
 585               // rescan, so we'll know when we'll exit the liquid
 586               findFloor(true); // force rescan
 587               applyGravity(true);
 588             end;
 589           TFloorType.LiquidOut: // exiting the liquid
 590             begin
 591               // rescan, so we'll know when we'll enter something interesting
 592               findFloor(true); // force rescan
 593               if (floorType <> TFloorType.Wall) or (floorY <> y) then applyGravity(floorType = TFloorType.LiquidIn);
 594             end;
 595         end;
 596       end
 597       else
 598       begin
 599         // looks like we're in the air
 600         applyGravity(false);
 601       end;
 602     end;
 603
 604     // trace movement
 605     if (dX <> 0) then
 606     begin
 607       // has some horizontal velocity
 608       pan := g_Map_traceToNearest(x, y, x+dX, y+dY, GridTagObstacle, @ex, @ey);
 609       checkEnv := (x <> ex);
 610       x := ex;
 611       y := ey;
 612       if checkEnv then
 613       begin
 614         // dunno yet
 615         floorY := Unknown;
 616         ceilingY := Unknown;
 617         // check environment (air/liquid)
 618         if (g_Map_PanelAtPoint(x, y, GridTagLiquid) <> nil) then env := TEnvType.ELiquid else env := TEnvType.EAir;
 619       end;
 620       if (pan <> nil) then
 621       begin
 622         // we stuck
 623         // the only case when we can have both ceiling and wall is corner; stick to wall in this case
 624         // check if we stuck to a wall
 625         if (dX < 0) then dX := -1 else dX := 1;
 626         if (g_Map_PanelAtPoint(x+dX, y, GridTagObstacle) <> nil) then
 627         begin
 628           // stuck to a wall
 629           stickToWall(dX);
 630         end
 631         else
 632         begin
 633           // stuck to a ceiling
 634           stickToCeiling();
 635         end;
 636       end;
 637     end
 638     else if (dY <> 0) then
 639     begin
 640       // has only vertical velocity
 641       if (dY < 0) then
 642       begin
 643         // flying up
 644         if (ceilingY = Unknown) then findCeiling(); // need to do this anyway
 645         y += dY;
 646         if (y <= ceilingY) then begin y := ceilingY; stickToCeiling(); end; // oops, hit a ceiling
 647         // environment didn't changed
 648       end
 649       else
 650       begin
 651         while (dY > 0) do
 652         begin
 653           // falling down
 654           floorJustTraced := (floorY = Unknown);
 655           if floorJustTraced then findFloor();
 656           if (floorType = TFloorType.LiquidOut) then env := TEnvType.ELiquid else env := TEnvType.EAir;
 657           y += dY;
 658           //e_LogWritefln('floorY=%s; newy=%s; dY=%s; floorType=%s', [floorY, y, dY, floorType]);
 659           if (y >= floorY) then
 660           begin
 661             // floor transition
 662             dY := y-floorY;
 663             y := floorY;
 664             //e_LogWritefln('  HIT FLOORY: floorY=%s; newy=%s; dY=%s; floorType=%s', [floorY, y, dY, floorType]);
 665             case floorType of
 666               TFloorType.Wall: // hit the ground
 667                 begin
 668                   // check if our ground wasn't moved since the last scan
 669                   if not floorJustTraced then
 670                   begin
 671                     e_LogWritefln('force rescanning vpart at (%d,%d); floorY=%d', [x, y, floorY]);
 672                     findFloor(true); // force trace
 673                     e_LogWritefln('  rescanned vpart at (%d,%d); floorY=%d', [x, y, floorY]);
 674                     if (floorType = TFloorType.LiquidOut) then env := TEnvType.ELiquid else env := TEnvType.EAir;
 675                     if (y <> floorY) then continue;
 676                   end;
 677                   // environment didn't changed
 678                   hitAFloor();
 679                   break; // done with vertical movement
 680                 end;
 681               TFloorType.LiquidIn: // entering the liquid
 682                 begin
 683                   // we're entered the liquid
 684                   env := TEnvType.ELiquid;
 685                   // rescan, so we'll know when we'll exit the liquid
 686                   findFloor(true); // force rescan
 687                 end;
 688               TFloorType.LiquidOut: // exiting the liquid
 689                 begin
 690                   // we're exited the liquid
 691                   env := TEnvType.EAir;
 692                   // rescan, so we'll know when we'll enter something interesting
 693                   findFloor(true); // force rescan
 694                   if (floorType = TFloorType.Wall) and (floorY = y) then
 695                   begin
 696                     hitAFloor();
 697                     break; // done with vertical movement
 698                   end;
 699                 end;
 700             end;
 701           end
 702           else
 703           begin
 704             break; // done with vertical movement
 705           end;
 706         end;
 707       end;
 708     end;
 709   end // if gAdvBlood
 710   else
 711   begin
 712     // simple blood
 713     dX := round(velX);
 714     dY := round(velY);
 715     y += dY;
 716     x += dX;
 717     if (g_Map_PanelAtPoint(x, y, GridTagObstacle) <> nil) then begin die(); exit; end;
 718   end;
 719
 720 _done:
 721   if (x < g_Map_MinX) or (y < g_Map_MinY) or (x > g_Map_MaxX) or (y > g_Map_MaxY) then begin die(); end;
 722
 723   velX += accelX;
 724   velY += accelY;
 725
 726   // blood will dissolve in other liquids
 727   if (particleType = TPartType.Blood) then
 728   begin
 729     if (env = TEnvType.ELiquid) then
 730     begin
 731       time += 1;
 732       if (liveTime <= 0) then begin die(); exit; end;
 733       ex := 255-trunc(255.0*time/liveTime);
 734       if (ex <= 10) then begin die(); exit; end;
 735       if (ex > 250) then ex := 255;
 736       alpha := Byte(ex);
 737     end;
 738   end
 739   else
 740   begin
 741     // water will disappear in any liquid
 742     if (env = TEnvType.ELiquid) then begin die(); exit; end;
 743     time += 1;
 744     // dry water
 745     if (liveTime <= 0) then begin die(); exit; end;
 746     ex := 255-trunc(255.0*time/liveTime);
 747     if (ex <= 10) then begin die(); exit; end;
 748     if (ex > 250) then ex := 255;
 749     alpha := Byte(ex);
 750   end;
 751 end;
 752
 753
 754 // ////////////////////////////////////////////////////////////////////////// //
 755 procedure g_GFX_SparkVel (fX, fY: Integer; count: Word; vx, vy: Integer; devX, devY: Byte); forward;
 756
 757 procedure g_GFX_Blood (fX, fY: Integer; count: Word; vx, vy: Integer;
 758                        devX, devY: Word; cr, cg, cb: Byte; kind: Byte = BLOOD_NORMAL);
 759
 760   function genColor (cbase, crnd: Integer; def: Byte=0): Byte;
 761   begin
 762     if (cbase > 0) then
 763     begin
 764       cbase += crnd;
 765            if (cbase < 0) then result := 0
 766       else if (cbase > 255) then result := 255
 767       else result := Byte(cbase);
 768     end
 769     else
 770     begin
 771       result := def;
 772     end;
 773   end;
 774
 775 var
 776   a: Integer;
 777   devX1, devX2, devY1, devY2: Integer;
 778   l: Integer;
 779   crnd: Integer;
 780   pan: TPanel;
 781 begin
 782   if not gpart_dbg_enabled then exit;
 783
 784   if (kind = BLOOD_SPARKS) then
 785   begin
 786     g_GFX_SparkVel(fX, fY, 2+Random(2), -vx div 2, -vy div 2, devX, devY);
 787     exit;
 788   end;
 789
 790   l := Length(Particles);
 791   if (l = 0) then exit;
 792   if (count > l) then count := l;
 793
 794   devX1 := devX div 2;
 795   devX2 := devX+1;
 796   devY1 := devY div 2;
 797   devY2 := devY+1;
 798
 799   for a := 1 to count do
 800   begin
 801     with Particles[CurrentParticle] do
 802     begin
 803       x := fX-devX1+Random(devX2);
 804       y := fY-devY1+Random(devY2);
 805
 806       // check for level bounds
 807       if (x < g_Map_MinX) or (y < g_Map_MinY) or (x > g_Map_MaxX) or (y > g_Map_MaxY) then continue;
 808
 809       // in what environment we are starting in?
 810       pan := g_Map_PanelAtPoint(x, y, (GridTagObstacle or GridTagLiquid));
 811       if (pan <> nil) then
 812       begin
 813         // either in a wall, or in a liquid
 814         if ((pan.tag and GridTagObstacle) <> 0) then continue; // don't spawn in walls
 815         env := TEnvType.ELiquid;
 816       end
 817       else
 818       begin
 819         env := TEnvType.EAir;
 820       end;
 821
 822       velX := vx+(Random-Random)*3;
 823       velY := vy+(Random-Random)*3;
 824
 825       if (velY > -4) then
 826       begin
 827         if (velY-4 < -4) then velY := -4 else velY := velY-4;
 828       end;
 829
 830       accelX := -sign(velX)*Random/100;
 831       accelY := 0.8;
 832
 833       crnd := 20*Random(6)-50;
 834
 835       red := genColor(cr, CRnd, 0);
 836       green := genColor(cg, CRnd, 0);
 837       blue := genColor(cb, CRnd, 0);
 838       alpha := 255;
 839
 840       particleType := TPartType.Blood;
 841       state := TPartState.Normal;
 842       time := 0;
 843       liveTime := 120+Random(40);
 844       floorY := Unknown;
 845       ceilingY := Unknown;
 846     end;
 847
 848     if (CurrentParticle >= MaxParticles-1) then CurrentParticle := 0 else CurrentParticle += 1;
 849   end;
 850 end;
 851
 852
 853 procedure g_GFX_Water (fX, fY: Integer; count: Word; fVelX, fVelY: Single; devX, devY, color: Byte;
 854                        simple: Boolean=false; cr: Byte=0; cg: Byte=0; cb: Byte=0);
 855 var
 856   a: Integer;
 857   devX1, devX2, devY1, devY2: Integer;
 858   l: Integer;
 859   pan: TPanel;
 860 begin
 861   if not gpart_dbg_enabled then exit;
 862
 863   l := Length(Particles);
 864   if (l = 0) then exit;
 865   if (count > l) then count := l;
 866
 867   if (abs(fVelX) < 3.0) then fVelX := 3.0-6.0*Random;
 868
 869   devX1 := devX div 2;
 870   devX2 := devX+1;
 871   devY1 := devY div 2;
 872   devY2 := devY+1;
 873
 874   if (not simple) and (color > 3) then color := 0;
 875
 876   for a := 1 to count do
 877   begin
 878     with Particles[CurrentParticle] do
 879     begin
 880       if not simple then
 881       begin
 882         x := fX-devX1+Random(devX2);
 883         y := fY-devY1+Random(devY2);
 884
 885         if (abs(fVelX) < 0.5) then velX := 1.0-2.0*Random else velX := fVelX*Random;
 886         if (Random(10) < 7) then velX := -velX;
 887         velY := fVelY*Random;
 888         accelX := 0.0;
 889         accelY := 0.8;
 890       end
 891       else
 892       begin
 893         x := fX;
 894         y := fY;
 895
 896         velX := fVelX;
 897         velY := fVelY;
 898         accelX := 0.0;
 899         accelY := 0.8;
 900       end;
 901
 902       // check for level bounds
 903       if (x < g_Map_MinX) or (y < g_Map_MinY) or (x > g_Map_MaxX) or (y > g_Map_MaxY) then continue;
 904
 905       // this hack will allow water spawned in water to fly out
 906       // it can happen when player fell from a huge height (see "DOOM2D.WAD:\MAP03", for example)
 907       if (fVelY >= 0) then
 908       begin
 909         // in what environment we are starting in?
 910         pan := g_Map_PanelAtPoint(x, y, (GridTagObstacle or GridTagLiquid));
 911       end
 912       else
 913       begin
 914         pan := g_Map_PanelAtPoint(x, y, GridTagObstacle);
 915       end;
 916       if (pan <> nil) then continue;
 917       env := TEnvType.EAir;
 918
 919       // color
 920       case color of
 921         1: // reddish
 922           begin
 923             red := 155+Random(9)*10;
 924             green := trunc(150*Random);
 925             blue := green;
 926           end;
 927         2: // greenish
 928           begin
 929             red := trunc(150*Random);
 930             green := 175+Random(9)*10;
 931             blue := red;
 932           end;
 933         3: // bluish
 934           begin
 935             red := trunc(200*Random);
 936             green := red;
 937             blue := 175+Random(9)*10;
 938           end;
 939         4: // Ñâîé öâåò, ñâåòëåå
 940           begin
 941             red := 20+Random(19)*10;
 942             green := red;
 943             blue := red;
 944             red := nmin(red+cr, 255);
 945             green := nmin(green+cg, 255);
 946             blue := nmin(blue+cb, 255);
 947           end;
 948         5: // Ñâîé öâåò, òåìíåå
 949           begin
 950             red := 20+Random(19)*10;
 951             green := red;
 952             blue := red;
 953             red := nmax(cr-red, 0);
 954             green := nmax(cg-green, 0);
 955             blue := nmax(cb-blue, 0);
 956           end;
 957         else // grayish
 958           begin
 959             red := 90+random(12)*10;
 960             green := red;
 961             blue := red;
 962           end;
 963       end;
 964       alpha := 255;
 965
 966       particleType := TPartType.Water;
 967       state := TPartState.Normal;
 968       time := 0;
 969       liveTime := 60+Random(60);
 970       floorY := Unknown;
 971       ceilingY := Unknown;
 972     end;
 973
 974     if (CurrentParticle >= MaxParticles-1) then CurrentParticle := 0 else CurrentParticle += 1;
 975   end;
 976 end;
 977
 978
 979 procedure g_GFX_SimpleWater (fX, fY: Integer; count: Word; fVelX, fVelY: Single; defColor, cr, cg, cb: Byte);
 980 begin
 981   g_GFX_Water(fX, fY, count, 0, 0, 0, 0, defColor, true, cr, cg, cb);
 982 end;
 983
 984
 985 // ////////////////////////////////////////////////////////////////////////// //
 986 procedure TParticle.thinkerBubble ();
 987 var
 988   dY: Integer;
 989 begin
 990   dY := round(velY);
 991
 992   if (dY <> 0) then
 993   begin
 994     y += dY;
 995     if (dY < 0) then
 996     begin
 997       if (y <= ceilingY) then begin die(); exit; end;
 998     end
 999     else
1000     begin
1001       if (y >= floorY) then begin die(); exit; end;
1002     end;
1003     if (y < g_Map_MinY) or (y > g_Map_MaxY) then begin die(); exit; end;
1004   end;
1005
1006   if (velY > -4) then velY += accelY;
1007
1008   time += 1;
1009 end;
1010
1011
1012 {.$DEFINE D2F_DEBUG_BUBBLES}
1013 procedure g_GFX_Bubbles (fX, fY: Integer; count: Word; devX, devY: Byte);
1014 var
1015   a, liquidx: Integer;
1016   devX1, devX2, devY1, devY2: Integer;
1017   l: Integer;
1018   {$IF DEFINED(D2F_DEBUG_BUBBLES)}
1019   stt: UInt64;
1020   nptr, ptr: Boolean;
1021   {$ENDIF}
1022 begin
1023   if not gpart_dbg_enabled then exit;
1024
1025   l := Length(Particles);
1026   if (l = 0) then exit;
1027   if (count > l) then count := l;
1028
1029   devX1 := devX div 2;
1030   devX2 := devX+1;
1031   devY1 := devY div 2;
1032   devY2 := devY+1;
1033
1034   for a := 1 to count do
1035   begin
1036     with Particles[CurrentParticle] do
1037     begin
1038       x := fX-devX1+Random(devX2);
1039       y := fY-devY1+Random(devY2);
1040
1041       // check for level bounds
1042       if (x < g_Map_MinX) or (y < g_Map_MinY) or (x > g_Map_MaxX) or (y > g_Map_MaxY) then continue;
1043
1044       (*
1045       // don't spawn bubbles outside of the liquid
1046       if not isLiquidAt(X, Y) {ByteBool(gCollideMap[Y, X] and MARK_LIQUID)} then
1047         Continue;
1048       *)
1049
1050       // trace liquid, so we'll know where it ends; do it in 8px steps for speed
1051       // tracer will return `false` if we started outside of the liquid
1052
1053       {$IF DEFINED(D2F_DEBUG_BUBBLES)}
1054       stt := curTimeMicro();
1055       ptr := mapGrid.traceOrthoRayWhileIn(liquidx, liquidTopY, x, y, x, 0, GridTagWater or GridTagAcid1 or GridTagAcid2);
1056       stt := curTimeMicro()-stt;
1057       e_LogWritefln('traceOrthoRayWhileIn: time=%s (%s); liquidTopY=%s', [Integer(stt), ptr, liquidTopY]);
1058       //
1059       stt := curTimeMicro();
1060       nptr := g_Map_TraceLiquidNonPrecise(x, y, 0, -8, liquidx, liquidTopY);
1061       stt := curTimeMicro()-stt;
1062       e_LogWritefln('g_Map_TraceLiquidNonPrecise: time=%s (%s); liquidTopY=%s', [Integer(stt), nptr, liquidTopY]);
1063       if not nptr then continue;
1064       {$ELSE}
1065       if not g_Map_TraceLiquidNonPrecise(x, y, 0, -8, liquidx, ceilingY) then continue;
1066       if not g_Map_TraceLiquidNonPrecise(x, y, 0, +8, liquidx, floorY) then continue;
1067       {$ENDIF}
1068
1069       velX := 0;
1070       velY := -1-Random;
1071       accelX := 0;
1072       accelY := velY/10;
1073
1074       red := 255;
1075       green := 255;
1076       blue := 255;
1077       alpha := 255;
1078
1079       state := TPartState.Normal;
1080       particleType := TPartType.Bubbles;
1081       time := 0;
1082       liveTime := 65535;
1083     end;
1084
1085     if (CurrentParticle >= MaxParticles-1) then CurrentParticle := 0 else CurrentParticle += 1;
1086   end;
1087 end;
1088
1089
1090 // ////////////////////////////////////////////////////////////////////////// //
1091 procedure TParticle.thinkerSpark ();
1092 label
1093   _done;
1094 var
1095   dX, dY: SmallInt;
1096   pan: TPanel;
1097   ex, ey: Integer;
1098 begin
1099   if not gpart_dbg_phys_enabled then goto _done;
1100
1101   dX := round(velX);
1102   dY := round(velY);
1103
1104   // apply gravity
1105   if (abs(velX) < 0.1) and (abs(velY) < 0.1) then
1106   begin
1107     velY := 0.8;
1108     accelY := 0.5;
1109   end;
1110
1111   // flying
1112   if (dX <> 0) then
1113   begin
1114     // has some horizontal velocity
1115     pan := g_Map_traceToNearest(x, y, x+dX, y+dY, (GridTagObstacle or GridTagLiquid), @ex, @ey);
1116     if (x <> ex) then begin floorY := Unknown; ceilingY := Unknown; end; // dunno yet
1117     x := ex;
1118     y := ey;
1119     if (pan <> nil) then
1120     begin
1121       if ((pan.tag and GridTagLiquid) <> 0) then begin die(); exit; end; // die in liquid
1122       // hit the wall; falling down vertically
1123       velX := 0;
1124       accelX := 0;
1125     end;
1126   end
1127   else if (dY <> 0) then
1128   begin
1129     // has some vertical velocity
1130     if (dY < 0) then
1131     begin
1132       // flying up
1133       if (ceilingY = Unknown) then findCeiling(); // need to do this anyway
1134       y += dY;
1135       if (y <= ceilingY) then
1136       begin
1137         // oops, hit a ceiling
1138         y := ceilingY;
1139         velY := -velY;
1140         accelY := abs(accelY);
1141       end;
1142       // environment didn't changed
1143     end
1144     else
1145     begin
1146       // falling down
1147       if (floorY = Unknown) then findFloor(); // need to do this anyway
1148       y += dY;
1149       if (y >= floorY) then
1150       begin
1151         // hit something except a floor?
1152         if (floorType <> TFloorType.Wall) then begin die(); exit; end; // yep: just die
1153         // otherwise, go to sleep
1154         y := floorY;
1155         sleep();
1156         // environment didn't changed
1157       end;
1158     end;
1159   end;
1160
1161 _done:
1162   if (x < g_Map_MinX) or (y < g_Map_MinY) or (x > g_Map_MaxX) or (y > g_Map_MaxY) then begin die(); end;
1163
1164   if (velX <> 0.0) then velX += accelX;
1165
1166   if (velY <> 0.0) then
1167   begin
1168     if (accelY < 10) then accelY += 0.08;
1169     velY += accelY;
1170   end;
1171
1172   time += 1;
1173 end;
1174
1175
1176 // ////////////////////////////////////////////////////////////////////////// //
1177 procedure g_GFX_SparkVel (fX, fY: Integer; count: Word; vx, vy: Integer; devX, devY: Byte);
1178 var
1179   a: Integer;
1180   devX1, devX2, devY1, devY2: Integer;
1181   l: Integer;
1182   pan: TPanel;
1183 begin
1184   if not gpart_dbg_enabled then exit;
1185
1186   l := Length(Particles);
1187   if (l = 0) then exit;
1188   if (count > l) then count := l;
1189
1190   devX1 := devX div 2;
1191   devX2 := devX+1;
1192   devY1 := devY div 2;
1193   devY2 := devY+1;
1194
1195   for a := 1 to count do
1196   begin
1197     with Particles[CurrentParticle] do
1198     begin
1199       x := fX-devX1+Random(devX2);
1200       y := fY-devY1+Random(devY2);
1201
1202       // check for level bounds
1203       if (x < g_Map_MinX) or (y < g_Map_MinY) or (x > g_Map_MaxX) or (y > g_Map_MaxY) then continue;
1204
1205       // in what environment we are starting in?
1206       pan := g_Map_PanelAtPoint(x, y, (GridTagObstacle or GridTagLiquid));
1207       if (pan <> nil) then
1208       begin
1209         // either in a wall, or in a liquid
1210         //if ((pan.tag and GridTagObstacle) <> 0) then continue; // don't spawn in walls
1211         //env := TEnvType.ELiquid;
1212         continue;
1213       end
1214       else
1215       begin
1216         env := TEnvType.EAir;
1217       end;
1218
1219       velX := vx+(Random-Random)*3;
1220       velY := vy+(Random-Random)*3;
1221
1222       if (velY > -4) then
1223       begin
1224         if (velY-4 < -4) then velY := -4 else velY := velY-4;
1225       end;
1226
1227       accelX := -sign(velX)*Random/100;
1228       accelY := 0.8;
1229
1230       red := 255;
1231       green := 100+Random(155);
1232       blue := 64;
1233       alpha := 255;
1234
1235       particleType := TPartType.Spark;
1236       state := TPartState.Normal;
1237       time := 0;
1238       liveTime := 30+Random(60);
1239       floorY := Unknown;
1240       ceilingY := Unknown;
1241     end;
1242
1243     if (CurrentParticle >= MaxParticles-1) then CurrentParticle := 0 else CurrentParticle += 1;
1244   end;
1245 end;
1246
1247
1248 procedure g_GFX_Spark (fX, fY: Integer; count: Word; angle: SmallInt; devX, devY: Byte);
1249 var
1250   a: Integer;
1251   b: Single;
1252   devX1, devX2, devY1, devY2: Integer;
1253   baseVelX, baseVelY: Single;
1254   l: Integer;
1255   pan: TPanel;
1256 begin
1257   if not gpart_dbg_enabled then exit;
1258
1259   l := Length(Particles);
1260   if (l = 0) then exit;
1261   if (count > l) then count := l;
1262
1263   angle := 360-angle;
1264
1265   devX1 := devX div 2;
1266   devX2 := devX+1;
1267   devY1 := devY div 2;
1268   devY2 := devY+1;
1269
1270   b := DegToRad(angle);
1271   baseVelX := cos(b);
1272   baseVelY := 1.6*sin(b);
1273   if (abs(baseVelX) < 0.01) then baseVelX := 0.0;
1274   if (abs(baseVelY) < 0.01) then baseVelY := 0.0;
1275
1276   for a := 1 to count do
1277   begin
1278     with Particles[CurrentParticle] do
1279     begin
1280       x := fX-devX1+Random(devX2);
1281       y := fY-devY1+Random(devY2);
1282
1283       // check for level bounds
1284       if (x < g_Map_MinX) or (y < g_Map_MinY) or (x > g_Map_MaxX) or (y > g_Map_MaxY) then continue;
1285
1286       // in what environment we are starting in?
1287       pan := g_Map_PanelAtPoint(x, y, (GridTagObstacle or GridTagLiquid));
1288       if (pan <> nil) then
1289       begin
1290         // either in a wall, or in a liquid
1291         //if ((pan.tag and GridTagObstacle) <> 0) then continue; // don't spawn in walls
1292         //env := TEnvType.ELiquid;
1293         continue;
1294       end
1295       else
1296       begin
1297         env := TEnvType.EAir;
1298       end;
1299
1300       velX := baseVelX*Random;
1301       velY := baseVelY-Random;
1302       accelX := velX/3.0;
1303       accelY := velY/5.0;
1304
1305       red := 255;
1306       green := 100+Random(155);
1307       blue := 64;
1308       alpha := 255;
1309
1310       particleType := TPartType.Spark;
1311       state := TPartState.Normal;
1312       time := 0;
1313       liveTime := 30+Random(60);
1314       floorY := Unknown;
1315       ceilingY := Unknown;
1316     end;
1317
1318     if (CurrentParticle >= MaxParticles-1) then CurrentParticle := 0 else CurrentParticle += 1;
1319   end;
1320 end;
1321
1322
1323 // ////////////////////////////////////////////////////////////////////////// //
1324 procedure g_GFX_SetMax (count: Integer);
1325 var
1326   a: Integer;
1327 begin
1328   if count > 50000 then count := 50000;
1329   if (count < 1) then count := 1;
1330   SetLength(Particles, count);
1331   for a := 0 to High(Particles) do Particles[a].die();
1332   MaxParticles := count;
1333   CurrentParticle := 0;
1334 end;
1335
1336
1337 function g_GFX_GetMax (): Integer;
1338 begin
1339   result := MaxParticles;
1340 end;
1341
1342
1343 function FindOnceAnim (): DWORD;
1344 var
1345   i: Integer;
1346 begin
1347   if OnceAnims <> nil then
1348     for i := 0 to High(OnceAnims) do
1349       if OnceAnims[i].Animation = nil then
1350       begin
1351         Result := i;
1352         Exit;
1353       end;
1354
1355   if OnceAnims = nil then
1356     begin
1357       SetLength(OnceAnims, 16);
1358       Result := 0;
1359     end
1360   else
1361     begin
1362       Result := High(OnceAnims) + 1;
1363       SetLength(OnceAnims, Length(OnceAnims) + 16);
1364     end;
1365 end;
1366
1367
1368 procedure g_GFX_OnceAnim (x, y: Integer; Anim: TAnimation; AnimType: Byte = 0);
1369 var
1370   find_id: DWORD;
1371 begin
1372   if not gpart_dbg_enabled then exit;
1373
1374   if (Anim = nil) then exit;
1375
1376   find_id := FindOnceAnim();
1377
1378   OnceAnims[find_id].AnimType := AnimType;
1379   OnceAnims[find_id].Animation := TAnimation.Create(Anim.FramesID, Anim.Loop, Anim.Speed);
1380   OnceAnims[find_id].Animation.Blending := Anim.Blending;
1381   OnceAnims[find_id].Animation.alpha := Anim.alpha;
1382   OnceAnims[find_id].x := x;
1383   OnceAnims[find_id].y := y;
1384 end;
1385
1386
1387 // ////////////////////////////////////////////////////////////////////////// //
1388 // st: set mark
1389 // t: mark type
1390 // currently unused
1391 procedure g_Mark (x, y, Width, Height: Integer; t: Byte; st: Boolean=true);
1392 var
1393   cx, ex, ey: Integer;
1394   ts: Integer;
1395 begin
1396   if not gpart_dbg_enabled then exit;
1397
1398   if (Width < 1) or (Height < 1) then exit;
1399   // make some border, so we'll hit particles lying around the panel
1400   x -= 1; Width += 2;
1401   y -= 1; Height += 2;
1402   ex := x+Width;
1403   ey := y+Height;
1404   ts := mapGrid.tileSize;
1405   while (y < ey) do
1406   begin
1407     cx := x;
1408     while (cx < ex) do
1409     begin
1410       awmSet(cx, y);
1411       Inc(cx, ts);
1412     end;
1413     Inc(y, ts);
1414   end;
1415 end;
1416
1417
1418 // ////////////////////////////////////////////////////////////////////////// //
1419 procedure g_GFX_Init ();
1420 begin
1421   //g_Game_SetLoadingText(_lc[I_LOAD_COLLIDE_MAP]+' 1/6', 0, False);
1422   //SetLength(gCollideMap, gMapInfo.Height+1);
1423   //for a := 0 to High(gCollideMap) do SetLength(gCollideMap[a], gMapInfo.Width+1);
1424   awmSetup();
1425 {$IFDEF HEADLESS}
1426   gpart_dbg_enabled := false;
1427 {$ENDIF}
1428 end;
1429
1430
1431 procedure g_GFX_Free ();
1432 var
1433   a: Integer;
1434 begin
1435   Particles := nil;
1436   SetLength(Particles, MaxParticles);
1437   for a := 0 to High(Particles) do Particles[a].die();
1438   CurrentParticle := 0;
1439
1440   if (OnceAnims <> nil) then
1441   begin
1442     for a := 0 to High(OnceAnims) do OnceAnims[a].Animation.Free();
1443     OnceAnims := nil;
1444   end;
1445
1446   awakeMap := nil;
1447   // why not?
1448   awakeMapH := -1;
1449   awakeMapW := -1;
1450 end;
1451
1452
1453 // ////////////////////////////////////////////////////////////////////////// //
1454 procedure g_GFX_Update ();
1455 var
1456   a: Integer;
1457   w, h: Integer;
1458   len: Integer;
1459 begin
1460   if not gpart_dbg_enabled then exit;
1461
1462   if (Particles <> nil) then
1463   begin
1464     w := gMapInfo.Width;
1465     h := gMapInfo.Height;
1466
1467     len := High(Particles);
1468
1469     for a := 0 to len do
1470     begin
1471       if Particles[a].alive then
1472       begin
1473         with Particles[a] do
1474         begin
1475           if (time = liveTime) then begin die(); continue; end;
1476           if (x+1 >= w) or (y+1 >= h) or (x <= 0) or (y <= 0) then begin die(); end;
1477           think();
1478         end; // with
1479       end; // if
1480     end; // for
1481   end; // Particles <> nil
1482
1483   // clear awake map
1484   awmClear();
1485
1486   if OnceAnims <> nil then
1487   begin
1488     for a := 0 to High(OnceAnims) do
1489       if OnceAnims[a].Animation <> nil then
1490       begin
1491         case OnceAnims[a].AnimType of
1492           ONCEANIM_SMOKE:
1493             begin
1494               if Random(3) = 0 then
1495                 OnceAnims[a].x := OnceAnims[a].x-1+Random(3);
1496               if Random(2) = 0 then
1497                 OnceAnims[a].y := OnceAnims[a].y-Random(2);
1498             end;
1499         end;
1500
1501         if OnceAnims[a].Animation.Played then
1502           begin
1503             OnceAnims[a].Animation.Free();
1504             OnceAnims[a].Animation := nil;
1505           end
1506         else
1507           OnceAnims[a].Animation.Update();
1508       end;
1509   end;
1510 end;
1511
1512
1513 procedure g_GFX_Draw ();
1514 var
1515   a, len: Integer;
1516   scaled: Boolean;
1517 begin
1518   if not gpart_dbg_enabled then exit;
1519
1520   if (Particles <> nil) then
1521   begin
1522     glDisable(GL_TEXTURE_2D);
1523     glPointSize(2);
1524
1525     glEnable(GL_BLEND);
1526     glBlendFunc(GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA);
1527
1528     glBegin(GL_POINTS);
1529
1530     scaled := (g_dbg_scale <> 1.0);
1531
1532     len := High(Particles);
1533     for a := 0 to len do
1534     begin
1535       with Particles[a] do
1536       begin
1537         if not alive then continue;
1538         if scaled or ((x >= sX) and (y >= sY) and (x <= sX+sWidth) and (sY <= sY+sHeight)) then
1539         begin
1540           glColor4ub(red, green, blue, alpha);
1541           glVertex2f(x+0.37, y+0.37);
1542         end;
1543       end;
1544     end;
1545
1546     glEnd();
1547
1548     glDisable(GL_BLEND);
1549   end;
1550
1551   if (OnceAnims <> nil) then
1552   begin
1553     len := High(OnceAnims);
1554     for a := 0 to len do
1555     begin
1556       if (OnceAnims[a].Animation <> nil) then
1557       begin
1558         with OnceAnims[a] do Animation.Draw(x, y, M_NONE);
1559       end;
1560     end;
1561   end;
1562 end;
1563
1564
1565 end.