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