DEADSOFTWARE

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