DEADSOFTWARE

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