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