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