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