DEADSOFTWARE

52c885692f6a5b61f994ce3f4942a954c0718043
[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 begin
338 pan := g_Map_PanelAtPoint(x, y, GridTagLift);
339 result := (pan <> nil);
340 if result then
341 begin
342 if ((pan.PanelType and PANEL_LIFTUP) <> 0) then
343 begin
344 if (velY > -1-Random(3)) then velY -= 0.8;
345 if (abs(velX) > 0.1) then velX -= velX/10.0;
346 velX += (Random-Random)*0.2;
347 accelY := 0.15;
348 end
349 else if ((pan.PanelType and PANEL_LIFTDOWN) <> 0) then
350 begin
351 if (velY < 1+Random(3)) then velY += 0.8;
352 accelY := 0.15;
353 end
354 else if ((pan.PanelType and PANEL_LIFTLEFT) <> 0) then
355 begin
356 if (velX > -8-Random(3)) then velX -= 0.8;
357 accelY := 0.15;
358 end
359 else if ((pan.PanelType and PANEL_LIFTRIGHT) <> 0) then
360 begin
361 if (velX < 8+Random(3)) then velX += 0.8;
362 accelY := 0.15;
363 end
364 else
365 begin
366 result := false;
367 end;
368 // awake
369 if result and (state = TPartState.Sleeping) then state := TPartState.Normal;
370 end;
371 end;
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;
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;
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, GridTagObstacle, @ex, @ceilingY)) then
459 begin
460 ceilingY := g_Map_MinY-2;
461 end;
462 end;
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;
501 begin
502 // awake sleeping particle, if necessary
503 if awakeDirty then
504 begin
505 if awmIsSet(x, y) then awake();
507 case state of
508 TPartState.Sleeping, TPartState.Stuck:
509 if awmIsSet(x, y) then awake();
510 else
511 if (env = TEnvType.EWall) and awmIsSet(x, y) then awake();
512 end;
514 end;
515 case particleType of
516 TPartType.Blood, TPartType.Water: thinkerBloodAndWater();
517 TPartType.Spark: thinkerSpark();
518 TPartType.Bubbles: thinkerBubble();
519 end;
520 end;
523 // ////////////////////////////////////////////////////////////////////////// //
524 procedure TParticle.thinkerBloodAndWater ();
525 procedure stickToCeiling ();
526 begin
527 state := TPartState.Stuck;
528 stickDX := 0;
529 freeze();
530 ceilingY := y; // yep
531 end;
533 procedure stickToWall (dx: Integer);
534 var
535 ex: Integer;
536 begin
537 state := TPartState.Stuck;
538 if (dx > 0) then stickDX := 1 else stickDX := -1;
539 freeze();
540 // find next floor transition
541 findFloor();
542 // find `wallEndY`
543 mapGrid.traceOrthoRayWhileIn(ex, wallEndY, x+stickDX, y, x+stickDX, floorY+1, (GridTagWall or GridTagDoor or GridTagStep));
544 end;
546 procedure hitAFloor ();
547 begin
548 state := TPartState.Sleeping; // we aren't moving anymore
549 freeze();
550 floorY := y; // yep
551 floorType := TFloorType.Wall; // yep
552 end;
554 // `true`: didn't, get outa thinker
555 function drip (): Boolean;
556 begin
557 case particleType of
558 TPartType.Blood: result := (Random(200) = 100);
559 TPartType.Water: result := (Random(30) = 15);
560 else raise Exception.Create('internal error in particle engine: drip');
561 end;
562 if result then
563 begin
564 velY := 0.5;
565 accelY := 0.15;
566 // if we're falling from ceiling, switch to normal mode
567 if (state = TPartState.Stuck) and (stickDX = 0) then state := TPartState.Normal;
568 end;
569 end;
571 // switch to freefall mode
572 procedure freefall ();
573 begin
574 state := TPartState.Normal;
575 velY := 0.5;
576 accelY := 0.15;
577 end;
579 procedure applyGravity (inLiquid: Boolean);
580 begin
581 state := TPartState.Normal;
582 if inLiquid then
583 begin
584 velY := 0.5;
585 accelY := 0.15;
586 end
587 else
588 begin
589 velY := 0.8;
590 accelY := 0.5;
591 end;
592 end;
594 label
595 _done, _gravityagain, _stuckagain;
596 var
597 pan: TPanel;
598 dx, dy: SmallInt;
599 ex, ey: Integer;
600 checkEnv: Boolean;
601 floorJustTraced: Boolean;
602 {$IF DEFINED(D2F_DEBUG_FALL_MPLAT)}
603 oldFloorY: Integer;
604 {$ENDIF}
605 begin
606 if not gpart_dbg_phys_enabled then begin x += round(velX); y += round(velY); goto _done; end;
608 if gAdvBlood then
609 begin
610 // still check for air streams when sleeping (no)
611 if (state = TPartState.Sleeping) then begin {checkAirStreams();} goto _done; end; // so blood will dissolve
613 // process stuck particles
614 if (state = TPartState.Stuck) then
615 begin
616 // stuck to a ceiling?
617 if (stickDX = 0) then
618 begin
619 // yeah, stuck to a ceiling
620 if (ceilingY = Unknown) then findCeiling();
621 // dropped from a ceiling?
622 if (y > ceilingY) then
623 begin
624 // yep
625 velY := 0.5;
626 accelY := 0.15;
627 state := TPartState.Normal;
628 end
629 else
630 begin
631 // otherwise, try to drip
632 if drip() then goto _done;
633 end;
634 end
635 else
636 begin
637 // stuck to a wall
638 if (wallEndY = Unknown) then
639 begin
640 // this can happen if mplat was moved out; find new `wallEndY`
641 findFloor(true); // force trace, just in case
642 if (floorType = TFloorType.LiquidOut) then env := TEnvType.ELiquid else env := TEnvType.EAir;
643 mapGrid.traceOrthoRayWhileIn(ex, wallEndY, x+stickDX, y, x+stickDX, floorY+1, (GridTagWall or GridTagDoor or GridTagStep));
644 end;
645 _stuckagain:
646 // floor transition?
647 if (wallEndY <= floorY) and (y >= floorY) then
648 begin
649 y := floorY;
650 case floorType of
651 TFloorType.Wall: // hit the ground
652 begin
653 // check if our ground wasn't moved since the last scan
654 findFloor(true); // force trace
655 if (y = floorY) then
656 begin
657 sleep();
658 goto _done; // nothing to do anymore
659 end;
660 // otherwise, do it again
661 goto _stuckagain;
662 end;
663 TFloorType.LiquidIn: // entering the liquid
664 begin
665 // rescan, so we'll know when we'll exit the liquid
666 findFloor(true); // force rescan
667 end;
668 TFloorType.LiquidOut: // exiting the liquid
669 begin
670 // rescan, so we'll know when we'll enter something interesting
671 findFloor(true); // force rescan
672 if (floorType = TFloorType.Wall) and (floorY = y) then begin sleep(); goto _done; end;
673 end;
674 end;
675 end;
676 // wall transition?
677 if (floorY <= wallEndY) and (y >= wallEndY) then
678 begin
679 // just unstuck from the wall, switch to freefall mode
680 y := wallEndY;
681 freefall();
682 end
683 else
684 begin
685 // otherwise, try to drip
686 if drip() then goto _done;
687 end;
688 end;
689 // nope, process as usual
690 end;
692 // it is important to have it here
693 dx := round(velX);
694 dy := round(velY);
696 if (state = TPartState.Normal) then checkAirStreams();
698 // gravity, if not stuck
699 if (state <> TPartState.Stuck) and (abs(velX) < 0.1) and (abs(velY) < 0.1) then
700 begin
701 floorJustTraced := (floorY = Unknown);
702 if floorJustTraced then findFloor();
703 _gravityagain:
704 // floor transition?
705 if (y = floorY) then
706 begin
707 case floorType of
708 TFloorType.Wall: // hit the ground
709 begin
710 // check if our ground wasn't moved since the last scan
711 if not floorJustTraced then
712 begin
713 findFloor(true); // force trace
714 if (floorType = TFloorType.LiquidOut) then env := TEnvType.ELiquid else env := TEnvType.EAir;
715 if (y <> floorY) then goto _gravityagain;
716 end;
717 // otherwise, nothing to do
718 end;
719 TFloorType.LiquidIn: // entering the liquid
720 begin
721 // rescan, so we'll know when we'll exit the liquid
722 findFloor(true); // force rescan
723 applyGravity(true);
724 end;
725 TFloorType.LiquidOut: // exiting the liquid
726 begin
727 // rescan, so we'll know when we'll enter something interesting
728 findFloor(true); // force rescan
729 if (floorType <> TFloorType.Wall) or (floorY <> y) then applyGravity(floorType = TFloorType.LiquidIn);
730 end;
731 end;
732 end
733 else
734 begin
735 // looks like we're in the air
736 applyGravity(false);
737 end;
738 end;
740 // trace movement
741 if (dx <> 0) then
742 begin
743 // has some horizontal velocity
744 pan := g_Map_traceToNearest(x, y, x+dx, y+dy, GridTagObstacle, @ex, @ey);
745 checkEnv := (x <> ex);
746 x := ex;
747 y := ey;
748 if checkEnv then
749 begin
750 // dunno yet
751 floorY := Unknown;
752 ceilingY := Unknown;
753 // check environment (air/liquid)
754 if (g_Map_PanelAtPoint(x, y, GridTagLiquid) <> nil) then env := TEnvType.ELiquid else env := TEnvType.EAir;
755 end;
756 if (pan <> nil) then
757 begin
758 // we stuck
759 // the only case when we can have both ceiling and wall is corner; stick to wall in this case
760 // check if we stuck to a wall
761 if (dx < 0) then dx := -1 else dx := 1;
762 if (g_Map_PanelAtPoint(x+dx, y, GridTagObstacle) <> nil) then
763 begin
764 // stuck to a wall
765 stickToWall(dx);
766 end
767 else
768 begin
769 // stuck to a ceiling
770 stickToCeiling();
771 end;
772 end;
773 end
774 else if (dy <> 0) then
775 begin
776 // has only vertical velocity
777 if (dy < 0) then
778 begin
779 // flying up
780 if (ceilingY = Unknown) then findCeiling(); // need to do this anyway
781 y += dy;
782 if (y <= ceilingY) then begin y := ceilingY; stickToCeiling(); end; // oops, hit a ceiling
783 // environment didn't changed
784 end
785 else
786 begin
787 while (dy > 0) do
788 begin
789 // falling down
790 floorJustTraced := (floorY = Unknown);
791 if floorJustTraced then findFloor();
792 if (floorType = TFloorType.LiquidOut) then env := TEnvType.ELiquid else env := TEnvType.EAir;
793 y += dy;
794 //e_LogWritefln('floorY=%s; newy=%s; dY=%s; floorType=%s', [floorY, y, dY, floorType]);
795 if (y >= floorY) then
796 begin
797 // floor transition
798 dy := y-floorY;
799 y := floorY;
800 //e_LogWritefln(' HIT FLOORY: floorY=%s; newy=%s; dY=%s; floorType=%s', [floorY, y, dY, floorType]);
801 case floorType of
802 TFloorType.Wall: // hit the ground
803 begin
804 // check if our ground wasn't moved since the last scan
805 if not floorJustTraced then
806 begin
807 {$IF DEFINED(D2F_DEBUG_FALL_MPLAT)}
808 oldFloorY := floorY;
809 {$ENDIF}
810 findFloor(true); // force trace
811 {$IF DEFINED(D2F_DEBUG_FALL_MPLAT)}
812 if (floorY <> oldFloorY) then
813 begin
814 e_LogWritefln('force rescanning vpart at (%s,%s); oldFloorY=%s; floorY=%s', [x, y, oldFloorY, floorY]);
815 end;
816 {$ENDIF}
817 if (floorType = TFloorType.LiquidOut) then env := TEnvType.ELiquid else env := TEnvType.EAir;
818 if (y <> floorY) then continue;
819 end;
820 // environment didn't changed
821 hitAFloor();
822 break; // done with vertical movement
823 end;
824 TFloorType.LiquidIn: // entering the liquid
825 begin
826 // we're entered the liquid
827 env := TEnvType.ELiquid;
828 // rescan, so we'll know when we'll exit the liquid
829 findFloor(true); // force rescan
830 end;
831 TFloorType.LiquidOut: // exiting the liquid
832 begin
833 // we're exited the liquid
834 env := TEnvType.EAir;
835 // rescan, so we'll know when we'll enter something interesting
836 findFloor(true); // force rescan
837 if (floorType = TFloorType.Wall) and (floorY = y) then
838 begin
839 hitAFloor();
840 break; // done with vertical movement
841 end;
842 end;
843 end;
844 end
845 else
846 begin
847 break; // done with vertical movement
848 end;
849 end;
850 end;
851 end;
852 end // if gAdvBlood
853 else
854 begin
855 // simple blood
856 dx := round(velX);
857 dy := round(velY);
858 y += dy;
859 x += dx;
860 if (g_Map_PanelAtPoint(x, y, GridTagObstacle) <> nil) then begin die(); exit; end;
861 end;
863 _done:
864 if (x < g_Map_MinX) or (y < g_Map_MinY) or (x > g_Map_MaxX) or (y > g_Map_MaxY) then begin die(); end;
866 velX += accelX;
867 velY += accelY;
869 // blood will dissolve in other liquids
870 if (particleType = TPartType.Blood) then
871 begin
872 if (env = TEnvType.ELiquid) then
873 begin
874 if waitTime > 0 then
875 waitTime -= 1
876 else
877 time += 1;
878 if (liveTime <= 0) then begin die(); exit; end;
879 ex := 255-trunc(255.0*time/liveTime);
880 if (ex <= 10) then begin die(); exit; end;
881 if (ex > 250) then ex := 255;
882 alpha := Byte(ex);
883 end;
884 end
885 else
886 begin
887 // water will disappear in any liquid
888 if (env = TEnvType.ELiquid) then begin die(); exit; end;
889 if waitTime > 0 then
890 waitTime -= 1
891 else
892 time += 1;
893 // dry water
894 if (liveTime <= 0) then begin die(); exit; end;
895 ex := 255-trunc(255.0*time/liveTime);
896 if (ex <= 10) then begin die(); exit; end;
897 if (ex > 250) then ex := 255;
898 alpha := Byte(ex);
899 end;
900 end;
903 // ////////////////////////////////////////////////////////////////////////// //
904 procedure g_GFX_SparkVel (fX, fY: Integer; count: Word; vx, vy: Integer; devX, devY: Byte); forward;
906 procedure g_GFX_Blood (fX, fY: Integer; count: Word; vx, vy: Integer;
907 devX, devY: Word; cr, cg, cb: Byte; kind: Byte = BLOOD_NORMAL);
909 function genColor (cbase, crnd: Integer; def: Byte=0): Byte;
910 begin
911 if (cbase > 0) then
912 begin
913 cbase += crnd;
914 if (cbase < 0) then result := 0
915 else if (cbase > 255) then result := 255
916 else result := Byte(cbase);
917 end
918 else
919 begin
920 result := def;
921 end;
922 end;
924 var
925 a: Integer;
926 devX1, devX2, devY1, devY2: Integer;
927 l: Integer;
928 crnd: Integer;
929 pan: TPanel;
930 begin
931 if not gpart_dbg_enabled then exit;
933 if (kind = BLOOD_SPARKS) then
934 begin
935 g_GFX_SparkVel(fX, fY, 2+Random(2), -vx div 2, -vy div 2, devX, devY);
936 exit;
937 end
938 else if (kind = BLOOD_CSPARKS) OR (kind = BLOOD_COMBINE) then
939 begin
940 g_GFX_SparkVel(fX, fY, count, -vx div 2, -vy div 2, devX, devY);
941 if kind <> BLOOD_COMBINE then exit
942 end;
944 l := Length(Particles);
945 if (l = 0) then exit;
946 if (count > l) then count := l;
948 devX1 := devX div 2;
949 devX2 := devX+1;
950 devY1 := devY div 2;
951 devY2 := devY+1;
953 for a := 1 to count do
954 begin
955 with Particles[CurrentParticle] do
956 begin
957 x := fX-devX1+Random(devX2);
958 y := fY-devY1+Random(devY2);
960 // check for level bounds
961 if (x < g_Map_MinX) or (y < g_Map_MinY) or (x > g_Map_MaxX) or (y > g_Map_MaxY) then continue;
963 // in what environment we are starting in?
964 pan := g_Map_PanelAtPoint(x, y, (GridTagObstacle or GridTagLiquid));
965 if (pan <> nil) then
966 begin
967 // either in a wall, or in a liquid
968 if ((pan.tag and GridTagObstacle) <> 0) then continue; // don't spawn in walls
969 env := TEnvType.ELiquid;
970 end
971 else
972 begin
973 env := TEnvType.EAir;
974 end;
976 velX := vx+(Random-Random)*3;
977 velY := vy+(Random-Random)*3;
979 if (velY > -4) then
980 begin
981 if (velY-4 < -4) then velY := -4 else velY := velY-4;
982 end;
984 accelX := -sign(velX)*Random/100;
985 accelY := 0.8;
987 crnd := 20*Random(6)-50;
989 red := genColor(cr, CRnd, 0);
990 green := genColor(cg, CRnd, 0);
991 blue := genColor(cb, CRnd, 0);
992 alpha := 255;
994 particleType := TPartType.Blood;
995 state := TPartState.Normal;
996 time := 0;
997 liveTime := 120+Random(40);
998 waitTime := 20;
999 floorY := Unknown;
1000 ceilingY := Unknown;
1001 end;
1003 if (CurrentParticle >= MaxParticles-1) then CurrentParticle := 0 else CurrentParticle += 1;
1004 end;
1005 end;
1008 procedure g_GFX_Water (fX, fY: Integer; count: Word; fVelX, fVelY: Single; devX, devY, color: Byte;
1009 simple: Boolean=false; cr: Byte=0; cg: Byte=0; cb: Byte=0);
1010 var
1011 a: Integer;
1012 devX1, devX2, devY1, devY2: Integer;
1013 l: Integer;
1014 pan: TPanel;
1015 begin
1016 if not gpart_dbg_enabled then exit;
1018 l := Length(Particles);
1019 if (l = 0) then exit;
1020 if (count > l) then count := l;
1022 if (abs(fVelX) < 3.0) then fVelX := 3.0-6.0*Random;
1024 devX1 := devX div 2;
1025 devX2 := devX+1;
1026 devY1 := devY div 2;
1027 devY2 := devY+1;
1029 if (not simple) and (color > 3) then color := 0;
1031 for a := 1 to count do
1032 begin
1033 with Particles[CurrentParticle] do
1034 begin
1035 if not simple then
1036 begin
1037 x := fX-devX1+Random(devX2);
1038 y := fY-devY1+Random(devY2);
1040 if (abs(fVelX) < 0.5) then velX := 1.0-2.0*Random else velX := fVelX*Random;
1041 if (Random(10) < 7) then velX := -velX;
1042 velY := fVelY*Random;
1043 accelX := 0.0;
1044 accelY := 0.8;
1045 end
1046 else
1047 begin
1048 x := fX;
1049 y := fY;
1051 velX := fVelX;
1052 velY := fVelY;
1053 accelX := 0.0;
1054 accelY := 0.8;
1055 end;
1057 // check for level bounds
1058 if (x < g_Map_MinX) or (y < g_Map_MinY) or (x > g_Map_MaxX) or (y > g_Map_MaxY) then continue;
1060 // this hack will allow water spawned in water to fly out
1061 // it can happen when player fell from a huge height (see "DOOM2D.WAD:\MAP03", for example)
1062 if (fVelY >= 0) then
1063 begin
1064 // in what environment we are starting in?
1065 pan := g_Map_PanelAtPoint(x, y, (GridTagObstacle or GridTagLiquid));
1066 end
1067 else
1068 begin
1069 pan := g_Map_PanelAtPoint(x, y, GridTagObstacle);
1070 end;
1071 if (pan <> nil) then continue;
1072 env := TEnvType.EAir;
1074 // color
1075 case color of
1076 1: // reddish
1077 begin
1078 red := 155+Random(9)*10;
1079 green := trunc(150*Random);
1080 blue := green;
1081 end;
1082 2: // greenish
1083 begin
1084 red := trunc(150*Random);
1085 green := 175+Random(9)*10;
1086 blue := red;
1087 end;
1088 3: // bluish
1089 begin
1090 red := trunc(200*Random);
1091 green := red;
1092 blue := 175+Random(9)*10;
1093 end;
1094 4: // Ñâîé öâåò, ñâåòëåå
1095 begin
1096 red := 20+Random(19)*10;
1097 green := red;
1098 blue := red;
1099 red := nmin(red+cr, 255);
1100 green := nmin(green+cg, 255);
1101 blue := nmin(blue+cb, 255);
1102 end;
1103 5: // Ñâîé öâåò, òåìíåå
1104 begin
1105 red := 20+Random(19)*10;
1106 green := red;
1107 blue := red;
1108 red := nmax(cr-red, 0);
1109 green := nmax(cg-green, 0);
1110 blue := nmax(cb-blue, 0);
1111 end;
1112 else // grayish
1113 begin
1114 red := 90+random(12)*10;
1115 green := red;
1116 blue := red;
1117 end;
1118 end;
1119 alpha := 255;
1121 particleType := TPartType.Water;
1122 state := TPartState.Normal;
1123 time := 0;
1124 liveTime := 60+Random(60);
1125 waitTime := 120;
1126 floorY := Unknown;
1127 ceilingY := Unknown;
1128 end;
1130 if (CurrentParticle >= MaxParticles-1) then CurrentParticle := 0 else CurrentParticle += 1;
1131 end;
1132 end;
1135 procedure g_GFX_SimpleWater (fX, fY: Integer; count: Word; fVelX, fVelY: Single; defColor, cr, cg, cb: Byte);
1136 begin
1137 g_GFX_Water(fX, fY, count, 0, 0, 0, 0, defColor, true, cr, cg, cb);
1138 end;
1141 // ////////////////////////////////////////////////////////////////////////// //
1142 procedure TParticle.thinkerBubble ();
1143 var
1144 dy: Integer;
1145 begin
1146 dy := round(velY);
1148 if (dy <> 0) then
1149 begin
1150 y += dy;
1151 if (dy < 0) then
1152 begin
1153 if (y <= ceilingY) then begin die(); exit; end;
1154 end
1155 else
1156 begin
1157 if (y >= floorY) then begin die(); exit; end;
1158 end;
1159 if (y < g_Map_MinY) or (y > g_Map_MaxY) then begin die(); exit; end;
1160 end;
1162 if (velY > -4) then velY += accelY;
1164 if waitTime > 0 then
1165 waitTime -= 1
1166 else
1167 time += 1;
1168 end;
1171 {.$DEFINE D2F_DEBUG_BUBBLES}
1172 procedure g_GFX_Bubbles (fX, fY: Integer; count: Word; devX, devY: Byte);
1173 var
1174 a, liquidx: Integer;
1175 devX1, devX2, devY1, devY2: Integer;
1176 l: Integer;
1177 {$IF DEFINED(D2F_DEBUG_BUBBLES)}
1178 stt: UInt64;
1179 nptr, ptr: Boolean;
1180 {$ENDIF}
1181 begin
1182 if not gpart_dbg_enabled then exit;
1184 l := Length(Particles);
1185 if (l = 0) then exit;
1186 if (count > l) then count := l;
1188 devX1 := devX div 2;
1189 devX2 := devX+1;
1190 devY1 := devY div 2;
1191 devY2 := devY+1;
1193 for a := 1 to count do
1194 begin
1195 with Particles[CurrentParticle] do
1196 begin
1197 x := fX-devX1+Random(devX2);
1198 y := fY-devY1+Random(devY2);
1200 // check for level bounds
1201 if (x < g_Map_MinX) or (y < g_Map_MinY) or (x > g_Map_MaxX) or (y > g_Map_MaxY) then continue;
1203 (*
1204 // don't spawn bubbles outside of the liquid
1205 if not isLiquidAt(X, Y) {ByteBool(gCollideMap[Y, X] and MARK_LIQUID)} then
1206 Continue;
1207 *)
1209 // trace liquid, so we'll know where it ends; do it in 8px steps for speed
1210 // tracer will return `false` if we started outside of the liquid
1212 {$IF DEFINED(D2F_DEBUG_BUBBLES)}
1213 stt := getTimeMicro();
1214 ptr := mapGrid.traceOrthoRayWhileIn(liquidx, liquidTopY, x, y, x, 0, GridTagWater or GridTagAcid1 or GridTagAcid2);
1215 stt := getTimeMicro()-stt;
1216 e_LogWritefln('traceOrthoRayWhileIn: time=%s (%s); liquidTopY=%s', [Integer(stt), ptr, liquidTopY]);
1217 //
1218 stt := getTimeMicro();
1219 nptr := g_Map_TraceLiquidNonPrecise(x, y, 0, -8, liquidx, liquidTopY);
1220 stt := getTimeMicro()-stt;
1221 e_LogWritefln('g_Map_TraceLiquidNonPrecise: time=%s (%s); liquidTopY=%s', [Integer(stt), nptr, liquidTopY]);
1222 if not nptr then continue;
1223 {$ELSE}
1224 if not g_Map_TraceLiquidNonPrecise(x, y, 0, -8, liquidx, ceilingY) then continue;
1225 if not g_Map_TraceLiquidNonPrecise(x, y, 0, +8, liquidx, floorY) then continue;
1226 {$ENDIF}
1228 velX := 0;
1229 velY := -1-Random;
1230 accelX := 0;
1231 accelY := velY/10;
1233 red := 255;
1234 green := 255;
1235 blue := 255;
1236 alpha := 255;
1238 state := TPartState.Normal;
1239 particleType := TPartType.Bubbles;
1240 time := 0;
1241 liveTime := 65535;
1242 waitTime := 0;
1243 end;
1245 if (CurrentParticle >= MaxParticles-1) then CurrentParticle := 0 else CurrentParticle += 1;
1246 end;
1247 end;
1250 // ////////////////////////////////////////////////////////////////////////// //
1251 procedure TParticle.thinkerSpark ();
1252 label
1253 _done;
1254 var
1255 dx, dy: SmallInt;
1256 pan: TPanel;
1257 ex, ey: Integer;
1258 begin
1259 if not gpart_dbg_phys_enabled then begin x += round(velX); y += round(velY); goto _done; end;
1261 dx := round(velX);
1262 dy := round(velY);
1264 //writeln('spark0: pos=(', x, ',', y, '); delta=(', dx, ',', dy, '); state=', state, '; ceilingY=', ceilingY, '; floorY=', floorY);
1266 // apply gravity
1267 if (abs(velX) < 0.1) and (abs(velY) < 0.1) then
1268 begin
1269 velY := 0.8;
1270 accelY := 0.5;
1271 end;
1273 // flying
1274 if (dx <> 0) then
1275 begin
1276 // has some horizontal velocity
1277 pan := g_Map_traceToNearest(x, y, x+dx, y+dy, (GridTagObstacle or GridTagLiquid), @ex, @ey);
1278 if (x <> ex) then begin floorY := Unknown; ceilingY := Unknown; end; // dunno yet
1279 x := ex;
1280 y := ey;
1281 if (pan <> nil) then
1282 begin
1283 if ((pan.tag and GridTagLiquid) <> 0) then begin die(); exit; end; // die in liquid
1284 // hit the wall; falling down vertically
1285 velX := 0;
1286 accelX := 0;
1287 end;
1288 end
1289 else if (dy <> 0) then
1290 begin
1291 // has some vertical velocity
1292 if (dy < 0) then
1293 begin
1294 // flying up
1295 if (ceilingY = Unknown) then findCeiling(); // need to do this anyway
1296 y += dy;
1297 if (y <= ceilingY) then
1298 begin
1299 // oops, hit a ceiling
1300 y := ceilingY;
1301 velY := -velY;
1302 accelY := abs(accelY);
1303 end;
1304 // environment didn't changed
1305 end
1306 else
1307 begin
1308 // falling down
1309 if (floorY = Unknown) then findFloor(); // need to do this anyway
1310 y += dy;
1311 if (y >= floorY) then
1312 begin
1313 // hit something except a floor?
1314 if (floorType <> TFloorType.Wall) then begin die(); exit; end; // yep: just die
1315 // otherwise, go to sleep
1316 y := floorY;
1317 sleep();
1318 // environment didn't changed
1319 end;
1320 end;
1321 end;
1323 _done:
1324 if (x < g_Map_MinX) or (y < g_Map_MinY) or (x > g_Map_MaxX) or (y > g_Map_MaxY) then begin die(); end;
1326 if (velX <> 0.0) then velX += accelX;
1328 if (velY <> 0.0) then
1329 begin
1330 if (accelY < 10) then accelY += 0.08;
1331 velY += accelY;
1332 end;
1334 //writeln('spark1: pos=(', x, ',', y, '); delta=(', velX:6:3, ',', velY:6:3, '); state=', state, '; ceilingY=', ceilingY, '; floorY=', floorY);
1336 if waitTime > 0 then
1337 waitTime -= 1
1338 else
1339 time += 1;
1340 end;
1343 // ////////////////////////////////////////////////////////////////////////// //
1344 procedure g_GFX_SparkVel (fX, fY: Integer; count: Word; vx, vy: Integer; devX, devY: Byte);
1345 var
1346 a: Integer;
1347 devX1, devX2, devY1, devY2: Integer;
1348 l: Integer;
1349 pan: TPanel;
1350 begin
1351 if not gpart_dbg_enabled then exit;
1353 l := Length(Particles);
1354 if (l = 0) then exit;
1355 if (count > l) then count := l;
1357 devX1 := devX div 2;
1358 devX2 := devX+1;
1359 devY1 := devY div 2;
1360 devY2 := devY+1;
1362 for a := 1 to count do
1363 begin
1364 with Particles[CurrentParticle] do
1365 begin
1366 x := fX-devX1+Random(devX2);
1367 y := fY-devY1+Random(devY2);
1369 // check for level bounds
1370 if (x < g_Map_MinX) or (y < g_Map_MinY) or (x > g_Map_MaxX) or (y > g_Map_MaxY) then continue;
1372 // in what environment we are starting in?
1373 pan := g_Map_PanelAtPoint(x, y, (GridTagObstacle or GridTagLiquid));
1374 if (pan <> nil) then
1375 begin
1376 // either in a wall, or in a liquid
1377 //if ((pan.tag and GridTagObstacle) <> 0) then continue; // don't spawn in walls
1378 //env := TEnvType.ELiquid;
1379 continue;
1380 end
1381 else
1382 begin
1383 env := TEnvType.EAir;
1384 end;
1386 velX := vx+(Random-Random)*3;
1387 velY := vy+(Random-Random)*3;
1389 if (velY > -4) then
1390 begin
1391 if (velY-4 < -4) then velY := -4 else velY := velY-4;
1392 end;
1394 accelX := -sign(velX)*Random/100;
1395 accelY := 0.8;
1397 red := 255;
1398 green := 100+Random(155);
1399 blue := 64;
1400 alpha := 255;
1402 particleType := TPartType.Spark;
1403 state := TPartState.Normal;
1404 time := 0;
1405 liveTime := 30+Random(60);
1406 waitTime := 0;
1407 floorY := Unknown;
1408 ceilingY := Unknown;
1409 end;
1411 if (CurrentParticle >= MaxParticles-1) then CurrentParticle := 0 else CurrentParticle += 1;
1412 end;
1413 end;
1416 procedure g_GFX_Spark (fX, fY: Integer; count: Word; angle: SmallInt; devX, devY: Byte);
1417 var
1418 a: Integer;
1419 b: Single;
1420 devX1, devX2, devY1, devY2: Integer;
1421 baseVelX, baseVelY: Single;
1422 l: Integer;
1423 pan: TPanel;
1424 begin
1425 if not gpart_dbg_enabled then exit;
1427 l := Length(Particles);
1428 if (l = 0) then exit;
1429 if (count > l) then count := l;
1431 angle := 360-angle;
1433 devX1 := devX div 2;
1434 devX2 := devX+1;
1435 devY1 := devY div 2;
1436 devY2 := devY+1;
1438 b := DegToRad(angle);
1439 baseVelX := cos(b);
1440 baseVelY := 1.6*sin(b);
1441 if (abs(baseVelX) < 0.01) then baseVelX := 0.0;
1442 if (abs(baseVelY) < 0.01) then baseVelY := 0.0;
1444 for a := 1 to count do
1445 begin
1446 with Particles[CurrentParticle] do
1447 begin
1448 x := fX-devX1+Random(devX2);
1449 y := fY-devY1+Random(devY2);
1451 // check for level bounds
1452 if (x < g_Map_MinX) or (y < g_Map_MinY) or (x > g_Map_MaxX) or (y > g_Map_MaxY) then continue;
1454 // in what environment we are starting in?
1455 pan := g_Map_PanelAtPoint(x, y, (GridTagObstacle or GridTagLiquid));
1456 if (pan <> nil) then
1457 begin
1458 // either in a wall, or in a liquid
1459 //if ((pan.tag and GridTagObstacle) <> 0) then continue; // don't spawn in walls
1460 //env := TEnvType.ELiquid;
1461 continue;
1462 end
1463 else
1464 begin
1465 env := TEnvType.EAir;
1466 end;
1468 velX := baseVelX*Random;
1469 velY := baseVelY-Random;
1470 accelX := velX/3.0;
1471 accelY := velY/5.0;
1473 red := 255;
1474 green := 100+Random(155);
1475 blue := 64;
1476 alpha := 255;
1478 particleType := TPartType.Spark;
1479 state := TPartState.Normal;
1480 time := 0;
1481 liveTime := 30+Random(60);
1482 waitTime := 0;
1483 floorY := Unknown;
1484 ceilingY := Unknown;
1485 end;
1487 if (CurrentParticle >= MaxParticles-1) then CurrentParticle := 0 else CurrentParticle += 1;
1488 end;
1489 end;
1492 // ////////////////////////////////////////////////////////////////////////// //
1493 procedure g_GFX_SetMax (count: Integer);
1494 var
1495 a: Integer;
1496 begin
1497 if count > 50000 then count := 50000;
1498 if (count < 1) then count := 1;
1499 SetLength(Particles, count);
1500 for a := 0 to High(Particles) do Particles[a].die();
1501 MaxParticles := count;
1502 CurrentParticle := 0;
1503 end;
1506 function g_GFX_GetMax (): Integer;
1507 begin
1508 result := MaxParticles;
1509 end;
1512 function FindOnceAnim (): DWORD;
1513 var
1514 i: Integer;
1515 begin
1516 if OnceAnims <> nil then
1517 for i := 0 to High(OnceAnims) do
1518 if OnceAnims[i].Animation = nil then
1519 begin
1520 Result := i;
1521 Exit;
1522 end;
1524 if OnceAnims = nil then
1525 begin
1526 SetLength(OnceAnims, 16);
1527 Result := 0;
1528 end
1529 else
1530 begin
1531 Result := High(OnceAnims) + 1;
1532 SetLength(OnceAnims, Length(OnceAnims) + 16);
1533 end;
1534 end;
1537 procedure g_GFX_OnceAnim (x, y: Integer; Anim: TAnimation; AnimType: Byte = 0);
1538 var
1539 find_id: DWORD;
1540 begin
1541 if not gpart_dbg_enabled then exit;
1543 if (Anim = nil) then exit;
1545 find_id := FindOnceAnim();
1547 OnceAnims[find_id].AnimType := AnimType;
1548 OnceAnims[find_id].Animation := TAnimation.Create(Anim.FramesID, Anim.Loop, Anim.Speed);
1549 OnceAnims[find_id].Animation.Blending := Anim.Blending;
1550 OnceAnims[find_id].Animation.alpha := Anim.alpha;
1551 OnceAnims[find_id].x := x;
1552 OnceAnims[find_id].y := y;
1553 end;
1556 // ////////////////////////////////////////////////////////////////////////// //
1557 procedure g_GFX_Init ();
1558 begin
1559 //g_Game_SetLoadingText(_lc[I_LOAD_COLLIDE_MAP]+' 1/6', 0, False);
1560 //SetLength(gCollideMap, gMapInfo.Height+1);
1561 //for a := 0 to High(gCollideMap) do SetLength(gCollideMap[a], gMapInfo.Width+1);
1562 awmSetup();
1563 {$IFDEF HEADLESS}
1564 gpart_dbg_enabled := false;
1565 {$ENDIF}
1566 end;
1569 procedure g_GFX_Free ();
1570 var
1571 a: Integer;
1572 begin
1573 Particles := nil;
1574 SetLength(Particles, MaxParticles);
1575 for a := 0 to High(Particles) do Particles[a].die();
1576 CurrentParticle := 0;
1578 if (OnceAnims <> nil) then
1579 begin
1580 for a := 0 to High(OnceAnims) do OnceAnims[a].Animation.Free();
1581 OnceAnims := nil;
1582 end;
1584 awakeMap := nil;
1585 // why not?
1586 awakeMapH := -1;
1587 awakeMapW := -1;
1588 end;
1591 // ////////////////////////////////////////////////////////////////////////// //
1592 procedure g_GFX_Update ();
1593 var
1594 a: Integer;
1595 w, h: Integer;
1596 len: Integer;
1597 begin
1598 if not gpart_dbg_enabled then exit;
1600 if (Particles <> nil) then
1601 begin
1602 w := gMapInfo.Width;
1603 h := gMapInfo.Height;
1605 len := High(Particles);
1607 for a := 0 to len do
1608 begin
1609 if Particles[a].alive then
1610 begin
1611 with Particles[a] do
1612 begin
1613 if (time = liveTime) then begin die(); continue; end;
1614 if (x+1 >= w) or (y+1 >= h) or (x <= 0) or (y <= 0) then begin die(); end;
1615 think();
1616 end; // with
1617 end; // if
1618 end; // for
1619 end; // Particles <> nil
1621 // clear awake map
1622 awmClear();
1624 if OnceAnims <> nil then
1625 begin
1626 for a := 0 to High(OnceAnims) do
1627 if OnceAnims[a].Animation <> nil then
1628 begin
1629 case OnceAnims[a].AnimType of
1630 ONCEANIM_SMOKE:
1631 begin
1632 if Random(3) = 0 then
1633 OnceAnims[a].x := OnceAnims[a].x-1+Random(3);
1634 if Random(2) = 0 then
1635 OnceAnims[a].y := OnceAnims[a].y-Random(2);
1636 end;
1637 end;
1639 if OnceAnims[a].Animation.Played then
1640 begin
1641 OnceAnims[a].Animation.Free();
1642 OnceAnims[a].Animation := nil;
1643 end
1644 else
1645 OnceAnims[a].Animation.Update();
1646 end;
1647 end;
1648 end;
1651 procedure g_GFX_Draw ();
1652 var
1653 a, len: Integer;
1654 {$IFDEF USE_NANOGL}
1655 type
1656 Vertex = record
1657 x, y: GLfloat;
1658 r, g, b, a: GLfloat;
1659 end;
1660 var
1661 count: Integer;
1662 v: array of Vertex;
1663 {$ENDIF}
1664 begin
1665 if not gpart_dbg_enabled then exit;
1667 if (Particles <> nil) then
1668 begin
1669 glDisable(GL_TEXTURE_2D);
1670 if (g_dbg_scale < 0.6) then glPointSize(1)
1671 else if (g_dbg_scale > 1.3) then glPointSize(g_dbg_scale+1)
1672 else glPointSize(2);
1673 glDisable(GL_POINT_SMOOTH);
1675 glEnable(GL_BLEND);
1676 glBlendFunc(GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA);
1678 {$IFDEF USE_NANOGL}
1679 count := 0;
1680 SetLength(v, Length(Particles));
1681 for a := 0 to High(Particles) do
1682 begin
1683 with Particles[a] do
1684 begin
1685 if alive and (x >= sX) and (y >= sY) and (x <= sX + sWidth) and (sY <= sY + sHeight) then
1686 begin
1687 v[count].x := x + 0.37;
1688 v[count].y := y + 0.37;
1689 v[count].r := red / 255;
1690 v[count].g := green / 255;
1691 v[count].b := blue / 255;
1692 v[count].a := alpha / 255;
1693 Inc(count);
1694 end;
1695 end;
1696 end;
1698 glVertexPointer(2, GL_FLOAT, SizeOf(Vertex), @v[0].x);
1699 glColorPointer(4, GL_FLOAT, SizeOf(Vertex), @v[0].r);
1700 glEnableClientState(GL_VERTEX_ARRAY);
1701 glEnableClientState(GL_COLOR_ARRAY);
1702 glDisableClientState(GL_NORMAL_ARRAY);
1703 glDisableClientState(GL_TEXTURE_COORD_ARRAY);
1704 glDrawArrays(GL_POINTS, 0, count);
1705 {$ELSE}
1706 glBegin(GL_POINTS);
1708 len := High(Particles);
1709 for a := 0 to len do
1710 begin
1711 with Particles[a] do
1712 begin
1713 if not alive then continue;
1714 if (x >= sX) and (y >= sY) and (x <= sX+sWidth) and (sY <= sY+sHeight) then
1715 begin
1716 glColor4ub(red, green, blue, alpha);
1717 glVertex2f(x+0.37, y+0.37);
1718 end;
1719 end;
1720 end;
1722 glEnd();
1723 {$ENDIF}
1725 glDisable(GL_BLEND);
1726 end;
1728 if (OnceAnims <> nil) then
1729 begin
1730 len := High(OnceAnims);
1731 for a := 0 to len do
1732 begin
1733 if (OnceAnims[a].Animation <> nil) then
1734 begin
1735 with OnceAnims[a] do Animation.Draw(x, y, TMirrorType.None);
1736 end;
1737 end;
1738 end;
1739 end;
1742 end.