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}
42 MARK_BLOCKED
= MARK_WALL
or MARK_DOOR
;
43 MARK_LIQUID
= MARK_WATER
or MARK_ACID
;
44 MARK_LIFT
= MARK_LIFTDOWN
or MARK_LIFTUP
or MARK_LIFTLEFT
or MARK_LIFTRIGHT
;
47 procedure g_GFX_Init ();
48 procedure g_GFX_Free ();
50 procedure g_GFX_Blood (fX
, fY
: Integer; count
: Word; vx
, vy
: Integer;
51 devX
, devY
: Word; cr
, cg
, cb
: Byte; kind
: Byte=BLOOD_NORMAL
);
52 procedure g_GFX_Spark (fX
, fY
: Integer; count
: Word; angle
: SmallInt
; devX
, devY
: Byte);
53 procedure g_GFX_Water (fX
, fY
: Integer; count
: Word; fVelX
, fVelY
: Single; devX
, devY
, color
: Byte;
54 simple
: Boolean=false; cr
: Byte=0; cg
: Byte=0; cb
: Byte=0);
55 procedure g_GFX_SimpleWater (fX
, fY
: Integer; count
: Word; fVelX
, fVelY
: Single; defColor
, cr
, cg
, cb
: Byte);
56 procedure g_GFX_Bubbles (fX
, fY
: Integer; count
: Word; devX
, devY
: Byte);
58 procedure g_GFX_SetMax (count
: Integer);
59 function g_GFX_GetMax (): Integer;
61 procedure g_GFX_OnceAnim (X
, Y
: Integer; Anim
: TAnimation
; AnimType
: Byte = 0);
63 procedure g_Mark (x
, y
, Width
, Height
: Integer; t
: Byte; st
: Boolean=true);
65 procedure g_GFX_Update ();
66 procedure g_GFX_Draw ();
70 gpart_dbg_enabled
: Boolean = true;
71 gpart_dbg_phys_enabled
: Boolean = true;
74 //WARNING: only for Holmes!
75 function awmIsSetHolmes (x
, y
: Integer): Boolean; inline;
86 g_map
, g_panel
, g_basic
, Math
, e_graphics
,
87 g_options
, g_console
, SysUtils
, g_triggers
, MAPDEF
,
88 g_game
, g_language
, g_net
, utils
, xprofiler
;
92 Unknown
= Integer($7fffffff);
96 TPartType
= (Blood
, Spark
, Bubbles
, Water
);
97 TPartState
= (Free
, Normal
, Stuck
, Sleeping
);
98 TFloorType
= (Wall
, LiquidIn
, LiquidOut
);
99 // Wall: floorY is just before floor
100 // LiquidIn: floorY is liquid *start* (i.e. just in a liquid)
101 // LiquidOut: floorY is liquid *end* (i.e. just out of a liquid)
102 TEnvType
= (EAir
, ELiquid
, EWall
); // where particle is now
104 // note: this MUST be record, so we can keep it in
105 // dynamic array and has sequential memory access pattern
106 PParticle
= ^TParticle
;
110 accelX
, accelY
: Single;
112 particleType
: TPartType
;
113 red
, green
, blue
: Byte;
115 time
, liveTime
: Word;
116 stickDX
: Integer; // STATE_STICK: -1,1: stuck to a wall; 0: stuck to ceiling
117 justSticked
: Boolean; // not used
118 floorY
: Integer; // actually, floor-1; `Unknown`: unknown
119 floorType
: TFloorType
;
120 env
: TEnvType
; // where particle is now
121 ceilingY
: Integer; // actually, ceiling+1; `Unknown`: unknown
122 wallEndY
: Integer; // if we stuck to a wall, this is where wall ends
124 //k8: sorry, i have to emulate virtual methods this way, 'cause i haet `Object`
125 procedure thinkerBloodAndWater ();
126 procedure thinkerSpark ();
127 procedure thinkerBubble ();
129 procedure findFloor (force
: Boolean=false); // this updates `floorY` if forced or Unknown
130 procedure findCeiling (force
: Boolean=false); // this updates `ceilingY` if forced or Unknown
132 procedure freeze (); inline; // remove velocities and acceleration
133 procedure sleep (); inline; // switch to sleep mode
135 function checkAirStreams (): Boolean; // `true`: affected by air stream
137 function alive (): Boolean; inline;
138 procedure die (); inline;
139 procedure think (); inline;
145 Animation
: TAnimation
;
150 Particles
: array of TParticle
= nil;
151 OnceAnims
: array of TOnceAnim
= nil;
152 MaxParticles
: Integer = 0;
153 CurrentParticle
: Integer = 0;
154 // awakeMap has one bit for each map grid cell; on g_Mark,
155 // corresponding bits will be set, and in `think()` all particles
156 // in marked cells will be awaken
157 awakeMap
: packed array of LongWord
= nil;
158 awakeMapH
: Integer = -1;
159 awakeMapW
: Integer = -1;
160 awakeMinX
, awakeMinY
: Integer;
161 awakeDirty
: Boolean = false;
162 {$IF DEFINED(D2F_DEBUG_PART_AWAKE)}
163 awakeMapHlm
: packed array of LongWord
= nil;
167 // ////////////////////////////////////////////////////////////////////////// //
168 function awmIsSetHolmes (x
, y
: Integer): Boolean; inline;
170 {$IF DEFINED(D2F_DEBUG_PART_AWAKE)}
171 if (Length(awakeMapHlm
) = 0) then begin result
:= false; exit
; end;
172 x
:= (x
-awakeMinX
) div mapGrid
.tileSize
;
173 y
:= (y
-awakeMinY
) div mapGrid
.tileSize
;
174 if (x
>= 0) and (y
>= 0) and (x
div 32 < awakeMapW
) and (y
< awakeMapH
) then
176 if (y
*awakeMapW
+x
div 32 < Length(awakeMapHlm
)) then
178 result
:= ((awakeMapHlm
[y
*awakeMapW
+x
div 32] and (LongWord(1) shl (x
mod 32))) <> 0);
195 // ////////////////////////////////////////////////////////////////////////// //
196 // HACK! using mapgrid
197 procedure awmClear (); inline;
199 {$IF DEFINED(D2F_DEBUG_PART_AWAKE)}
200 if (Length(awakeMap
) > 0) then
202 if (Length(awakeMapHlm
) <> Length(awakeMap
)) then SetLength(awakeMapHlm
, Length(awakeMap
));
203 Move(awakeMap
[0], awakeMapHlm
[0], Length(awakeMap
)*sizeof(awakeMap
[0]));
206 if awakeDirty
and (awakeMapW
> 0) then
208 FillDWord(awakeMap
[0], Length(awakeMap
), 0);
214 procedure awmSetup ();
216 assert(mapGrid
<> nil);
217 awakeMapW
:= (mapGrid
.gridWidth
+mapGrid
.tileSize
-1) div mapGrid
.tileSize
;
218 awakeMapW
:= (awakeMapW
+31) div 32; // LongWord has 32 bits ;-)
219 awakeMapH
:= (mapGrid
.gridHeight
+mapGrid
.tileSize
-1) div mapGrid
.tileSize
;
220 awakeMinX
:= mapGrid
.gridX0
;
221 awakeMinY
:= mapGrid
.gridY0
;
222 SetLength(awakeMap
, awakeMapW
*awakeMapH
);
223 {$IF DEFINED(D2F_DEBUG_PART_AWAKE)}
224 SetLength(awakeMapHlm
, awakeMapW
*awakeMapH
);
225 FillDWord(awakeMapHlm
[0], Length(awakeMapHlm
), 0);
227 //{$IF DEFINED(D2F_DEBUG)}
228 e_LogWritefln('particle awake map: %sx%s (for grid of size %sx%s)', [awakeMapW
, awakeMapH
, mapGrid
.gridWidth
, mapGrid
.gridHeight
]);
235 function awmIsSet (x
, y
: Integer): Boolean; inline;
237 x
:= (x
-awakeMinX
) div mapGrid
.tileSize
;
238 y
:= (y
-awakeMinY
) div mapGrid
.tileSize
;
239 if (x
>= 0) and (y
>= 0) and (x
div 32 < awakeMapW
) and (y
< awakeMapH
) then
241 {$IF DEFINED(D2F_DEBUG)}
242 assert(y
*awakeMapW
+x
div 32 < Length(awakeMap
));
244 result
:= ((awakeMap
[y
*awakeMapW
+x
div 32] and (LongWord(1) shl (x
mod 32))) <> 0);
253 procedure awmSet (x
, y
: Integer); inline;
257 x
:= (x
-awakeMinX
) div mapGrid
.tileSize
;
258 y
:= (y
-awakeMinY
) div mapGrid
.tileSize
;
259 if (x
>= 0) and (y
>= 0) and (x
div 32 < awakeMapW
) and (y
< awakeMapH
) then
261 {$IF DEFINED(D2F_DEBUG)}
262 assert(y
*awakeMapW
+x
div 32 < Length(awakeMap
));
264 v
:= @awakeMap
[y
*awakeMapW
+x
div 32];
265 v
^ := v
^ or (LongWord(1) shl (x
mod 32));
271 // ////////////////////////////////////////////////////////////////////////// //
275 procedure g_Mark (x
, y
, Width
, Height
: Integer; t
: Byte; st
: Boolean=true);
278 dx
, dy
, ex
, ey
: Integer;
281 if (not gpart_dbg_enabled
) or (not gpart_dbg_phys_enabled
) then exit
;
282 if (awakeMapW
< 1) or (awakeMapH
< 1) then exit
;
284 if (Width
< 1) or (Height
< 1) then exit
;
286 // make some border, so we'll hit particles around the panel
287 ex
:= x
+Width
+Extrude
-1-awakeMinX
;
288 ey
:= y
+Height
+Extrude
-1-awakeMinY
;
289 x
:= (x
-Extrude
)-awakeMinX
;
290 y
:= (y
-Extrude
)-awakeMinY
;
292 x
:= x
div mapGrid
.tileSize
;
293 y
:= y
div mapGrid
.tileSize
;
294 ex
:= ex
div mapGrid
.tileSize
;
295 ey
:= ey
div mapGrid
.tileSize
;
297 // has something to do?
298 if (ex
< 0) or (ey
< 0) or (x
>= awakeMapW
*32) or (y
>= awakeMapH
) then exit
;
299 if (x
< 0) then x
:= 0;
300 if (y
< 0) then y
:= 0;
301 if (ex
>= awakeMapW
*32) then ex
:= awakeMapW
*32-1;
302 if (ey
>= awakeMapH
) then ey
:= awakeMapH
;
309 {$IF DEFINED(D2F_DEBUG)}
310 assert((dx
>= 0) and (dy
>= 0) and (dx
div 32 < awakeMapW
) and (dy
< awakeMapH
));
311 assert(dy
*awakeMapW
+dx
div 32 < Length(awakeMap
));
313 v
:= @awakeMap
[dy
*awakeMapW
+dx
div 32];
314 v
^ := v
^ or (LongWord(1) shl (dx
mod 32));
320 // ////////////////////////////////////////////////////////////////////////// //
321 function TParticle
.alive (): Boolean; inline; begin result
:= (state
<> TPartState
.Free
); end;
322 procedure TParticle
.die (); inline; begin state
:= TPartState
.Free
; end;
324 // remove velocities and acceleration
325 procedure TParticle
.freeze (); inline;
327 // stop right there, you criminal scum!
335 // `true`: affected by air stream
336 function TParticle
.checkAirStreams (): Boolean;
340 pan
:= g_Map_PanelAtPoint(x
, y
, GridTagLift
);
341 result
:= (pan
<> nil);
344 if ((pan
.PanelType
and PANEL_LIFTUP
) <> 0) then
346 if (velY
> -4-Random(3)) 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_LIFTLEFT
) <> 0) then
353 if (velX
> -8-Random(3)) then velX
-= 0.8;
356 else if ((pan
.PanelType
and PANEL_LIFTRIGHT
) <> 0) then
358 if (velX
< 8+Random(3)) then velX
+= 0.8;
366 if result
and (state
= TPartState
.Sleeping
) then state
:= TPartState
.Normal
;
371 // switch to sleep mode
372 procedure TParticle
.sleep (); inline;
374 if not checkAirStreams() then
376 state
:= TPartState
.Sleeping
;
382 procedure TParticle
.findFloor (force
: Boolean=false);
387 if (not force
) and (floorY
<> Unknown
) then exit
;
388 // stuck in the wall? rescan, 'cause it can be mplat
389 if (env
= TEnvType
.EWall
) then
391 pan
:= g_Map_PanelAtPoint(x
, y
, (GridTagObstacle
or GridTagLiquid
));
394 // either in a wall, or in a liquid
395 if ((pan
.tag
and GridTagObstacle
) <> 0) then
397 // we are in the wall, wtf?!
399 env
:= TEnvType
.EWall
;
400 floorType
:= TFloorType
.Wall
;
401 state
:= TPartState
.Sleeping
; // anyway
404 // we are in liquid, trace to liquid end
405 env
:= TEnvType
.ELiquid
;
408 // are we in a liquid?
409 if (env
= TEnvType
.ELiquid
) then
411 // trace out of the liquid
412 //env := TEnvType.ELiquid;
413 floorType
:= TFloorType
.LiquidOut
;
414 //e_LogWritefln('tracing out of a liquid; floorY=%s; y=%s', [floorY, y]);
415 mapGrid
.traceOrthoRayWhileIn(ex
, floorY
, x
, y
, x
, g_Map_MaxY
, GridTagLiquid
);
416 floorY
+= 1; // so `floorY` is just out of a liquid
417 //e_LogWritefln(' traced out of a liquid; floorY=%s; y=%s', [floorY, y]);
422 assert(env
= TEnvType
.EAir
);
423 //env := TEnvType.EAir;
424 pan
:= g_Map_traceToNearest(x
, y
, x
, g_Map_MaxY
, (GridTagObstacle
or GridTagLiquid
), @ex
, @floorY
);
428 if ((pan
.tag
and GridTagObstacle
) <> 0) then
431 floorType
:= TFloorType
.Wall
;
436 floorType
:= TFloorType
.LiquidIn
; // entering liquid
437 floorY
+= 1; // so `floorY` is just in a liquid
442 // out of the level; assume wall, but it doesn't really matter
443 floorType
:= TFloorType
.Wall
;
444 floorY
:= g_Map_MaxY
+2;
450 procedure TParticle
.findCeiling (force
: Boolean=false);
454 if (not force
) and (ceilingY
<> Unknown
) then exit
;
455 if (nil = g_Map_traceToNearest(x
, y
, x
, g_Map_MinY
, GridTagObstacle
, @ex
, @ceilingY
)) then
457 ceilingY
:= g_Map_MinY
-2;
462 procedure TParticle
.think (); inline;
465 if (state
= TPartState
.Stuck
) then
467 //writeln('awaking particle at (', x, ',', y, ')');
468 if (stickDX
= 0) then
470 state
:= TPartState
.Normal
; // stuck to a ceiling
474 // stuck to a wall, check if wall is still there
475 if (wallEndY
<> Unknown
) then
478 if (g_Map_PanelAtPoint(x
+stickDX
, y
, GridTagObstacle
) = nil) then
480 // a wall was moved out, start falling
481 state
:= TPartState
.Normal
;
482 if (velY
= 0) then velY
:= 0.1;
483 if (accelY
= 0) then accelY
:= 0.5;
490 state
:= TPartState
.Normal
;
491 if (velY
= 0) then velY
:= 0.1;
492 if (accelY
= 0) then accelY
:= 0.5;
499 // awake sleeping particle, if necessary
502 if awmIsSet(x
, y
) then awake();
505 TPartState.Sleeping, TPartState.Stuck:
506 if awmIsSet(x, y) then awake();
508 if (env = TEnvType.EWall) and awmIsSet(x, y) then awake();
513 TPartType
.Blood
, TPartType
.Water
: thinkerBloodAndWater();
514 TPartType
.Spark
: thinkerSpark();
515 TPartType
.Bubbles
: thinkerBubble();
520 // ////////////////////////////////////////////////////////////////////////// //
521 procedure TParticle
.thinkerBloodAndWater ();
522 procedure stickToCeiling ();
524 state
:= TPartState
.Stuck
;
527 ceilingY
:= y
; // yep
530 procedure stickToWall (dx
: Integer);
534 state
:= TPartState
.Stuck
;
535 if (dx
> 0) then stickDX
:= 1 else stickDX
:= -1;
537 // find next floor transition
540 mapGrid
.traceOrthoRayWhileIn(ex
, wallEndY
, x
+stickDX
, y
, x
+stickDX
, floorY
+1, (GridTagWall
or GridTagDoor
or GridTagStep
));
543 procedure hitAFloor ();
545 state
:= TPartState
.Sleeping
; // we aren't moving anymore
548 floorType
:= TFloorType
.Wall
; // yep
551 // `true`: didn't, get outa thinker
552 function drip (): Boolean;
555 TPartType
.Blood
: result
:= (Random(200) = 100);
556 TPartType
.Water
: result
:= (Random(30) = 15);
557 else raise Exception
.Create('internal error in particle engine: drip');
563 // if we're falling from ceiling, switch to normal mode
564 if (state
= TPartState
.Stuck
) and (stickDX
= 0) then state
:= TPartState
.Normal
;
568 // switch to freefall mode
569 procedure freefall ();
571 state
:= TPartState
.Normal
;
576 procedure applyGravity (inLiquid
: Boolean);
578 state
:= TPartState
.Normal
;
592 _done
, _gravityagain
, _stuckagain
;
598 floorJustTraced
: Boolean;
599 {$IF DEFINED(D2F_DEBUG_FALL_MPLAT)}
603 if not gpart_dbg_phys_enabled
then begin x
+= round(velX
); y
+= round(velY
); goto _done
; end;
607 // still check for air streams when sleeping (no)
608 if (state
= TPartState
.Sleeping
) then begin {checkAirStreams();} goto _done
; end; // so blood will dissolve
610 // process stuck particles
611 if (state
= TPartState
.Stuck
) then
613 // stuck to a ceiling?
614 if (stickDX
= 0) then
616 // yeah, stuck to a ceiling
617 if (ceilingY
= Unknown
) then findCeiling();
618 // dropped from a ceiling?
619 if (y
> ceilingY
) then
624 state
:= TPartState
.Normal
;
628 // otherwise, try to drip
629 if drip() then goto _done
;
635 if (wallEndY
= Unknown
) then
637 // this can happen if mplat was moved out; find new `wallEndY`
638 findFloor(true); // force trace, just in case
639 if (floorType
= TFloorType
.LiquidOut
) then env
:= TEnvType
.ELiquid
else env
:= TEnvType
.EAir
;
640 mapGrid
.traceOrthoRayWhileIn(ex
, wallEndY
, x
+stickDX
, y
, x
+stickDX
, floorY
+1, (GridTagWall
or GridTagDoor
or GridTagStep
));
644 if (wallEndY
<= floorY
) and (y
>= floorY
) then
648 TFloorType
.Wall
: // hit the ground
650 // check if our ground wasn't moved since the last scan
651 findFloor(true); // force trace
655 goto _done
; // nothing to do anymore
657 // otherwise, do it again
660 TFloorType
.LiquidIn
: // entering the liquid
662 // rescan, so we'll know when we'll exit the liquid
663 findFloor(true); // force rescan
665 TFloorType
.LiquidOut
: // exiting the liquid
667 // rescan, so we'll know when we'll enter something interesting
668 findFloor(true); // force rescan
669 if (floorType
= TFloorType
.Wall
) and (floorY
= y
) then begin sleep(); goto _done
; end;
674 if (floorY
<= wallEndY
) and (y
>= wallEndY
) then
676 // just unstuck from the wall, switch to freefall mode
682 // otherwise, try to drip
683 if drip() then goto _done
;
686 // nope, process as usual
689 // it is important to have it here
693 if (state
= TPartState
.Normal
) then checkAirStreams();
695 // gravity, if not stuck
696 if (state
<> TPartState
.Stuck
) and (abs(velX
) < 0.1) and (abs(velY
) < 0.1) then
698 floorJustTraced
:= (floorY
= Unknown
);
699 if floorJustTraced
then findFloor();
705 TFloorType
.Wall
: // hit the ground
707 // check if our ground wasn't moved since the last scan
708 if not floorJustTraced
then
710 findFloor(true); // force trace
711 if (floorType
= TFloorType
.LiquidOut
) then env
:= TEnvType
.ELiquid
else env
:= TEnvType
.EAir
;
712 if (y
<> floorY
) then goto _gravityagain
;
714 // otherwise, nothing to do
716 TFloorType
.LiquidIn
: // entering the liquid
718 // rescan, so we'll know when we'll exit the liquid
719 findFloor(true); // force rescan
722 TFloorType
.LiquidOut
: // exiting the liquid
724 // rescan, so we'll know when we'll enter something interesting
725 findFloor(true); // force rescan
726 if (floorType
<> TFloorType
.Wall
) or (floorY
<> y
) then applyGravity(floorType
= TFloorType
.LiquidIn
);
732 // looks like we're in the air
740 // has some horizontal velocity
741 pan
:= g_Map_traceToNearest(x
, y
, x
+dx
, y
+dy
, GridTagObstacle
, @ex
, @ey
);
742 checkEnv
:= (x
<> ex
);
750 // check environment (air/liquid)
751 if (g_Map_PanelAtPoint(x
, y
, GridTagLiquid
) <> nil) then env
:= TEnvType
.ELiquid
else env
:= TEnvType
.EAir
;
756 // the only case when we can have both ceiling and wall is corner; stick to wall in this case
757 // check if we stuck to a wall
758 if (dx
< 0) then dx
:= -1 else dx
:= 1;
759 if (g_Map_PanelAtPoint(x
+dx
, y
, GridTagObstacle
) <> nil) then
766 // stuck to a ceiling
771 else if (dy
<> 0) then
773 // has only vertical velocity
777 if (ceilingY
= Unknown
) then findCeiling(); // need to do this anyway
779 if (y
<= ceilingY
) then begin y
:= ceilingY
; stickToCeiling(); end; // oops, hit a ceiling
780 // environment didn't changed
787 floorJustTraced
:= (floorY
= Unknown
);
788 if floorJustTraced
then findFloor();
789 if (floorType
= TFloorType
.LiquidOut
) then env
:= TEnvType
.ELiquid
else env
:= TEnvType
.EAir
;
791 //e_LogWritefln('floorY=%s; newy=%s; dY=%s; floorType=%s', [floorY, y, dY, floorType]);
792 if (y
>= floorY
) then
797 //e_LogWritefln(' HIT FLOORY: floorY=%s; newy=%s; dY=%s; floorType=%s', [floorY, y, dY, floorType]);
799 TFloorType
.Wall
: // hit the ground
801 // check if our ground wasn't moved since the last scan
802 if not floorJustTraced
then
804 {$IF DEFINED(D2F_DEBUG_FALL_MPLAT)}
807 findFloor(true); // force trace
808 {$IF DEFINED(D2F_DEBUG_FALL_MPLAT)}
809 if (floorY
<> oldFloorY
) then
811 e_LogWritefln('force rescanning vpart at (%s,%s); oldFloorY=%s; floorY=%s', [x
, y
, oldFloorY
, floorY
]);
814 if (floorType
= TFloorType
.LiquidOut
) then env
:= TEnvType
.ELiquid
else env
:= TEnvType
.EAir
;
815 if (y
<> floorY
) then continue
;
817 // environment didn't changed
819 break
; // done with vertical movement
821 TFloorType
.LiquidIn
: // entering the liquid
823 // we're entered the liquid
824 env
:= TEnvType
.ELiquid
;
825 // rescan, so we'll know when we'll exit the liquid
826 findFloor(true); // force rescan
828 TFloorType
.LiquidOut
: // exiting the liquid
830 // we're exited the liquid
831 env
:= TEnvType
.EAir
;
832 // rescan, so we'll know when we'll enter something interesting
833 findFloor(true); // force rescan
834 if (floorType
= TFloorType
.Wall
) and (floorY
= y
) then
837 break
; // done with vertical movement
844 break
; // done with vertical movement
857 if (g_Map_PanelAtPoint(x
, y
, GridTagObstacle
) <> nil) then begin die(); exit
; end;
861 if (x
< g_Map_MinX
) or (y
< g_Map_MinY
) or (x
> g_Map_MaxX
) or (y
> g_Map_MaxY
) then begin die(); end;
866 // blood will dissolve in other liquids
867 if (particleType
= TPartType
.Blood
) then
869 if (env
= TEnvType
.ELiquid
) then
872 if (liveTime
<= 0) then begin die(); exit
; end;
873 ex
:= 255-trunc(255.0*time
/liveTime
);
874 if (ex
<= 10) then begin die(); exit
; end;
875 if (ex
> 250) then ex
:= 255;
881 // water will disappear in any liquid
882 if (env
= TEnvType
.ELiquid
) then begin die(); exit
; end;
885 if (liveTime
<= 0) then begin die(); exit
; end;
886 ex
:= 255-trunc(255.0*time
/liveTime
);
887 if (ex
<= 10) then begin die(); exit
; end;
888 if (ex
> 250) then ex
:= 255;
894 // ////////////////////////////////////////////////////////////////////////// //
895 procedure g_GFX_SparkVel (fX
, fY
: Integer; count
: Word; vx
, vy
: Integer; devX
, devY
: Byte); forward;
897 procedure g_GFX_Blood (fX
, fY
: Integer; count
: Word; vx
, vy
: Integer;
898 devX
, devY
: Word; cr
, cg
, cb
: Byte; kind
: Byte = BLOOD_NORMAL
);
900 function genColor (cbase
, crnd
: Integer; def
: Byte=0): Byte;
905 if (cbase
< 0) then result
:= 0
906 else if (cbase
> 255) then result
:= 255
907 else result
:= Byte(cbase
);
917 devX1
, devX2
, devY1
, devY2
: Integer;
922 if not gpart_dbg_enabled
then exit
;
924 if (kind
= BLOOD_SPARKS
) then
926 g_GFX_SparkVel(fX
, fY
, 2+Random(2), -vx
div 2, -vy
div 2, devX
, devY
);
930 l
:= Length(Particles
);
931 if (l
= 0) then exit
;
932 if (count
> l
) then count
:= l
;
939 for a
:= 1 to count
do
941 with Particles
[CurrentParticle
] do
943 x
:= fX
-devX1
+Random(devX2
);
944 y
:= fY
-devY1
+Random(devY2
);
946 // check for level bounds
947 if (x
< g_Map_MinX
) or (y
< g_Map_MinY
) or (x
> g_Map_MaxX
) or (y
> g_Map_MaxY
) then continue
;
949 // in what environment we are starting in?
950 pan
:= g_Map_PanelAtPoint(x
, y
, (GridTagObstacle
or GridTagLiquid
));
953 // either in a wall, or in a liquid
954 if ((pan
.tag
and GridTagObstacle
) <> 0) then continue
; // don't spawn in walls
955 env
:= TEnvType
.ELiquid
;
959 env
:= TEnvType
.EAir
;
962 velX
:= vx
+(Random
-Random
)*3;
963 velY
:= vy
+(Random
-Random
)*3;
967 if (velY
-4 < -4) then velY
:= -4 else velY
:= velY
-4;
970 accelX
:= -sign(velX
)*Random
/100;
973 crnd
:= 20*Random(6)-50;
975 red
:= genColor(cr
, CRnd
, 0);
976 green
:= genColor(cg
, CRnd
, 0);
977 blue
:= genColor(cb
, CRnd
, 0);
980 particleType
:= TPartType
.Blood
;
981 state
:= TPartState
.Normal
;
983 liveTime
:= 120+Random(40);
988 if (CurrentParticle
>= MaxParticles
-1) then CurrentParticle
:= 0 else CurrentParticle
+= 1;
993 procedure g_GFX_Water (fX
, fY
: Integer; count
: Word; fVelX
, fVelY
: Single; devX
, devY
, color
: Byte;
994 simple
: Boolean=false; cr
: Byte=0; cg
: Byte=0; cb
: Byte=0);
997 devX1
, devX2
, devY1
, devY2
: Integer;
1001 if not gpart_dbg_enabled
then exit
;
1003 l
:= Length(Particles
);
1004 if (l
= 0) then exit
;
1005 if (count
> l
) then count
:= l
;
1007 if (abs(fVelX
) < 3.0) then fVelX
:= 3.0-6.0*Random
;
1009 devX1
:= devX
div 2;
1011 devY1
:= devY
div 2;
1014 if (not simple
) and (color
> 3) then color
:= 0;
1016 for a
:= 1 to count
do
1018 with Particles
[CurrentParticle
] do
1022 x
:= fX
-devX1
+Random(devX2
);
1023 y
:= fY
-devY1
+Random(devY2
);
1025 if (abs(fVelX
) < 0.5) then velX
:= 1.0-2.0*Random
else velX
:= fVelX
*Random
;
1026 if (Random(10) < 7) then velX
:= -velX
;
1027 velY
:= fVelY
*Random
;
1042 // check for level bounds
1043 if (x
< g_Map_MinX
) or (y
< g_Map_MinY
) or (x
> g_Map_MaxX
) or (y
> g_Map_MaxY
) then continue
;
1045 // this hack will allow water spawned in water to fly out
1046 // it can happen when player fell from a huge height (see "DOOM2D.WAD:\MAP03", for example)
1047 if (fVelY
>= 0) then
1049 // in what environment we are starting in?
1050 pan
:= g_Map_PanelAtPoint(x
, y
, (GridTagObstacle
or GridTagLiquid
));
1054 pan
:= g_Map_PanelAtPoint(x
, y
, GridTagObstacle
);
1056 if (pan
<> nil) then continue
;
1057 env
:= TEnvType
.EAir
;
1063 red
:= 155+Random(9)*10;
1064 green
:= trunc(150*Random
);
1069 red
:= trunc(150*Random
);
1070 green
:= 175+Random(9)*10;
1075 red
:= trunc(200*Random
);
1077 blue
:= 175+Random(9)*10;
1079 4: // Ñâîé öâåò, ñâåòëåå
1081 red
:= 20+Random(19)*10;
1084 red
:= nmin(red
+cr
, 255);
1085 green
:= nmin(green
+cg
, 255);
1086 blue
:= nmin(blue
+cb
, 255);
1088 5: // Ñâîé öâåò, òåìÃåå
1090 red
:= 20+Random(19)*10;
1093 red
:= nmax(cr
-red
, 0);
1094 green
:= nmax(cg
-green
, 0);
1095 blue
:= nmax(cb
-blue
, 0);
1099 red
:= 90+random(12)*10;
1106 particleType
:= TPartType
.Water
;
1107 state
:= TPartState
.Normal
;
1109 liveTime
:= 60+Random(60);
1111 ceilingY
:= Unknown
;
1114 if (CurrentParticle
>= MaxParticles
-1) then CurrentParticle
:= 0 else CurrentParticle
+= 1;
1119 procedure g_GFX_SimpleWater (fX
, fY
: Integer; count
: Word; fVelX
, fVelY
: Single; defColor
, cr
, cg
, cb
: Byte);
1121 g_GFX_Water(fX
, fY
, count
, 0, 0, 0, 0, defColor
, true, cr
, cg
, cb
);
1125 // ////////////////////////////////////////////////////////////////////////// //
1126 procedure TParticle
.thinkerBubble ();
1137 if (y
<= ceilingY
) then begin die(); exit
; end;
1141 if (y
>= floorY
) then begin die(); exit
; end;
1143 if (y
< g_Map_MinY
) or (y
> g_Map_MaxY
) then begin die(); exit
; end;
1146 if (velY
> -4) then velY
+= accelY
;
1152 {.$DEFINE D2F_DEBUG_BUBBLES}
1153 procedure g_GFX_Bubbles (fX
, fY
: Integer; count
: Word; devX
, devY
: Byte);
1155 a
, liquidx
: Integer;
1156 devX1
, devX2
, devY1
, devY2
: Integer;
1158 {$IF DEFINED(D2F_DEBUG_BUBBLES)}
1163 if not gpart_dbg_enabled
then exit
;
1165 l
:= Length(Particles
);
1166 if (l
= 0) then exit
;
1167 if (count
> l
) then count
:= l
;
1169 devX1
:= devX
div 2;
1171 devY1
:= devY
div 2;
1174 for a
:= 1 to count
do
1176 with Particles
[CurrentParticle
] do
1178 x
:= fX
-devX1
+Random(devX2
);
1179 y
:= fY
-devY1
+Random(devY2
);
1181 // check for level bounds
1182 if (x
< g_Map_MinX
) or (y
< g_Map_MinY
) or (x
> g_Map_MaxX
) or (y
> g_Map_MaxY
) then continue
;
1185 // don't spawn bubbles outside of the liquid
1186 if not isLiquidAt(X, Y) {ByteBool(gCollideMap[Y, X] and MARK_LIQUID)} then
1190 // trace liquid, so we'll know where it ends; do it in 8px steps for speed
1191 // tracer will return `false` if we started outside of the liquid
1193 {$IF DEFINED(D2F_DEBUG_BUBBLES)}
1194 stt
:= getTimeMicro();
1195 ptr
:= mapGrid
.traceOrthoRayWhileIn(liquidx
, liquidTopY
, x
, y
, x
, 0, GridTagWater
or GridTagAcid1
or GridTagAcid2
);
1196 stt
:= getTimeMicro()-stt
;
1197 e_LogWritefln('traceOrthoRayWhileIn: time=%s (%s); liquidTopY=%s', [Integer(stt
), ptr
, liquidTopY
]);
1199 stt
:= getTimeMicro();
1200 nptr
:= g_Map_TraceLiquidNonPrecise(x
, y
, 0, -8, liquidx
, liquidTopY
);
1201 stt
:= getTimeMicro()-stt
;
1202 e_LogWritefln('g_Map_TraceLiquidNonPrecise: time=%s (%s); liquidTopY=%s', [Integer(stt
), nptr
, liquidTopY
]);
1203 if not nptr
then continue
;
1205 if not g_Map_TraceLiquidNonPrecise(x
, y
, 0, -8, liquidx
, ceilingY
) then continue
;
1206 if not g_Map_TraceLiquidNonPrecise(x
, y
, 0, +8, liquidx
, floorY
) then continue
;
1219 state
:= TPartState
.Normal
;
1220 particleType
:= TPartType
.Bubbles
;
1225 if (CurrentParticle
>= MaxParticles
-1) then CurrentParticle
:= 0 else CurrentParticle
+= 1;
1230 // ////////////////////////////////////////////////////////////////////////// //
1231 procedure TParticle
.thinkerSpark ();
1239 if not gpart_dbg_phys_enabled
then begin x
+= round(velX
); y
+= round(velY
); goto _done
; end;
1244 //writeln('spark0: pos=(', x, ',', y, '); delta=(', dx, ',', dy, '); state=', state, '; ceilingY=', ceilingY, '; floorY=', floorY);
1247 if (abs(velX
) < 0.1) and (abs(velY
) < 0.1) then
1256 // has some horizontal velocity
1257 pan
:= g_Map_traceToNearest(x
, y
, x
+dx
, y
+dy
, (GridTagObstacle
or GridTagLiquid
), @ex
, @ey
);
1258 if (x
<> ex
) then begin floorY
:= Unknown
; ceilingY
:= Unknown
; end; // dunno yet
1261 if (pan
<> nil) then
1263 if ((pan
.tag
and GridTagLiquid
) <> 0) then begin die(); exit
; end; // die in liquid
1264 // hit the wall; falling down vertically
1269 else if (dy
<> 0) then
1271 // has some vertical velocity
1275 if (ceilingY
= Unknown
) then findCeiling(); // need to do this anyway
1277 if (y
<= ceilingY
) then
1279 // oops, hit a ceiling
1282 accelY
:= abs(accelY
);
1284 // environment didn't changed
1289 if (floorY
= Unknown
) then findFloor(); // need to do this anyway
1291 if (y
>= floorY
) then
1293 // hit something except a floor?
1294 if (floorType
<> TFloorType
.Wall
) then begin die(); exit
; end; // yep: just die
1295 // otherwise, go to sleep
1298 // environment didn't changed
1304 if (x
< g_Map_MinX
) or (y
< g_Map_MinY
) or (x
> g_Map_MaxX
) or (y
> g_Map_MaxY
) then begin die(); end;
1306 if (velX
<> 0.0) then velX
+= accelX
;
1308 if (velY
<> 0.0) then
1310 if (accelY
< 10) then accelY
+= 0.08;
1314 //writeln('spark1: pos=(', x, ',', y, '); delta=(', velX:6:3, ',', velY:6:3, '); state=', state, '; ceilingY=', ceilingY, '; floorY=', floorY);
1320 // ////////////////////////////////////////////////////////////////////////// //
1321 procedure g_GFX_SparkVel (fX
, fY
: Integer; count
: Word; vx
, vy
: Integer; devX
, devY
: Byte);
1324 devX1
, devX2
, devY1
, devY2
: Integer;
1328 if not gpart_dbg_enabled
then exit
;
1330 l
:= Length(Particles
);
1331 if (l
= 0) then exit
;
1332 if (count
> l
) then count
:= l
;
1334 devX1
:= devX
div 2;
1336 devY1
:= devY
div 2;
1339 for a
:= 1 to count
do
1341 with Particles
[CurrentParticle
] do
1343 x
:= fX
-devX1
+Random(devX2
);
1344 y
:= fY
-devY1
+Random(devY2
);
1346 // check for level bounds
1347 if (x
< g_Map_MinX
) or (y
< g_Map_MinY
) or (x
> g_Map_MaxX
) or (y
> g_Map_MaxY
) then continue
;
1349 // in what environment we are starting in?
1350 pan
:= g_Map_PanelAtPoint(x
, y
, (GridTagObstacle
or GridTagLiquid
));
1351 if (pan
<> nil) then
1353 // either in a wall, or in a liquid
1354 //if ((pan.tag and GridTagObstacle) <> 0) then continue; // don't spawn in walls
1355 //env := TEnvType.ELiquid;
1360 env
:= TEnvType
.EAir
;
1363 velX
:= vx
+(Random
-Random
)*3;
1364 velY
:= vy
+(Random
-Random
)*3;
1368 if (velY
-4 < -4) then velY
:= -4 else velY
:= velY
-4;
1371 accelX
:= -sign(velX
)*Random
/100;
1375 green
:= 100+Random(155);
1379 particleType
:= TPartType
.Spark
;
1380 state
:= TPartState
.Normal
;
1382 liveTime
:= 30+Random(60);
1384 ceilingY
:= Unknown
;
1387 if (CurrentParticle
>= MaxParticles
-1) then CurrentParticle
:= 0 else CurrentParticle
+= 1;
1392 procedure g_GFX_Spark (fX
, fY
: Integer; count
: Word; angle
: SmallInt
; devX
, devY
: Byte);
1396 devX1
, devX2
, devY1
, devY2
: Integer;
1397 baseVelX
, baseVelY
: Single;
1401 if not gpart_dbg_enabled
then exit
;
1403 l
:= Length(Particles
);
1404 if (l
= 0) then exit
;
1405 if (count
> l
) then count
:= l
;
1409 devX1
:= devX
div 2;
1411 devY1
:= devY
div 2;
1414 b
:= DegToRad(angle
);
1416 baseVelY
:= 1.6*sin(b
);
1417 if (abs(baseVelX
) < 0.01) then baseVelX
:= 0.0;
1418 if (abs(baseVelY
) < 0.01) then baseVelY
:= 0.0;
1420 for a
:= 1 to count
do
1422 with Particles
[CurrentParticle
] do
1424 x
:= fX
-devX1
+Random(devX2
);
1425 y
:= fY
-devY1
+Random(devY2
);
1427 // check for level bounds
1428 if (x
< g_Map_MinX
) or (y
< g_Map_MinY
) or (x
> g_Map_MaxX
) or (y
> g_Map_MaxY
) then continue
;
1430 // in what environment we are starting in?
1431 pan
:= g_Map_PanelAtPoint(x
, y
, (GridTagObstacle
or GridTagLiquid
));
1432 if (pan
<> nil) then
1434 // either in a wall, or in a liquid
1435 //if ((pan.tag and GridTagObstacle) <> 0) then continue; // don't spawn in walls
1436 //env := TEnvType.ELiquid;
1441 env
:= TEnvType
.EAir
;
1444 velX
:= baseVelX
*Random
;
1445 velY
:= baseVelY
-Random
;
1450 green
:= 100+Random(155);
1454 particleType
:= TPartType
.Spark
;
1455 state
:= TPartState
.Normal
;
1457 liveTime
:= 30+Random(60);
1459 ceilingY
:= Unknown
;
1462 if (CurrentParticle
>= MaxParticles
-1) then CurrentParticle
:= 0 else CurrentParticle
+= 1;
1467 // ////////////////////////////////////////////////////////////////////////// //
1468 procedure g_GFX_SetMax (count
: Integer);
1472 if count
> 50000 then count
:= 50000;
1473 if (count
< 1) then count
:= 1;
1474 SetLength(Particles
, count
);
1475 for a
:= 0 to High(Particles
) do Particles
[a
].die();
1476 MaxParticles
:= count
;
1477 CurrentParticle
:= 0;
1481 function g_GFX_GetMax (): Integer;
1483 result
:= MaxParticles
;
1487 function FindOnceAnim (): DWORD
;
1491 if OnceAnims
<> nil then
1492 for i
:= 0 to High(OnceAnims
) do
1493 if OnceAnims
[i
].Animation
= nil then
1499 if OnceAnims
= nil then
1501 SetLength(OnceAnims
, 16);
1506 Result
:= High(OnceAnims
) + 1;
1507 SetLength(OnceAnims
, Length(OnceAnims
) + 16);
1512 procedure g_GFX_OnceAnim (x
, y
: Integer; Anim
: TAnimation
; AnimType
: Byte = 0);
1516 if not gpart_dbg_enabled
then exit
;
1518 if (Anim
= nil) then exit
;
1520 find_id
:= FindOnceAnim();
1522 OnceAnims
[find_id
].AnimType
:= AnimType
;
1523 OnceAnims
[find_id
].Animation
:= TAnimation
.Create(Anim
.FramesID
, Anim
.Loop
, Anim
.Speed
);
1524 OnceAnims
[find_id
].Animation
.Blending
:= Anim
.Blending
;
1525 OnceAnims
[find_id
].Animation
.alpha
:= Anim
.alpha
;
1526 OnceAnims
[find_id
].x
:= x
;
1527 OnceAnims
[find_id
].y
:= y
;
1531 // ////////////////////////////////////////////////////////////////////////// //
1532 procedure g_GFX_Init ();
1534 //g_Game_SetLoadingText(_lc[I_LOAD_COLLIDE_MAP]+' 1/6', 0, False);
1535 //SetLength(gCollideMap, gMapInfo.Height+1);
1536 //for a := 0 to High(gCollideMap) do SetLength(gCollideMap[a], gMapInfo.Width+1);
1539 gpart_dbg_enabled
:= false;
1544 procedure g_GFX_Free ();
1549 SetLength(Particles
, MaxParticles
);
1550 for a
:= 0 to High(Particles
) do Particles
[a
].die();
1551 CurrentParticle
:= 0;
1553 if (OnceAnims
<> nil) then
1555 for a
:= 0 to High(OnceAnims
) do OnceAnims
[a
].Animation
.Free();
1566 // ////////////////////////////////////////////////////////////////////////// //
1567 procedure g_GFX_Update ();
1573 if not gpart_dbg_enabled
then exit
;
1575 if (Particles
<> nil) then
1577 w
:= gMapInfo
.Width
;
1578 h
:= gMapInfo
.Height
;
1580 len
:= High(Particles
);
1582 for a
:= 0 to len
do
1584 if Particles
[a
].alive
then
1586 with Particles
[a
] do
1588 if (time
= liveTime
) then begin die(); continue
; end;
1589 if (x
+1 >= w
) or (y
+1 >= h
) or (x
<= 0) or (y
<= 0) then begin die(); end;
1594 end; // Particles <> nil
1599 if OnceAnims
<> nil then
1601 for a
:= 0 to High(OnceAnims
) do
1602 if OnceAnims
[a
].Animation
<> nil then
1604 case OnceAnims
[a
].AnimType
of
1607 if Random(3) = 0 then
1608 OnceAnims
[a
].x
:= OnceAnims
[a
].x
-1+Random(3);
1609 if Random(2) = 0 then
1610 OnceAnims
[a
].y
:= OnceAnims
[a
].y
-Random(2);
1614 if OnceAnims
[a
].Animation
.Played
then
1616 OnceAnims
[a
].Animation
.Free();
1617 OnceAnims
[a
].Animation
:= nil;
1620 OnceAnims
[a
].Animation
.Update();
1626 procedure g_GFX_Draw ();
1633 r
, g
, b
, a
: GLfloat
;
1640 if not gpart_dbg_enabled
then exit
;
1642 if (Particles
<> nil) then
1644 glDisable(GL_TEXTURE_2D
);
1645 if (g_dbg_scale
< 0.6) then glPointSize(1)
1646 else if (g_dbg_scale
> 1.3) then glPointSize(g_dbg_scale
+1)
1647 else glPointSize(2);
1648 glDisable(GL_POINT_SMOOTH
);
1651 glBlendFunc(GL_SRC_ALPHA
, GL_ONE_MINUS_SRC_ALPHA
);
1655 SetLength(v
, Length(Particles
));
1656 for a
:= 0 to High(Particles
) do
1658 with Particles
[a
] do
1660 if alive
and (x
>= sX
) and (y
>= sY
) and (x
<= sX
+ sWidth
) and (sY
<= sY
+ sHeight
) then
1662 v
[count
].x
:= x
+ 0.37;
1663 v
[count
].y
:= y
+ 0.37;
1664 v
[count
].r
:= red
/ 255;
1665 v
[count
].g
:= green
/ 255;
1666 v
[count
].b
:= blue
/ 255;
1667 v
[count
].a
:= alpha
/ 255;
1673 glVertexPointer(2, GL_FLOAT
, SizeOf(Vertex
), @v
[0].x
);
1674 glColorPointer(4, GL_FLOAT
, SizeOf(Vertex
), @v
[0].r
);
1675 glEnableClientState(GL_VERTEX_ARRAY
);
1676 glEnableClientState(GL_COLOR_ARRAY
);
1677 glDisableClientState(GL_NORMAL_ARRAY
);
1678 glDisableClientState(GL_TEXTURE_COORD_ARRAY
);
1679 glDrawArrays(GL_POINTS
, 0, count
);
1683 len
:= High(Particles
);
1684 for a
:= 0 to len
do
1686 with Particles
[a
] do
1688 if not alive
then continue
;
1689 if (x
>= sX
) and (y
>= sY
) and (x
<= sX
+sWidth
) and (sY
<= sY
+sHeight
) then
1691 glColor4ub(red
, green
, blue
, alpha
);
1692 glVertex2f(x
+0.37, y
+0.37);
1700 glDisable(GL_BLEND
);
1703 if (OnceAnims
<> nil) then
1705 len
:= High(OnceAnims
);
1706 for a
:= 0 to len
do
1708 if (OnceAnims
[a
].Animation
<> nil) then
1710 with OnceAnims
[a
] do Animation
.Draw(x
, y
, TMirrorType
.None
);