DEADSOFTWARE

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