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