DEADSOFTWARE

render: use only r_render to access render
[d2df-sdl.git] / 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, version 3 of the License ONLY.
6 *
7 * This program is distributed in the hope that it will be useful,
8 * but WITHOUT ANY WARRANTY; without even the implied warranty of
9 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
10 * GNU General Public License for more details.
11 *
12 * You should have received a copy of the GNU General Public License
13 * along with this program. If not, see <http://www.gnu.org/licenses/>.
14 *)
15 {$INCLUDE ../shared/a_modes.inc}
16 {.$DEFINE D2F_DEBUG_FALL_MPLAT}
17 {/$DEFINE D2F_DEBUG_PART_AWAKE}
18 unit g_gfx;
20 interface
22 uses
23 e_log, g_textures;
25 const
26 BLOOD_NORMAL = 0;
27 BLOOD_SPARKS = 1;
28 BLOOD_CSPARKS = 2;
29 BLOOD_COMBINE = 3;
31 MARK_FREE = 0;
32 MARK_WALL = 1;
33 MARK_WATER = 2;
34 MARK_ACID = 4;
35 MARK_LIFTDOWN = 8;
36 MARK_LIFTUP = 16;
37 MARK_DOOR = 32;
38 MARK_LIFTLEFT = 64;
39 MARK_LIFTRIGHT = 128;
40 MARK_BLOCKED = MARK_WALL or MARK_DOOR;
41 MARK_LIQUID = MARK_WATER or MARK_ACID;
42 MARK_LIFT = MARK_LIFTDOWN or MARK_LIFTUP or MARK_LIFTLEFT or MARK_LIFTRIGHT;
44 R_GFX_NONE = 0;
45 R_GFX_TELEPORT = 1;
46 R_GFX_FLAME = 2;
47 R_GFX_EXPLODE_ROCKET = 3;
48 R_GFX_EXPLODE_BFG = 4;
49 R_GFX_BFG_HIT = 5;
50 R_GFX_FIRE = 6;
51 R_GFX_ITEM_RESPAWN = 7;
52 R_GFX_SMOKE = 8;
53 R_GFX_EXPLODE_SKELFIRE = 9;
54 R_GFX_EXPLODE_PLASMA = 10;
55 R_GFX_EXPLODE_BSPFIRE = 11;
56 R_GFX_EXPLODE_IMPFIRE = 12;
57 R_GFX_EXPLODE_CACOFIRE = 13;
58 R_GFX_EXPLODE_BARONFIRE = 14;
59 R_GFX_TELEPORT_FAST = 15;
60 R_GFX_SMOKE_TRANS = 16;
61 R_GFX_FLAME_RAND = 17;
62 R_GFX_LAST = 17;
64 R_GFX_FLAME_WIDTH = 32;
65 R_GFX_FLAME_HEIGHT = 32;
66 R_GFX_SMOKE_WIDTH = 32;
67 R_GFX_SMOKE_HEIGHT = 32;
69 procedure g_GFX_Init ();
70 procedure g_GFX_Free ();
72 procedure g_GFX_Blood (fX, fY: Integer; count: Word; vx, vy: Integer;
73 devX, devY: Word; cr, cg, cb: Byte; kind: Byte=BLOOD_NORMAL);
74 procedure g_GFX_Spark (fX, fY: Integer; count: Word; angle: SmallInt; devX, devY: Byte);
75 procedure g_GFX_Water (fX, fY: Integer; count: Word; fVelX, fVelY: Single; devX, devY, color: Byte;
76 simple: Boolean=false; cr: Byte=0; cg: Byte=0; cb: Byte=0);
77 procedure g_GFX_SimpleWater (fX, fY: Integer; count: Word; fVelX, fVelY: Single; defColor, cr, cg, cb: Byte);
78 procedure g_GFX_Bubbles (fX, fY: Integer; count: Word; devX, devY: Byte);
80 procedure g_GFX_SetMax (count: Integer);
81 function g_GFX_GetMax (): Integer;
83 procedure g_Mark (x, y, Width, Height: Integer; t: Byte; st: Boolean=true);
85 procedure g_GFX_QueueEffect (AnimType, X, Y: Integer);
87 procedure g_GFX_Update ();
89 var
90 gpart_dbg_enabled: Boolean = true;
91 gpart_dbg_phys_enabled: Boolean = true;
94 //WARNING: only for Holmes!
95 function awmIsSetHolmes (x, y: Integer): Boolean; inline;
97 type (* private state *)
98 TPartType = (Blood, Spark, Bubbles, Water);
99 TPartState = (Free, Normal, Stuck, Sleeping);
100 TFloorType = (Wall, LiquidIn, LiquidOut);
101 // Wall: floorY is just before floor
102 // LiquidIn: floorY is liquid *start* (i.e. just in a liquid)
103 // LiquidOut: floorY is liquid *end* (i.e. just out of a liquid)
104 TEnvType = (EAir, ELiquid, EWall); // where particle is now
106 // note: this MUST be record, so we can keep it in
107 // dynamic array and has sequential memory access pattern
108 PParticle = ^TParticle;
109 TParticle = record
110 x, y: Integer;
111 oldX, oldY: Integer;
112 velX, velY: Single;
113 accelX, accelY: Single;
114 state: TPartState;
115 particleType: TPartType;
116 red, green, blue: Byte;
117 alpha: Byte;
118 time, liveTime, waitTime: Word;
119 stickDX: Integer; // STATE_STICK: -1,1: stuck to a wall; 0: stuck to ceiling
120 justSticked: Boolean; // not used
121 floorY: Integer; // actually, floor-1; `Unknown`: unknown
122 floorType: TFloorType;
123 env: TEnvType; // where particle is now
124 ceilingY: Integer; // actually, ceiling+1; `Unknown`: unknown
125 wallEndY: Integer; // if we stuck to a wall, this is where wall ends
127 //k8: sorry, i have to emulate virtual methods this way, 'cause i haet `Object`
128 procedure thinkerBloodAndWater ();
129 procedure thinkerSpark ();
130 procedure thinkerBubble ();
132 procedure findFloor (force: Boolean=false); // this updates `floorY` if forced or Unknown
133 procedure findCeiling (force: Boolean=false); // this updates `ceilingY` if forced or Unknown
135 procedure freeze (); inline; // remove velocities and acceleration
136 procedure sleep (); inline; // switch to sleep mode
138 function checkAirStreams (): Boolean; // `true`: affected by air stream
140 function alive (): Boolean; inline;
141 procedure die (); inline;
142 procedure think (); inline;
143 end;
145 var (* private state *)
146 Particles: array of TParticle = nil;
148 implementation
150 uses
151 {$IFNDEF HEADLESS}
152 r_render,
153 {$ENDIF}
154 g_map, g_panel, g_basic, Math,
155 g_options, g_console, SysUtils, g_triggers, MAPDEF,
156 g_game, g_language, g_net, utils, xprofiler;
159 const
160 Unknown = Integer($7fffffff);
162 var
163 MaxParticles: Integer = 0;
164 CurrentParticle: Integer = 0;
165 // awakeMap has one bit for each map grid cell; on g_Mark,
166 // corresponding bits will be set, and in `think()` all particles
167 // in marked cells will be awaken
168 awakeMap: packed array of LongWord = nil;
169 awakeMapH: Integer = -1;
170 awakeMapW: Integer = -1;
171 awakeMinX, awakeMinY: Integer;
172 awakeDirty: Boolean = false;
173 {$IF DEFINED(D2F_DEBUG_PART_AWAKE)}
174 awakeMapHlm: packed array of LongWord = nil;
175 {$ENDIF}
177 procedure g_GFX_QueueEffect (AnimType, X, Y: Integer);
178 begin
179 {$IFNDEF HEADLESS}
180 r_Render_QueueEffect(AnimType, X, Y)
181 {$ENDIF}
182 end;
184 // ////////////////////////////////////////////////////////////////////////// //
185 function awmIsSetHolmes (x, y: Integer): Boolean; inline;
186 begin
187 {$IF DEFINED(D2F_DEBUG_PART_AWAKE)}
188 if (Length(awakeMapHlm) = 0) then begin result := false; exit; end;
189 x := (x-awakeMinX) div mapGrid.tileSize;
190 y := (y-awakeMinY) div mapGrid.tileSize;
191 if (x >= 0) and (y >= 0) and (x div 32 < awakeMapW) and (y < awakeMapH) then
192 begin
193 if (y*awakeMapW+x div 32 < Length(awakeMapHlm)) then
194 begin
195 result := ((awakeMapHlm[y*awakeMapW+x div 32] and (LongWord(1) shl (x mod 32))) <> 0);
196 end
197 else
198 begin
199 result := false;
200 end;
201 end
202 else
203 begin
204 result := false;
205 end;
206 {$ELSE}
207 result := false;
208 {$ENDIF}
209 end;
212 // ////////////////////////////////////////////////////////////////////////// //
213 // HACK! using mapgrid
214 procedure awmClear (); inline;
215 begin
216 {$IF DEFINED(D2F_DEBUG_PART_AWAKE)}
217 if (Length(awakeMap) > 0) then
218 begin
219 if (Length(awakeMapHlm) <> Length(awakeMap)) then SetLength(awakeMapHlm, Length(awakeMap));
220 Move(awakeMap[0], awakeMapHlm[0], Length(awakeMap)*sizeof(awakeMap[0]));
221 end;
222 {$ENDIF}
223 if awakeDirty and (awakeMapW > 0) then
224 begin
225 FillDWord(awakeMap[0], Length(awakeMap), 0);
226 awakeDirty := false;
227 end;
228 end;
231 procedure awmSetup ();
232 begin
233 assert(mapGrid <> nil);
234 awakeMapW := (mapGrid.gridWidth+mapGrid.tileSize-1) div mapGrid.tileSize;
235 awakeMapW := (awakeMapW+31) div 32; // LongWord has 32 bits ;-)
236 awakeMapH := (mapGrid.gridHeight+mapGrid.tileSize-1) div mapGrid.tileSize;
237 awakeMinX := mapGrid.gridX0;
238 awakeMinY := mapGrid.gridY0;
239 SetLength(awakeMap, awakeMapW*awakeMapH);
240 {$IF DEFINED(D2F_DEBUG_PART_AWAKE)}
241 SetLength(awakeMapHlm, awakeMapW*awakeMapH);
242 FillDWord(awakeMapHlm[0], Length(awakeMapHlm), 0);
243 {$ENDIF}
244 //{$IF DEFINED(D2F_DEBUG)}
245 e_LogWritefln('particle awake map: %sx%s (for grid of size %sx%s)', [awakeMapW, awakeMapH, mapGrid.gridWidth, mapGrid.gridHeight]);
246 //{$ENDIF}
247 awakeDirty := true;
248 awmClear();
249 end;
252 function awmIsSet (x, y: Integer): Boolean; inline;
253 begin
254 x := (x-awakeMinX) div mapGrid.tileSize;
255 y := (y-awakeMinY) div mapGrid.tileSize;
256 if (x >= 0) and (y >= 0) and (x div 32 < awakeMapW) and (y < awakeMapH) then
257 begin
258 {$IF DEFINED(D2F_DEBUG)}
259 assert(y*awakeMapW+x div 32 < Length(awakeMap));
260 {$ENDIF}
261 result := ((awakeMap[y*awakeMapW+x div 32] and (LongWord(1) shl (x mod 32))) <> 0);
262 end
263 else
264 begin
265 result := false;
266 end;
267 end;
270 procedure awmSet (x, y: Integer); inline;
271 var
272 v: PLongWord;
273 begin
274 x := (x-awakeMinX) div mapGrid.tileSize;
275 y := (y-awakeMinY) div mapGrid.tileSize;
276 if (x >= 0) and (y >= 0) and (x div 32 < awakeMapW) and (y < awakeMapH) then
277 begin
278 {$IF DEFINED(D2F_DEBUG)}
279 assert(y*awakeMapW+x div 32 < Length(awakeMap));
280 {$ENDIF}
281 v := @awakeMap[y*awakeMapW+x div 32];
282 v^ := v^ or (LongWord(1) shl (x mod 32));
283 awakeDirty := true;
284 end;
285 end;
288 // ////////////////////////////////////////////////////////////////////////// //
289 // st: set mark
290 // t: mark type
291 // currently unused
292 procedure g_Mark (x, y, Width, Height: Integer; t: Byte; st: Boolean=true);
293 const Extrude = 1;
294 var
295 dx, dy, ex, ey: Integer;
296 v: PLongWord;
297 begin
298 if (not gpart_dbg_enabled) or (not gpart_dbg_phys_enabled) then exit;
299 if (awakeMapW < 1) or (awakeMapH < 1) then exit;
301 if (Width < 1) or (Height < 1) then exit;
303 // make some border, so we'll hit particles around the panel
304 ex := x+Width+Extrude-1-awakeMinX;
305 ey := y+Height+Extrude-1-awakeMinY;
306 x := (x-Extrude)-awakeMinX;
307 y := (y-Extrude)-awakeMinY;
309 x := x div mapGrid.tileSize;
310 y := y div mapGrid.tileSize;
311 ex := ex div mapGrid.tileSize;
312 ey := ey div mapGrid.tileSize;
314 // has something to do?
315 if (ex < 0) or (ey < 0) or (x >= awakeMapW*32) or (y >= awakeMapH) then exit;
316 if (x < 0) then x := 0;
317 if (y < 0) then y := 0;
318 if (ex >= awakeMapW*32) then ex := awakeMapW*32-1;
319 if (ey >= awakeMapH) then ey := awakeMapH;
321 awakeDirty := true;
322 for dy := y to ey do
323 begin
324 for dx := x to ex do
325 begin
326 {$IF DEFINED(D2F_DEBUG)}
327 assert((dx >= 0) and (dy >= 0) and (dx div 32 < awakeMapW) and (dy < awakeMapH));
328 assert(dy*awakeMapW+dx div 32 < Length(awakeMap));
329 {$ENDIF}
330 v := @awakeMap[dy*awakeMapW+dx div 32];
331 v^ := v^ or (LongWord(1) shl (dx mod 32));
332 end;
333 end;
334 end;
337 // ////////////////////////////////////////////////////////////////////////// //
338 function TParticle.alive (): Boolean; inline; begin result := (state <> TPartState.Free); end;
339 procedure TParticle.die (); inline; begin state := TPartState.Free; end;
341 // remove velocities and acceleration
342 procedure TParticle.freeze (); inline;
343 begin
344 // stop right there, you criminal scum!
345 velX := 0;
346 velY := 0;
347 accelX := 0;
348 accelY := 0;
349 end;
352 // `true`: affected by air stream
353 function TParticle.checkAirStreams (): Boolean;
354 var
355 pan: TPanel;
356 r: Integer;
357 begin
358 pan := g_Map_PanelAtPoint(x, y, GridTagLift);
359 result := (pan <> nil) and WordBool(pan.PanelType and (PANEL_LIFTUP or PANEL_LIFTDOWN or PANEL_LIFTLEFT or PANEL_LIFTRIGHT));
360 r := Random(3);
361 if result then
362 begin
363 case pan.LiftType of
364 LIFTTYPE_UP:
365 begin
366 if (velY > -1-r) then velY -= 0.8;
367 if (abs(velX) > 0.1) then velX -= velX/10.0;
368 velX += (Random-Random)*0.2;
369 accelY := 0.15;
370 end;
371 LIFTTYPE_DOWN:
372 begin
373 if (velY < 1+r) then velY += 0.8;
374 accelY := 0.15;
375 end;
376 LIFTTYPE_LEFT:
377 begin
378 if (velX > -8-r) then velX -= (8+r) div 2;
379 accelY := 0.15;
380 end;
381 LIFTTYPE_RIGHT:
382 begin
383 if (velX < 8+r) then velX += (8+r) div 2;
384 accelY := 0.15;
385 end;
386 else
387 result := false;
388 end;
389 // awake
390 if result and (state = TPartState.Sleeping) then state := TPartState.Normal;
391 end;
392 end;
395 // switch to sleep mode
396 procedure TParticle.sleep (); inline;
397 begin
398 if not checkAirStreams() then
399 begin
400 state := TPartState.Sleeping;
401 freeze();
402 end;
403 end;
406 procedure TParticle.findFloor (force: Boolean=false);
407 var
408 ex: Integer;
409 pan: TPanel;
410 begin
411 if (not force) and (floorY <> Unknown) then exit;
412 // stuck in the wall? rescan, 'cause it can be mplat
413 if (env = TEnvType.EWall) then
414 begin
415 pan := g_Map_PanelAtPoint(x, y, (GridTagObstacle or GridTagLiquid));
416 if (pan <> nil) then
417 begin
418 // either in a wall, or in a liquid
419 if ((pan.tag and GridTagObstacle) <> 0) then
420 begin
421 // we are in the wall, wtf?!
422 floorY := y;
423 env := TEnvType.EWall;
424 floorType := TFloorType.Wall;
425 state := TPartState.Sleeping; // anyway
426 exit;
427 end;
428 // we are in liquid, trace to liquid end
429 env := TEnvType.ELiquid;
430 end;
431 end;
432 // are we in a liquid?
433 if (env = TEnvType.ELiquid) then
434 begin
435 // trace out of the liquid
436 //env := TEnvType.ELiquid;
437 floorType := TFloorType.LiquidOut;
438 //e_LogWritefln('tracing out of a liquid; floorY=%s; y=%s', [floorY, y]);
439 mapGrid.traceOrthoRayWhileIn(ex, floorY, x, y, x, g_Map_MaxY, GridTagLiquid);
440 floorY += 1; // so `floorY` is just out of a liquid
441 //e_LogWritefln(' traced out of a liquid; floorY=%s; y=%s', [floorY, y]);
442 end
443 else
444 begin
445 // in the air
446 assert(env = TEnvType.EAir);
447 //env := TEnvType.EAir;
448 pan := g_Map_traceToNearest(x, y, x, g_Map_MaxY, (GridTagObstacle or GridTagLiquid), @ex, @floorY);
449 if (pan <> nil) then
450 begin
451 // wall or liquid
452 if ((pan.tag and GridTagObstacle) <> 0) then
453 begin
454 // wall
455 floorType := TFloorType.Wall;
456 end
457 else
458 begin
459 // liquid
460 floorType := TFloorType.LiquidIn; // entering liquid
461 floorY += 1; // so `floorY` is just in a liquid
462 end;
463 end
464 else
465 begin
466 // out of the level; assume wall, but it doesn't really matter
467 floorType := TFloorType.Wall;
468 floorY := g_Map_MaxY+2;
469 end;
470 end;
471 end;
474 procedure TParticle.findCeiling (force: Boolean=false);
475 var
476 ex: Integer;
477 begin
478 if (not force) and (ceilingY <> Unknown) then exit;
479 if (nil = g_Map_traceToNearest(x, y, x, g_Map_MinY, GridTagSolid, @ex, @ceilingY)) then
480 begin
481 ceilingY := g_Map_MinY-2;
482 end;
483 end;
486 procedure TParticle.think (); inline;
487 procedure awake ();
488 begin
489 if (state = TPartState.Stuck) then
490 begin
491 //writeln('awaking particle at (', x, ',', y, ')');
492 if (stickDX = 0) then
493 begin
494 state := TPartState.Normal; // stuck to a ceiling
495 end
496 else
497 begin
498 // stuck to a wall, check if wall is still there
499 if (wallEndY <> Unknown) then
500 begin
501 wallEndY := Unknown;
502 if (g_Map_PanelAtPoint(x+stickDX, y, GridTagObstacle) = nil) then
503 begin
504 // a wall was moved out, start falling
505 state := TPartState.Normal;
506 if (velY = 0) then velY := 0.1;
507 if (accelY = 0) then accelY := 0.5;
508 end;
509 end;
510 end;
511 end
512 else
513 begin
514 state := TPartState.Normal;
515 if (velY = 0) then velY := 0.1;
516 if (accelY = 0) then accelY := 0.5;
517 end;
518 floorY := Unknown;
519 ceilingY := Unknown;
520 end;
522 begin
523 oldx := x;
524 oldy := y;
525 // awake sleeping particle, if necessary
526 if awakeDirty then
527 begin
528 if awmIsSet(x, y) then awake();
530 case state of
531 TPartState.Sleeping, TPartState.Stuck:
532 if awmIsSet(x, y) then awake();
533 else
534 if (env = TEnvType.EWall) and awmIsSet(x, y) then awake();
535 end;
537 end;
538 case particleType of
539 TPartType.Blood, TPartType.Water: thinkerBloodAndWater();
540 TPartType.Spark: thinkerSpark();
541 TPartType.Bubbles: thinkerBubble();
542 end;
543 end;
546 // ////////////////////////////////////////////////////////////////////////// //
547 procedure TParticle.thinkerBloodAndWater ();
548 procedure stickToCeiling ();
549 begin
550 state := TPartState.Stuck;
551 stickDX := 0;
552 freeze();
553 ceilingY := y; // yep
554 end;
556 procedure stickToWall (dx: Integer);
557 var
558 ex: Integer;
559 begin
560 state := TPartState.Stuck;
561 if (dx > 0) then stickDX := 1 else stickDX := -1;
562 freeze();
563 // find next floor transition
564 findFloor();
565 // find `wallEndY`
566 mapGrid.traceOrthoRayWhileIn(ex, wallEndY, x+stickDX, y, x+stickDX, floorY+1, (GridTagWall or GridTagDoor or GridTagStep));
567 end;
569 procedure hitAFloor ();
570 begin
571 state := TPartState.Sleeping; // we aren't moving anymore
572 freeze();
573 floorY := y; // yep
574 floorType := TFloorType.Wall; // yep
575 end;
577 // `true`: didn't, get outa thinker
578 function drip (): Boolean;
579 begin
580 case particleType of
581 TPartType.Blood: result := (Random(200) = 100);
582 TPartType.Water: result := (Random(30) = 15);
583 else raise Exception.Create('internal error in particle engine: drip');
584 end;
585 if result then
586 begin
587 velY := 0.5;
588 accelY := 0.15;
589 // if we're falling from ceiling, switch to normal mode
590 if (state = TPartState.Stuck) and (stickDX = 0) then state := TPartState.Normal;
591 end;
592 end;
594 // switch to freefall mode
595 procedure freefall ();
596 begin
597 state := TPartState.Normal;
598 velY := 0.5;
599 accelY := 0.15;
600 end;
602 procedure applyGravity (inLiquid: Boolean);
603 begin
604 state := TPartState.Normal;
605 if inLiquid then
606 begin
607 velY := 0.5;
608 accelY := 0.15;
609 end
610 else
611 begin
612 velY := 0.8;
613 accelY := 0.5;
614 end;
615 end;
617 label
618 _done, _gravityagain, _stuckagain;
619 var
620 pan: TPanel;
621 dx, dy: SmallInt;
622 ex, ey: Integer;
623 checkEnv, inAir, inStep: Boolean;
624 floorJustTraced: Boolean;
625 {$IF DEFINED(D2F_DEBUG_FALL_MPLAT)}
626 oldFloorY: Integer;
627 {$ENDIF}
628 begin
629 if not gpart_dbg_phys_enabled then begin x += round(velX); y += round(velY); goto _done; end;
631 if gAdvBlood then
632 begin
633 // still check for air streams when sleeping (no)
634 if (state = TPartState.Sleeping) then begin {checkAirStreams();} goto _done; end; // so blood will dissolve
636 // process stuck particles
637 if (state = TPartState.Stuck) then
638 begin
639 // stuck to a ceiling?
640 if (stickDX = 0) then
641 begin
642 // yeah, stuck to a ceiling
643 if (ceilingY = Unknown) then findCeiling();
644 // dropped from a ceiling?
645 if (y > ceilingY) then
646 begin
647 // yep
648 velY := 0.5;
649 accelY := 0.15;
650 state := TPartState.Normal;
651 end
652 else
653 begin
654 // otherwise, try to drip
655 if drip() then goto _done;
656 end;
657 end
658 else
659 begin
660 // stuck to a wall
661 if (wallEndY = Unknown) then
662 begin
663 // this can happen if mplat was moved out; find new `wallEndY`
664 findFloor(true); // force trace, just in case
665 if (floorType = TFloorType.LiquidOut) then env := TEnvType.ELiquid else env := TEnvType.EAir;
666 mapGrid.traceOrthoRayWhileIn(ex, wallEndY, x+stickDX, y, x+stickDX, floorY+1, (GridTagWall or GridTagDoor or GridTagStep));
667 end;
668 _stuckagain:
669 // floor transition?
670 if (wallEndY <= floorY) and (y >= floorY) then
671 begin
672 y := floorY;
673 case floorType of
674 TFloorType.Wall: // hit the ground
675 begin
676 // check if our ground wasn't moved since the last scan
677 findFloor(true); // force trace
678 if (y = floorY) then
679 begin
680 sleep();
681 goto _done; // nothing to do anymore
682 end;
683 // otherwise, do it again
684 goto _stuckagain;
685 end;
686 TFloorType.LiquidIn: // entering the liquid
687 begin
688 // rescan, so we'll know when we'll exit the liquid
689 findFloor(true); // force rescan
690 end;
691 TFloorType.LiquidOut: // exiting the liquid
692 begin
693 // rescan, so we'll know when we'll enter something interesting
694 findFloor(true); // force rescan
695 if (floorType = TFloorType.Wall) and (floorY = y) then begin sleep(); goto _done; end;
696 end;
697 end;
698 end;
699 // wall transition?
700 if (floorY <= wallEndY) and (y >= wallEndY) then
701 begin
702 // just unstuck from the wall, switch to freefall mode
703 y := wallEndY;
704 freefall();
705 end
706 else
707 begin
708 // otherwise, try to drip
709 if drip() then goto _done;
710 end;
711 end;
712 // nope, process as usual
713 end;
715 // it is important to have it here
716 dx := round(velX);
717 dy := round(velY);
719 inAir := checkAirStreams();
721 // gravity, if not stuck
722 if (state <> TPartState.Stuck) and (abs(velX) < 0.1) and (abs(velY) < 0.1) then
723 begin
724 floorJustTraced := (floorY = Unknown);
725 if floorJustTraced then findFloor();
726 _gravityagain:
727 // floor transition?
728 if (y = floorY) then
729 begin
730 case floorType of
731 TFloorType.Wall: // hit the ground
732 begin
733 // check if our ground wasn't moved since the last scan
734 if not floorJustTraced then
735 begin
736 findFloor(true); // force trace
737 if (floorType = TFloorType.LiquidOut) then env := TEnvType.ELiquid else env := TEnvType.EAir;
738 if (y <> floorY) then goto _gravityagain;
739 end;
740 // otherwise, nothing to do
741 end;
742 TFloorType.LiquidIn: // entering the liquid
743 begin
744 // rescan, so we'll know when we'll exit the liquid
745 findFloor(true); // force rescan
746 applyGravity(true);
747 end;
748 TFloorType.LiquidOut: // exiting the liquid
749 begin
750 // rescan, so we'll know when we'll enter something interesting
751 findFloor(true); // force rescan
752 if (floorType <> TFloorType.Wall) or (floorY <> y) then applyGravity(floorType = TFloorType.LiquidIn);
753 end;
754 end;
755 end
756 else
757 begin
758 // looks like we're in the air
759 applyGravity(false);
760 end;
761 end;
763 // trace movement
764 if (dx <> 0) then
765 begin
766 // has some horizontal velocity
767 inStep := False;
768 pan := g_Map_traceToNearest(x, y, x+dx, y+dy, GridTagSolid, @ex, @ey);
769 if (pan = nil) and (dy >= 0) then
770 begin
771 // do not stuck inside step
772 if g_Map_traceToNearest(x, y, x, y, GridTagStep, nil, nil) = nil then
773 // check for step panel below
774 pan := g_Map_traceToNearest(x, y, x, y+dy, GridTagStep, nil, @ey);
775 inStep := pan <> nil;
776 if inStep then
777 begin
778 // stick to panel edges
779 if ex < pan.X then
780 ex := pan.X
781 else if ex > pan.X + pan.Width - 1 then
782 ex := pan.X + pan.Width - 1;
783 end;
784 end;
785 checkEnv := (x <> ex);
786 x := ex;
787 y := ey;
788 if checkEnv then
789 begin
790 // dunno yet
791 floorY := Unknown;
792 ceilingY := Unknown;
793 // check environment (air/liquid)
794 if (g_Map_PanelAtPoint(x, y, GridTagLiquid) <> nil) then env := TEnvType.ELiquid else env := TEnvType.EAir;
795 end;
796 if (pan <> nil) then
797 begin
798 if inStep then
799 stickToWall(dx)
800 else
801 begin
802 // we stuck
803 // the only case when we can have both ceiling and wall is corner; stick to wall in this case
804 // check if we stuck to a wall
805 if (dx < 0) then dx := -1 else dx := 1;
806 if (g_Map_PanelAtPoint(x+dx, y, GridTagSolid) <> nil) then
807 begin
808 // stuck to a wall
809 stickToWall(dx);
810 end
811 else
812 begin
813 // stuck to a ceiling
814 stickToCeiling();
815 end;
816 end;
817 end;
818 end
819 else if (dy <> 0) then
820 begin
821 // has only vertical velocity
822 if (dy < 0) then
823 begin
824 // flying up
825 if (ceilingY = Unknown) then findCeiling(); // need to do this anyway
826 y += dy;
827 if (y <= ceilingY) then begin y := ceilingY; stickToCeiling(); end; // oops, hit a ceiling
828 // environment didn't changed
829 end
830 else
831 begin
832 while (dy > 0) do
833 begin
834 // falling down
835 floorJustTraced := (floorY = Unknown);
836 if floorJustTraced then findFloor();
837 if (floorType = TFloorType.LiquidOut) then env := TEnvType.ELiquid else env := TEnvType.EAir;
838 y += dy;
839 //e_LogWritefln('floorY=%s; newy=%s; dY=%s; floorType=%s', [floorY, y, dY, floorType]);
840 if (y >= floorY) then
841 begin
842 // floor transition
843 dy := y-floorY;
844 y := floorY;
845 //e_LogWritefln(' HIT FLOORY: floorY=%s; newy=%s; dY=%s; floorType=%s', [floorY, y, dY, floorType]);
846 case floorType of
847 TFloorType.Wall: // hit the ground
848 begin
849 // check if our ground wasn't moved since the last scan
850 if not floorJustTraced then
851 begin
852 {$IF DEFINED(D2F_DEBUG_FALL_MPLAT)}
853 oldFloorY := floorY;
854 {$ENDIF}
855 findFloor(true); // force trace
856 {$IF DEFINED(D2F_DEBUG_FALL_MPLAT)}
857 if (floorY <> oldFloorY) then
858 begin
859 e_LogWritefln('force rescanning vpart at (%s,%s); oldFloorY=%s; floorY=%s', [x, y, oldFloorY, floorY]);
860 end;
861 {$ENDIF}
862 if (floorType = TFloorType.LiquidOut) then env := TEnvType.ELiquid else env := TEnvType.EAir;
863 if (y <> floorY) then continue;
864 end;
865 // environment didn't changed
866 if not inAir then hitAFloor();
867 break; // done with vertical movement
868 end;
869 TFloorType.LiquidIn: // entering the liquid
870 begin
871 // we're entered the liquid
872 env := TEnvType.ELiquid;
873 // rescan, so we'll know when we'll exit the liquid
874 findFloor(true); // force rescan
875 end;
876 TFloorType.LiquidOut: // exiting the liquid
877 begin
878 // we're exited the liquid
879 env := TEnvType.EAir;
880 // rescan, so we'll know when we'll enter something interesting
881 findFloor(true); // force rescan
882 if (floorType = TFloorType.Wall) and (floorY = y) then
883 begin
884 if not inAir then hitAFloor();
885 break; // done with vertical movement
886 end;
887 end;
888 end;
889 end
890 else
891 begin
892 break; // done with vertical movement
893 end;
894 end;
895 end;
896 end;
897 end // if gAdvBlood
898 else
899 begin
900 // simple blood
901 dx := round(velX);
902 dy := round(velY);
903 y += dy;
904 x += dx;
905 if (g_Map_PanelAtPoint(x, y, GridTagObstacle) <> nil) then begin die(); exit; end;
906 end;
908 _done:
909 if (x < g_Map_MinX) or (y < g_Map_MinY) or (x > g_Map_MaxX) or (y > g_Map_MaxY) then begin die(); end;
911 velX += accelX;
912 velY += accelY;
914 // blood will dissolve in other liquids
915 if (particleType = TPartType.Blood) then
916 begin
917 if (env = TEnvType.ELiquid) then
918 begin
919 if waitTime > 0 then
920 waitTime -= 1
921 else
922 time += 1;
923 if (liveTime <= 0) then begin die(); exit; end;
924 ex := 255-trunc(255.0*time/liveTime);
925 if (ex <= 10) then begin die(); exit; end;
926 if (ex > 250) then ex := 255;
927 alpha := Byte(ex);
928 end;
929 end
930 else
931 begin
932 // water will disappear in any liquid
933 if (env = TEnvType.ELiquid) then begin die(); exit; end;
934 if waitTime > 0 then
935 waitTime -= 1
936 else
937 time += 1;
938 // dry water
939 if (liveTime <= 0) then begin die(); exit; end;
940 ex := 255-trunc(255.0*time/liveTime);
941 if (ex <= 10) then begin die(); exit; end;
942 if (ex > 250) then ex := 255;
943 alpha := Byte(ex);
944 end;
945 end;
948 // ////////////////////////////////////////////////////////////////////////// //
949 procedure g_GFX_SparkVel (fX, fY: Integer; count: Word; vx, vy: Integer; devX, devY: Byte); forward;
951 procedure g_GFX_Blood (fX, fY: Integer; count: Word; vx, vy: Integer;
952 devX, devY: Word; cr, cg, cb: Byte; kind: Byte = BLOOD_NORMAL);
954 function genColor (cbase, crnd: Integer; def: Byte=0): Byte;
955 begin
956 if (cbase > 0) then
957 begin
958 cbase += crnd;
959 if (cbase < 0) then result := 0
960 else if (cbase > 255) then result := 255
961 else result := Byte(cbase);
962 end
963 else
964 begin
965 result := def;
966 end;
967 end;
969 var
970 a: Integer;
971 devX1, devX2, devY1, devY2: Integer;
972 l: Integer;
973 crnd: Integer;
974 pan: TPanel;
975 begin
976 if not gpart_dbg_enabled then exit;
978 if (kind = BLOOD_SPARKS) then
979 begin
980 g_GFX_SparkVel(fX, fY, 2+Random(2), -vx div 2, -vy div 2, devX, devY);
981 exit;
982 end
983 else if (kind = BLOOD_CSPARKS) OR (kind = BLOOD_COMBINE) then
984 begin
985 g_GFX_SparkVel(fX, fY, count, -vx div 2, -vy div 2, devX, devY);
986 if kind <> BLOOD_COMBINE then exit
987 end;
989 l := Length(Particles);
990 if (l = 0) then exit;
991 if (count > l) then count := l;
993 devX1 := devX div 2;
994 devX2 := devX+1;
995 devY1 := devY div 2;
996 devY2 := devY+1;
998 for a := 1 to count do
999 begin
1000 with Particles[CurrentParticle] do
1001 begin
1002 x := fX-devX1+Random(devX2);
1003 y := fY-devY1+Random(devY2);
1004 oldx := x;
1005 oldy := y;
1007 // check for level bounds
1008 if (x < g_Map_MinX) or (y < g_Map_MinY) or (x > g_Map_MaxX) or (y > g_Map_MaxY) then continue;
1010 // in what environment we are starting in?
1011 pan := g_Map_PanelAtPoint(x, y, (GridTagSolid or GridTagLiquid));
1012 if (pan <> nil) then
1013 begin
1014 // either in a wall, or in a liquid
1015 if ((pan.tag and GridTagSolid) <> 0) then continue; // don't spawn in walls
1016 env := TEnvType.ELiquid;
1017 end
1018 else
1019 begin
1020 env := TEnvType.EAir;
1021 end;
1023 velX := vx+(Random-Random)*3;
1024 velY := vy+(Random-Random)*3;
1026 if (velY > -4) then
1027 begin
1028 if (velY-4 < -4) then velY := -4 else velY := velY-4;
1029 end;
1031 accelX := -sign(velX)*Random/100;
1032 accelY := 0.8;
1034 crnd := 20*Random(6)-50;
1036 red := genColor(cr, CRnd, 0);
1037 green := genColor(cg, CRnd, 0);
1038 blue := genColor(cb, CRnd, 0);
1039 alpha := 255;
1041 particleType := TPartType.Blood;
1042 state := TPartState.Normal;
1043 time := 0;
1044 liveTime := 120+Random(40);
1045 waitTime := 20;
1046 floorY := Unknown;
1047 ceilingY := Unknown;
1048 end;
1050 if (CurrentParticle >= MaxParticles-1) then CurrentParticle := 0 else CurrentParticle += 1;
1051 end;
1052 end;
1055 procedure g_GFX_Water (fX, fY: Integer; count: Word; fVelX, fVelY: Single; devX, devY, color: Byte;
1056 simple: Boolean=false; cr: Byte=0; cg: Byte=0; cb: Byte=0);
1057 var
1058 a: Integer;
1059 devX1, devX2, devY1, devY2: Integer;
1060 l: Integer;
1061 pan: TPanel;
1062 begin
1063 if not gpart_dbg_enabled then exit;
1065 l := Length(Particles);
1066 if (l = 0) then exit;
1067 if (count > l) then count := l;
1069 if (abs(fVelX) < 3.0) then fVelX := 3.0-6.0*Random;
1071 devX1 := devX div 2;
1072 devX2 := devX+1;
1073 devY1 := devY div 2;
1074 devY2 := devY+1;
1076 if (not simple) and (color > 3) then color := 0;
1078 for a := 1 to count do
1079 begin
1080 with Particles[CurrentParticle] do
1081 begin
1082 if not simple then
1083 begin
1084 x := fX-devX1+Random(devX2);
1085 y := fY-devY1+Random(devY2);
1087 if (abs(fVelX) < 0.5) then velX := 1.0-2.0*Random else velX := fVelX*Random;
1088 if (Random(10) < 7) then velX := -velX;
1089 velY := fVelY*Random;
1090 accelX := 0.0;
1091 accelY := 0.8;
1092 end
1093 else
1094 begin
1095 x := fX;
1096 y := fY;
1098 velX := fVelX;
1099 velY := fVelY;
1100 accelX := 0.0;
1101 accelY := 0.8;
1102 end;
1104 oldx := x;
1105 oldy := y;
1107 // check for level bounds
1108 if (x < g_Map_MinX) or (y < g_Map_MinY) or (x > g_Map_MaxX) or (y > g_Map_MaxY) then continue;
1110 // this hack will allow water spawned in water to fly out
1111 // it can happen when player fell from a huge height (see "DOOM2D.WAD:\MAP03", for example)
1112 if (fVelY >= 0) then
1113 begin
1114 // in what environment we are starting in?
1115 pan := g_Map_PanelAtPoint(x, y, (GridTagObstacle or GridTagLiquid));
1116 end
1117 else
1118 begin
1119 pan := g_Map_PanelAtPoint(x, y, GridTagObstacle);
1120 end;
1121 if (pan <> nil) then continue;
1122 env := TEnvType.EAir;
1124 // color
1125 case color of
1126 1: // reddish
1127 begin
1128 red := 155+Random(9)*10;
1129 green := trunc(150*Random);
1130 blue := green;
1131 end;
1132 2: // greenish
1133 begin
1134 red := trunc(150*Random);
1135 green := 175+Random(9)*10;
1136 blue := red;
1137 end;
1138 3: // bluish
1139 begin
1140 red := trunc(200*Random);
1141 green := red;
1142 blue := 175+Random(9)*10;
1143 end;
1144 4: // Ñâîé öâåò, ñâåòëåå
1145 begin
1146 red := 20+Random(19)*10;
1147 green := red;
1148 blue := red;
1149 red := nmin(red+cr, 255);
1150 green := nmin(green+cg, 255);
1151 blue := nmin(blue+cb, 255);
1152 end;
1153 5: // Ñâîé öâåò, òåìíåå
1154 begin
1155 red := 20+Random(19)*10;
1156 green := red;
1157 blue := red;
1158 red := nmax(cr-red, 0);
1159 green := nmax(cg-green, 0);
1160 blue := nmax(cb-blue, 0);
1161 end;
1162 else // grayish
1163 begin
1164 red := 90+random(12)*10;
1165 green := red;
1166 blue := red;
1167 end;
1168 end;
1169 alpha := 255;
1171 particleType := TPartType.Water;
1172 state := TPartState.Normal;
1173 time := 0;
1174 liveTime := 60+Random(60);
1175 waitTime := 120;
1176 floorY := Unknown;
1177 ceilingY := Unknown;
1178 end;
1180 if (CurrentParticle >= MaxParticles-1) then CurrentParticle := 0 else CurrentParticle += 1;
1181 end;
1182 end;
1185 procedure g_GFX_SimpleWater (fX, fY: Integer; count: Word; fVelX, fVelY: Single; defColor, cr, cg, cb: Byte);
1186 begin
1187 g_GFX_Water(fX, fY, count, 0, 0, 0, 0, defColor, true, cr, cg, cb);
1188 end;
1191 // ////////////////////////////////////////////////////////////////////////// //
1192 procedure TParticle.thinkerBubble ();
1193 var
1194 dy: Integer;
1195 begin
1196 dy := round(velY);
1198 if (dy <> 0) then
1199 begin
1200 y += dy;
1201 if (dy < 0) then
1202 begin
1203 if (y <= ceilingY) then begin die(); exit; end;
1204 end
1205 else
1206 begin
1207 if (y >= floorY) then begin die(); exit; end;
1208 end;
1209 if (y < g_Map_MinY) or (y > g_Map_MaxY) then begin die(); exit; end;
1210 end;
1212 if (velY > -4) then velY += accelY;
1214 if waitTime > 0 then
1215 waitTime -= 1
1216 else
1217 time += 1;
1218 end;
1221 {.$DEFINE D2F_DEBUG_BUBBLES}
1222 procedure g_GFX_Bubbles (fX, fY: Integer; count: Word; devX, devY: Byte);
1223 var
1224 a, liquidx: Integer;
1225 devX1, devX2, devY1, devY2: Integer;
1226 l: Integer;
1227 {$IF DEFINED(D2F_DEBUG_BUBBLES)}
1228 stt: UInt64;
1229 nptr, ptr: Boolean;
1230 {$ENDIF}
1231 begin
1232 if not gpart_dbg_enabled then exit;
1234 l := Length(Particles);
1235 if (l = 0) then exit;
1236 if (count > l) then count := l;
1238 devX1 := devX div 2;
1239 devX2 := devX+1;
1240 devY1 := devY div 2;
1241 devY2 := devY+1;
1243 for a := 1 to count do
1244 begin
1245 with Particles[CurrentParticle] do
1246 begin
1247 x := fX-devX1+Random(devX2);
1248 y := fY-devY1+Random(devY2);
1249 oldx := x;
1250 oldy := y;
1252 // check for level bounds
1253 if (x < g_Map_MinX) or (y < g_Map_MinY) or (x > g_Map_MaxX) or (y > g_Map_MaxY) then continue;
1255 (*
1256 // don't spawn bubbles outside of the liquid
1257 if not isLiquidAt(X, Y) {ByteBool(gCollideMap[Y, X] and MARK_LIQUID)} then
1258 Continue;
1259 *)
1261 // trace liquid, so we'll know where it ends; do it in 8px steps for speed
1262 // tracer will return `false` if we started outside of the liquid
1264 {$IF DEFINED(D2F_DEBUG_BUBBLES)}
1265 stt := getTimeMicro();
1266 ptr := mapGrid.traceOrthoRayWhileIn(liquidx, liquidTopY, x, y, x, 0, GridTagWater or GridTagAcid1 or GridTagAcid2);
1267 stt := getTimeMicro()-stt;
1268 e_LogWritefln('traceOrthoRayWhileIn: time=%s (%s); liquidTopY=%s', [Integer(stt), ptr, liquidTopY]);
1269 //
1270 stt := getTimeMicro();
1271 nptr := g_Map_TraceLiquidNonPrecise(x, y, 0, -8, liquidx, liquidTopY);
1272 stt := getTimeMicro()-stt;
1273 e_LogWritefln('g_Map_TraceLiquidNonPrecise: time=%s (%s); liquidTopY=%s', [Integer(stt), nptr, liquidTopY]);
1274 if not nptr then continue;
1275 {$ELSE}
1276 if not g_Map_TraceLiquidNonPrecise(x, y, 0, -8, liquidx, ceilingY) then continue;
1277 if not g_Map_TraceLiquidNonPrecise(x, y, 0, +8, liquidx, floorY) then continue;
1278 {$ENDIF}
1280 velX := 0;
1281 velY := -1-Random;
1282 accelX := 0;
1283 accelY := velY/10;
1285 red := 255;
1286 green := 255;
1287 blue := 255;
1288 alpha := 255;
1290 state := TPartState.Normal;
1291 particleType := TPartType.Bubbles;
1292 time := 0;
1293 liveTime := 65535;
1294 waitTime := 0;
1295 end;
1297 if (CurrentParticle >= MaxParticles-1) then CurrentParticle := 0 else CurrentParticle += 1;
1298 end;
1299 end;
1302 // ////////////////////////////////////////////////////////////////////////// //
1303 procedure TParticle.thinkerSpark ();
1304 label
1305 _done;
1306 var
1307 dx, dy: SmallInt;
1308 pan: TPanel;
1309 ex, ey: Integer;
1310 begin
1311 if not gpart_dbg_phys_enabled then begin x += round(velX); y += round(velY); goto _done; end;
1313 dx := round(velX);
1314 dy := round(velY);
1316 //writeln('spark0: pos=(', x, ',', y, '); delta=(', dx, ',', dy, '); state=', state, '; ceilingY=', ceilingY, '; floorY=', floorY);
1318 // apply gravity
1319 if (abs(velX) < 0.1) and (abs(velY) < 0.1) then
1320 begin
1321 velY := 0.8;
1322 accelY := 0.5;
1323 end;
1325 // flying
1326 if (dx <> 0) then
1327 begin
1328 // has some horizontal velocity
1329 pan := g_Map_traceToNearest(x, y, x+dx, y+dy, (GridTagSolid or GridTagLiquid), @ex, @ey);
1330 if (x <> ex) then begin floorY := Unknown; ceilingY := Unknown; end; // dunno yet
1331 x := ex;
1332 y := ey;
1333 if (pan <> nil) then
1334 begin
1335 if ((pan.tag and GridTagLiquid) <> 0) then begin die(); exit; end; // die in liquid
1336 // hit the wall; falling down vertically
1337 velX := 0;
1338 accelX := 0;
1339 end;
1340 end
1341 else if (dy <> 0) then
1342 begin
1343 // has some vertical velocity
1344 if (dy < 0) then
1345 begin
1346 // flying up
1347 if (ceilingY = Unknown) then findCeiling(); // need to do this anyway
1348 y += dy;
1349 if (y <= ceilingY) then
1350 begin
1351 // oops, hit a ceiling
1352 y := ceilingY;
1353 velY := -velY;
1354 accelY := abs(accelY);
1355 end;
1356 // environment didn't changed
1357 end
1358 else
1359 begin
1360 // falling down
1361 if (floorY = Unknown) then findFloor(); // need to do this anyway
1362 y += dy;
1363 if (y >= floorY) then
1364 begin
1365 // hit something except a floor?
1366 if (floorType <> TFloorType.Wall) then begin die(); exit; end; // yep: just die
1367 // otherwise, go to sleep
1368 y := floorY;
1369 sleep();
1370 // environment didn't changed
1371 end;
1372 end;
1373 end;
1375 _done:
1376 if (x < g_Map_MinX) or (y < g_Map_MinY) or (x > g_Map_MaxX) or (y > g_Map_MaxY) then begin die(); end;
1378 if (velX <> 0.0) then velX += accelX;
1380 if (velY <> 0.0) then
1381 begin
1382 if (accelY < 10) then accelY += 0.08;
1383 velY += accelY;
1384 end;
1386 //writeln('spark1: pos=(', x, ',', y, '); delta=(', velX:6:3, ',', velY:6:3, '); state=', state, '; ceilingY=', ceilingY, '; floorY=', floorY);
1388 if waitTime > 0 then
1389 waitTime -= 1
1390 else
1391 time += 1;
1392 end;
1395 // ////////////////////////////////////////////////////////////////////////// //
1396 procedure g_GFX_SparkVel (fX, fY: Integer; count: Word; vx, vy: Integer; devX, devY: Byte);
1397 var
1398 a: Integer;
1399 devX1, devX2, devY1, devY2: Integer;
1400 l: Integer;
1401 pan: TPanel;
1402 begin
1403 if not gpart_dbg_enabled then exit;
1405 l := Length(Particles);
1406 if (l = 0) then exit;
1407 if (count > l) then count := l;
1409 devX1 := devX div 2;
1410 devX2 := devX+1;
1411 devY1 := devY div 2;
1412 devY2 := devY+1;
1414 for a := 1 to count do
1415 begin
1416 with Particles[CurrentParticle] do
1417 begin
1418 x := fX-devX1+Random(devX2);
1419 y := fY-devY1+Random(devY2);
1420 oldx := x;
1421 oldy := y;
1423 // check for level bounds
1424 if (x < g_Map_MinX) or (y < g_Map_MinY) or (x > g_Map_MaxX) or (y > g_Map_MaxY) then continue;
1426 // in what environment we are starting in?
1427 pan := g_Map_PanelAtPoint(x, y, (GridTagSolid or GridTagLiquid));
1428 if (pan <> nil) then
1429 begin
1430 // either in a wall, or in a liquid
1431 //if ((pan.tag and GridTagSolid) <> 0) then continue; // don't spawn in walls
1432 //env := TEnvType.ELiquid;
1433 continue;
1434 end
1435 else
1436 begin
1437 env := TEnvType.EAir;
1438 end;
1440 velX := vx+(Random-Random)*3;
1441 velY := vy+(Random-Random)*3;
1443 if (velY > -4) then
1444 begin
1445 if (velY-4 < -4) then velY := -4 else velY := velY-4;
1446 end;
1448 accelX := -sign(velX)*Random/100;
1449 accelY := 0.8;
1451 red := 255;
1452 green := 100+Random(155);
1453 blue := 64;
1454 alpha := 255;
1456 particleType := TPartType.Spark;
1457 state := TPartState.Normal;
1458 time := 0;
1459 liveTime := 30+Random(60);
1460 waitTime := 0;
1461 floorY := Unknown;
1462 ceilingY := Unknown;
1463 end;
1465 if (CurrentParticle >= MaxParticles-1) then CurrentParticle := 0 else CurrentParticle += 1;
1466 end;
1467 end;
1470 procedure g_GFX_Spark (fX, fY: Integer; count: Word; angle: SmallInt; devX, devY: Byte);
1471 var
1472 a: Integer;
1473 b: Single;
1474 devX1, devX2, devY1, devY2: Integer;
1475 baseVelX, baseVelY: Single;
1476 l: Integer;
1477 pan: TPanel;
1478 begin
1479 if not gpart_dbg_enabled then exit;
1481 l := Length(Particles);
1482 if (l = 0) then exit;
1483 if (count > l) then count := l;
1485 angle := 360-angle;
1487 devX1 := devX div 2;
1488 devX2 := devX+1;
1489 devY1 := devY div 2;
1490 devY2 := devY+1;
1492 b := DegToRad(angle);
1493 baseVelX := cos(b);
1494 baseVelY := 1.6*sin(b);
1495 if (abs(baseVelX) < 0.01) then baseVelX := 0.0;
1496 if (abs(baseVelY) < 0.01) then baseVelY := 0.0;
1498 for a := 1 to count do
1499 begin
1500 with Particles[CurrentParticle] do
1501 begin
1502 x := fX-devX1+Random(devX2);
1503 y := fY-devY1+Random(devY2);
1504 oldx := x;
1505 oldy := y;
1507 // check for level bounds
1508 if (x < g_Map_MinX) or (y < g_Map_MinY) or (x > g_Map_MaxX) or (y > g_Map_MaxY) then continue;
1510 // in what environment we are starting in?
1511 pan := g_Map_PanelAtPoint(x, y, (GridTagSolid or GridTagLiquid));
1512 if (pan <> nil) then
1513 begin
1514 // either in a wall, or in a liquid
1515 //if ((pan.tag and GridTagSolid) <> 0) then continue; // don't spawn in walls
1516 //env := TEnvType.ELiquid;
1517 continue;
1518 end
1519 else
1520 begin
1521 env := TEnvType.EAir;
1522 end;
1524 velX := baseVelX*Random;
1525 velY := baseVelY-Random;
1526 accelX := velX/3.0;
1527 accelY := velY/5.0;
1529 red := 255;
1530 green := 100+Random(155);
1531 blue := 64;
1532 alpha := 255;
1534 particleType := TPartType.Spark;
1535 state := TPartState.Normal;
1536 time := 0;
1537 liveTime := 30+Random(60);
1538 waitTime := 0;
1539 floorY := Unknown;
1540 ceilingY := Unknown;
1541 end;
1543 if (CurrentParticle >= MaxParticles-1) then CurrentParticle := 0 else CurrentParticle += 1;
1544 end;
1545 end;
1548 // ////////////////////////////////////////////////////////////////////////// //
1549 procedure g_GFX_SetMax (count: Integer);
1550 var
1551 a: Integer;
1552 begin
1553 if count > 50000 then count := 50000;
1554 if (count < 1) then count := 1;
1555 SetLength(Particles, count);
1556 for a := 0 to High(Particles) do Particles[a].die();
1557 MaxParticles := count;
1558 CurrentParticle := 0;
1559 end;
1562 function g_GFX_GetMax (): Integer;
1563 begin
1564 result := MaxParticles;
1565 end;
1567 // ////////////////////////////////////////////////////////////////////////// //
1568 procedure g_GFX_Init ();
1569 begin
1570 //g_Game_SetLoadingText(_lc[I_LOAD_COLLIDE_MAP]+' 1/6', 0, False);
1571 //SetLength(gCollideMap, gMapInfo.Height+1);
1572 //for a := 0 to High(gCollideMap) do SetLength(gCollideMap[a], gMapInfo.Width+1);
1573 awmSetup();
1574 {$IFDEF HEADLESS}
1575 gpart_dbg_enabled := false;
1576 {$ENDIF}
1577 end;
1580 procedure g_GFX_Free ();
1581 var
1582 a: Integer;
1583 begin
1584 Particles := nil;
1585 SetLength(Particles, MaxParticles);
1586 for a := 0 to High(Particles) do Particles[a].die();
1587 CurrentParticle := 0;
1589 awakeMap := nil;
1590 // why not?
1591 awakeMapH := -1;
1592 awakeMapW := -1;
1593 end;
1596 // ////////////////////////////////////////////////////////////////////////// //
1597 procedure g_GFX_Update ();
1598 var
1599 a: Integer;
1600 w, h: Integer;
1601 len: Integer;
1602 begin
1603 if not gpart_dbg_enabled then exit;
1605 if (Particles <> nil) then
1606 begin
1607 w := gMapInfo.Width;
1608 h := gMapInfo.Height;
1610 len := High(Particles);
1612 for a := 0 to len do
1613 begin
1614 if Particles[a].alive then
1615 begin
1616 with Particles[a] do
1617 begin
1618 if (time = liveTime) then begin die(); continue; end;
1619 if (x+1 >= w) or (y+1 >= h) or (x <= 0) or (y <= 0) then begin die(); end;
1620 think();
1621 end; // with
1622 end; // if
1623 end; // for
1624 end; // Particles <> nil
1626 // clear awake map
1627 awmClear();
1628 end;
1630 end.