DEADSOFTWARE

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