DEADSOFTWARE

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