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