1 (* Copyright (C) Doom 2D: Forever Developers
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.
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.
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/>.
16 {$INCLUDE ../shared/a_modes.inc}
17 {.$DEFINE D2F_DEBUG_FALL_MPLAT}
18 {/$DEFINE D2F_DEBUG_PART_AWAKE}
44 MARK_BLOCKED
= MARK_WALL
or MARK_DOOR
;
45 MARK_LIQUID
= MARK_WATER
or MARK_ACID
;
46 MARK_LIFT
= MARK_LIFTDOWN
or MARK_LIFTUP
or MARK_LIFTLEFT
or MARK_LIFTRIGHT
;
49 procedure g_GFX_Init ();
50 procedure g_GFX_Free ();
52 procedure g_GFX_Blood (fX
, fY
: Integer; count
: Word; vx
, vy
: Integer;
53 devX
, devY
: Word; cr
, cg
, cb
: Byte; kind
: Byte=BLOOD_NORMAL
);
54 procedure g_GFX_Spark (fX
, fY
: Integer; count
: Word; angle
: SmallInt
; devX
, devY
: Byte);
55 procedure g_GFX_Water (fX
, fY
: Integer; count
: Word; fVelX
, fVelY
: Single; devX
, devY
, color
: Byte;
56 simple
: Boolean=false; cr
: Byte=0; cg
: Byte=0; cb
: Byte=0);
57 procedure g_GFX_SimpleWater (fX
, fY
: Integer; count
: Word; fVelX
, fVelY
: Single; defColor
, cr
, cg
, cb
: Byte);
58 procedure g_GFX_Bubbles (fX
, fY
: Integer; count
: Word; devX
, devY
: Byte);
60 procedure g_GFX_SetMax (count
: Integer);
61 function g_GFX_GetMax (): Integer;
63 procedure g_GFX_OnceAnim (X
, Y
: Integer; Anim
: TAnimation
; AnimType
: Byte = 0);
65 procedure g_Mark (x
, y
, Width
, Height
: Integer; t
: Byte; st
: Boolean=true);
67 procedure g_GFX_Update ();
68 procedure g_GFX_Draw ();
72 gpart_dbg_enabled
: Boolean = true;
73 gpart_dbg_phys_enabled
: Boolean = true;
76 //WARNING: only for Holmes!
77 function awmIsSetHolmes (x
, y
: Integer): Boolean; inline;
83 {$INCLUDE ../nogl/noGLuses.inc}
84 g_map
, g_panel
, g_basic
, Math
, e_graphics
,
85 g_options
, g_console
, SysUtils
, g_triggers
, MAPDEF
,
86 g_game
, g_language
, g_net
, utils
, xprofiler
;
90 Unknown
= Integer($7fffffff);
94 TPartType
= (Blood
, Spark
, Bubbles
, Water
);
95 TPartState
= (Free
, Normal
, Stuck
, Sleeping
);
96 TFloorType
= (Wall
, LiquidIn
, LiquidOut
);
97 // Wall: floorY is just before floor
98 // LiquidIn: floorY is liquid *start* (i.e. just in a liquid)
99 // LiquidOut: floorY is liquid *end* (i.e. just out of a liquid)
100 TEnvType
= (EAir
, ELiquid
, EWall
); // where particle is now
102 // note: this MUST be record, so we can keep it in
103 // dynamic array and has sequential memory access pattern
104 PParticle
= ^TParticle
;
108 accelX
, accelY
: Single;
110 particleType
: TPartType
;
111 red
, green
, blue
: Byte;
113 time
, liveTime
, waitTime
: Word;
114 stickDX
: Integer; // STATE_STICK: -1,1: stuck to a wall; 0: stuck to ceiling
115 justSticked
: Boolean; // not used
116 floorY
: Integer; // actually, floor-1; `Unknown`: unknown
117 floorType
: TFloorType
;
118 env
: TEnvType
; // where particle is now
119 ceilingY
: Integer; // actually, ceiling+1; `Unknown`: unknown
120 wallEndY
: Integer; // if we stuck to a wall, this is where wall ends
122 //k8: sorry, i have to emulate virtual methods this way, 'cause i haet `Object`
123 procedure thinkerBloodAndWater ();
124 procedure thinkerSpark ();
125 procedure thinkerBubble ();
127 procedure findFloor (force
: Boolean=false); // this updates `floorY` if forced or Unknown
128 procedure findCeiling (force
: Boolean=false); // this updates `ceilingY` if forced or Unknown
130 procedure freeze (); inline; // remove velocities and acceleration
131 procedure sleep (); inline; // switch to sleep mode
133 function checkAirStreams (): Boolean; // `true`: affected by air stream
135 function alive (): Boolean; inline;
136 procedure die (); inline;
137 procedure think (); inline;
143 Animation
: TAnimation
;
148 Particles
: array of TParticle
= nil;
149 OnceAnims
: array of TOnceAnim
= nil;
150 MaxParticles
: Integer = 0;
151 CurrentParticle
: Integer = 0;
152 // awakeMap has one bit for each map grid cell; on g_Mark,
153 // corresponding bits will be set, and in `think()` all particles
154 // in marked cells will be awaken
155 awakeMap
: packed array of LongWord
= nil;
156 awakeMapH
: Integer = -1;
157 awakeMapW
: Integer = -1;
158 awakeMinX
, awakeMinY
: Integer;
159 awakeDirty
: Boolean = false;
160 {$IF DEFINED(D2F_DEBUG_PART_AWAKE)}
161 awakeMapHlm
: packed array of LongWord
= nil;
165 // ////////////////////////////////////////////////////////////////////////// //
166 function awmIsSetHolmes (x
, y
: Integer): Boolean; inline;
168 {$IF DEFINED(D2F_DEBUG_PART_AWAKE)}
169 if (Length(awakeMapHlm
) = 0) then begin result
:= false; exit
; end;
170 x
:= (x
-awakeMinX
) div mapGrid
.tileSize
;
171 y
:= (y
-awakeMinY
) div mapGrid
.tileSize
;
172 if (x
>= 0) and (y
>= 0) and (x
div 32 < awakeMapW
) and (y
< awakeMapH
) then
174 if (y
*awakeMapW
+x
div 32 < Length(awakeMapHlm
)) then
176 result
:= ((awakeMapHlm
[y
*awakeMapW
+x
div 32] and (LongWord(1) shl (x
mod 32))) <> 0);
193 // ////////////////////////////////////////////////////////////////////////// //
194 // HACK! using mapgrid
195 procedure awmClear (); inline;
197 {$IF DEFINED(D2F_DEBUG_PART_AWAKE)}
198 if (Length(awakeMap
) > 0) then
200 if (Length(awakeMapHlm
) <> Length(awakeMap
)) then SetLength(awakeMapHlm
, Length(awakeMap
));
201 Move(awakeMap
[0], awakeMapHlm
[0], Length(awakeMap
)*sizeof(awakeMap
[0]));
204 if awakeDirty
and (awakeMapW
> 0) then
206 FillDWord(awakeMap
[0], Length(awakeMap
), 0);
212 procedure awmSetup ();
214 assert(mapGrid
<> nil);
215 awakeMapW
:= (mapGrid
.gridWidth
+mapGrid
.tileSize
-1) div mapGrid
.tileSize
;
216 awakeMapW
:= (awakeMapW
+31) div 32; // LongWord has 32 bits ;-)
217 awakeMapH
:= (mapGrid
.gridHeight
+mapGrid
.tileSize
-1) div mapGrid
.tileSize
;
218 awakeMinX
:= mapGrid
.gridX0
;
219 awakeMinY
:= mapGrid
.gridY0
;
220 SetLength(awakeMap
, awakeMapW
*awakeMapH
);
221 {$IF DEFINED(D2F_DEBUG_PART_AWAKE)}
222 SetLength(awakeMapHlm
, awakeMapW
*awakeMapH
);
223 FillDWord(awakeMapHlm
[0], Length(awakeMapHlm
), 0);
225 //{$IF DEFINED(D2F_DEBUG)}
226 e_LogWritefln('particle awake map: %sx%s (for grid of size %sx%s)', [awakeMapW
, awakeMapH
, mapGrid
.gridWidth
, mapGrid
.gridHeight
]);
233 function awmIsSet (x
, y
: Integer): Boolean; inline;
235 x
:= (x
-awakeMinX
) div mapGrid
.tileSize
;
236 y
:= (y
-awakeMinY
) div mapGrid
.tileSize
;
237 if (x
>= 0) and (y
>= 0) and (x
div 32 < awakeMapW
) and (y
< awakeMapH
) then
239 {$IF DEFINED(D2F_DEBUG)}
240 assert(y
*awakeMapW
+x
div 32 < Length(awakeMap
));
242 result
:= ((awakeMap
[y
*awakeMapW
+x
div 32] and (LongWord(1) shl (x
mod 32))) <> 0);
251 procedure awmSet (x
, y
: Integer); inline;
255 x
:= (x
-awakeMinX
) div mapGrid
.tileSize
;
256 y
:= (y
-awakeMinY
) div mapGrid
.tileSize
;
257 if (x
>= 0) and (y
>= 0) and (x
div 32 < awakeMapW
) and (y
< awakeMapH
) then
259 {$IF DEFINED(D2F_DEBUG)}
260 assert(y
*awakeMapW
+x
div 32 < Length(awakeMap
));
262 v
:= @awakeMap
[y
*awakeMapW
+x
div 32];
263 v
^ := v
^ or (LongWord(1) shl (x
mod 32));
269 // ////////////////////////////////////////////////////////////////////////// //
273 procedure g_Mark (x
, y
, Width
, Height
: Integer; t
: Byte; st
: Boolean=true);
276 dx
, dy
, ex
, ey
: Integer;
279 if (not gpart_dbg_enabled
) or (not gpart_dbg_phys_enabled
) then exit
;
280 if (awakeMapW
< 1) or (awakeMapH
< 1) then exit
;
282 if (Width
< 1) or (Height
< 1) then exit
;
284 // make some border, so we'll hit particles around the panel
285 ex
:= x
+Width
+Extrude
-1-awakeMinX
;
286 ey
:= y
+Height
+Extrude
-1-awakeMinY
;
287 x
:= (x
-Extrude
)-awakeMinX
;
288 y
:= (y
-Extrude
)-awakeMinY
;
290 x
:= x
div mapGrid
.tileSize
;
291 y
:= y
div mapGrid
.tileSize
;
292 ex
:= ex
div mapGrid
.tileSize
;
293 ey
:= ey
div mapGrid
.tileSize
;
295 // has something to do?
296 if (ex
< 0) or (ey
< 0) or (x
>= awakeMapW
*32) or (y
>= awakeMapH
) then exit
;
297 if (x
< 0) then x
:= 0;
298 if (y
< 0) then y
:= 0;
299 if (ex
>= awakeMapW
*32) then ex
:= awakeMapW
*32-1;
300 if (ey
>= awakeMapH
) then ey
:= awakeMapH
;
307 {$IF DEFINED(D2F_DEBUG)}
308 assert((dx
>= 0) and (dy
>= 0) and (dx
div 32 < awakeMapW
) and (dy
< awakeMapH
));
309 assert(dy
*awakeMapW
+dx
div 32 < Length(awakeMap
));
311 v
:= @awakeMap
[dy
*awakeMapW
+dx
div 32];
312 v
^ := v
^ or (LongWord(1) shl (dx
mod 32));
318 // ////////////////////////////////////////////////////////////////////////// //
319 function TParticle
.alive (): Boolean; inline; begin result
:= (state
<> TPartState
.Free
); end;
320 procedure TParticle
.die (); inline; begin state
:= TPartState
.Free
; end;
322 // remove velocities and acceleration
323 procedure TParticle
.freeze (); inline;
325 // stop right there, you criminal scum!
333 // `true`: affected by air stream
334 function TParticle
.checkAirStreams (): Boolean;
339 pan
:= g_Map_PanelAtPoint(x
, y
, GridTagLift
);
340 result
:= (pan
<> nil);
344 if ((pan
.PanelType
and PANEL_LIFTUP
) <> 0) then
346 if (velY
> -1-r
) then velY
-= 0.8;
347 if (abs(velX
) > 0.1) then velX
-= velX
/10.0;
348 velX
+= (Random
-Random
)*0.2;
351 else if ((pan
.PanelType
and PANEL_LIFTDOWN
) <> 0) then
353 if (velY
< 1+r
) then velY
+= 0.8;
356 else if ((pan
.PanelType
and PANEL_LIFTLEFT
) <> 0) then
358 if (velX
> -8-r
) then velX
-= (8+r
) div 2;
361 else if ((pan
.PanelType
and PANEL_LIFTRIGHT
) <> 0) then
363 if (velX
< 8+r
) then velX
+= (8+r
) div 2;
371 if result
and (state
= TPartState
.Sleeping
) then state
:= TPartState
.Normal
;
376 // switch to sleep mode
377 procedure TParticle
.sleep (); inline;
379 if not checkAirStreams() then
381 state
:= TPartState
.Sleeping
;
387 procedure TParticle
.findFloor (force
: Boolean=false);
392 if (not force
) and (floorY
<> Unknown
) then exit
;
393 // stuck in the wall? rescan, 'cause it can be mplat
394 if (env
= TEnvType
.EWall
) then
396 pan
:= g_Map_PanelAtPoint(x
, y
, (GridTagObstacle
or GridTagLiquid
));
399 // either in a wall, or in a liquid
400 if ((pan
.tag
and GridTagObstacle
) <> 0) then
402 // we are in the wall, wtf?!
404 env
:= TEnvType
.EWall
;
405 floorType
:= TFloorType
.Wall
;
406 state
:= TPartState
.Sleeping
; // anyway
409 // we are in liquid, trace to liquid end
410 env
:= TEnvType
.ELiquid
;
413 // are we in a liquid?
414 if (env
= TEnvType
.ELiquid
) then
416 // trace out of the liquid
417 //env := TEnvType.ELiquid;
418 floorType
:= TFloorType
.LiquidOut
;
419 //e_LogWritefln('tracing out of a liquid; floorY=%s; y=%s', [floorY, y]);
420 mapGrid
.traceOrthoRayWhileIn(ex
, floorY
, x
, y
, x
, g_Map_MaxY
, GridTagLiquid
);
421 floorY
+= 1; // so `floorY` is just out of a liquid
422 //e_LogWritefln(' traced out of a liquid; floorY=%s; y=%s', [floorY, y]);
427 assert(env
= TEnvType
.EAir
);
428 //env := TEnvType.EAir;
429 pan
:= g_Map_traceToNearest(x
, y
, x
, g_Map_MaxY
, (GridTagObstacle
or GridTagLiquid
), @ex
, @floorY
);
433 if ((pan
.tag
and GridTagObstacle
) <> 0) then
436 floorType
:= TFloorType
.Wall
;
441 floorType
:= TFloorType
.LiquidIn
; // entering liquid
442 floorY
+= 1; // so `floorY` is just in a liquid
447 // out of the level; assume wall, but it doesn't really matter
448 floorType
:= TFloorType
.Wall
;
449 floorY
:= g_Map_MaxY
+2;
455 procedure TParticle
.findCeiling (force
: Boolean=false);
459 if (not force
) and (ceilingY
<> Unknown
) then exit
;
460 if (nil = g_Map_traceToNearest(x
, y
, x
, g_Map_MinY
, GridTagObstacle
, @ex
, @ceilingY
)) then
462 ceilingY
:= g_Map_MinY
-2;
467 procedure TParticle
.think (); inline;
470 if (state
= TPartState
.Stuck
) then
472 //writeln('awaking particle at (', x, ',', y, ')');
473 if (stickDX
= 0) then
475 state
:= TPartState
.Normal
; // stuck to a ceiling
479 // stuck to a wall, check if wall is still there
480 if (wallEndY
<> Unknown
) then
483 if (g_Map_PanelAtPoint(x
+stickDX
, y
, GridTagObstacle
) = nil) then
485 // a wall was moved out, start falling
486 state
:= TPartState
.Normal
;
487 if (velY
= 0) then velY
:= 0.1;
488 if (accelY
= 0) then accelY
:= 0.5;
495 state
:= TPartState
.Normal
;
496 if (velY
= 0) then velY
:= 0.1;
497 if (accelY
= 0) then accelY
:= 0.5;
504 // awake sleeping particle, if necessary
507 if awmIsSet(x
, y
) then awake();
510 TPartState.Sleeping, TPartState.Stuck:
511 if awmIsSet(x, y) then awake();
513 if (env = TEnvType.EWall) and awmIsSet(x, y) then awake();
518 TPartType
.Blood
, TPartType
.Water
: thinkerBloodAndWater();
519 TPartType
.Spark
: thinkerSpark();
520 TPartType
.Bubbles
: thinkerBubble();
525 // ////////////////////////////////////////////////////////////////////////// //
526 procedure TParticle
.thinkerBloodAndWater ();
527 procedure stickToCeiling ();
529 state
:= TPartState
.Stuck
;
532 ceilingY
:= y
; // yep
535 procedure stickToWall (dx
: Integer);
539 state
:= TPartState
.Stuck
;
540 if (dx
> 0) then stickDX
:= 1 else stickDX
:= -1;
542 // find next floor transition
545 mapGrid
.traceOrthoRayWhileIn(ex
, wallEndY
, x
+stickDX
, y
, x
+stickDX
, floorY
+1, (GridTagWall
or GridTagDoor
or GridTagStep
));
548 procedure hitAFloor ();
550 state
:= TPartState
.Sleeping
; // we aren't moving anymore
553 floorType
:= TFloorType
.Wall
; // yep
556 // `true`: didn't, get outa thinker
557 function drip (): Boolean;
560 TPartType
.Blood
: result
:= (Random(200) = 100);
561 TPartType
.Water
: result
:= (Random(30) = 15);
562 else raise Exception
.Create('internal error in particle engine: drip');
568 // if we're falling from ceiling, switch to normal mode
569 if (state
= TPartState
.Stuck
) and (stickDX
= 0) then state
:= TPartState
.Normal
;
573 // switch to freefall mode
574 procedure freefall ();
576 state
:= TPartState
.Normal
;
581 procedure applyGravity (inLiquid
: Boolean);
583 state
:= TPartState
.Normal
;
597 _done
, _gravityagain
, _stuckagain
;
602 checkEnv
, inAir
: Boolean;
603 floorJustTraced
: Boolean;
604 {$IF DEFINED(D2F_DEBUG_FALL_MPLAT)}
608 if not gpart_dbg_phys_enabled
then begin x
+= round(velX
); y
+= round(velY
); goto _done
; end;
612 // still check for air streams when sleeping (no)
613 if (state
= TPartState
.Sleeping
) then begin {checkAirStreams();} goto _done
; end; // so blood will dissolve
615 // process stuck particles
616 if (state
= TPartState
.Stuck
) then
618 // stuck to a ceiling?
619 if (stickDX
= 0) then
621 // yeah, stuck to a ceiling
622 if (ceilingY
= Unknown
) then findCeiling();
623 // dropped from a ceiling?
624 if (y
> ceilingY
) then
629 state
:= TPartState
.Normal
;
633 // otherwise, try to drip
634 if drip() then goto _done
;
640 if (wallEndY
= Unknown
) then
642 // this can happen if mplat was moved out; find new `wallEndY`
643 findFloor(true); // force trace, just in case
644 if (floorType
= TFloorType
.LiquidOut
) then env
:= TEnvType
.ELiquid
else env
:= TEnvType
.EAir
;
645 mapGrid
.traceOrthoRayWhileIn(ex
, wallEndY
, x
+stickDX
, y
, x
+stickDX
, floorY
+1, (GridTagWall
or GridTagDoor
or GridTagStep
));
649 if (wallEndY
<= floorY
) and (y
>= floorY
) then
653 TFloorType
.Wall
: // hit the ground
655 // check if our ground wasn't moved since the last scan
656 findFloor(true); // force trace
660 goto _done
; // nothing to do anymore
662 // otherwise, do it again
665 TFloorType
.LiquidIn
: // entering the liquid
667 // rescan, so we'll know when we'll exit the liquid
668 findFloor(true); // force rescan
670 TFloorType
.LiquidOut
: // exiting the liquid
672 // rescan, so we'll know when we'll enter something interesting
673 findFloor(true); // force rescan
674 if (floorType
= TFloorType
.Wall
) and (floorY
= y
) then begin sleep(); goto _done
; end;
679 if (floorY
<= wallEndY
) and (y
>= wallEndY
) then
681 // just unstuck from the wall, switch to freefall mode
687 // otherwise, try to drip
688 if drip() then goto _done
;
691 // nope, process as usual
694 // it is important to have it here
698 inAir
:= checkAirStreams();
700 // gravity, if not stuck
701 if (state
<> TPartState
.Stuck
) and (abs(velX
) < 0.1) and (abs(velY
) < 0.1) then
703 floorJustTraced
:= (floorY
= Unknown
);
704 if floorJustTraced
then findFloor();
710 TFloorType
.Wall
: // hit the ground
712 // check if our ground wasn't moved since the last scan
713 if not floorJustTraced
then
715 findFloor(true); // force trace
716 if (floorType
= TFloorType
.LiquidOut
) then env
:= TEnvType
.ELiquid
else env
:= TEnvType
.EAir
;
717 if (y
<> floorY
) then goto _gravityagain
;
719 // otherwise, nothing to do
721 TFloorType
.LiquidIn
: // entering the liquid
723 // rescan, so we'll know when we'll exit the liquid
724 findFloor(true); // force rescan
727 TFloorType
.LiquidOut
: // exiting the liquid
729 // rescan, so we'll know when we'll enter something interesting
730 findFloor(true); // force rescan
731 if (floorType
<> TFloorType
.Wall
) or (floorY
<> y
) then applyGravity(floorType
= TFloorType
.LiquidIn
);
737 // looks like we're in the air
745 // has some horizontal velocity
746 pan
:= g_Map_traceToNearest(x
, y
, x
+dx
, y
+dy
, GridTagObstacle
, @ex
, @ey
);
747 checkEnv
:= (x
<> ex
);
755 // check environment (air/liquid)
756 if (g_Map_PanelAtPoint(x
, y
, GridTagLiquid
) <> nil) then env
:= TEnvType
.ELiquid
else env
:= TEnvType
.EAir
;
761 // the only case when we can have both ceiling and wall is corner; stick to wall in this case
762 // check if we stuck to a wall
763 if (dx
< 0) then dx
:= -1 else dx
:= 1;
764 if (g_Map_PanelAtPoint(x
+dx
, y
, GridTagObstacle
) <> nil) then
771 // stuck to a ceiling
776 else if (dy
<> 0) then
778 // has only vertical velocity
782 if (ceilingY
= Unknown
) then findCeiling(); // need to do this anyway
784 if (y
<= ceilingY
) then begin y
:= ceilingY
; stickToCeiling(); end; // oops, hit a ceiling
785 // environment didn't changed
792 floorJustTraced
:= (floorY
= Unknown
);
793 if floorJustTraced
then findFloor();
794 if (floorType
= TFloorType
.LiquidOut
) then env
:= TEnvType
.ELiquid
else env
:= TEnvType
.EAir
;
796 //e_LogWritefln('floorY=%s; newy=%s; dY=%s; floorType=%s', [floorY, y, dY, floorType]);
797 if (y
>= floorY
) then
802 //e_LogWritefln(' HIT FLOORY: floorY=%s; newy=%s; dY=%s; floorType=%s', [floorY, y, dY, floorType]);
804 TFloorType
.Wall
: // hit the ground
806 // check if our ground wasn't moved since the last scan
807 if not floorJustTraced
then
809 {$IF DEFINED(D2F_DEBUG_FALL_MPLAT)}
812 findFloor(true); // force trace
813 {$IF DEFINED(D2F_DEBUG_FALL_MPLAT)}
814 if (floorY
<> oldFloorY
) then
816 e_LogWritefln('force rescanning vpart at (%s,%s); oldFloorY=%s; floorY=%s', [x
, y
, oldFloorY
, floorY
]);
819 if (floorType
= TFloorType
.LiquidOut
) then env
:= TEnvType
.ELiquid
else env
:= TEnvType
.EAir
;
820 if (y
<> floorY
) then continue
;
822 // environment didn't changed
823 if not inAir
then hitAFloor();
824 break
; // done with vertical movement
826 TFloorType
.LiquidIn
: // entering the liquid
828 // we're entered the liquid
829 env
:= TEnvType
.ELiquid
;
830 // rescan, so we'll know when we'll exit the liquid
831 findFloor(true); // force rescan
833 TFloorType
.LiquidOut
: // exiting the liquid
835 // we're exited the liquid
836 env
:= TEnvType
.EAir
;
837 // rescan, so we'll know when we'll enter something interesting
838 findFloor(true); // force rescan
839 if (floorType
= TFloorType
.Wall
) and (floorY
= y
) then
841 if not inAir
then hitAFloor();
842 break
; // done with vertical movement
849 break
; // done with vertical movement
862 if (g_Map_PanelAtPoint(x
, y
, GridTagObstacle
) <> nil) then begin die(); exit
; end;
866 if (x
< g_Map_MinX
) or (y
< g_Map_MinY
) or (x
> g_Map_MaxX
) or (y
> g_Map_MaxY
) then begin die(); end;
871 // blood will dissolve in other liquids
872 if (particleType
= TPartType
.Blood
) then
874 if (env
= TEnvType
.ELiquid
) then
880 if (liveTime
<= 0) then begin die(); exit
; end;
881 ex
:= 255-trunc(255.0*time
/liveTime
);
882 if (ex
<= 10) then begin die(); exit
; end;
883 if (ex
> 250) then ex
:= 255;
889 // water will disappear in any liquid
890 if (env
= TEnvType
.ELiquid
) then begin die(); exit
; end;
896 if (liveTime
<= 0) then begin die(); exit
; end;
897 ex
:= 255-trunc(255.0*time
/liveTime
);
898 if (ex
<= 10) then begin die(); exit
; end;
899 if (ex
> 250) then ex
:= 255;
905 // ////////////////////////////////////////////////////////////////////////// //
906 procedure g_GFX_SparkVel (fX
, fY
: Integer; count
: Word; vx
, vy
: Integer; devX
, devY
: Byte); forward;
908 procedure g_GFX_Blood (fX
, fY
: Integer; count
: Word; vx
, vy
: Integer;
909 devX
, devY
: Word; cr
, cg
, cb
: Byte; kind
: Byte = BLOOD_NORMAL
);
911 function genColor (cbase
, crnd
: Integer; def
: Byte=0): Byte;
916 if (cbase
< 0) then result
:= 0
917 else if (cbase
> 255) then result
:= 255
918 else result
:= Byte(cbase
);
928 devX1
, devX2
, devY1
, devY2
: Integer;
933 if not gpart_dbg_enabled
then exit
;
935 if (kind
= BLOOD_SPARKS
) then
937 g_GFX_SparkVel(fX
, fY
, 2+Random(2), -vx
div 2, -vy
div 2, devX
, devY
);
940 else if (kind
= BLOOD_CSPARKS
) OR (kind
= BLOOD_COMBINE
) then
942 g_GFX_SparkVel(fX
, fY
, count
, -vx
div 2, -vy
div 2, devX
, devY
);
943 if kind
<> BLOOD_COMBINE
then exit
946 l
:= Length(Particles
);
947 if (l
= 0) then exit
;
948 if (count
> l
) then count
:= l
;
955 for a
:= 1 to count
do
957 with Particles
[CurrentParticle
] do
959 x
:= fX
-devX1
+Random(devX2
);
960 y
:= fY
-devY1
+Random(devY2
);
962 // check for level bounds
963 if (x
< g_Map_MinX
) or (y
< g_Map_MinY
) or (x
> g_Map_MaxX
) or (y
> g_Map_MaxY
) then continue
;
965 // in what environment we are starting in?
966 pan
:= g_Map_PanelAtPoint(x
, y
, (GridTagObstacle
or GridTagLiquid
));
969 // either in a wall, or in a liquid
970 if ((pan
.tag
and GridTagObstacle
) <> 0) then continue
; // don't spawn in walls
971 env
:= TEnvType
.ELiquid
;
975 env
:= TEnvType
.EAir
;
978 velX
:= vx
+(Random
-Random
)*3;
979 velY
:= vy
+(Random
-Random
)*3;
983 if (velY
-4 < -4) then velY
:= -4 else velY
:= velY
-4;
986 accelX
:= -sign(velX
)*Random
/100;
989 crnd
:= 20*Random(6)-50;
991 red
:= genColor(cr
, CRnd
, 0);
992 green
:= genColor(cg
, CRnd
, 0);
993 blue
:= genColor(cb
, CRnd
, 0);
996 particleType
:= TPartType
.Blood
;
997 state
:= TPartState
.Normal
;
999 liveTime
:= 120+Random(40);
1002 ceilingY
:= Unknown
;
1005 if (CurrentParticle
>= MaxParticles
-1) then CurrentParticle
:= 0 else CurrentParticle
+= 1;
1010 procedure g_GFX_Water (fX
, fY
: Integer; count
: Word; fVelX
, fVelY
: Single; devX
, devY
, color
: Byte;
1011 simple
: Boolean=false; cr
: Byte=0; cg
: Byte=0; cb
: Byte=0);
1014 devX1
, devX2
, devY1
, devY2
: Integer;
1018 if not gpart_dbg_enabled
then exit
;
1020 l
:= Length(Particles
);
1021 if (l
= 0) then exit
;
1022 if (count
> l
) then count
:= l
;
1024 if (abs(fVelX
) < 3.0) then fVelX
:= 3.0-6.0*Random
;
1026 devX1
:= devX
div 2;
1028 devY1
:= devY
div 2;
1031 if (not simple
) and (color
> 3) then color
:= 0;
1033 for a
:= 1 to count
do
1035 with Particles
[CurrentParticle
] do
1039 x
:= fX
-devX1
+Random(devX2
);
1040 y
:= fY
-devY1
+Random(devY2
);
1042 if (abs(fVelX
) < 0.5) then velX
:= 1.0-2.0*Random
else velX
:= fVelX
*Random
;
1043 if (Random(10) < 7) then velX
:= -velX
;
1044 velY
:= fVelY
*Random
;
1059 // check for level bounds
1060 if (x
< g_Map_MinX
) or (y
< g_Map_MinY
) or (x
> g_Map_MaxX
) or (y
> g_Map_MaxY
) then continue
;
1062 // this hack will allow water spawned in water to fly out
1063 // it can happen when player fell from a huge height (see "DOOM2D.WAD:\MAP03", for example)
1064 if (fVelY
>= 0) then
1066 // in what environment we are starting in?
1067 pan
:= g_Map_PanelAtPoint(x
, y
, (GridTagObstacle
or GridTagLiquid
));
1071 pan
:= g_Map_PanelAtPoint(x
, y
, GridTagObstacle
);
1073 if (pan
<> nil) then continue
;
1074 env
:= TEnvType
.EAir
;
1080 red
:= 155+Random(9)*10;
1081 green
:= trunc(150*Random
);
1086 red
:= trunc(150*Random
);
1087 green
:= 175+Random(9)*10;
1092 red
:= trunc(200*Random
);
1094 blue
:= 175+Random(9)*10;
1096 4: // Ñâîé öâåò, ñâåòëåå
1098 red
:= 20+Random(19)*10;
1101 red
:= nmin(red
+cr
, 255);
1102 green
:= nmin(green
+cg
, 255);
1103 blue
:= nmin(blue
+cb
, 255);
1105 5: // Ñâîé öâåò, òåìÃåå
1107 red
:= 20+Random(19)*10;
1110 red
:= nmax(cr
-red
, 0);
1111 green
:= nmax(cg
-green
, 0);
1112 blue
:= nmax(cb
-blue
, 0);
1116 red
:= 90+random(12)*10;
1123 particleType
:= TPartType
.Water
;
1124 state
:= TPartState
.Normal
;
1126 liveTime
:= 60+Random(60);
1129 ceilingY
:= Unknown
;
1132 if (CurrentParticle
>= MaxParticles
-1) then CurrentParticle
:= 0 else CurrentParticle
+= 1;
1137 procedure g_GFX_SimpleWater (fX
, fY
: Integer; count
: Word; fVelX
, fVelY
: Single; defColor
, cr
, cg
, cb
: Byte);
1139 g_GFX_Water(fX
, fY
, count
, 0, 0, 0, 0, defColor
, true, cr
, cg
, cb
);
1143 // ////////////////////////////////////////////////////////////////////////// //
1144 procedure TParticle
.thinkerBubble ();
1155 if (y
<= ceilingY
) then begin die(); exit
; end;
1159 if (y
>= floorY
) then begin die(); exit
; end;
1161 if (y
< g_Map_MinY
) or (y
> g_Map_MaxY
) then begin die(); exit
; end;
1164 if (velY
> -4) then velY
+= accelY
;
1166 if waitTime
> 0 then
1173 {.$DEFINE D2F_DEBUG_BUBBLES}
1174 procedure g_GFX_Bubbles (fX
, fY
: Integer; count
: Word; devX
, devY
: Byte);
1176 a
, liquidx
: Integer;
1177 devX1
, devX2
, devY1
, devY2
: Integer;
1179 {$IF DEFINED(D2F_DEBUG_BUBBLES)}
1184 if not gpart_dbg_enabled
then exit
;
1186 l
:= Length(Particles
);
1187 if (l
= 0) then exit
;
1188 if (count
> l
) then count
:= l
;
1190 devX1
:= devX
div 2;
1192 devY1
:= devY
div 2;
1195 for a
:= 1 to count
do
1197 with Particles
[CurrentParticle
] do
1199 x
:= fX
-devX1
+Random(devX2
);
1200 y
:= fY
-devY1
+Random(devY2
);
1202 // check for level bounds
1203 if (x
< g_Map_MinX
) or (y
< g_Map_MinY
) or (x
> g_Map_MaxX
) or (y
> g_Map_MaxY
) then continue
;
1206 // don't spawn bubbles outside of the liquid
1207 if not isLiquidAt(X, Y) {ByteBool(gCollideMap[Y, X] and MARK_LIQUID)} then
1211 // trace liquid, so we'll know where it ends; do it in 8px steps for speed
1212 // tracer will return `false` if we started outside of the liquid
1214 {$IF DEFINED(D2F_DEBUG_BUBBLES)}
1215 stt
:= getTimeMicro();
1216 ptr
:= mapGrid
.traceOrthoRayWhileIn(liquidx
, liquidTopY
, x
, y
, x
, 0, GridTagWater
or GridTagAcid1
or GridTagAcid2
);
1217 stt
:= getTimeMicro()-stt
;
1218 e_LogWritefln('traceOrthoRayWhileIn: time=%s (%s); liquidTopY=%s', [Integer(stt
), ptr
, liquidTopY
]);
1220 stt
:= getTimeMicro();
1221 nptr
:= g_Map_TraceLiquidNonPrecise(x
, y
, 0, -8, liquidx
, liquidTopY
);
1222 stt
:= getTimeMicro()-stt
;
1223 e_LogWritefln('g_Map_TraceLiquidNonPrecise: time=%s (%s); liquidTopY=%s', [Integer(stt
), nptr
, liquidTopY
]);
1224 if not nptr
then continue
;
1226 if not g_Map_TraceLiquidNonPrecise(x
, y
, 0, -8, liquidx
, ceilingY
) then continue
;
1227 if not g_Map_TraceLiquidNonPrecise(x
, y
, 0, +8, liquidx
, floorY
) then continue
;
1240 state
:= TPartState
.Normal
;
1241 particleType
:= TPartType
.Bubbles
;
1247 if (CurrentParticle
>= MaxParticles
-1) then CurrentParticle
:= 0 else CurrentParticle
+= 1;
1252 // ////////////////////////////////////////////////////////////////////////// //
1253 procedure TParticle
.thinkerSpark ();
1261 if not gpart_dbg_phys_enabled
then begin x
+= round(velX
); y
+= round(velY
); goto _done
; end;
1266 //writeln('spark0: pos=(', x, ',', y, '); delta=(', dx, ',', dy, '); state=', state, '; ceilingY=', ceilingY, '; floorY=', floorY);
1269 if (abs(velX
) < 0.1) and (abs(velY
) < 0.1) then
1278 // has some horizontal velocity
1279 pan
:= g_Map_traceToNearest(x
, y
, x
+dx
, y
+dy
, (GridTagObstacle
or GridTagLiquid
), @ex
, @ey
);
1280 if (x
<> ex
) then begin floorY
:= Unknown
; ceilingY
:= Unknown
; end; // dunno yet
1283 if (pan
<> nil) then
1285 if ((pan
.tag
and GridTagLiquid
) <> 0) then begin die(); exit
; end; // die in liquid
1286 // hit the wall; falling down vertically
1291 else if (dy
<> 0) then
1293 // has some vertical velocity
1297 if (ceilingY
= Unknown
) then findCeiling(); // need to do this anyway
1299 if (y
<= ceilingY
) then
1301 // oops, hit a ceiling
1304 accelY
:= abs(accelY
);
1306 // environment didn't changed
1311 if (floorY
= Unknown
) then findFloor(); // need to do this anyway
1313 if (y
>= floorY
) then
1315 // hit something except a floor?
1316 if (floorType
<> TFloorType
.Wall
) then begin die(); exit
; end; // yep: just die
1317 // otherwise, go to sleep
1320 // environment didn't changed
1326 if (x
< g_Map_MinX
) or (y
< g_Map_MinY
) or (x
> g_Map_MaxX
) or (y
> g_Map_MaxY
) then begin die(); end;
1328 if (velX
<> 0.0) then velX
+= accelX
;
1330 if (velY
<> 0.0) then
1332 if (accelY
< 10) then accelY
+= 0.08;
1336 //writeln('spark1: pos=(', x, ',', y, '); delta=(', velX:6:3, ',', velY:6:3, '); state=', state, '; ceilingY=', ceilingY, '; floorY=', floorY);
1338 if waitTime
> 0 then
1345 // ////////////////////////////////////////////////////////////////////////// //
1346 procedure g_GFX_SparkVel (fX
, fY
: Integer; count
: Word; vx
, vy
: Integer; devX
, devY
: Byte);
1349 devX1
, devX2
, devY1
, devY2
: Integer;
1353 if not gpart_dbg_enabled
then exit
;
1355 l
:= Length(Particles
);
1356 if (l
= 0) then exit
;
1357 if (count
> l
) then count
:= l
;
1359 devX1
:= devX
div 2;
1361 devY1
:= devY
div 2;
1364 for a
:= 1 to count
do
1366 with Particles
[CurrentParticle
] do
1368 x
:= fX
-devX1
+Random(devX2
);
1369 y
:= fY
-devY1
+Random(devY2
);
1371 // check for level bounds
1372 if (x
< g_Map_MinX
) or (y
< g_Map_MinY
) or (x
> g_Map_MaxX
) or (y
> g_Map_MaxY
) then continue
;
1374 // in what environment we are starting in?
1375 pan
:= g_Map_PanelAtPoint(x
, y
, (GridTagObstacle
or GridTagLiquid
));
1376 if (pan
<> nil) then
1378 // either in a wall, or in a liquid
1379 //if ((pan.tag and GridTagObstacle) <> 0) then continue; // don't spawn in walls
1380 //env := TEnvType.ELiquid;
1385 env
:= TEnvType
.EAir
;
1388 velX
:= vx
+(Random
-Random
)*3;
1389 velY
:= vy
+(Random
-Random
)*3;
1393 if (velY
-4 < -4) then velY
:= -4 else velY
:= velY
-4;
1396 accelX
:= -sign(velX
)*Random
/100;
1400 green
:= 100+Random(155);
1404 particleType
:= TPartType
.Spark
;
1405 state
:= TPartState
.Normal
;
1407 liveTime
:= 30+Random(60);
1410 ceilingY
:= Unknown
;
1413 if (CurrentParticle
>= MaxParticles
-1) then CurrentParticle
:= 0 else CurrentParticle
+= 1;
1418 procedure g_GFX_Spark (fX
, fY
: Integer; count
: Word; angle
: SmallInt
; devX
, devY
: Byte);
1422 devX1
, devX2
, devY1
, devY2
: Integer;
1423 baseVelX
, baseVelY
: Single;
1427 if not gpart_dbg_enabled
then exit
;
1429 l
:= Length(Particles
);
1430 if (l
= 0) then exit
;
1431 if (count
> l
) then count
:= l
;
1435 devX1
:= devX
div 2;
1437 devY1
:= devY
div 2;
1440 b
:= DegToRad(angle
);
1442 baseVelY
:= 1.6*sin(b
);
1443 if (abs(baseVelX
) < 0.01) then baseVelX
:= 0.0;
1444 if (abs(baseVelY
) < 0.01) then baseVelY
:= 0.0;
1446 for a
:= 1 to count
do
1448 with Particles
[CurrentParticle
] do
1450 x
:= fX
-devX1
+Random(devX2
);
1451 y
:= fY
-devY1
+Random(devY2
);
1453 // check for level bounds
1454 if (x
< g_Map_MinX
) or (y
< g_Map_MinY
) or (x
> g_Map_MaxX
) or (y
> g_Map_MaxY
) then continue
;
1456 // in what environment we are starting in?
1457 pan
:= g_Map_PanelAtPoint(x
, y
, (GridTagObstacle
or GridTagLiquid
));
1458 if (pan
<> nil) then
1460 // either in a wall, or in a liquid
1461 //if ((pan.tag and GridTagObstacle) <> 0) then continue; // don't spawn in walls
1462 //env := TEnvType.ELiquid;
1467 env
:= TEnvType
.EAir
;
1470 velX
:= baseVelX
*Random
;
1471 velY
:= baseVelY
-Random
;
1476 green
:= 100+Random(155);
1480 particleType
:= TPartType
.Spark
;
1481 state
:= TPartState
.Normal
;
1483 liveTime
:= 30+Random(60);
1486 ceilingY
:= Unknown
;
1489 if (CurrentParticle
>= MaxParticles
-1) then CurrentParticle
:= 0 else CurrentParticle
+= 1;
1494 // ////////////////////////////////////////////////////////////////////////// //
1495 procedure g_GFX_SetMax (count
: Integer);
1499 if count
> 50000 then count
:= 50000;
1500 if (count
< 1) then count
:= 1;
1501 SetLength(Particles
, count
);
1502 for a
:= 0 to High(Particles
) do Particles
[a
].die();
1503 MaxParticles
:= count
;
1504 CurrentParticle
:= 0;
1508 function g_GFX_GetMax (): Integer;
1510 result
:= MaxParticles
;
1514 function FindOnceAnim (): DWORD
;
1518 if OnceAnims
<> nil then
1519 for i
:= 0 to High(OnceAnims
) do
1520 if OnceAnims
[i
].Animation
= nil then
1526 if OnceAnims
= nil then
1528 SetLength(OnceAnims
, 16);
1533 Result
:= High(OnceAnims
) + 1;
1534 SetLength(OnceAnims
, Length(OnceAnims
) + 16);
1539 procedure g_GFX_OnceAnim (x
, y
: Integer; Anim
: TAnimation
; AnimType
: Byte = 0);
1543 if not gpart_dbg_enabled
then exit
;
1545 if (Anim
= nil) then exit
;
1547 find_id
:= FindOnceAnim();
1549 OnceAnims
[find_id
].AnimType
:= AnimType
;
1550 OnceAnims
[find_id
].Animation
:= TAnimation
.Create(Anim
.FramesID
, Anim
.Loop
, Anim
.Speed
);
1551 OnceAnims
[find_id
].Animation
.Blending
:= Anim
.Blending
;
1552 OnceAnims
[find_id
].Animation
.alpha
:= Anim
.alpha
;
1553 OnceAnims
[find_id
].x
:= x
;
1554 OnceAnims
[find_id
].y
:= y
;
1558 // ////////////////////////////////////////////////////////////////////////// //
1559 procedure g_GFX_Init ();
1561 //g_Game_SetLoadingText(_lc[I_LOAD_COLLIDE_MAP]+' 1/6', 0, False);
1562 //SetLength(gCollideMap, gMapInfo.Height+1);
1563 //for a := 0 to High(gCollideMap) do SetLength(gCollideMap[a], gMapInfo.Width+1);
1566 gpart_dbg_enabled
:= false;
1571 procedure g_GFX_Free ();
1576 SetLength(Particles
, MaxParticles
);
1577 for a
:= 0 to High(Particles
) do Particles
[a
].die();
1578 CurrentParticle
:= 0;
1580 if (OnceAnims
<> nil) then
1582 for a
:= 0 to High(OnceAnims
) do OnceAnims
[a
].Animation
.Free();
1593 // ////////////////////////////////////////////////////////////////////////// //
1594 procedure g_GFX_Update ();
1600 if not gpart_dbg_enabled
then exit
;
1602 if (Particles
<> nil) then
1604 w
:= gMapInfo
.Width
;
1605 h
:= gMapInfo
.Height
;
1607 len
:= High(Particles
);
1609 for a
:= 0 to len
do
1611 if Particles
[a
].alive
then
1613 with Particles
[a
] do
1615 if (time
= liveTime
) then begin die(); continue
; end;
1616 if (x
+1 >= w
) or (y
+1 >= h
) or (x
<= 0) or (y
<= 0) then begin die(); end;
1621 end; // Particles <> nil
1626 if OnceAnims
<> nil then
1628 for a
:= 0 to High(OnceAnims
) do
1629 if OnceAnims
[a
].Animation
<> nil then
1631 case OnceAnims
[a
].AnimType
of
1634 if Random(3) = 0 then
1635 OnceAnims
[a
].x
:= OnceAnims
[a
].x
-1+Random(3);
1636 if Random(2) = 0 then
1637 OnceAnims
[a
].y
:= OnceAnims
[a
].y
-Random(2);
1641 if OnceAnims
[a
].Animation
.Played
then
1643 OnceAnims
[a
].Animation
.Free();
1644 OnceAnims
[a
].Animation
:= nil;
1647 OnceAnims
[a
].Animation
.Update();
1653 procedure g_GFX_Draw ();
1660 r
, g
, b
, a
: GLfloat
;
1667 if not gpart_dbg_enabled
then exit
;
1669 if (Particles
<> nil) then
1671 glDisable(GL_TEXTURE_2D
);
1672 if (g_dbg_scale
< 0.6) then glPointSize(1)
1673 else if (g_dbg_scale
> 1.3) then glPointSize(g_dbg_scale
+1)
1674 else glPointSize(2);
1675 glDisable(GL_POINT_SMOOTH
);
1678 glBlendFunc(GL_SRC_ALPHA
, GL_ONE_MINUS_SRC_ALPHA
);
1682 SetLength(v
, Length(Particles
));
1683 for a
:= 0 to High(Particles
) do
1685 with Particles
[a
] do
1687 if alive
and (x
>= sX
) and (y
>= sY
) and (x
<= sX
+ sWidth
) and (sY
<= sY
+ sHeight
) then
1689 v
[count
].x
:= x
+ 0.37;
1690 v
[count
].y
:= y
+ 0.37;
1691 v
[count
].r
:= red
/ 255;
1692 v
[count
].g
:= green
/ 255;
1693 v
[count
].b
:= blue
/ 255;
1694 v
[count
].a
:= alpha
/ 255;
1700 glVertexPointer(2, GL_FLOAT
, SizeOf(Vertex
), @v
[0].x
);
1701 glColorPointer(4, GL_FLOAT
, SizeOf(Vertex
), @v
[0].r
);
1702 glEnableClientState(GL_VERTEX_ARRAY
);
1703 glEnableClientState(GL_COLOR_ARRAY
);
1704 glDisableClientState(GL_NORMAL_ARRAY
);
1705 glDisableClientState(GL_TEXTURE_COORD_ARRAY
);
1706 glDrawArrays(GL_POINTS
, 0, count
);
1710 len
:= High(Particles
);
1711 for a
:= 0 to len
do
1713 with Particles
[a
] do
1715 if not alive
then continue
;
1716 if (x
>= sX
) and (y
>= sY
) and (x
<= sX
+sWidth
) and (sY
<= sY
+sHeight
) then
1718 glColor4ub(red
, green
, blue
, alpha
);
1719 glVertex2f(x
+0.37, y
+0.37);
1727 glDisable(GL_BLEND
);
1730 if (OnceAnims
<> nil) then
1732 len
:= High(OnceAnims
);
1733 for a
:= 0 to len
do
1735 if (OnceAnims
[a
].Animation
<> nil) then
1737 with OnceAnims
[a
] do Animation
.Draw(x
, y
, TMirrorType
.None
);