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 procedure TParticle.thinkerSpark ();
1091 var
1092   dX, dY: SmallInt;
1093   {$IF not DEFINED(D2F_NEW_SPARK_THINKER)}
1094   b: Integer;
1095   s: ShortInt;
1096   {$ELSE}
1097   pan: TPanel;
1098   ex, ey: Integer;
1099   {$ENDIF}
1100 begin
1101   dX := Round(velX);
1102   dY := Round(velY);
1103
1104   {$IF DEFINED(D2F_NEW_SPARK_THINKER)}
1105   if (abs(velX) < 0.1) and (abs(velY) < 0.1) then
1106   begin
1107     pan := g_Map_traceToNearest(x, y-1, x, y+1, (GridTagWall or GridTagDoor or GridTagStep or GridTagAcid1 or GridTagAcid2 or GridTagWater), @ex, @ey);
1108   end;
1109   {$ELSE}
1110   if (abs(velX) < 0.1) and (abs(velY) < 0.1) and
1111      (not isBlockedAt(x, y-1) {ByteBool(gCollideMap[Y-1, X] and MARK_BLOCKED)}) and
1112      (not isBlockedAt(x, y) {ByteBool(gCollideMap[Y, X] and MARK_BLOCKED)}) and
1113      (not isBlockedAt(x, y+1) {ByteBool(gCollideMap[Y+1, X] and MARK_BLOCKED)}) then
1114   begin // Âèñèò â âîçäóõå
1115     velY := 0.8;
1116     accelY := 0.5;
1117   end;
1118   {$ENDIF}
1119
1120   if (dX <> 0) then
1121   begin
1122     {$IF DEFINED(D2F_NEW_SPARK_THINKER)}
1123     pan := g_Map_traceToNearest(x, y, x+dX, y, (GridTagWall or GridTagDoor or GridTagStep or GridTagAcid1 or GridTagAcid2 or GridTagWater), @ex, @ey);
1124     //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);
1125     if (x <> ex) then onGround := false;
1126     x := ex;
1127     // free to ride?
1128     if (pan <> nil) then
1129     begin
1130       // nope
1131       if ((pan.tag and (GridTagAcid1 or GridTagAcid2 or GridTagWater)) <> 0) then begin die(); exit; end;
1132       velX := 0;
1133       accelX := 0;
1134     end;
1135     if (x < 0) or (x >= gMapInfo.Width) then begin die(); exit; end;
1136     {$ELSE}
1137     if (dX > 0) then s := 1 else s := -1;
1138     dX := abs(dX);
1139     for b := 1 to dX do
1140     begin
1141       if (x+s >= gMapInfo.Width) or (x+s <= 0) then begin die(); break; end;
1142       //c := gCollideMap[Y, X+s];
1143       if isBlockedAt(x+s, y) {ByteBool(c and MARK_BLOCKED)} then
1144         begin // Ñòåíà/äâåðü - ïàäàåò âåðòèêàëüíî
1145           velX := 0;
1146           accelX := 0;
1147           Break;
1148         end
1149       else // Ïóñòî:
1150         if not isAnythingAt(x+s, y) {c = MARK_FREE} then
1151           x := x + s
1152         else // Îñòàëüíîå:
1153           begin
1154             die();
1155             break;
1156           end;
1157     end;
1158     {$ENDIF}
1159   end;
1160
1161   if (dY <> 0) then
1162   begin
1163     {$IF DEFINED(D2F_NEW_SPARK_THINKER)}
1164     if (dY < 0) or not onGround then
1165     begin
1166       pan := g_Map_traceToNearest(x, y, x, y+dY, (GridTagWall or GridTagDoor or GridTagStep or GridTagAcid1 or GridTagAcid2 or GridTagWater), @ex, @ey);
1167       y := ey;
1168       {
1169       if awaken then
1170       begin
1171         awaken := false;
1172         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]);
1173       end;
1174       }
1175       // free to ride?
1176       if (pan <> nil) then
1177       begin
1178         // nope
1179         if ((pan.tag and (GridTagAcid1 or GridTagAcid2 or GridTagWater)) <> 0) then begin die(); exit; end;
1180         if (dY < 0) then
1181         begin
1182           velY := -velY;
1183           accelY := abs(accelY);
1184         end
1185         else
1186         begin
1187           velX := 0;
1188           accelX := 0;
1189           velY := 0;
1190           accelY := 0.8;
1191         end;
1192       end;
1193       onGround := (velY >= 0) and g_Map_HasAnyPanelAtPoint(x, y+1, (PANEL_WALL or PANEL_CLOSEDOOR or PANEL_STEP));
1194     end;
1195     if (y < 0) or (y >= gMapInfo.Height) then begin die(); exit; end;
1196     {$ELSE}
1197     if (dY > 0) then s := 1 else s := -1;
1198     dY := abs(dY);
1199     for b := 1 to dY do
1200     begin
1201       if (y+s >= gMapInfo.Height) or (y+s <= 0) then begin die(); break; end;
1202       //c := gCollideMap[Y+s, X];
1203       if isBlockedAt(x, y+s) {ByteBool(c and MARK_BLOCKED)} then
1204         begin // Ñòåíà/äâåðü - ïàäàåò âåðòèêàëüíî
1205           if s < 0 then
1206             begin
1207               velY := -velY;
1208               accelY := abs(accelY);
1209             end
1210           else // Èëè íå ïàäàåò
1211             begin
1212               velX := 0;
1213               accelX := 0;
1214               velY := 0;
1215               accelY := 0.8;
1216             end;
1217
1218           Break;
1219         end
1220       else // Ïóñòî:
1221         if not isAnythingAt(x, y+s) {c = MARK_FREE} then
1222           y := y + s
1223         else // Îñàëüíîå:
1224           begin
1225             die();
1226             break;
1227           end;
1228     end;
1229     {$ENDIF}
1230   end;
1231
1232   if (velX <> 0.0) then velX += accelX;
1233
1234   if (velY <> 0.0) then
1235   begin
1236     if (accelY < 10) then accelY += 0.08;
1237     velY += accelY;
1238   end;
1239
1240   time += 1;
1241 end;
1242
1243
1244 // ////////////////////////////////////////////////////////////////////////// //
1245 procedure g_GFX_SparkVel (fX, fY: Integer; count: Word; VX, VY: Integer; devX, devY: Byte);
1246 var
1247   a: Integer;
1248   devX1, devX2,
1249   devY1, devY2: Byte;
1250   l: Integer;
1251 begin
1252   exit;
1253   if not gpart_dbg_enabled then Exit;
1254   l := Length(Particles);
1255   if l = 0 then exit;
1256   if count > l then count := l;
1257
1258   devX1 := devX div 2;
1259   devX2 := devX + 1;
1260   devY1 := devY div 2;
1261   devY2 := devY + 1;
1262
1263   for a := 1 to count do
1264   begin
1265     with Particles[CurrentParticle] do
1266     begin
1267       x := fX-devX1+Random(devX2);
1268       y := fY-devY1+Random(devY2);
1269
1270       velX := VX + (Random-Random)*3;
1271       velY := VY + (Random-Random)*3;
1272
1273       if velY > -4 then
1274         if velY-4 < -4 then
1275           velY := -4
1276         else
1277           velY := velY-4;
1278
1279       accelX := -Sign(velX)*Random/100;
1280       accelY := 0.8;
1281
1282       red := 255;
1283       green := 100+Random(155);
1284       blue := 64;
1285       alpha := 255;
1286
1287       state := TPartState.Normal;
1288       time := 0;
1289       liveTime := 30+Random(60);
1290       particleType := TPartType.Spark;
1291       justSticked := false;
1292       onGround := (velY >= 0) and g_Map_HasAnyPanelAtPoint(x, y+1, (PANEL_WALL or PANEL_CLOSEDOOR or PANEL_STEP));
1293       awaken := false;
1294     end;
1295
1296     if CurrentParticle+2 > MaxParticles then
1297       CurrentParticle := 0
1298     else
1299       CurrentParticle := CurrentParticle+1;
1300   end;
1301 end;
1302
1303
1304 procedure g_GFX_Spark(fX, fY: Integer; count: Word; angle: SmallInt; devX, devY: Byte);
1305 var
1306   a: Integer;
1307   b: Single;
1308   devX1, devX2,
1309   devY1, devY2: Byte;
1310   BaseVelX, BaseVelY: Single;
1311   l: Integer;
1312 begin
1313   exit;
1314   if not gpart_dbg_enabled then Exit;
1315   l := Length(Particles);
1316   if l = 0 then
1317     Exit;
1318   if count > l then
1319     count := l;
1320
1321   angle := 360 - angle;
1322
1323   devX1 := devX div 2;
1324   devX2 := devX + 1;
1325   devY1 := devY div 2;
1326   devY2 := devY + 1;
1327
1328   b := DegToRad(angle);
1329   BaseVelX := cos(b);
1330   BaseVelY := 1.6*sin(b);
1331   if abs(BaseVelX) < 0.01 then
1332     BaseVelX := 0.0;
1333   if abs(BaseVelY) < 0.01 then
1334     BaseVelY := 0.0;
1335   for a := 1 to count do
1336   begin
1337     with Particles[CurrentParticle] do
1338     begin
1339       x := fX-devX1+Random(devX2);
1340       y := fY-devY1+Random(devY2);
1341
1342       velX := BaseVelX*Random;
1343       velY := BaseVelY-Random;
1344       accelX := velX/3.0;
1345       accelY := velY/5.0;
1346
1347       red := 255;
1348       green := 100+Random(155);
1349       blue := 64;
1350       alpha := 255;
1351
1352       state := TPartState.Normal;
1353       time := 0;
1354       liveTime := 30+Random(60);
1355       particleType := TPartType.Spark;
1356       justSticked := false;
1357       onGround := (velY >= 0) and g_Map_HasAnyPanelAtPoint(x, y+1, (PANEL_WALL or PANEL_CLOSEDOOR or PANEL_STEP));
1358       awaken := false;
1359     end;
1360
1361     if CurrentParticle+2 > MaxParticles then
1362       CurrentParticle := 0
1363     else
1364       CurrentParticle := CurrentParticle+1;
1365   end;
1366 end;
1367
1368
1369 // ////////////////////////////////////////////////////////////////////////// //
1370 procedure g_GFX_SetMax(count: Integer);
1371 var
1372   a: Integer;
1373 begin
1374   if count > 50000 then count := 50000;
1375   if (count < 1) then count := 1;
1376
1377   SetLength(Particles, count);
1378   for a := 0 to High(Particles) do Particles[a].die();
1379   MaxParticles := count;
1380   //if CurrentParticle >= Count then
1381     CurrentParticle := 0;
1382 end;
1383
1384
1385 function g_GFX_GetMax(): Integer;
1386 begin
1387   Result := MaxParticles;
1388 end;
1389
1390
1391 function FindOnceAnim (): DWORD;
1392 var
1393   i: Integer;
1394 begin
1395   if OnceAnims <> nil then
1396     for i := 0 to High(OnceAnims) do
1397       if OnceAnims[i].Animation = nil then
1398       begin
1399         Result := i;
1400         Exit;
1401       end;
1402
1403   if OnceAnims = nil then
1404     begin
1405       SetLength(OnceAnims, 16);
1406       Result := 0;
1407     end
1408   else
1409     begin
1410       Result := High(OnceAnims) + 1;
1411       SetLength(OnceAnims, Length(OnceAnims) + 16);
1412     end;
1413 end;
1414
1415
1416 procedure g_GFX_OnceAnim (x, y: Integer; Anim: TAnimation; AnimType: Byte = 0);
1417 var
1418   find_id: DWORD;
1419 begin
1420   if not gpart_dbg_enabled then Exit;
1421   if Anim = nil then
1422     Exit;
1423
1424   find_id := FindOnceAnim();
1425
1426   OnceAnims[find_id].AnimType := AnimType;
1427   OnceAnims[find_id].Animation := TAnimation.Create(Anim.FramesID, Anim.Loop, Anim.Speed);
1428   OnceAnims[find_id].Animation.Blending := Anim.Blending;
1429   OnceAnims[find_id].Animation.alpha := Anim.alpha;
1430   OnceAnims[find_id].x := x;
1431   OnceAnims[find_id].y := y;
1432 end;
1433
1434
1435 // ////////////////////////////////////////////////////////////////////////// //
1436 // st: set mark
1437 // t: mark type
1438 // currently unused
1439 procedure g_Mark(x, y, Width, Height: Integer; t: Byte; st: Boolean=true);
1440 var
1441   cx, ex, ey: Integer;
1442   ts: Integer;
1443 begin
1444   if (Width < 1) or (Height < 1) then exit;
1445   // make some border, so we'll hit particles lying around the panel
1446   x -= 1; Width += 2;
1447   y -= 1; Height += 2;
1448   ex := x+Width;
1449   ey := y+Height;
1450   ts := mapGrid.tileSize;
1451   while (y < ey) do
1452   begin
1453     cx := x;
1454     while (cx < ex) do
1455     begin
1456       awmSet(cx, y);
1457       Inc(cx, ts);
1458     end;
1459     Inc(y, ts);
1460   end;
1461 end;
1462
1463
1464 // ////////////////////////////////////////////////////////////////////////// //
1465 {$IF DEFINED(HAS_COLLIDE_BITMAP)}
1466 procedure CreateCollideMap();
1467 var
1468   a: Integer;
1469 begin
1470   //g_Game_SetLoadingText(_lc[I_LOAD_COLLIDE_MAP]+' 1/6', 0, False);
1471   //SetLength(gCollideMap, gMapInfo.Height+1);
1472   //for a := 0 to High(gCollideMap) do SetLength(gCollideMap[a], gMapInfo.Width+1);
1473 end;
1474 {$ENDIF}
1475
1476
1477 procedure g_GFX_Init();
1478 begin
1479   //CreateCollideMap();
1480   awmSetup();
1481 {$IFDEF HEADLESS}
1482   gpart_dbg_enabled := False;
1483 {$ENDIF}
1484 end;
1485
1486
1487 procedure g_GFX_Free();
1488 var
1489   a: Integer;
1490 begin
1491   Particles := nil;
1492   SetLength(Particles, MaxParticles);
1493   for a := 0 to High(Particles) do Particles[a].die();
1494   CurrentParticle := 0;
1495
1496   if (OnceAnims <> nil) then
1497   begin
1498     for a := 0 to High(OnceAnims) do OnceAnims[a].Animation.Free();
1499     OnceAnims := nil;
1500   end;
1501
1502   awakeMap := nil;
1503   // why not?
1504   awakeMapH := -1;
1505   awakeMapW := -1;
1506 end;
1507
1508
1509 // ////////////////////////////////////////////////////////////////////////// //
1510 procedure g_GFX_Update ();
1511 var
1512   a: Integer;
1513   w, h: Integer;
1514   len: Integer;
1515 begin
1516   if not gpart_dbg_enabled then exit;
1517
1518   if (Particles <> nil) then
1519   begin
1520     w := gMapInfo.Width;
1521     h := gMapInfo.Height;
1522
1523     len := High(Particles);
1524
1525     for a := 0 to len do
1526     begin
1527       if Particles[a].alive then
1528       begin
1529         with Particles[a] do
1530         begin
1531           if (time = liveTime) then begin die(); continue; end;
1532           if (x+1 >= w) or (y+1 >= h) or (x <= 0) or (y <= 0) then begin die(); end;
1533           //if not alive then Continue;
1534           //e_WriteLog(Format('particle #%d: %d', [State, ParticleType]), MSG_NOTIFY);
1535           think();
1536         end; // with
1537       end; // if
1538     end; // for
1539   end; // Particles <> nil
1540
1541   // clear awake map
1542   awmClear();
1543
1544   if OnceAnims <> nil then
1545   begin
1546     for a := 0 to High(OnceAnims) do
1547       if OnceAnims[a].Animation <> nil then
1548       begin
1549         case OnceAnims[a].AnimType of
1550           ONCEANIM_SMOKE:
1551             begin
1552               if Random(3) = 0 then
1553                 OnceAnims[a].x := OnceAnims[a].x-1+Random(3);
1554               if Random(2) = 0 then
1555                 OnceAnims[a].y := OnceAnims[a].y-Random(2);
1556             end;
1557         end;
1558
1559         if OnceAnims[a].Animation.Played then
1560           begin
1561             OnceAnims[a].Animation.Free();
1562             OnceAnims[a].Animation := nil;
1563           end
1564         else
1565           OnceAnims[a].Animation.Update();
1566       end;
1567   end;
1568 end;
1569
1570
1571 procedure g_GFX_Draw ();
1572 var
1573   a, len: Integer;
1574 begin
1575   if Particles <> nil then
1576   begin
1577     glDisable(GL_TEXTURE_2D);
1578     glPointSize(2);
1579
1580     glEnable(GL_BLEND);
1581     glBlendFunc(GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA);
1582
1583     glBegin(GL_POINTS);
1584
1585     len := High(Particles);
1586
1587     for a := 0 to len do
1588       with Particles[a] do
1589         if alive and (x >= sX) and (y >= sY) and (x <= sX+sWidth) and (sY <= sY+sHeight) then
1590         begin
1591           glColor4ub(red, green, blue, alpha);
1592           glVertex2i(x + offsetX, y + offsetY);
1593         end;
1594
1595     glEnd();
1596
1597     glDisable(GL_BLEND);
1598   end;
1599
1600   if OnceAnims <> nil then
1601     for a := 0 to High(OnceAnims) do
1602       if OnceAnims[a].Animation <> nil then
1603         with OnceAnims[a] do
1604           Animation.Draw(x, y, M_NONE);
1605 end;
1606
1607
1608 end.