DEADSOFTWARE

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