DEADSOFTWARE

GIT / REPO / FRED-BOY
Projects / d2df-sdl.git / blob
summary | shortlog | log | commit | commitdiff | tree
history | raw | HEAD
added "dbg_scale_half" experimental deBUG mode
[d2df-sdl.git] / src / game / g_panel.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 unit g_panel;
18
19 interface
20
21 uses
22 MAPDEF, BinEditor, g_textures;
23
24 type
25 TAddTextureArray = Array of
26 record
27 Texture: Cardinal;
28 Anim: Boolean;
29 end;
30
31 TPanel = Class (TObject)
32 private
33 FTextureWidth: Word;
34 FTextureHeight: Word;
35 FAlpha: Byte;
36 FBlending: Boolean;
37 FTextureIDs: Array of
38 record
39 case Anim: Boolean of
40 False: (Tex: Cardinal);
41 True: (AnTex: TAnimation);
42 end;
43
44 private
45 function getx1 (): Integer; inline;
46 function gety1 (): Integer; inline;
47 function getvisvalid (): Boolean; inline;
48
49 public
50 FCurTexture: Integer; // Íîìåð òåêóùåé òåêñòóðû
51 FCurFrame: Integer;
52 FCurFrameCount: Byte;
53 X, Y: Integer;
54 Width, Height: Word;
55 PanelType: Word;
56 SaveIt: Boolean; // Ñîõðàíÿòü ïðè SaveState?
57 Enabled: Boolean;
58 Door: Boolean;
59 Moved: Boolean;
60 LiftType: Byte;
61 LastAnimLoop: Byte;
62 arrIdx: Integer; // index in one of internal arrays; sorry
63 tag: Integer; // used in coldets and such; sorry
64 proxyId: Integer; // proxy id in map grid (DO NOT USE!)
65
66 constructor Create(PanelRec: TPanelRec_1;
67 AddTextures: TAddTextureArray;
68 CurTex: Integer;
69 var Textures: TLevelTextureArray);
70 destructor Destroy(); override;
71
72 procedure Draw();
73 procedure DrawShadowVolume(lightX: Integer; lightY: Integer; radius: Integer);
74 procedure Update();
75 procedure SetFrame(Frame: Integer; Count: Byte);
76 procedure NextTexture(AnimLoop: Byte = 0);
77 procedure SetTexture(ID: Integer; AnimLoop: Byte = 0);
78 function GetTextureID(): Cardinal;
79 function GetTextureCount(): Integer;
80
81 procedure SaveState(var Mem: TBinMemoryWriter);
82 procedure LoadState(var Mem: TBinMemoryReader);
83
84 property x0: Integer read X;
85 property y0: Integer read Y;
86 property x1: Integer read getx1; // inclusive!
87 property y1: Integer read gety1; // inclusive!
88 property visvalid: Boolean read getvisvalid; // panel is "visvalid" when it's width and height are positive
89 end;
90
91 PPanel = ^TPanel;
92 TPanelArray = Array of TPanel;
93
94 implementation
95
96 uses
97 SysUtils, g_basic, g_map, g_game, e_graphics,
98 g_console, g_language, e_log, GL;
99
100 const
101 PANEL_SIGNATURE = $4C4E4150; // 'PANL'
102
103 { T P a n e l : }
104
105 constructor TPanel.Create(PanelRec: TPanelRec_1;
106 AddTextures: TAddTextureArray;
107 CurTex: Integer;
108 var Textures: TLevelTextureArray);
109 var
110 i: Integer;
111 begin
112 X := PanelRec.X;
113 Y := PanelRec.Y;
114 Width := PanelRec.Width;
115 Height := PanelRec.Height;
116 FAlpha := 0;
117 FBlending := False;
118 FCurFrame := 0;
119 FCurFrameCount := 0;
120 LastAnimLoop := 0;
121 Moved := False;
122
123 // Òèï ïàíåëè:
124 PanelType := PanelRec.PanelType;
125 Enabled := True;
126 Door := False;
127 LiftType := 0;
128 SaveIt := False;
129
130 case PanelType of
131 PANEL_OPENDOOR:
132 begin
133 Enabled := False;
134 Door := True;
135 SaveIt := True;
136 end;
137 PANEL_CLOSEDOOR:
138 begin
139 Door := True;
140 SaveIt := True;
141 end;
142 PANEL_LIFTUP:
143 SaveIt := True;
144 PANEL_LIFTDOWN:
145 begin
146 LiftType := 1;
147 SaveIt := True;
148 end;
149 PANEL_LIFTLEFT:
150 begin
151 LiftType := 2;
152 SaveIt := True;
153 end;
154 PANEL_LIFTRIGHT:
155 begin
156 LiftType := 3;
157 SaveIt := True;
158 end;
159 end;
160
161 // Íåâèäèìàÿ:
162 if ByteBool(PanelRec.Flags and PANEL_FLAG_HIDE) then
163 begin
164 SetLength(FTextureIDs, 0);
165 FCurTexture := -1;
166 Exit;
167 end;
168 // Ïàíåëè, íå èñïîëüçóþùèå òåêñòóðû:
169 if ByteBool(PanelType and
170 (PANEL_LIFTUP or
171 PANEL_LIFTDOWN or
172 PANEL_LIFTLEFT or
173 PANEL_LIFTRIGHT or
174 PANEL_BLOCKMON)) then
175 begin
176 SetLength(FTextureIDs, 0);
177 FCurTexture := -1;
178 Exit;
179 end;
180
181 // Åñëè ýòî æèäêîñòü áåç òåêñòóðû - ñïåöòåêñòóðó:
182 if WordBool(PanelType and (PANEL_WATER or PANEL_ACID1 or PANEL_ACID2)) and
183 (not ByteBool(PanelRec.Flags and PANEL_FLAG_WATERTEXTURES)) then
184 begin
185 SetLength(FTextureIDs, 1);
186 FTextureIDs[0].Anim := False;
187
188 case PanelRec.PanelType of
189 PANEL_WATER:
190 FTextureIDs[0].Tex := LongWord(TEXTURE_SPECIAL_WATER);
191 PANEL_ACID1:
192 FTextureIDs[0].Tex := LongWord(TEXTURE_SPECIAL_ACID1);
193 PANEL_ACID2:
194 FTextureIDs[0].Tex := LongWord(TEXTURE_SPECIAL_ACID2);
195 end;
196
197 FCurTexture := 0;
198 Exit;
199 end;
200
201 SetLength(FTextureIDs, Length(AddTextures));
202
203 if CurTex < 0 then
204 FCurTexture := -1
205 else
206 if CurTex >= Length(FTextureIDs) then
207 FCurTexture := Length(FTextureIDs) - 1
208 else
209 FCurTexture := CurTex;
210
211 for i := 0 to Length(FTextureIDs)-1 do
212 begin
213 FTextureIDs[i].Anim := AddTextures[i].Anim;
214 if FTextureIDs[i].Anim then
215 begin // Àíèìèðîâàííàÿ òåêñòóðà
216 FTextureIDs[i].AnTex :=
217 TAnimation.Create(Textures[AddTextures[i].Texture].FramesID,
218 True, Textures[AddTextures[i].Texture].Speed);
219 FTextureIDs[i].AnTex.Blending := ByteBool(PanelRec.Flags and PANEL_FLAG_BLENDING);
220 FTextureIDs[i].AnTex.Alpha := PanelRec.Alpha;
221 SaveIt := True;
222 end
223 else
224 begin // Îáû÷íàÿ òåêñòóðà
225 FTextureIDs[i].Tex := Textures[AddTextures[i].Texture].TextureID;
226 end;
227 end;
228
229 // Òåêñòóð íåñêîëüêî - íóæíî ñîõðàíÿòü òåêóùóþ:
230 if Length(FTextureIDs) > 1 then
231 SaveIt := True;
232
233 // Åñëè íå ñïåöòåêñòóðà, òî çàäàåì ðàçìåðû:
234 if PanelRec.TextureNum > High(Textures) then
235 begin
236 e_WriteLog(Format('WTF?! PanelRec.TextureNum is out of limits! (%d : %d)', [PanelRec.TextureNum, High(Textures)]), MSG_FATALERROR);
237 FTextureWidth := 2;
238 FTextureHeight := 2;
239 FAlpha := 0;
240 FBlending := ByteBool(0);
241 end
242 else if not g_Map_IsSpecialTexture(Textures[PanelRec.TextureNum].TextureName) then
243 begin
244 FTextureWidth := Textures[PanelRec.TextureNum].Width;
245 FTextureHeight := Textures[PanelRec.TextureNum].Height;
246 FAlpha := PanelRec.Alpha;
247 FBlending := ByteBool(PanelRec.Flags and PANEL_FLAG_BLENDING);
248 end;
249 end;
250
251 destructor TPanel.Destroy();
252 var
253 i: Integer;
254 begin
255 for i := 0 to High(FTextureIDs) do
256 if FTextureIDs[i].Anim then
257 FTextureIDs[i].AnTex.Free();
258 SetLength(FTextureIDs, 0);
259
260 Inherited;
261 end;
262
263 function TPanel.getx1 (): Integer; inline; begin result := X+Width-1; end;
264 function TPanel.gety1 (): Integer; inline; begin result := Y+Height-1; end;
265 function TPanel.getvisvalid (): Boolean; inline; begin result := (Width > 0) and (Height > 0); end;
266
267 procedure TPanel.Draw();
268 var
269 xx, yy: Integer;
270 NoTextureID: DWORD;
271 NW, NH: Word;
272 begin
273 if {Enabled and} (FCurTexture >= 0) and
274 (Width > 0) and (Height > 0) and (FAlpha < 255) and
275 (g_dbg_scale_05 or g_Collide(X, Y, Width, Height, sX, sY, sWidth, sHeight)) then
276 begin
277 if FTextureIDs[FCurTexture].Anim then
278 begin // Àíèìèðîâàííàÿ òåêñòóðà
279 if FTextureIDs[FCurTexture].AnTex = nil then
280 Exit;
281
282 for xx := 0 to (Width div FTextureWidth)-1 do
283 for yy := 0 to (Height div FTextureHeight)-1 do
284 FTextureIDs[FCurTexture].AnTex.Draw(
285 X + xx*FTextureWidth,
286 Y + yy*FTextureHeight, M_NONE);
287 end
288 else
289 begin // Îáû÷íàÿ òåêñòóðà
290 case FTextureIDs[FCurTexture].Tex of
291 LongWord(TEXTURE_SPECIAL_WATER):
292 e_DrawFillQuad(X, Y, X+Width-1, Y+Height-1,
293 0, 0, 255, 0, B_FILTER);
294 LongWord(TEXTURE_SPECIAL_ACID1):
295 e_DrawFillQuad(X, Y, X+Width-1, Y+Height-1,
296 0, 128, 0, 0, B_FILTER);
297 LongWord(TEXTURE_SPECIAL_ACID2):
298 e_DrawFillQuad(X, Y, X+Width-1, Y+Height-1,
299 128, 0, 0, 0, B_FILTER);
300 LongWord(TEXTURE_NONE):
301 if g_Texture_Get('NOTEXTURE', NoTextureID) then
302 begin
303 e_GetTextureSize(NoTextureID, @NW, @NH);
304 e_DrawFill(NoTextureID, X, Y, Width div NW, Height div NH,
305 0, False, False);
306 end else
307 begin
308 xx := X + (Width div 2);
309 yy := Y + (Height div 2);
310 e_DrawFillQuad(X, Y, xx, yy,
311 255, 0, 255, 0);
312 e_DrawFillQuad(xx, Y, X+Width-1, yy,
313 255, 255, 0, 0);
314 e_DrawFillQuad(X, yy, xx, Y+Height-1,
315 255, 255, 0, 0);
316 e_DrawFillQuad(xx, yy, X+Width-1, Y+Height-1,
317 255, 0, 255, 0);
318 end;
319
320 else
321 e_DrawFill(FTextureIDs[FCurTexture].Tex, X, Y,
322 Width div FTextureWidth,
323 Height div FTextureHeight,
324 FAlpha, True, FBlending);
325 end;
326 end;
327 end;
328 end;
329
330 procedure TPanel.DrawShadowVolume(lightX: Integer; lightY: Integer; radius: Integer);
331 procedure extrude (x: Integer; y: Integer);
332 begin
333 glVertex2i(x+(x-lightX)*500, y+(y-lightY)*500);
334 //e_WriteLog(Format(' : (%d,%d)', [x+(x-lightX)*300, y+(y-lightY)*300]), MSG_WARNING);
335 end;
336
337 procedure drawLine (x0: Integer; y0: Integer; x1: Integer; y1: Integer);
338 begin
339 // does this side facing the light?
340 if ((x1-x0)*(lightY-y0)-(lightX-x0)*(y1-y0) >= 0) then exit;
341 //e_WriteLog(Format('lightpan: (%d,%d)-(%d,%d)', [x0, y0, x1, y1]), MSG_WARNING);
342 // this edge is facing the light, extrude and draw it
343 glVertex2i(x0, y0);
344 glVertex2i(x1, y1);
345 extrude(x1, y1);
346 extrude(x0, y0);
347 end;
348
349 begin
350 if radius < 4 then exit;
351 if Enabled and (FCurTexture >= 0) and (Width > 0) and (Height > 0) and (FAlpha < 255) and g_Collide(X, Y, Width, Height, sX, sY, sWidth, sHeight) then
352 begin
353 if not FTextureIDs[FCurTexture].Anim then
354 begin
355 case FTextureIDs[FCurTexture].Tex of
356 LongWord(TEXTURE_SPECIAL_WATER): exit;
357 LongWord(TEXTURE_SPECIAL_ACID1): exit;
358 LongWord(TEXTURE_SPECIAL_ACID2): exit;
359 LongWord(TEXTURE_NONE): exit;
360 end;
361 end;
362 if (X+Width < lightX-radius) then exit;
363 if (Y+Height < lightY-radius) then exit;
364 if (X > lightX+radius) then exit;
365 if (Y > lightY+radius) then exit;
366 //e_DrawFill(FTextureIDs[FCurTexture].Tex, X, Y, Width div FTextureWidth, Height div FTextureHeight, FAlpha, True, FBlending);
367
368 glBegin(GL_QUADS);
369 drawLine(x, y, x+width, y); // top
370 drawLine(x+width, y, x+width, y+height); // right
371 drawLine(x+width, y+height, x, y+height); // bottom
372 drawLine(x, y+height, x, y); // left
373 glEnd();
374 end;
375 end;
376
377 procedure TPanel.Update();
378 begin
379 if Enabled and (FCurTexture >= 0) and
380 (FTextureIDs[FCurTexture].Anim) and
381 (FTextureIDs[FCurTexture].AnTex <> nil) and
382 (Width > 0) and (Height > 0) and (FAlpha < 255) then
383 begin
384 FTextureIDs[FCurTexture].AnTex.Update();
385 FCurFrame := FTextureIDs[FCurTexture].AnTex.CurrentFrame;
386 FCurFrameCount := FTextureIDs[FCurTexture].AnTex.CurrentCounter;
387 end;
388 end;
389
390 procedure TPanel.SetFrame(Frame: Integer; Count: Byte);
391
392 function ClampInt(X, A, B: Integer): Integer;
393 begin
394 Result := X;
395 if X < A then Result := A else if X > B then Result := B;
396 end;
397
398 begin
399 if Enabled and (FCurTexture >= 0) and
400 (FTextureIDs[FCurTexture].Anim) and
401 (FTextureIDs[FCurTexture].AnTex <> nil) and
402 (Width > 0) and (Height > 0) and (FAlpha < 255) then
403 begin
404 FCurFrame := ClampInt(Frame, 0, FTextureIDs[FCurTexture].AnTex.TotalFrames);
405 FCurFrameCount := Count;
406 FTextureIDs[FCurTexture].AnTex.CurrentFrame := FCurFrame;
407 FTextureIDs[FCurTexture].AnTex.CurrentCounter := FCurFrameCount;
408 end;
409 end;
410
411 procedure TPanel.NextTexture(AnimLoop: Byte = 0);
412 begin
413 Assert(FCurTexture >= -1, 'FCurTexture < -1');
414
415 // Íåò òåêñòóð:
416 if Length(FTextureIDs) = 0 then
417 FCurTexture := -1
418 else
419 // Òîëüêî îäíà òåêñòóðà:
420 if Length(FTextureIDs) = 1 then
421 begin
422 if FCurTexture = 0 then
423 FCurTexture := -1
424 else
425 FCurTexture := 0;
426 end
427 else
428 // Áîëüøå îäíîé òåêñòóðû:
429 begin
430 // Ñëåäóþùàÿ:
431 Inc(FCurTexture);
432 // Ñëåäóþùåé íåò - âîçâðàò ê íà÷àëó:
433 if FCurTexture >= Length(FTextureIDs) then
434 FCurTexture := 0;
435 end;
436
437 // Ïåðåêëþ÷èëèñü íà âèäèìóþ àíèì. òåêñòóðó:
438 if (FCurTexture >= 0) and FTextureIDs[FCurTexture].Anim then
439 begin
440 if (FTextureIDs[FCurTexture].AnTex = nil) then
441 begin
442 g_FatalError(_lc[I_GAME_ERROR_SWITCH_TEXTURE]);
443 Exit;
444 end;
445
446 if AnimLoop = 1 then
447 FTextureIDs[FCurTexture].AnTex.Loop := True
448 else
449 if AnimLoop = 2 then
450 FTextureIDs[FCurTexture].AnTex.Loop := False;
451
452 FTextureIDs[FCurTexture].AnTex.Reset();
453 end;
454
455 LastAnimLoop := AnimLoop;
456 end;
457
458 procedure TPanel.SetTexture(ID: Integer; AnimLoop: Byte = 0);
459 begin
460 // Íåò òåêñòóð:
461 if Length(FTextureIDs) = 0 then
462 FCurTexture := -1
463 else
464 // Òîëüêî îäíà òåêñòóðà:
465 if Length(FTextureIDs) = 1 then
466 begin
467 if (ID = 0) or (ID = -1) then
468 FCurTexture := ID;
469 end
470 else
471 // Áîëüøå îäíîé òåêñòóðû:
472 begin
473 if (ID >= -1) and (ID <= High(FTextureIDs)) then
474 FCurTexture := ID;
475 end;
476
477 // Ïåðåêëþ÷èëèñü íà âèäèìóþ àíèì. òåêñòóðó:
478 if (FCurTexture >= 0) and FTextureIDs[FCurTexture].Anim then
479 begin
480 if (FTextureIDs[FCurTexture].AnTex = nil) then
481 begin
482 g_FatalError(_lc[I_GAME_ERROR_SWITCH_TEXTURE]);
483 Exit;
484 end;
485
486 if AnimLoop = 1 then
487 FTextureIDs[FCurTexture].AnTex.Loop := True
488 else
489 if AnimLoop = 2 then
490 FTextureIDs[FCurTexture].AnTex.Loop := False;
491
492 FTextureIDs[FCurTexture].AnTex.Reset();
493 end;
494
495 LastAnimLoop := AnimLoop;
496 end;
497
498 function TPanel.GetTextureID(): DWORD;
499 begin
500 Result := LongWord(TEXTURE_NONE);
501
502 if (FCurTexture >= 0) then
503 begin
504 if FTextureIDs[FCurTexture].Anim then
505 Result := FTextureIDs[FCurTexture].AnTex.FramesID
506 else
507 Result := FTextureIDs[FCurTexture].Tex;
508 end;
509 end;
510
511 function TPanel.GetTextureCount(): Integer;
512 begin
513 Result := Length(FTextureIDs);
514 if Enabled and (FCurTexture >= 0) then
515 if (FTextureIDs[FCurTexture].Anim) and
516 (FTextureIDs[FCurTexture].AnTex <> nil) and
517 (Width > 0) and (Height > 0) and (FAlpha < 255) then
518 Result := Result + 100;
519 end;
520
521 procedure TPanel.SaveState(Var Mem: TBinMemoryWriter);
522 var
523 sig: DWORD;
524 anim: Boolean;
525 begin
526 if (not SaveIt) or (Mem = nil) then
527 Exit;
528
529 // Ñèãíàòóðà ïàíåëè:
530 sig := PANEL_SIGNATURE; // 'PANL'
531 Mem.WriteDWORD(sig);
532 // Îòêðûòà/çàêðûòà, åñëè äâåðü:
533 Mem.WriteBoolean(Enabled);
534 // Íàïðàâëåíèå ëèôòà, åñëè ëèôò:
535 Mem.WriteByte(LiftType);
536 // Íîìåð òåêóùåé òåêñòóðû:
537 Mem.WriteInt(FCurTexture);
538 // Êîîðäû
539 Mem.WriteInt(X);
540 Mem.WriteInt(Y);
541 // Àíèìèðîâàííàÿ ëè òåêóùàÿ òåêñòóðà:
542 if (FCurTexture >= 0) and (FTextureIDs[FCurTexture].Anim) then
543 begin
544 Assert(FTextureIDs[FCurTexture].AnTex <> nil,
545 'TPanel.SaveState: No animation object');
546 anim := True;
547 end
548 else
549 anim := False;
550 Mem.WriteBoolean(anim);
551 // Åñëè äà - ñîõðàíÿåì àíèìàöèþ:
552 if anim then
553 FTextureIDs[FCurTexture].AnTex.SaveState(Mem);
554 end;
555
556 procedure TPanel.LoadState(var Mem: TBinMemoryReader);
557 var
558 sig: DWORD;
559 anim: Boolean;
560 begin
561 if (not SaveIt) or (Mem = nil) then
562 Exit;
563
564 // Ñèãíàòóðà ïàíåëè:
565 Mem.ReadDWORD(sig);
566 if sig <> PANEL_SIGNATURE then // 'PANL'
567 begin
568 raise EBinSizeError.Create('TPanel.LoadState: Wrong Panel Signature');
569 end;
570 // Îòêðûòà/çàêðûòà, åñëè äâåðü:
571 Mem.ReadBoolean(Enabled);
572 // Íàïðàâëåíèå ëèôòà, åñëè ëèôò:
573 Mem.ReadByte(LiftType);
574 // Íîìåð òåêóùåé òåêñòóðû:
575 Mem.ReadInt(FCurTexture);
576 // Êîîðäû
577 Mem.ReadInt(X);
578 Mem.ReadInt(Y);
579 // Àíèìèðîâàííàÿ ëè òåêóùàÿ òåêñòóðà:
580 Mem.ReadBoolean(anim);
581 // Åñëè äà - çàãðóæàåì àíèìàöèþ:
582 if anim then
583 begin
584 Assert((FCurTexture >= 0) and
585 (FTextureIDs[FCurTexture].Anim) and
586 (FTextureIDs[FCurTexture].AnTex <> nil),
587 'TPanel.LoadState: No animation object');
588 FTextureIDs[FCurTexture].AnTex.LoadState(Mem);
589 end;
590 end;
591
592 end.
[MIRROR] a port of Doom 2D Forever to FPC/SDL
[25/02/2024 19:55:35]
DEADSOFTWARE 2012-2024