DEADSOFTWARE

1970ac3baf39de4462a1fe43818ba205734b3463
[d2df-sdl.git] / src / game / opengl / r_map.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, version 3 of the License ONLY.
6 *
7 * This program is distributed in the hope that it will be useful,
8 * but WITHOUT ANY WARRANTY; without even the implied warranty of
9 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
10 * GNU General Public License for more details.
11 *
12 * You should have received a copy of the GNU General Public License
13 * along with this program. If not, see <http://www.gnu.org/licenses/>.
14 *)
15 {$INCLUDE ../../shared/a_modes.inc}
16 unit r_map;
18 interface
20 uses g_panel, MAPDEF; // TPanel, TDFColor
22 procedure r_Map_Initialize;
23 procedure r_Map_Finalize;
25 procedure r_Map_Load;
26 procedure r_Map_Free;
28 procedure r_Map_LoadTextures;
29 // TODO procedure r_Map_FreeTextures
31 procedure r_Map_Update;
33 procedure r_Map_DrawBack (dx, dy: Integer);
34 procedure r_Map_DrawPanels (PanelType: Word; hasAmbient: Boolean; constref ambColor: TDFColor); // unaccelerated
35 procedure r_Map_CollectDrawPanels (x0, y0, wdt, hgt: Integer);
36 procedure r_Map_DrawPanelShadowVolumes (lightX: Integer; lightY: Integer; radius: Integer);
37 procedure r_Map_DrawFlags;
39 procedure r_Panel_Draw (constref p: TPanel; hasAmbient: Boolean; constref ambColor: TDFColor);
40 procedure r_Panel_DrawShadowVolume (constref p: TPanel; lightX, lightY: Integer; radius: Integer);
42 implementation
44 uses
45 {$INCLUDE ../nogl/noGLuses.inc}
46 SysUtils, Classes, Math, e_log, wadreader, CONFIG, utils,
47 r_graphics, r_animations, r_textures, g_textures,
48 g_base, g_basic, g_game, g_options,
49 g_map
50 ;
52 var
53 RenTextures: array of record
54 ID: DWORD;
55 Width, Height: WORD;
56 Anim: Boolean;
57 end;
58 FlagFrames: array [FLAG_RED..FLAG_BLUE] of DWORD;
59 FlagAnim: TAnimationState;
61 procedure r_Map_Initialize;
62 begin
63 FlagAnim := TAnimationState.Create(True, 8, 5);
64 end;
66 procedure r_Map_Finalize;
67 begin
68 FlagAnim.Free;
69 FlagAnim := nil;
70 end;
72 procedure r_Map_Load;
73 begin
74 g_Frames_CreateWAD(@FlagFrames[FLAG_RED], 'FRAMES_FLAG_RED', GameWAD + ':TEXTURES\FLAGRED', 64, 64, 5, False);
75 g_Frames_CreateWAD(@FlagFrames[FLAG_BLUE], 'FRAMES_FLAG_BLUE', GameWAD + ':TEXTURES\FLAGBLUE', 64, 64, 5, False);
76 end;
78 procedure r_Map_Free;
79 begin
80 g_Frames_DeleteByName('FRAMES_FLAG_RED');
81 g_Frames_DeleteByName('FRAMES_FLAG_BLUE');
82 end;
84 procedure r_Map_LoadTextures;
85 const
86 log = True;
87 var
88 i, n: Integer;
89 WadName, ResName: String;
90 WAD, WADZ: TWADFile;
91 ResData, ReszData: Pointer;
92 ResLen, ReszLen: Integer;
93 cfg: TConfig;
94 TextureResource: String;
95 Width, Height: Integer;
96 FramesCount: Integer;
97 BackAnim: Boolean;
98 begin
99 if Textures <> nil then
100 begin
101 n := Length(Textures);
102 SetLength(RenTextures, n);
103 for i := 0 to n - 1 do
104 begin
105 // e_LogWritefln('r_Map_LoadTextures: -> [%s] :: [%s]', [Textures[i].FullName, Textures[i].TextureName]);
106 RenTextures[i].ID := LongWord(TEXTURE_NONE);
107 RenTextures[i].Width := 0;
108 RenTextures[i].Height := 0;
109 RenTextures[i].Anim := False;
110 case Textures[i].TextureName of
111 TEXTURE_NAME_WATER: RenTextures[i].ID := LongWord(TEXTURE_SPECIAL_WATER);
112 TEXTURE_NAME_ACID1: RenTextures[i].ID := LongWord(TEXTURE_SPECIAL_ACID1);
113 TEXTURE_NAME_ACID2: RenTextures[i].ID := LongWord(TEXTURE_SPECIAL_ACID2);
114 else
115 WadName := g_ExtractWadName(Textures[i].FullName);
116 ResName := g_ExtractFilePathName(Textures[i].FullName);
117 WAD := TWADFile.Create();
118 if WAD.ReadFile(WadName) then
119 begin
120 if WAD.GetResource(ResName, ResData, ResLen, log) then
121 begin
122 if IsWadData(ResData, ResLen) then
123 begin
124 WADz := TWADFile.Create();
125 if WADz.ReadMemory(ResData, ResLen) then
126 begin
127 if WADz.GetResource('TEXT/ANIM', ReszData, ReszLen) then
128 begin
129 cfg := TConfig.CreateMem(ReszData, ReszLen);
130 FreeMem(ReszData);
131 if cfg <> nil then
132 begin
133 TextureResource := cfg.ReadStr('', 'resource', '');
134 Width := cfg.ReadInt('', 'framewidth', 0);
135 Height := cfg.ReadInt('', 'frameheight', 0);
136 FramesCount := cfg.ReadInt('', 'framecount', 0);
137 // Speed := cfg.ReadInt('', 'waitcount', 0);
138 BackAnim := cfg.ReadBool('', 'backanimation', False);
139 RenTextures[i].Width := Width;
140 RenTextures[i].Height := Height;
141 if TextureResource <> '' then
142 begin
143 if WADz.GetResource('TEXTURES/' + TextureResource, ReszData, ReszLen) then
144 begin
145 if g_Frames_CreateMemory(@RenTextures[i].ID, '', ReszData, ReszLen, Width, Height, FramesCount, BackAnim) then
146 RenTextures[i].Anim := True
147 else
148 e_LogWritefln('r_Map_LoadTextures: failed to create frames object (%s)', [Textures[i].FullName]);
149 FreeMem(ReszData)
150 end
151 else
152 e_LogWritefln('r_Map_LoadTextures: failed to open animation resources (%s)', [Textures[i].FullName])
153 end
154 else
155 e_LogWritefln('r_Map_LoadTextures: failed to animation has no texture resource string (%s)', [Textures[i].FullName]);
156 cfg.Free
157 end
158 else
159 e_LogWritefln('r_Map_LoadTextures: failed to parse animation description (%s)', [Textures[i].FullName])
160 end
161 else
162 e_LogWritefln('r_Map_LoadTextures: failed to open animation description (%s)', [Textures[i].FullName])
163 end
164 else
165 e_LogWritefln('r_Map_LoadTextures: failed to open animation (%s)', [Textures[i].FullName]);
166 WADz.Free
167 end
168 else
169 begin
170 if e_CreateTextureMem(ResData, ResLen, RenTextures[i].ID) then
171 e_GetTextureSize(RenTextures[i].ID, @RenTextures[i].Width, @RenTextures[i].Height)
172 else
173 e_LogWritefln('r_Map_LoadTextures: failed to create texture (%s)', [Textures[i].FullName])
174 end;
175 FreeMem(ResData);
176 end
177 else
178 e_LogWritefln('r_Map_LoadTextures: failed to open (%s)', [Textures[i].FullName])
179 end
180 else
181 e_LogWritefln('r_Map_LoadTextures: failed to open %s', [WadName]);
182 WAD.Free;
183 end
184 end
185 end
186 end;
188 procedure dplClear ();
189 begin
190 if (gDrawPanelList = nil) then gDrawPanelList := TBinHeapPanelDraw.Create() else gDrawPanelList.clear();
191 end;
193 // old algo
194 procedure r_Map_DrawPanels (PanelType: Word; hasAmbient: Boolean; constref ambColor: TDFColor);
196 procedure DrawPanels (constref panels: TPanelArray; drawDoors: Boolean=False);
197 var
198 idx: Integer;
199 begin
200 if (panels <> nil) then
201 begin
202 // alas, no visible set
203 for idx := 0 to High(panels) do
204 begin
205 if not (drawDoors xor panels[idx].Door) then
206 r_Panel_Draw(panels[idx], hasAmbient, ambColor);
207 end;
208 end;
209 end;
211 begin
212 case PanelType of
213 PANEL_WALL: DrawPanels(gWalls);
214 PANEL_CLOSEDOOR: DrawPanels(gWalls, True);
215 PANEL_BACK: DrawPanels(gRenderBackgrounds);
216 PANEL_FORE: DrawPanels(gRenderForegrounds);
217 PANEL_WATER: DrawPanels(gWater);
218 PANEL_ACID1: DrawPanels(gAcid1);
219 PANEL_ACID2: DrawPanels(gAcid2);
220 PANEL_STEP: DrawPanels(gSteps);
221 end;
222 end;
224 // new algo
225 procedure r_Map_CollectDrawPanels (x0, y0, wdt, hgt: Integer);
226 var
227 mwit: PPanel;
228 it: TPanelGrid.Iter;
229 begin
230 dplClear();
231 it := mapGrid.forEachInAABB(x0, y0, wdt, hgt, GridDrawableMask);
232 for mwit in it do if (((mwit^.tag and GridTagDoor) <> 0) = mwit^.Door) then gDrawPanelList.insert(mwit^);
233 it.release();
234 // list will be rendered in `g_game.DrawPlayer()`
235 end;
237 procedure r_Map_DrawPanelShadowVolumes (lightX: Integer; lightY: Integer; radius: Integer);
238 var
239 mwit: PPanel;
240 it: TPanelGrid.Iter;
241 begin
242 it := mapGrid.forEachInAABB(lightX-radius, lightY-radius, radius*2, radius*2, (GridTagWall or GridTagDoor));
243 for mwit in it do r_Panel_DrawShadowVolume(mwit^, lightX, lightY, radius);
244 it.release();
245 end;
247 procedure r_Map_DrawBack(dx, dy: Integer);
248 begin
249 if gDrawBackGround and (BackID <> DWORD(-1)) then
250 e_DrawSize(BackID, dx, dy, 0, False, False, gBackSize.X, gBackSize.Y)
251 else
252 e_Clear(GL_COLOR_BUFFER_BIT, 0, 0, 0);
253 end;
255 procedure r_Map_DrawFlags;
256 var i, dx: Integer; Mirror: TMirrorType; f: PFlag;
257 begin
258 if gGameSettings.GameMode = GM_CTF then
259 begin
260 for i := FLAG_RED to FLAG_BLUE do
261 begin
262 f := @gFlags[i];
263 if not (f.State in [FLAG_STATE_NONE, FLAG_STATE_CAPTURED]) then
264 begin
265 if f.Direction = TDirection.D_LEFT then
266 Mirror := TMirrorType.Horizontal
267 else
268 Mirror := TMirrorType.None;
269 dx := IfThen(f.Direction = TDirection.D_LEFT, -1, +1);
270 r_AnimationState_Draw(FlagFrames[i], FlagAnim, f.Obj.X + dx, f.Obj.Y + 1, Mirror);
271 if g_debug_Frames then
272 e_DrawQuad(f.Obj.X + f.Obj.Rect.X, f.Obj.Y + f.Obj.Rect.Y, f.Obj.X + f.Obj.Rect.X + f.Obj.Rect.Width - 1, f.Obj.Y + f.Obj.Rect.Y + f.Obj.Rect.Height - 1, 0, 255, 0)
273 end
274 end
275 end
276 end;
278 procedure r_Panel_Draw (constref p: TPanel; hasAmbient: Boolean; constref ambColor: TDFColor);
279 var xx, yy: Integer; NoTextureID, TextureID, FramesID: DWORD; NW, NH: Word; Texture: Cardinal; IsAnim: Boolean; w, h: Integer;
280 begin
281 if {p.Enabled and} (p.FCurTexture >= 0) and (p.Width > 0) and (p.Height > 0) and (p.Alpha < 255) {and g_Collide(X, Y, Width, Height, sX, sY, sWidth, sHeight)} then
282 begin
283 Texture := p.TextureIDs[p.FCurTexture].Texture;
284 IsAnim := RenTextures[Texture].Anim;
285 if IsAnim then
286 begin
287 if p.TextureIDs[p.FCurTexture].AnTex <> nil then
288 begin
289 FramesID := RenTextures[Texture].ID;
290 w := RenTextures[Texture].Width;
291 h := RenTextures[Texture].Height;
292 for xx := 0 to p.Width div w - 1 do
293 for yy := 0 to p.Height div h - 1 do
294 r_AnimationState_Draw(FramesID, p.TextureIDs[p.FCurTexture].AnTex, p.X + xx * w, p.Y + yy * h, TMirrorType.None);
295 end
296 end
297 else
298 begin
299 TextureID := RenTextures[Texture].ID;
300 w := RenTextures[Texture].Width;
301 h := RenTextures[Texture].Height;
302 case TextureID of
303 LongWord(TEXTURE_SPECIAL_WATER): e_DrawFillQuad(p.X, p.Y, p.X + p.Width - 1, p.Y + p.Height - 1, 0, 0, 255, 0, TBlending.Filter);
304 LongWord(TEXTURE_SPECIAL_ACID1): e_DrawFillQuad(p.X, p.Y, p.X + p.Width - 1, p.Y + p.Height - 1, 0, 230, 0, 0, TBlending.Filter);
305 LongWord(TEXTURE_SPECIAL_ACID2): e_DrawFillQuad(p.X, p.Y, p.X + p.Width - 1, p.Y + p.Height - 1, 230, 0, 0, 0, TBlending.Filter);
306 LongWord(TEXTURE_NONE):
307 if g_Texture_Get('NOTEXTURE', NoTextureID) then
308 begin
309 e_GetTextureSize(NoTextureID, @NW, @NH);
310 e_DrawFill(NoTextureID, p.X, p.Y, p.Width div NW, p.Height div NH, 0, False, False);
311 end
312 else
313 begin
314 xx := p.X + (p.Width div 2);
315 yy := p.Y + (p.Height div 2);
316 e_DrawFillQuad(p.X, p.Y, xx, yy, 255, 0, 255, 0);
317 e_DrawFillQuad(xx, p.Y, p.X + p.Width - 1, yy, 255, 255, 0, 0);
318 e_DrawFillQuad(p.X, yy, xx, p.Y + p.Height - 1, 255, 255, 0, 0);
319 e_DrawFillQuad(xx, yy, p.X + p.Width - 1, p.Y + p.Height - 1, 255, 0, 255, 0);
320 end;
321 else
322 if not p.movingActive then
323 e_DrawFill(TextureID, p.X, p.Y, p.Width div w, p.Height div h, p.Alpha, True, p.Blending, hasAmbient)
324 else
325 e_DrawFillX(TextureID, p.X, p.Y, p.Width, p.Height, p.Alpha, True, p.Blending, g_dbg_scale, hasAmbient);
326 if hasAmbient then
327 e_AmbientQuad(p.X, p.Y, p.Width, p.Height, ambColor.r, ambColor.g, ambColor.b, ambColor.a);
328 end
329 end
330 end
331 end;
333 procedure r_Panel_DrawShadowVolume (constref p: TPanel; lightX, lightY: Integer; radius: Integer);
334 var Texture: Cardinal;
336 procedure extrude (x: Integer; y: Integer);
337 begin
338 glVertex2i(x + (x - lightX) * 500, y + (y - lightY) * 500);
339 //e_WriteLog(Format(' : (%d,%d)', [x + (x - lightX) * 300, y + (y - lightY) * 300]), MSG_WARNING);
340 end;
342 procedure drawLine (x0: Integer; y0: Integer; x1: Integer; y1: Integer);
343 begin
344 // does this side facing the light?
345 if ((x1 - x0) * (lightY - y0) - (lightX - x0) * (y1 - y0) >= 0) then exit;
346 //e_WriteLog(Format('lightpan: (%d,%d)-(%d,%d)', [x0, y0, x1, y1]), MSG_WARNING);
347 // this edge is facing the light, extrude and draw it
348 glVertex2i(x0, y0);
349 glVertex2i(x1, y1);
350 extrude(x1, y1);
351 extrude(x0, y0);
352 end;
354 begin
355 if radius < 4 then exit;
356 if p.Enabled and (p.FCurTexture >= 0) and (p.Width > 0) and (p.Height > 0) and (p.Alpha < 255) {and g_Collide(X, Y, Width, Height, sX, sY, sWidth, sHeight)} then
357 begin
358 Texture := p.TextureIDs[p.FCurTexture].Texture;
359 if not RenTextures[Texture].Anim then
360 begin
361 case RenTextures[Texture].ID of
362 LongWord(TEXTURE_SPECIAL_WATER): exit;
363 LongWord(TEXTURE_SPECIAL_ACID1): exit;
364 LongWord(TEXTURE_SPECIAL_ACID2): exit;
365 LongWord(TEXTURE_NONE): exit;
366 end;
367 end;
368 if (p.X + p.Width < lightX - radius) then exit;
369 if (p.Y + p.Height < lightY - radius) then exit;
370 if (p.X > lightX + radius) then exit;
371 if (p.Y > lightY + radius) then exit;
372 //e_DrawFill(TextureIDs[FCurTexture].Tex, X, Y, Width div TextureWidth, Height div TextureHeight, Alpha, True, Blending);
373 glBegin(GL_QUADS);
374 drawLine(p.x, p.y, p.x + p.width, p.y); // top
375 drawLine(p.x + p.width, p.y, p.x + p.width, p.y + p.height); // right
376 drawLine(p.x + p.width, p.y + p.height, p.x, p.y + p.height); // bottom
377 drawLine(p.x, p.y + p.height, p.x, p.y); // left
378 glEnd;
379 end
380 end;
382 procedure r_Map_Update;
383 begin
384 FlagAnim.Update
385 end;
387 end.