DEADSOFTWARE

rewritten dyntree visitor; seems to fix segfaults (but i don't know why)
[d2df-sdl.git] / src / engine / e_texture.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 e_texture;
19 { This unit provides interface to load 24-bit and 32-bit uncompressed images
20 from Truevision Targa (TGA) graphic files, and create OpenGL textures
21 from it's data. }
23 interface
25 uses
26 GL, GLExt, SysUtils, e_log,
27 ImagingTypes, Imaging, ImagingUtility;
29 type
30 GLTexture = record
31 id: GLuint;
32 width, height: Word; // real
33 glwidth, glheight: Word; // powerof2
34 u, v: Single; // usually 1.0
35 fmt: GLuint;
36 end;
38 var
39 e_DummyTextures: Boolean = False;
40 TEXTUREFILTER: Integer = GL_NEAREST;
42 function CreateTexture (var tex: GLTexture; Width, Height, aFormat: Word; pData: Pointer): Boolean;
44 // Standard set of images loading functions
45 function LoadTexture (Filename: String; var Texture: GLTexture; var pWidth, pHeight: Word; Fmt: PWord=nil): Boolean;
46 function LoadTextureEx (Filename: String; var Texture: GLTexture; fX, fY, fWidth, fHeight: Word; Fmt: PWord=nil): Boolean;
47 function LoadTextureMem (pData: Pointer; dataSize: LongInt; var Texture: GLTexture; var pWidth, pHeight: Word; Fmt: PWord=nil): Boolean;
48 function LoadTextureMemEx (pData: Pointer; dataSize: LongInt; var Texture: GLTexture; fX, fY, fWidth, fHeight: Word; Fmt: PWord=nil): Boolean;
50 // `img` must be valid!
51 function LoadTextureImg (var img: TImageData; var Texture: GLTexture; var pWidth, pHeight: Word; Fmt: PWord=nil): Boolean;
54 implementation
56 uses
57 Classes, BinEditor, g_options, utils;
60 function AlignP2 (n: Word): Word;
61 begin
62 Dec(n);
63 n := n or (n shr 1);
64 n := n or (n shr 2);
65 n := n or (n shr 4);
66 n := n or (n shr 8);
67 n := n or (n shr 16);
68 Inc(n);
69 Result := n;
70 end;
73 // This is auxiliary function that creates OpenGL texture from raw image data
74 function CreateTexture (var tex: GLTexture; Width, Height, aFormat: Word; pData: Pointer): Boolean;
75 var
76 Texture: GLuint;
77 fmt: GLenum;
78 //buf: PByte;
79 //f, c: Integer;
80 begin
81 tex.width := Width;
82 tex.height := Height;
83 tex.glwidth := Width;
84 tex.glheight := Height;
85 tex.u := 1;
86 tex.v := 1;
88 if glLegacyNPOT then
89 begin
90 tex.glwidth := AlignP2(Width);
91 tex.glheight := AlignP2(Height);
92 if tex.glwidth <> tex.width then tex.u := (tex.width+0.0)/(tex.glwidth+0.0);
93 if tex.glheight <> tex.height then tex.v := (tex.height+0.0)/(tex.glheight+0.0);
94 end;
96 //if (tex.glwidth <> tex.width) or (tex.glheight <> tex.height) then
97 // e_WriteLog(Format('NPOT: orig is %ux%u; gl is %ux%u; u=%f; v=%f', [Width, Height, tex.glwidth, tex.glheight, tex.u, tex.v]), MSG_NOTIFY);
99 if e_DummyTextures then
100 begin
101 tex.id := GLuint(-1);
102 Result := True;
103 Exit;
104 end;
106 glGenTextures(1, @Texture);
107 tex.id := Texture;
108 glBindTexture(GL_TEXTURE_2D, Texture);
110 if (tex.glwidth <> tex.width) or (tex.glheight <> tex.height) then
111 e_WriteLog(Format('NPOT: %u is %ux%u; gl is %ux%u; u=%f; v=%f', [tex.id, Width, Height, tex.glwidth, tex.glheight, tex.u, tex.v]), MSG_NOTIFY);
113 // texture blends with object background
114 glTexEnvi( GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_MODULATE);
115 // texture does NOT blend with object background
116 //glTexEnvi(GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_DECAL);
119 Select a filtering type.
120 BiLinear filtering produces very good results with little performance impact
122 GL_NEAREST - Basic texture (grainy looking texture)
123 GL_LINEAR - BiLinear filtering
124 GL_LINEAR_MIPMAP_NEAREST - Basic mipmapped texture
125 GL_LINEAR_MIPMAP_LINEAR - BiLinear Mipmapped texture
128 // for GL_TEXTURE_MAG_FILTER only first two can be used
129 glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_MAG_FILTER, TEXTUREFILTER);
130 // for GL_TEXTURE_MIN_FILTER all of the above can be used
131 glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_MIN_FILTER, TEXTUREFILTER);
133 // create empty texture
134 if aFormat = GL_RGBA then fmt := GL_RGBA else fmt := GL_RGB; // silly, yeah?
135 glTexImage2D(GL_TEXTURE_2D, 0, fmt, tex.glwidth, tex.glheight, 0, GL_RGBA, GL_UNSIGNED_BYTE, nil);
137 (*
138 GetMem(buf, tex.glwidth*4*tex.glheight);
139 try
140 FillChar(buf^, tex.glwidth*4*tex.glheight, 255);
141 glTexSubImage2D(GL_TEXTURE_2D, 0, 0, 0, tex.glwidth, tex.glheight, fmt, GL_UNSIGNED_BYTE, buf);
142 if (tex.glheight = 128) and (tex.height = 80) then
143 begin
144 for f := 0 to tex.glheight-1 do
145 begin
146 for c := 0 to tex.glwidth-1 do
147 begin
148 buf[f*(tex.glwidth*4)+c*4+0] := 255;
149 buf[f*(tex.glwidth*4)+c*4+1] := 127;
150 buf[f*(tex.glwidth*4)+c*4+2] := 0;
151 end;
152 end;
153 glTexSubImage2D(GL_TEXTURE_2D, 0, 0, 82, tex.glwidth, {tex.glheight}1, fmt, GL_UNSIGNED_BYTE, buf);
154 end;
155 finally
156 FreeMem(buf);
157 end;
158 *)
160 glTexSubImage2D(GL_TEXTURE_2D, 0, 0, 0, Width, Height, fmt, GL_UNSIGNED_BYTE, pData);
161 //glTexSubImage2D(GL_TEXTURE_2D, 0, 0, tex.glheight-tex.height, Width, Height, fmt, GL_UNSIGNED_BYTE, pData);
163 glBindTexture(GL_TEXTURE_2D, 0);
165 Result := true;
166 end;
168 // `img` must be valid!
169 function LoadTextureImg (var img: TImageData; var Texture: GLTexture; var pWidth, pHeight: Word; Fmt: PWord=nil): Boolean;
170 var
171 image, ii: PByte;
172 width, height: Integer;
173 imageSize: Integer;
174 x, y: Integer;
175 clr: TColor32Rec;
176 begin
177 result := false;
178 pWidth := 0;
179 pHeight := 0;
180 if Fmt <> nil then Fmt^ := GL_RGBA; // anyway
182 if (img.width < 1) or (img.width > 32768) or (img.height < 1) or (img.height > 32768) then
183 begin
184 e_WriteLog('Error loading texture: invalid image dimensions', MSG_WARNING);
185 exit;
186 end;
187 //ConvertImage(img, ifA8R8G8B8);
188 width := img.width;
189 height := img.height;
190 pWidth := width;
191 pHeight := height;
192 imageSize := Width*Height*4;
193 GetMem(image, imageSize);
194 try
195 // it's slow, but i don't care for now
196 ii := image;
197 for y := height-1 downto 0 do
198 begin
199 for x := 0 to width-1 do
200 begin
201 clr := GetPixel32(img, x, y);
202 ii^ := clr.r; Inc(ii);
203 ii^ := clr.g; Inc(ii);
204 ii^ := clr.b; Inc(ii);
205 ii^ := clr.a; Inc(ii);
206 end;
207 end;
208 CreateTexture(Texture, width, height, GL_RGBA, image);
209 result := true;
210 finally
211 FreeMem(image);
212 end;
213 end;
216 function LoadTextureMem (pData: Pointer; dataSize: LongInt; var Texture: GLTexture; var pWidth, pHeight: Word; Fmt: PWord=nil): Boolean;
217 var
218 //image, ii: PByte;
219 //width, height: Integer;
220 //imageSize: Integer;
221 img: TImageData;
222 //x, y: Integer;
223 //clr: TColor32Rec;
224 begin
225 result := false;
226 pWidth := 0;
227 pHeight := 0;
228 if Fmt <> nil then Fmt^ := GL_RGBA; // anyway
230 InitImage(img);
231 if not LoadImageFromMemory(pData, dataSize, img) then
232 begin
233 e_WriteLog('Error loading texture: unknown image format', MSG_WARNING);
234 exit;
235 end;
236 try
237 result := LoadTextureImg(img, Texture, pWidth, pHeight, Fmt);
238 finally
239 FreeImage(img);
240 end;
241 end;
244 function LoadTextureMemEx (pData: Pointer; dataSize: LongInt; var Texture: GLTexture; fX, fY, fWidth, fHeight: Word; Fmt: PWord=nil): Boolean;
245 var
246 image, ii: PByte;
247 //width, height: Integer;
248 imageSize: Integer;
249 img: TImageData;
250 x, y: Integer;
251 clr: TColor32Rec;
252 begin
253 result := false;
254 if Fmt <> nil then Fmt^ := GL_RGBA; // anyway
256 InitImage(img);
257 if not LoadImageFromMemory(pData, dataSize, img) then
258 begin
259 e_WriteLog('Error loading texture: unknown image format', MSG_WARNING);
260 exit;
261 end;
262 try
263 if (img.width < 1) or (img.width > 32768) or (img.height < 1) or (img.height > 32768) then
264 begin
265 e_WriteLog('Error loading texture: invalid image dimensions', MSG_WARNING);
266 exit;
267 end;
268 //ConvertImage(img, ifA8R8G8B8);
269 if fX > img.width then exit;
270 if fY > img.height then exit;
271 if fX+fWidth > img.width then exit;
272 if fY+fHeight > img.height then exit;
273 //writeln('fX=', fX, '; fY=', fY, '; fWidth=', fWidth, '; fHeight=', fHeight);
274 imageSize := img.width*img.height*4;
275 GetMem(image, imageSize);
276 try
277 // it's slow, but i don't care for now
278 ii := image;
279 for y := fY+fHeight-1 downto fY do
280 begin
281 for x := fX to fX+fWidth-1 do
282 begin
283 clr := GetPixel32(img, x, y);
284 ii^ := clr.r; Inc(ii);
285 ii^ := clr.g; Inc(ii);
286 ii^ := clr.b; Inc(ii);
287 ii^ := clr.a; Inc(ii);
288 end;
289 end;
290 CreateTexture(Texture, fWidth, fHeight, GL_RGBA, image);
291 result := true;
292 finally
293 FreeMem(image);
294 end;
295 finally
296 FreeImage(img);
297 end;
298 end;
301 function LoadTexture (filename: AnsiString; var Texture: GLTexture; var pWidth, pHeight: Word; Fmt: PWord=nil): Boolean;
302 var
303 fs: TStream;
304 img: Pointer;
305 imageSize: LongInt;
306 begin
307 result := False;
308 pWidth := 0;
309 pHeight := 0;
310 if Fmt <> nil then Fmt^ := GL_RGBA; // anyway
311 fs := nil;
313 try
314 fs := openDiskFileRO(filename);
315 except
316 fs := nil;
317 end;
318 if fs = nil then
319 begin
320 e_WriteLog('Texture "'+filename+'" not found', MSG_WARNING);
321 exit;
322 end;
324 try
325 imageSize := fs.size;
326 GetMem(img, imageSize);
327 try
328 fs.readBuffer(img^, imageSize);
329 result := LoadTextureMem(img, imageSize, Texture, pWidth, pHeight, Fmt);
330 finally
331 FreeMem(img);
332 end;
333 finally
334 fs.Free();
335 end;
336 end;
339 function LoadTextureEx (filename: AnsiString; var Texture: GLTexture; fX, fY, fWidth, fHeight: Word; Fmt: PWord=nil): Boolean;
340 var
341 fs: TStream;
342 img: Pointer;
343 imageSize: LongInt;
344 begin
345 result := False;
346 if Fmt <> nil then Fmt^ := GL_RGBA; // anyway
347 fs := nil;
349 try
350 fs := openDiskFileRO(filename);
351 except
352 fs := nil;
353 end;
354 if fs = nil then
355 begin
356 e_WriteLog('Texture "'+filename+'" not found', MSG_WARNING);
357 exit;
358 end;
360 try
361 imageSize := fs.size;
362 GetMem(img, imageSize);
363 try
364 fs.readBuffer(img^, imageSize);
365 result := LoadTextureMemEx(img, imageSize, Texture, fX, fY, fWidth, fHeight, Fmt);
366 finally
367 FreeMem(img);
368 end;
369 finally
370 fs.Free();
371 end;
372 end;
374 end.