DEADSOFTWARE

Console: Automatically save console variables
[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 {$INCLUDE ../nogl/noGLuses.inc}
27 SysUtils, e_log, 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, 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]), TMsgType.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 // so driver will really upload the texture (this is *sometimes* required for buggy videodrivers)
166 glFlush();
167 glFinish();
169 Result := true;
170 end;
172 // `img` must be valid!
173 function LoadTextureImg (var img: TImageData; var Texture: GLTexture; var pWidth, pHeight: Word; Fmt: PWord=nil): Boolean;
174 var
175 image, ii: PByte;
176 width, height: Integer;
177 imageSize: Integer;
178 x, y: Integer;
179 clr: TColor32Rec;
180 begin
181 result := false;
182 pWidth := 0;
183 pHeight := 0;
184 if Fmt <> nil then Fmt^ := GL_RGBA; // anyway
186 if (img.width < 1) or (img.width > 32768) or (img.height < 1) or (img.height > 32768) then
187 begin
188 e_WriteLog('Error loading texture: invalid image dimensions', TMsgType.Warning);
189 exit;
190 end;
191 //ConvertImage(img, ifA8R8G8B8);
192 width := img.width;
193 height := img.height;
194 pWidth := width;
195 pHeight := height;
196 imageSize := Width*Height*4;
197 GetMem(image, imageSize);
198 try
199 // it is slow, but i don't care for now
200 ii := image;
201 for y := height-1 downto 0 do
202 begin
203 for x := 0 to width-1 do
204 begin
205 clr := GetPixel32(img, x, y);
206 ii^ := clr.r; Inc(ii);
207 ii^ := clr.g; Inc(ii);
208 ii^ := clr.b; Inc(ii);
209 ii^ := clr.a; Inc(ii);
210 end;
211 end;
212 CreateTexture(Texture, width, height, GL_RGBA, image);
213 result := true;
214 finally
215 FreeMem(image);
216 end;
217 end;
220 function LoadTextureMem (pData: Pointer; dataSize: LongInt; var Texture: GLTexture; var pWidth, pHeight: Word; Fmt: PWord=nil): Boolean;
221 var
222 //image, ii: PByte;
223 //width, height: Integer;
224 //imageSize: Integer;
225 img: TImageData;
226 //x, y: Integer;
227 //clr: TColor32Rec;
228 begin
229 result := false;
230 pWidth := 0;
231 pHeight := 0;
232 if Fmt <> nil then Fmt^ := GL_RGBA; // anyway
234 InitImage(img);
235 if not LoadImageFromMemory(pData, dataSize, img) then
236 begin
237 e_WriteLog('Error loading texture: unknown image format', TMsgType.Warning);
238 exit;
239 end;
240 try
241 result := LoadTextureImg(img, Texture, pWidth, pHeight, Fmt);
242 finally
243 FreeImage(img);
244 end;
245 end;
248 function LoadTextureMemEx (pData: Pointer; dataSize: LongInt; var Texture: GLTexture; fX, fY, fWidth, fHeight: Word; Fmt: PWord=nil): Boolean;
249 var
250 image, ii: PByte;
251 //width, height: Integer;
252 imageSize: Integer;
253 img: TImageData;
254 x, y: Integer;
255 clr: TColor32Rec;
256 begin
257 result := false;
258 if Fmt <> nil then Fmt^ := GL_RGBA; // anyway
260 InitImage(img);
261 if not LoadImageFromMemory(pData, dataSize, img) then
262 begin
263 e_WriteLog('Error loading texture: unknown image format', TMsgType.Warning);
264 exit;
265 end;
266 try
267 if (img.width < 1) or (img.width > 32768) or (img.height < 1) or (img.height > 32768) then
268 begin
269 e_WriteLog('Error loading texture: invalid image dimensions', TMsgType.Warning);
270 exit;
271 end;
272 //ConvertImage(img, ifA8R8G8B8);
273 if fX > img.width then exit;
274 if fY > img.height then exit;
275 if fX+fWidth > img.width then exit;
276 if fY+fHeight > img.height then exit;
277 //writeln('fX=', fX, '; fY=', fY, '; fWidth=', fWidth, '; fHeight=', fHeight);
278 imageSize := img.width*img.height*4;
279 GetMem(image, imageSize);
280 try
281 // it is slow, but i don't care for now
282 ii := image;
283 for y := fY+fHeight-1 downto fY do
284 begin
285 for x := fX to fX+fWidth-1 do
286 begin
287 clr := GetPixel32(img, x, y);
288 ii^ := clr.r; Inc(ii);
289 ii^ := clr.g; Inc(ii);
290 ii^ := clr.b; Inc(ii);
291 ii^ := clr.a; Inc(ii);
292 end;
293 end;
294 CreateTexture(Texture, fWidth, fHeight, GL_RGBA, image);
295 result := true;
296 finally
297 FreeMem(image);
298 end;
299 finally
300 FreeImage(img);
301 end;
302 end;
305 function LoadTexture (filename: AnsiString; var Texture: GLTexture; var pWidth, pHeight: Word; Fmt: PWord=nil): Boolean;
306 var
307 fs: TStream;
308 img: Pointer;
309 imageSize: LongInt;
310 begin
311 result := False;
312 pWidth := 0;
313 pHeight := 0;
314 if Fmt <> nil then Fmt^ := GL_RGBA; // anyway
315 fs := nil;
317 try
318 fs := openDiskFileRO(filename);
319 except
320 fs := nil;
321 end;
322 if fs = nil then
323 begin
324 e_WriteLog('Texture "'+filename+'" not found', TMsgType.Warning);
325 exit;
326 end;
328 try
329 imageSize := fs.size;
330 GetMem(img, imageSize);
331 try
332 fs.readBuffer(img^, imageSize);
333 result := LoadTextureMem(img, imageSize, Texture, pWidth, pHeight, Fmt);
334 finally
335 FreeMem(img);
336 end;
337 finally
338 fs.Free();
339 end;
340 end;
343 function LoadTextureEx (filename: AnsiString; var Texture: GLTexture; fX, fY, fWidth, fHeight: Word; Fmt: PWord=nil): Boolean;
344 var
345 fs: TStream;
346 img: Pointer;
347 imageSize: LongInt;
348 begin
349 result := False;
350 if Fmt <> nil then Fmt^ := GL_RGBA; // anyway
351 fs := nil;
353 try
354 fs := openDiskFileRO(filename);
355 except
356 fs := nil;
357 end;
358 if fs = nil then
359 begin
360 e_WriteLog('Texture "'+filename+'" not found', TMsgType.Warning);
361 exit;
362 end;
364 try
365 imageSize := fs.size;
366 GetMem(img, imageSize);
367 try
368 fs.readBuffer(img^, imageSize);
369 result := LoadTextureMemEx(img, imageSize, Texture, fX, fY, fWidth, fHeight, Fmt);
370 finally
371 FreeMem(img);
372 end;
373 finally
374 fs.Free();
375 end;
376 end;
378 end.