DEADSOFTWARE

e92f369d78fd66ce8b8cfd57298003928bb0ef42
[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, either version 3 of the License, or
6 * (at your option) any later version.
7 *
8 * This program is distributed in the hope that it will be useful,
9 * but WITHOUT ANY WARRANTY; without even the implied warranty of
10 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
11 * GNU General Public License for more details.
12 *
13 * You should have received a copy of the GNU General Public License
14 * along with this program. If not, see <http://www.gnu.org/licenses/>.
15 *)
16 {$INCLUDE ../shared/a_modes.inc}
17 {.$DEFINE D2F_DEBUG_FALL_MPLAT}
18 {/$DEFINE D2F_DEBUG_PART_AWAKE}
19 unit g_gfx;
21 interface
23 uses
24 e_log, g_textures;
26 const
27 BLOOD_NORMAL = 0;
28 BLOOD_SPARKS = 1;
29 BLOOD_CSPARKS = 2;
30 BLOOD_COMBINE = 3;
32 ONCEANIM_NONE = 0;
33 ONCEANIM_SMOKE = 1;
35 MARK_FREE = 0;
36 MARK_WALL = 1;
37 MARK_WATER = 2;
38 MARK_ACID = 4;
39 MARK_LIFTDOWN = 8;
40 MARK_LIFTUP = 16;
41 MARK_DOOR = 32;
42 MARK_LIFTLEFT = 64;
43 MARK_LIFTRIGHT = 128;
44 MARK_BLOCKED = MARK_WALL or MARK_DOOR;
45 MARK_LIQUID = MARK_WATER or MARK_ACID;
46 MARK_LIFT = MARK_LIFTDOWN or MARK_LIFTUP or MARK_LIFTLEFT or MARK_LIFTRIGHT;
49 procedure g_GFX_Init ();
50 procedure g_GFX_Free ();
52 procedure g_GFX_Blood (fX, fY: Integer; count: Word; vx, vy: Integer;
53 devX, devY: Word; cr, cg, cb: Byte; kind: Byte=BLOOD_NORMAL);
54 procedure g_GFX_Spark (fX, fY: Integer; count: Word; angle: SmallInt; devX, devY: Byte);
55 procedure g_GFX_Water (fX, fY: Integer; count: Word; fVelX, fVelY: Single; devX, devY, color: Byte;
56 simple: Boolean=false; cr: Byte=0; cg: Byte=0; cb: Byte=0);
57 procedure g_GFX_SimpleWater (fX, fY: Integer; count: Word; fVelX, fVelY: Single; defColor, cr, cg, cb: Byte);
58 procedure g_GFX_Bubbles (fX, fY: Integer; count: Word; devX, devY: Byte);
60 procedure g_GFX_SetMax (count: Integer);
61 function g_GFX_GetMax (): Integer;
63 procedure g_GFX_OnceAnim (X, Y: Integer; Anim: TAnimation; AnimType: Byte = 0);
65 procedure g_Mark (x, y, Width, Height: Integer; t: Byte; st: Boolean=true);
67 procedure g_GFX_Update ();
68 procedure g_GFX_Draw ();
71 var
72 gpart_dbg_enabled: Boolean = true;
73 gpart_dbg_phys_enabled: Boolean = true;
76 //WARNING: only for Holmes!
77 function awmIsSetHolmes (x, y: Integer): Boolean; inline;
80 implementation
82 uses
83 {$INCLUDE ../nogl/noGLuses.inc}
84 g_map, g_panel, g_basic, Math, e_graphics,
85 g_options, g_console, SysUtils, g_triggers, MAPDEF,
86 g_game, g_language, g_net, utils, xprofiler;
89 const
90 Unknown = Integer($7fffffff);
93 type
94 TPartType = (Blood, Spark, Bubbles, Water);
95 TPartState = (Free, Normal, Stuck, Sleeping);
96 TFloorType = (Wall, LiquidIn, LiquidOut);
97 // Wall: floorY is just before floor
98 // LiquidIn: floorY is liquid *start* (i.e. just in a liquid)
99 // LiquidOut: floorY is liquid *end* (i.e. just out of a liquid)
100 TEnvType = (EAir, ELiquid, EWall); // where particle is now
102 // note: this MUST be record, so we can keep it in
103 // dynamic array and has sequential memory access pattern
104 PParticle = ^TParticle;
105 TParticle = record
106 x, y: Integer;
107 velX, velY: Single;
108 accelX, accelY: Single;
109 state: TPartState;
110 particleType: TPartType;
111 red, green, blue: Byte;
112 alpha: Byte;
113 time, liveTime, waitTime: Word;
114 stickDX: Integer; // STATE_STICK: -1,1: stuck to a wall; 0: stuck to ceiling
115 justSticked: Boolean; // not used
116 floorY: Integer; // actually, floor-1; `Unknown`: unknown
117 floorType: TFloorType;
118 env: TEnvType; // where particle is now
119 ceilingY: Integer; // actually, ceiling+1; `Unknown`: unknown
120 wallEndY: Integer; // if we stuck to a wall, this is where wall ends
122 //k8: sorry, i have to emulate virtual methods this way, 'cause i haet `Object`
123 procedure thinkerBloodAndWater ();
124 procedure thinkerSpark ();
125 procedure thinkerBubble ();
127 procedure findFloor (force: Boolean=false); // this updates `floorY` if forced or Unknown
128 procedure findCeiling (force: Boolean=false); // this updates `ceilingY` if forced or Unknown
130 procedure freeze (); inline; // remove velocities and acceleration
131 procedure sleep (); inline; // switch to sleep mode
133 function checkAirStreams (): Boolean; // `true`: affected by air stream
135 function alive (): Boolean; inline;
136 procedure die (); inline;
137 procedure think (); inline;
138 end;
140 TOnceAnim = record
141 AnimType: Byte;
142 x, y: Integer;
143 Animation: TAnimation;
144 end;
147 var
148 Particles: array of TParticle = nil;
149 OnceAnims: array of TOnceAnim = nil;
150 MaxParticles: Integer = 0;
151 CurrentParticle: Integer = 0;
152 // awakeMap has one bit for each map grid cell; on g_Mark,
153 // corresponding bits will be set, and in `think()` all particles
154 // in marked cells will be awaken
155 awakeMap: packed array of LongWord = nil;
156 awakeMapH: Integer = -1;
157 awakeMapW: Integer = -1;
158 awakeMinX, awakeMinY: Integer;
159 awakeDirty: Boolean = false;
160 {$IF DEFINED(D2F_DEBUG_PART_AWAKE)}
161 awakeMapHlm: packed array of LongWord = nil;
162 {$ENDIF}
165 // ////////////////////////////////////////////////////////////////////////// //
166 function awmIsSetHolmes (x, y: Integer): Boolean; inline;
167 begin
168 {$IF DEFINED(D2F_DEBUG_PART_AWAKE)}
169 if (Length(awakeMapHlm) = 0) then begin result := false; exit; end;
170 x := (x-awakeMinX) div mapGrid.tileSize;
171 y := (y-awakeMinY) div mapGrid.tileSize;
172 if (x >= 0) and (y >= 0) and (x div 32 < awakeMapW) and (y < awakeMapH) then
173 begin
174 if (y*awakeMapW+x div 32 < Length(awakeMapHlm)) then
175 begin
176 result := ((awakeMapHlm[y*awakeMapW+x div 32] and (LongWord(1) shl (x mod 32))) <> 0);
177 end
178 else
179 begin
180 result := false;
181 end;
182 end
183 else
184 begin
185 result := false;
186 end;
187 {$ELSE}
188 result := false;
189 {$ENDIF}
190 end;
193 // ////////////////////////////////////////////////////////////////////////// //
194 // HACK! using mapgrid
195 procedure awmClear (); inline;
196 begin
197 {$IF DEFINED(D2F_DEBUG_PART_AWAKE)}
198 if (Length(awakeMap) > 0) then
199 begin
200 if (Length(awakeMapHlm) <> Length(awakeMap)) then SetLength(awakeMapHlm, Length(awakeMap));
201 Move(awakeMap[0], awakeMapHlm[0], Length(awakeMap)*sizeof(awakeMap[0]));
202 end;
203 {$ENDIF}
204 if awakeDirty and (awakeMapW > 0) then
205 begin
206 FillDWord(awakeMap[0], Length(awakeMap), 0);
207 awakeDirty := false;
208 end;
209 end;
212 procedure awmSetup ();
213 begin
214 assert(mapGrid <> nil);
215 awakeMapW := (mapGrid.gridWidth+mapGrid.tileSize-1) div mapGrid.tileSize;
216 awakeMapW := (awakeMapW+31) div 32; // LongWord has 32 bits ;-)
217 awakeMapH := (mapGrid.gridHeight+mapGrid.tileSize-1) div mapGrid.tileSize;
218 awakeMinX := mapGrid.gridX0;
219 awakeMinY := mapGrid.gridY0;
220 SetLength(awakeMap, awakeMapW*awakeMapH);
221 {$IF DEFINED(D2F_DEBUG_PART_AWAKE)}
222 SetLength(awakeMapHlm, awakeMapW*awakeMapH);
223 FillDWord(awakeMapHlm[0], Length(awakeMapHlm), 0);
224 {$ENDIF}
225 //{$IF DEFINED(D2F_DEBUG)}
226 e_LogWritefln('particle awake map: %sx%s (for grid of size %sx%s)', [awakeMapW, awakeMapH, mapGrid.gridWidth, mapGrid.gridHeight]);
227 //{$ENDIF}
228 awakeDirty := true;
229 awmClear();
230 end;
233 function awmIsSet (x, y: Integer): Boolean; inline;
234 begin
235 x := (x-awakeMinX) div mapGrid.tileSize;
236 y := (y-awakeMinY) div mapGrid.tileSize;
237 if (x >= 0) and (y >= 0) and (x div 32 < awakeMapW) and (y < awakeMapH) then
238 begin
239 {$IF DEFINED(D2F_DEBUG)}
240 assert(y*awakeMapW+x div 32 < Length(awakeMap));
241 {$ENDIF}
242 result := ((awakeMap[y*awakeMapW+x div 32] and (LongWord(1) shl (x mod 32))) <> 0);
243 end
244 else
245 begin
246 result := false;
247 end;
248 end;
251 procedure awmSet (x, y: Integer); inline;
252 var
253 v: PLongWord;
254 begin
255 x := (x-awakeMinX) div mapGrid.tileSize;
256 y := (y-awakeMinY) div mapGrid.tileSize;
257 if (x >= 0) and (y >= 0) and (x div 32 < awakeMapW) and (y < awakeMapH) then
258 begin
259 {$IF DEFINED(D2F_DEBUG)}
260 assert(y*awakeMapW+x div 32 < Length(awakeMap));
261 {$ENDIF}
262 v := @awakeMap[y*awakeMapW+x div 32];
263 v^ := v^ or (LongWord(1) shl (x mod 32));
264 awakeDirty := true;
265 end;
266 end;
269 // ////////////////////////////////////////////////////////////////////////// //
270 // st: set mark
271 // t: mark type
272 // currently unused
273 procedure g_Mark (x, y, Width, Height: Integer; t: Byte; st: Boolean=true);
274 const Extrude = 1;
275 var
276 dx, dy, ex, ey: Integer;
277 v: PLongWord;
278 begin
279 if (not gpart_dbg_enabled) or (not gpart_dbg_phys_enabled) then exit;
280 if (awakeMapW < 1) or (awakeMapH < 1) then exit;
282 if (Width < 1) or (Height < 1) then exit;
284 // make some border, so we'll hit particles around the panel
285 ex := x+Width+Extrude-1-awakeMinX;
286 ey := y+Height+Extrude-1-awakeMinY;
287 x := (x-Extrude)-awakeMinX;
288 y := (y-Extrude)-awakeMinY;
290 x := x div mapGrid.tileSize;
291 y := y div mapGrid.tileSize;
292 ex := ex div mapGrid.tileSize;
293 ey := ey div mapGrid.tileSize;
295 // has something to do?
296 if (ex < 0) or (ey < 0) or (x >= awakeMapW*32) or (y >= awakeMapH) then exit;
297 if (x < 0) then x := 0;
298 if (y < 0) then y := 0;
299 if (ex >= awakeMapW*32) then ex := awakeMapW*32-1;
300 if (ey >= awakeMapH) then ey := awakeMapH;
302 awakeDirty := true;
303 for dy := y to ey do
304 begin
305 for dx := x to ex do
306 begin
307 {$IF DEFINED(D2F_DEBUG)}
308 assert((dx >= 0) and (dy >= 0) and (dx div 32 < awakeMapW) and (dy < awakeMapH));
309 assert(dy*awakeMapW+dx div 32 < Length(awakeMap));
310 {$ENDIF}
311 v := @awakeMap[dy*awakeMapW+dx div 32];
312 v^ := v^ or (LongWord(1) shl (dx mod 32));
313 end;
314 end;
315 end;
318 // ////////////////////////////////////////////////////////////////////////// //
319 function TParticle.alive (): Boolean; inline; begin result := (state <> TPartState.Free); end;
320 procedure TParticle.die (); inline; begin state := TPartState.Free; end;
322 // remove velocities and acceleration
323 procedure TParticle.freeze (); inline;
324 begin
325 // stop right there, you criminal scum!
326 velX := 0;
327 velY := 0;
328 accelX := 0;
329 accelY := 0;
330 end;
333 // `true`: affected by air stream
334 function TParticle.checkAirStreams (): Boolean;
335 var
336 pan: TPanel;
337 r: Integer;
338 begin
339 pan := g_Map_PanelAtPoint(x, y, GridTagLift);
340 result := (pan <> nil);
341 r := Random(3);
342 if result then
343 begin
344 if ((pan.PanelType and PANEL_LIFTUP) <> 0) then
345 begin
346 if (velY > -1-r) then velY -= 0.8;
347 if (abs(velX) > 0.1) then velX -= velX/10.0;
348 velX += (Random-Random)*0.2;
349 accelY := 0.15;
350 end
351 else if ((pan.PanelType and PANEL_LIFTDOWN) <> 0) then
352 begin
353 if (velY < 1+r) then velY += 0.8;
354 accelY := 0.15;
355 end
356 else if ((pan.PanelType and PANEL_LIFTLEFT) <> 0) then
357 begin
358 if (velX > -8-r) then velX -= (8+r) div 2;
359 accelY := 0.15;
360 end
361 else if ((pan.PanelType and PANEL_LIFTRIGHT) <> 0) then
362 begin
363 if (velX < 8+r) then velX += (8+r) div 2;
364 accelY := 0.15;
365 end
366 else
367 begin
368 result := false;
369 end;
370 // awake
371 if result and (state = TPartState.Sleeping) then state := TPartState.Normal;
372 end;
373 end;
376 // switch to sleep mode
377 procedure TParticle.sleep (); inline;
378 begin
379 if not checkAirStreams() then
380 begin
381 state := TPartState.Sleeping;
382 freeze();
383 end;
384 end;
387 procedure TParticle.findFloor (force: Boolean=false);
388 var
389 ex: Integer;
390 pan: TPanel;
391 begin
392 if (not force) and (floorY <> Unknown) then exit;
393 // stuck in the wall? rescan, 'cause it can be mplat
394 if (env = TEnvType.EWall) then
395 begin
396 pan := g_Map_PanelAtPoint(x, y, (GridTagObstacle or GridTagLiquid));
397 if (pan <> nil) then
398 begin
399 // either in a wall, or in a liquid
400 if ((pan.tag and GridTagObstacle) <> 0) then
401 begin
402 // we are in the wall, wtf?!
403 floorY := y;
404 env := TEnvType.EWall;
405 floorType := TFloorType.Wall;
406 state := TPartState.Sleeping; // anyway
407 exit;
408 end;
409 // we are in liquid, trace to liquid end
410 env := TEnvType.ELiquid;
411 end;
412 end;
413 // are we in a liquid?
414 if (env = TEnvType.ELiquid) then
415 begin
416 // trace out of the liquid
417 //env := TEnvType.ELiquid;
418 floorType := TFloorType.LiquidOut;
419 //e_LogWritefln('tracing out of a liquid; floorY=%s; y=%s', [floorY, y]);
420 mapGrid.traceOrthoRayWhileIn(ex, floorY, x, y, x, g_Map_MaxY, GridTagLiquid);
421 floorY += 1; // so `floorY` is just out of a liquid
422 //e_LogWritefln(' traced out of a liquid; floorY=%s; y=%s', [floorY, y]);
423 end
424 else
425 begin
426 // in the air
427 assert(env = TEnvType.EAir);
428 //env := TEnvType.EAir;
429 pan := g_Map_traceToNearest(x, y, x, g_Map_MaxY, (GridTagObstacle or GridTagLiquid), @ex, @floorY);
430 if (pan <> nil) then
431 begin
432 // wall or liquid
433 if ((pan.tag and GridTagObstacle) <> 0) then
434 begin
435 // wall
436 floorType := TFloorType.Wall;
437 end
438 else
439 begin
440 // liquid
441 floorType := TFloorType.LiquidIn; // entering liquid
442 floorY += 1; // so `floorY` is just in a liquid
443 end;
444 end
445 else
446 begin
447 // out of the level; assume wall, but it doesn't really matter
448 floorType := TFloorType.Wall;
449 floorY := g_Map_MaxY+2;
450 end;
451 end;
452 end;
455 procedure TParticle.findCeiling (force: Boolean=false);
456 var
457 ex: Integer;
458 begin
459 if (not force) and (ceilingY <> Unknown) then exit;
460 if (nil = g_Map_traceToNearest(x, y, x, g_Map_MinY, GridTagObstacle, @ex, @ceilingY)) then
461 begin
462 ceilingY := g_Map_MinY-2;
463 end;
464 end;
467 procedure TParticle.think (); inline;
468 procedure awake ();
469 begin
470 if (state = TPartState.Stuck) then
471 begin
472 //writeln('awaking particle at (', x, ',', y, ')');
473 if (stickDX = 0) then
474 begin
475 state := TPartState.Normal; // stuck to a ceiling
476 end
477 else
478 begin
479 // stuck to a wall, check if wall is still there
480 if (wallEndY <> Unknown) then
481 begin
482 wallEndY := Unknown;
483 if (g_Map_PanelAtPoint(x+stickDX, y, GridTagObstacle) = nil) then
484 begin
485 // a wall was moved out, start falling
486 state := TPartState.Normal;
487 if (velY = 0) then velY := 0.1;
488 if (accelY = 0) then accelY := 0.5;
489 end;
490 end;
491 end;
492 end
493 else
494 begin
495 state := TPartState.Normal;
496 if (velY = 0) then velY := 0.1;
497 if (accelY = 0) then accelY := 0.5;
498 end;
499 floorY := Unknown;
500 ceilingY := Unknown;
501 end;
503 begin
504 // awake sleeping particle, if necessary
505 if awakeDirty then
506 begin
507 if awmIsSet(x, y) then awake();
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;
516 end;
517 case particleType of
518 TPartType.Blood, TPartType.Water: thinkerBloodAndWater();
519 TPartType.Spark: thinkerSpark();
520 TPartType.Bubbles: thinkerBubble();
521 end;
522 end;
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;
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;
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;
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;
573 // switch to freefall mode
574 procedure freefall ();
575 begin
576 state := TPartState.Normal;
577 velY := 0.5;
578 accelY := 0.15;
579 end;
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;
596 label
597 _done, _gravityagain, _stuckagain;
598 var
599 pan: TPanel;
600 dx, dy: SmallInt;
601 ex, ey: Integer;
602 checkEnv, inAir: 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;
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
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;
694 // it is important to have it here
695 dx := round(velX);
696 dy := round(velY);
698 inAir := checkAirStreams();
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;
742 // trace movement
743 if (dx <> 0) then
744 begin
745 // has some horizontal velocity
746 pan := g_Map_traceToNearest(x, y, x+dx, y+dy, GridTagObstacle, @ex, @ey);
747 checkEnv := (x <> ex);
748 x := ex;
749 y := ey;
750 if checkEnv then
751 begin
752 // dunno yet
753 floorY := Unknown;
754 ceilingY := Unknown;
755 // check environment (air/liquid)
756 if (g_Map_PanelAtPoint(x, y, GridTagLiquid) <> nil) then env := TEnvType.ELiquid else env := TEnvType.EAir;
757 end;
758 if (pan <> nil) then
759 begin
760 // we stuck
761 // the only case when we can have both ceiling and wall is corner; stick to wall in this case
762 // check if we stuck to a wall
763 if (dx < 0) then dx := -1 else dx := 1;
764 if (g_Map_PanelAtPoint(x+dx, y, GridTagObstacle) <> nil) then
765 begin
766 // stuck to a wall
767 stickToWall(dx);
768 end
769 else
770 begin
771 // stuck to a ceiling
772 stickToCeiling();
773 end;
774 end;
775 end
776 else if (dy <> 0) then
777 begin
778 // has only vertical velocity
779 if (dy < 0) then
780 begin
781 // flying up
782 if (ceilingY = Unknown) then findCeiling(); // need to do this anyway
783 y += dy;
784 if (y <= ceilingY) then begin y := ceilingY; stickToCeiling(); end; // oops, hit a ceiling
785 // environment didn't changed
786 end
787 else
788 begin
789 while (dy > 0) do
790 begin
791 // falling down
792 floorJustTraced := (floorY = Unknown);
793 if floorJustTraced then findFloor();
794 if (floorType = TFloorType.LiquidOut) then env := TEnvType.ELiquid else env := TEnvType.EAir;
795 y += dy;
796 //e_LogWritefln('floorY=%s; newy=%s; dY=%s; floorType=%s', [floorY, y, dY, floorType]);
797 if (y >= floorY) then
798 begin
799 // floor transition
800 dy := y-floorY;
801 y := floorY;
802 //e_LogWritefln(' HIT FLOORY: floorY=%s; newy=%s; dY=%s; floorType=%s', [floorY, y, dY, floorType]);
803 case floorType of
804 TFloorType.Wall: // hit the ground
805 begin
806 // check if our ground wasn't moved since the last scan
807 if not floorJustTraced then
808 begin
809 {$IF DEFINED(D2F_DEBUG_FALL_MPLAT)}
810 oldFloorY := floorY;
811 {$ENDIF}
812 findFloor(true); // force trace
813 {$IF DEFINED(D2F_DEBUG_FALL_MPLAT)}
814 if (floorY <> oldFloorY) then
815 begin
816 e_LogWritefln('force rescanning vpart at (%s,%s); oldFloorY=%s; floorY=%s', [x, y, oldFloorY, floorY]);
817 end;
818 {$ENDIF}
819 if (floorType = TFloorType.LiquidOut) then env := TEnvType.ELiquid else env := TEnvType.EAir;
820 if (y <> floorY) then continue;
821 end;
822 // environment didn't changed
823 if not inAir then hitAFloor();
824 break; // done with vertical movement
825 end;
826 TFloorType.LiquidIn: // entering the liquid
827 begin
828 // we're entered the liquid
829 env := TEnvType.ELiquid;
830 // rescan, so we'll know when we'll exit the liquid
831 findFloor(true); // force rescan
832 end;
833 TFloorType.LiquidOut: // exiting the liquid
834 begin
835 // we're exited the liquid
836 env := TEnvType.EAir;
837 // rescan, so we'll know when we'll enter something interesting
838 findFloor(true); // force rescan
839 if (floorType = TFloorType.Wall) and (floorY = y) then
840 begin
841 if not inAir then hitAFloor();
842 break; // done with vertical movement
843 end;
844 end;
845 end;
846 end
847 else
848 begin
849 break; // done with vertical movement
850 end;
851 end;
852 end;
853 end;
854 end // if gAdvBlood
855 else
856 begin
857 // simple blood
858 dx := round(velX);
859 dy := round(velY);
860 y += dy;
861 x += dx;
862 if (g_Map_PanelAtPoint(x, y, GridTagObstacle) <> nil) then begin die(); exit; end;
863 end;
865 _done:
866 if (x < g_Map_MinX) or (y < g_Map_MinY) or (x > g_Map_MaxX) or (y > g_Map_MaxY) then begin die(); end;
868 velX += accelX;
869 velY += accelY;
871 // blood will dissolve in other liquids
872 if (particleType = TPartType.Blood) then
873 begin
874 if (env = TEnvType.ELiquid) then
875 begin
876 if waitTime > 0 then
877 waitTime -= 1
878 else
879 time += 1;
880 if (liveTime <= 0) then begin die(); exit; end;
881 ex := 255-trunc(255.0*time/liveTime);
882 if (ex <= 10) then begin die(); exit; end;
883 if (ex > 250) then ex := 255;
884 alpha := Byte(ex);
885 end;
886 end
887 else
888 begin
889 // water will disappear in any liquid
890 if (env = TEnvType.ELiquid) then begin die(); exit; end;
891 if waitTime > 0 then
892 waitTime -= 1
893 else
894 time += 1;
895 // dry water
896 if (liveTime <= 0) then begin die(); exit; end;
897 ex := 255-trunc(255.0*time/liveTime);
898 if (ex <= 10) then begin die(); exit; end;
899 if (ex > 250) then ex := 255;
900 alpha := Byte(ex);
901 end;
902 end;
905 // ////////////////////////////////////////////////////////////////////////// //
906 procedure g_GFX_SparkVel (fX, fY: Integer; count: Word; vx, vy: Integer; devX, devY: Byte); forward;
908 procedure g_GFX_Blood (fX, fY: Integer; count: Word; vx, vy: Integer;
909 devX, devY: Word; cr, cg, cb: Byte; kind: Byte = BLOOD_NORMAL);
911 function genColor (cbase, crnd: Integer; def: Byte=0): Byte;
912 begin
913 if (cbase > 0) then
914 begin
915 cbase += crnd;
916 if (cbase < 0) then result := 0
917 else if (cbase > 255) then result := 255
918 else result := Byte(cbase);
919 end
920 else
921 begin
922 result := def;
923 end;
924 end;
926 var
927 a: Integer;
928 devX1, devX2, devY1, devY2: Integer;
929 l: Integer;
930 crnd: Integer;
931 pan: TPanel;
932 begin
933 if not gpart_dbg_enabled then exit;
935 if (kind = BLOOD_SPARKS) then
936 begin
937 g_GFX_SparkVel(fX, fY, 2+Random(2), -vx div 2, -vy div 2, devX, devY);
938 exit;
939 end
940 else if (kind = BLOOD_CSPARKS) OR (kind = BLOOD_COMBINE) then
941 begin
942 g_GFX_SparkVel(fX, fY, count, -vx div 2, -vy div 2, devX, devY);
943 if kind <> BLOOD_COMBINE then exit
944 end;
946 l := Length(Particles);
947 if (l = 0) then exit;
948 if (count > l) then count := l;
950 devX1 := devX div 2;
951 devX2 := devX+1;
952 devY1 := devY div 2;
953 devY2 := devY+1;
955 for a := 1 to count do
956 begin
957 with Particles[CurrentParticle] do
958 begin
959 x := fX-devX1+Random(devX2);
960 y := fY-devY1+Random(devY2);
962 // check for level bounds
963 if (x < g_Map_MinX) or (y < g_Map_MinY) or (x > g_Map_MaxX) or (y > g_Map_MaxY) then continue;
965 // in what environment we are starting in?
966 pan := g_Map_PanelAtPoint(x, y, (GridTagObstacle or GridTagLiquid));
967 if (pan <> nil) then
968 begin
969 // either in a wall, or in a liquid
970 if ((pan.tag and GridTagObstacle) <> 0) then continue; // don't spawn in walls
971 env := TEnvType.ELiquid;
972 end
973 else
974 begin
975 env := TEnvType.EAir;
976 end;
978 velX := vx+(Random-Random)*3;
979 velY := vy+(Random-Random)*3;
981 if (velY > -4) then
982 begin
983 if (velY-4 < -4) then velY := -4 else velY := velY-4;
984 end;
986 accelX := -sign(velX)*Random/100;
987 accelY := 0.8;
989 crnd := 20*Random(6)-50;
991 red := genColor(cr, CRnd, 0);
992 green := genColor(cg, CRnd, 0);
993 blue := genColor(cb, CRnd, 0);
994 alpha := 255;
996 particleType := TPartType.Blood;
997 state := TPartState.Normal;
998 time := 0;
999 liveTime := 120+Random(40);
1000 waitTime := 20;
1001 floorY := Unknown;
1002 ceilingY := Unknown;
1003 end;
1005 if (CurrentParticle >= MaxParticles-1) then CurrentParticle := 0 else CurrentParticle += 1;
1006 end;
1007 end;
1010 procedure g_GFX_Water (fX, fY: Integer; count: Word; fVelX, fVelY: Single; devX, devY, color: Byte;
1011 simple: Boolean=false; cr: Byte=0; cg: Byte=0; cb: Byte=0);
1012 var
1013 a: Integer;
1014 devX1, devX2, devY1, devY2: Integer;
1015 l: Integer;
1016 pan: TPanel;
1017 begin
1018 if not gpart_dbg_enabled then exit;
1020 l := Length(Particles);
1021 if (l = 0) then exit;
1022 if (count > l) then count := l;
1024 if (abs(fVelX) < 3.0) then fVelX := 3.0-6.0*Random;
1026 devX1 := devX div 2;
1027 devX2 := devX+1;
1028 devY1 := devY div 2;
1029 devY2 := devY+1;
1031 if (not simple) and (color > 3) then color := 0;
1033 for a := 1 to count do
1034 begin
1035 with Particles[CurrentParticle] do
1036 begin
1037 if not simple then
1038 begin
1039 x := fX-devX1+Random(devX2);
1040 y := fY-devY1+Random(devY2);
1042 if (abs(fVelX) < 0.5) then velX := 1.0-2.0*Random else velX := fVelX*Random;
1043 if (Random(10) < 7) then velX := -velX;
1044 velY := fVelY*Random;
1045 accelX := 0.0;
1046 accelY := 0.8;
1047 end
1048 else
1049 begin
1050 x := fX;
1051 y := fY;
1053 velX := fVelX;
1054 velY := fVelY;
1055 accelX := 0.0;
1056 accelY := 0.8;
1057 end;
1059 // check for level bounds
1060 if (x < g_Map_MinX) or (y < g_Map_MinY) or (x > g_Map_MaxX) or (y > g_Map_MaxY) then continue;
1062 // this hack will allow water spawned in water to fly out
1063 // it can happen when player fell from a huge height (see "DOOM2D.WAD:\MAP03", for example)
1064 if (fVelY >= 0) then
1065 begin
1066 // in what environment we are starting in?
1067 pan := g_Map_PanelAtPoint(x, y, (GridTagObstacle or GridTagLiquid));
1068 end
1069 else
1070 begin
1071 pan := g_Map_PanelAtPoint(x, y, GridTagObstacle);
1072 end;
1073 if (pan <> nil) then continue;
1074 env := TEnvType.EAir;
1076 // color
1077 case color of
1078 1: // reddish
1079 begin
1080 red := 155+Random(9)*10;
1081 green := trunc(150*Random);
1082 blue := green;
1083 end;
1084 2: // greenish
1085 begin
1086 red := trunc(150*Random);
1087 green := 175+Random(9)*10;
1088 blue := red;
1089 end;
1090 3: // bluish
1091 begin
1092 red := trunc(200*Random);
1093 green := red;
1094 blue := 175+Random(9)*10;
1095 end;
1096 4: // Ñâîé öâåò, ñâåòëåå
1097 begin
1098 red := 20+Random(19)*10;
1099 green := red;
1100 blue := red;
1101 red := nmin(red+cr, 255);
1102 green := nmin(green+cg, 255);
1103 blue := nmin(blue+cb, 255);
1104 end;
1105 5: // Ñâîé öâåò, òåìíåå
1106 begin
1107 red := 20+Random(19)*10;
1108 green := red;
1109 blue := red;
1110 red := nmax(cr-red, 0);
1111 green := nmax(cg-green, 0);
1112 blue := nmax(cb-blue, 0);
1113 end;
1114 else // grayish
1115 begin
1116 red := 90+random(12)*10;
1117 green := red;
1118 blue := red;
1119 end;
1120 end;
1121 alpha := 255;
1123 particleType := TPartType.Water;
1124 state := TPartState.Normal;
1125 time := 0;
1126 liveTime := 60+Random(60);
1127 waitTime := 120;
1128 floorY := Unknown;
1129 ceilingY := Unknown;
1130 end;
1132 if (CurrentParticle >= MaxParticles-1) then CurrentParticle := 0 else CurrentParticle += 1;
1133 end;
1134 end;
1137 procedure g_GFX_SimpleWater (fX, fY: Integer; count: Word; fVelX, fVelY: Single; defColor, cr, cg, cb: Byte);
1138 begin
1139 g_GFX_Water(fX, fY, count, 0, 0, 0, 0, defColor, true, cr, cg, cb);
1140 end;
1143 // ////////////////////////////////////////////////////////////////////////// //
1144 procedure TParticle.thinkerBubble ();
1145 var
1146 dy: Integer;
1147 begin
1148 dy := round(velY);
1150 if (dy <> 0) then
1151 begin
1152 y += dy;
1153 if (dy < 0) then
1154 begin
1155 if (y <= ceilingY) then begin die(); exit; end;
1156 end
1157 else
1158 begin
1159 if (y >= floorY) then begin die(); exit; end;
1160 end;
1161 if (y < g_Map_MinY) or (y > g_Map_MaxY) then begin die(); exit; end;
1162 end;
1164 if (velY > -4) then velY += accelY;
1166 if waitTime > 0 then
1167 waitTime -= 1
1168 else
1169 time += 1;
1170 end;
1173 {.$DEFINE D2F_DEBUG_BUBBLES}
1174 procedure g_GFX_Bubbles (fX, fY: Integer; count: Word; devX, devY: Byte);
1175 var
1176 a, liquidx: Integer;
1177 devX1, devX2, devY1, devY2: Integer;
1178 l: Integer;
1179 {$IF DEFINED(D2F_DEBUG_BUBBLES)}
1180 stt: UInt64;
1181 nptr, ptr: Boolean;
1182 {$ENDIF}
1183 begin
1184 if not gpart_dbg_enabled then exit;
1186 l := Length(Particles);
1187 if (l = 0) then exit;
1188 if (count > l) then count := l;
1190 devX1 := devX div 2;
1191 devX2 := devX+1;
1192 devY1 := devY div 2;
1193 devY2 := devY+1;
1195 for a := 1 to count do
1196 begin
1197 with Particles[CurrentParticle] do
1198 begin
1199 x := fX-devX1+Random(devX2);
1200 y := fY-devY1+Random(devY2);
1202 // check for level bounds
1203 if (x < g_Map_MinX) or (y < g_Map_MinY) or (x > g_Map_MaxX) or (y > g_Map_MaxY) then continue;
1205 (*
1206 // don't spawn bubbles outside of the liquid
1207 if not isLiquidAt(X, Y) {ByteBool(gCollideMap[Y, X] and MARK_LIQUID)} then
1208 Continue;
1209 *)
1211 // trace liquid, so we'll know where it ends; do it in 8px steps for speed
1212 // tracer will return `false` if we started outside of the liquid
1214 {$IF DEFINED(D2F_DEBUG_BUBBLES)}
1215 stt := getTimeMicro();
1216 ptr := mapGrid.traceOrthoRayWhileIn(liquidx, liquidTopY, x, y, x, 0, GridTagWater or GridTagAcid1 or GridTagAcid2);
1217 stt := getTimeMicro()-stt;
1218 e_LogWritefln('traceOrthoRayWhileIn: time=%s (%s); liquidTopY=%s', [Integer(stt), ptr, liquidTopY]);
1219 //
1220 stt := getTimeMicro();
1221 nptr := g_Map_TraceLiquidNonPrecise(x, y, 0, -8, liquidx, liquidTopY);
1222 stt := getTimeMicro()-stt;
1223 e_LogWritefln('g_Map_TraceLiquidNonPrecise: time=%s (%s); liquidTopY=%s', [Integer(stt), nptr, liquidTopY]);
1224 if not nptr then continue;
1225 {$ELSE}
1226 if not g_Map_TraceLiquidNonPrecise(x, y, 0, -8, liquidx, ceilingY) then continue;
1227 if not g_Map_TraceLiquidNonPrecise(x, y, 0, +8, liquidx, floorY) then continue;
1228 {$ENDIF}
1230 velX := 0;
1231 velY := -1-Random;
1232 accelX := 0;
1233 accelY := velY/10;
1235 red := 255;
1236 green := 255;
1237 blue := 255;
1238 alpha := 255;
1240 state := TPartState.Normal;
1241 particleType := TPartType.Bubbles;
1242 time := 0;
1243 liveTime := 65535;
1244 waitTime := 0;
1245 end;
1247 if (CurrentParticle >= MaxParticles-1) then CurrentParticle := 0 else CurrentParticle += 1;
1248 end;
1249 end;
1252 // ////////////////////////////////////////////////////////////////////////// //
1253 procedure TParticle.thinkerSpark ();
1254 label
1255 _done;
1256 var
1257 dx, dy: SmallInt;
1258 pan: TPanel;
1259 ex, ey: Integer;
1260 begin
1261 if not gpart_dbg_phys_enabled then begin x += round(velX); y += round(velY); goto _done; end;
1263 dx := round(velX);
1264 dy := round(velY);
1266 //writeln('spark0: pos=(', x, ',', y, '); delta=(', dx, ',', dy, '); state=', state, '; ceilingY=', ceilingY, '; floorY=', floorY);
1268 // apply gravity
1269 if (abs(velX) < 0.1) and (abs(velY) < 0.1) then
1270 begin
1271 velY := 0.8;
1272 accelY := 0.5;
1273 end;
1275 // flying
1276 if (dx <> 0) then
1277 begin
1278 // has some horizontal velocity
1279 pan := g_Map_traceToNearest(x, y, x+dx, y+dy, (GridTagObstacle or GridTagLiquid), @ex, @ey);
1280 if (x <> ex) then begin floorY := Unknown; ceilingY := Unknown; end; // dunno yet
1281 x := ex;
1282 y := ey;
1283 if (pan <> nil) then
1284 begin
1285 if ((pan.tag and GridTagLiquid) <> 0) then begin die(); exit; end; // die in liquid
1286 // hit the wall; falling down vertically
1287 velX := 0;
1288 accelX := 0;
1289 end;
1290 end
1291 else if (dy <> 0) then
1292 begin
1293 // has some vertical velocity
1294 if (dy < 0) then
1295 begin
1296 // flying up
1297 if (ceilingY = Unknown) then findCeiling(); // need to do this anyway
1298 y += dy;
1299 if (y <= ceilingY) then
1300 begin
1301 // oops, hit a ceiling
1302 y := ceilingY;
1303 velY := -velY;
1304 accelY := abs(accelY);
1305 end;
1306 // environment didn't changed
1307 end
1308 else
1309 begin
1310 // falling down
1311 if (floorY = Unknown) then findFloor(); // need to do this anyway
1312 y += dy;
1313 if (y >= floorY) then
1314 begin
1315 // hit something except a floor?
1316 if (floorType <> TFloorType.Wall) then begin die(); exit; end; // yep: just die
1317 // otherwise, go to sleep
1318 y := floorY;
1319 sleep();
1320 // environment didn't changed
1321 end;
1322 end;
1323 end;
1325 _done:
1326 if (x < g_Map_MinX) or (y < g_Map_MinY) or (x > g_Map_MaxX) or (y > g_Map_MaxY) then begin die(); end;
1328 if (velX <> 0.0) then velX += accelX;
1330 if (velY <> 0.0) then
1331 begin
1332 if (accelY < 10) then accelY += 0.08;
1333 velY += accelY;
1334 end;
1336 //writeln('spark1: pos=(', x, ',', y, '); delta=(', velX:6:3, ',', velY:6:3, '); state=', state, '; ceilingY=', ceilingY, '; floorY=', floorY);
1338 if waitTime > 0 then
1339 waitTime -= 1
1340 else
1341 time += 1;
1342 end;
1345 // ////////////////////////////////////////////////////////////////////////// //
1346 procedure g_GFX_SparkVel (fX, fY: Integer; count: Word; vx, vy: Integer; devX, devY: Byte);
1347 var
1348 a: Integer;
1349 devX1, devX2, devY1, devY2: Integer;
1350 l: Integer;
1351 pan: TPanel;
1352 begin
1353 if not gpart_dbg_enabled then exit;
1355 l := Length(Particles);
1356 if (l = 0) then exit;
1357 if (count > l) then count := l;
1359 devX1 := devX div 2;
1360 devX2 := devX+1;
1361 devY1 := devY div 2;
1362 devY2 := devY+1;
1364 for a := 1 to count do
1365 begin
1366 with Particles[CurrentParticle] do
1367 begin
1368 x := fX-devX1+Random(devX2);
1369 y := fY-devY1+Random(devY2);
1371 // check for level bounds
1372 if (x < g_Map_MinX) or (y < g_Map_MinY) or (x > g_Map_MaxX) or (y > g_Map_MaxY) then continue;
1374 // in what environment we are starting in?
1375 pan := g_Map_PanelAtPoint(x, y, (GridTagObstacle or GridTagLiquid));
1376 if (pan <> nil) then
1377 begin
1378 // either in a wall, or in a liquid
1379 //if ((pan.tag and GridTagObstacle) <> 0) then continue; // don't spawn in walls
1380 //env := TEnvType.ELiquid;
1381 continue;
1382 end
1383 else
1384 begin
1385 env := TEnvType.EAir;
1386 end;
1388 velX := vx+(Random-Random)*3;
1389 velY := vy+(Random-Random)*3;
1391 if (velY > -4) then
1392 begin
1393 if (velY-4 < -4) then velY := -4 else velY := velY-4;
1394 end;
1396 accelX := -sign(velX)*Random/100;
1397 accelY := 0.8;
1399 red := 255;
1400 green := 100+Random(155);
1401 blue := 64;
1402 alpha := 255;
1404 particleType := TPartType.Spark;
1405 state := TPartState.Normal;
1406 time := 0;
1407 liveTime := 30+Random(60);
1408 waitTime := 0;
1409 floorY := Unknown;
1410 ceilingY := Unknown;
1411 end;
1413 if (CurrentParticle >= MaxParticles-1) then CurrentParticle := 0 else CurrentParticle += 1;
1414 end;
1415 end;
1418 procedure g_GFX_Spark (fX, fY: Integer; count: Word; angle: SmallInt; devX, devY: Byte);
1419 var
1420 a: Integer;
1421 b: Single;
1422 devX1, devX2, devY1, devY2: Integer;
1423 baseVelX, baseVelY: Single;
1424 l: Integer;
1425 pan: TPanel;
1426 begin
1427 if not gpart_dbg_enabled then exit;
1429 l := Length(Particles);
1430 if (l = 0) then exit;
1431 if (count > l) then count := l;
1433 angle := 360-angle;
1435 devX1 := devX div 2;
1436 devX2 := devX+1;
1437 devY1 := devY div 2;
1438 devY2 := devY+1;
1440 b := DegToRad(angle);
1441 baseVelX := cos(b);
1442 baseVelY := 1.6*sin(b);
1443 if (abs(baseVelX) < 0.01) then baseVelX := 0.0;
1444 if (abs(baseVelY) < 0.01) then baseVelY := 0.0;
1446 for a := 1 to count do
1447 begin
1448 with Particles[CurrentParticle] do
1449 begin
1450 x := fX-devX1+Random(devX2);
1451 y := fY-devY1+Random(devY2);
1453 // check for level bounds
1454 if (x < g_Map_MinX) or (y < g_Map_MinY) or (x > g_Map_MaxX) or (y > g_Map_MaxY) then continue;
1456 // in what environment we are starting in?
1457 pan := g_Map_PanelAtPoint(x, y, (GridTagObstacle or GridTagLiquid));
1458 if (pan <> nil) then
1459 begin
1460 // either in a wall, or in a liquid
1461 //if ((pan.tag and GridTagObstacle) <> 0) then continue; // don't spawn in walls
1462 //env := TEnvType.ELiquid;
1463 continue;
1464 end
1465 else
1466 begin
1467 env := TEnvType.EAir;
1468 end;
1470 velX := baseVelX*Random;
1471 velY := baseVelY-Random;
1472 accelX := velX/3.0;
1473 accelY := velY/5.0;
1475 red := 255;
1476 green := 100+Random(155);
1477 blue := 64;
1478 alpha := 255;
1480 particleType := TPartType.Spark;
1481 state := TPartState.Normal;
1482 time := 0;
1483 liveTime := 30+Random(60);
1484 waitTime := 0;
1485 floorY := Unknown;
1486 ceilingY := Unknown;
1487 end;
1489 if (CurrentParticle >= MaxParticles-1) then CurrentParticle := 0 else CurrentParticle += 1;
1490 end;
1491 end;
1494 // ////////////////////////////////////////////////////////////////////////// //
1495 procedure g_GFX_SetMax (count: Integer);
1496 var
1497 a: Integer;
1498 begin
1499 if count > 50000 then count := 50000;
1500 if (count < 1) then count := 1;
1501 SetLength(Particles, count);
1502 for a := 0 to High(Particles) do Particles[a].die();
1503 MaxParticles := count;
1504 CurrentParticle := 0;
1505 end;
1508 function g_GFX_GetMax (): Integer;
1509 begin
1510 result := MaxParticles;
1511 end;
1514 function FindOnceAnim (): DWORD;
1515 var
1516 i: Integer;
1517 begin
1518 if OnceAnims <> nil then
1519 for i := 0 to High(OnceAnims) do
1520 if OnceAnims[i].Animation = nil then
1521 begin
1522 Result := i;
1523 Exit;
1524 end;
1526 if OnceAnims = nil then
1527 begin
1528 SetLength(OnceAnims, 16);
1529 Result := 0;
1530 end
1531 else
1532 begin
1533 Result := High(OnceAnims) + 1;
1534 SetLength(OnceAnims, Length(OnceAnims) + 16);
1535 end;
1536 end;
1539 procedure g_GFX_OnceAnim (x, y: Integer; Anim: TAnimation; AnimType: Byte = 0);
1540 var
1541 find_id: DWORD;
1542 begin
1543 if not gpart_dbg_enabled then exit;
1545 if (Anim = nil) then exit;
1547 find_id := FindOnceAnim();
1549 OnceAnims[find_id].AnimType := AnimType;
1550 OnceAnims[find_id].Animation := TAnimation.Create(Anim.FramesID, Anim.Loop, Anim.Speed);
1551 OnceAnims[find_id].Animation.Blending := Anim.Blending;
1552 OnceAnims[find_id].Animation.alpha := Anim.alpha;
1553 OnceAnims[find_id].x := x;
1554 OnceAnims[find_id].y := y;
1555 end;
1558 // ////////////////////////////////////////////////////////////////////////// //
1559 procedure g_GFX_Init ();
1560 begin
1561 //g_Game_SetLoadingText(_lc[I_LOAD_COLLIDE_MAP]+' 1/6', 0, False);
1562 //SetLength(gCollideMap, gMapInfo.Height+1);
1563 //for a := 0 to High(gCollideMap) do SetLength(gCollideMap[a], gMapInfo.Width+1);
1564 awmSetup();
1565 {$IFDEF HEADLESS}
1566 gpart_dbg_enabled := false;
1567 {$ENDIF}
1568 end;
1571 procedure g_GFX_Free ();
1572 var
1573 a: Integer;
1574 begin
1575 Particles := nil;
1576 SetLength(Particles, MaxParticles);
1577 for a := 0 to High(Particles) do Particles[a].die();
1578 CurrentParticle := 0;
1580 if (OnceAnims <> nil) then
1581 begin
1582 for a := 0 to High(OnceAnims) do OnceAnims[a].Animation.Free();
1583 OnceAnims := nil;
1584 end;
1586 awakeMap := nil;
1587 // why not?
1588 awakeMapH := -1;
1589 awakeMapW := -1;
1590 end;
1593 // ////////////////////////////////////////////////////////////////////////// //
1594 procedure g_GFX_Update ();
1595 var
1596 a: Integer;
1597 w, h: Integer;
1598 len: Integer;
1599 begin
1600 if not gpart_dbg_enabled then exit;
1602 if (Particles <> nil) then
1603 begin
1604 w := gMapInfo.Width;
1605 h := gMapInfo.Height;
1607 len := High(Particles);
1609 for a := 0 to len do
1610 begin
1611 if Particles[a].alive then
1612 begin
1613 with Particles[a] do
1614 begin
1615 if (time = liveTime) then begin die(); continue; end;
1616 if (x+1 >= w) or (y+1 >= h) or (x <= 0) or (y <= 0) then begin die(); end;
1617 think();
1618 end; // with
1619 end; // if
1620 end; // for
1621 end; // Particles <> nil
1623 // clear awake map
1624 awmClear();
1626 if OnceAnims <> nil then
1627 begin
1628 for a := 0 to High(OnceAnims) do
1629 if OnceAnims[a].Animation <> nil then
1630 begin
1631 case OnceAnims[a].AnimType of
1632 ONCEANIM_SMOKE:
1633 begin
1634 if Random(3) = 0 then
1635 OnceAnims[a].x := OnceAnims[a].x-1+Random(3);
1636 if Random(2) = 0 then
1637 OnceAnims[a].y := OnceAnims[a].y-Random(2);
1638 end;
1639 end;
1641 if OnceAnims[a].Animation.Played then
1642 begin
1643 OnceAnims[a].Animation.Free();
1644 OnceAnims[a].Animation := nil;
1645 end
1646 else
1647 OnceAnims[a].Animation.Update();
1648 end;
1649 end;
1650 end;
1653 procedure g_GFX_Draw ();
1654 var
1655 a, len: Integer;
1656 {$IFDEF USE_NANOGL}
1657 type
1658 Vertex = record
1659 x, y: GLfloat;
1660 r, g, b, a: GLfloat;
1661 end;
1662 var
1663 count: Integer;
1664 v: array of Vertex;
1665 {$ENDIF}
1666 begin
1667 if not gpart_dbg_enabled then exit;
1669 if (Particles <> nil) then
1670 begin
1671 glDisable(GL_TEXTURE_2D);
1672 if (g_dbg_scale < 0.6) then glPointSize(1)
1673 else if (g_dbg_scale > 1.3) then glPointSize(g_dbg_scale+1)
1674 else glPointSize(2);
1675 glDisable(GL_POINT_SMOOTH);
1677 glEnable(GL_BLEND);
1678 glBlendFunc(GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA);
1680 {$IFDEF USE_NANOGL}
1681 count := 0;
1682 SetLength(v, Length(Particles));
1683 for a := 0 to High(Particles) do
1684 begin
1685 with Particles[a] do
1686 begin
1687 if alive and (x >= sX) and (y >= sY) and (x <= sX + sWidth) and (sY <= sY + sHeight) then
1688 begin
1689 v[count].x := x + 0.37;
1690 v[count].y := y + 0.37;
1691 v[count].r := red / 255;
1692 v[count].g := green / 255;
1693 v[count].b := blue / 255;
1694 v[count].a := alpha / 255;
1695 Inc(count);
1696 end;
1697 end;
1698 end;
1700 glVertexPointer(2, GL_FLOAT, SizeOf(Vertex), @v[0].x);
1701 glColorPointer(4, GL_FLOAT, SizeOf(Vertex), @v[0].r);
1702 glEnableClientState(GL_VERTEX_ARRAY);
1703 glEnableClientState(GL_COLOR_ARRAY);
1704 glDisableClientState(GL_NORMAL_ARRAY);
1705 glDisableClientState(GL_TEXTURE_COORD_ARRAY);
1706 glDrawArrays(GL_POINTS, 0, count);
1707 {$ELSE}
1708 glBegin(GL_POINTS);
1710 len := High(Particles);
1711 for a := 0 to len do
1712 begin
1713 with Particles[a] do
1714 begin
1715 if not alive then continue;
1716 if (x >= sX) and (y >= sY) and (x <= sX+sWidth) and (sY <= sY+sHeight) then
1717 begin
1718 glColor4ub(red, green, blue, alpha);
1719 glVertex2f(x+0.37, y+0.37);
1720 end;
1721 end;
1722 end;
1724 glEnd();
1725 {$ENDIF}
1727 glDisable(GL_BLEND);
1728 end;
1730 if (OnceAnims <> nil) then
1731 begin
1732 len := High(OnceAnims);
1733 for a := 0 to len do
1734 begin
1735 if (OnceAnims[a].Animation <> nil) then
1736 begin
1737 with OnceAnims[a] do Animation.Draw(x, y, TMirrorType.None);
1738 end;
1739 end;
1740 end;
1741 end;
1744 end.