DEADSOFTWARE

proofreading
[d2df-editor.git] / src / engine / e_textures.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 e_textures;
18 { This unit provides interface to load 24-bit and 32-bit uncompressed images
19 from Truevision Targa (TGA) graphic files, and create OpenGL textures
20 from it's data. }
22 interface
24 uses
25 GL, GLExt, SysUtils, e_log,
26 ImagingTypes, Imaging, ImagingUtility;
28 type
29 GLTexture = record
30 id: GLuint;
31 width, height: Word; // real
32 glwidth, glheight: Word; // powerof2
33 u, v: Single; // usually 1.0
34 fmt: GLuint;
35 end;
37 var
38 e_DummyTextures: Boolean = False;
39 e_glLegacyNPOT: Boolean = True;
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, 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 begin
79 tex.width := Width;
80 tex.height := Height;
81 tex.glwidth := Width;
82 tex.glheight := Height;
83 tex.u := 1;
84 tex.v := 1;
86 if e_glLegacyNPOT then
87 begin
88 tex.glwidth := AlignP2(Width);
89 tex.glheight := AlignP2(Height);
90 if tex.glwidth <> tex.width then tex.u := (tex.width+0.0)/(tex.glwidth+0.0);
91 if tex.glheight <> tex.height then tex.v := (tex.height+0.0)/(tex.glheight+0.0);
92 end;
94 //if (tex.glwidth <> tex.width) or (tex.glheight <> tex.height) then
95 // 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);
97 if e_DummyTextures then
98 begin
99 tex.id := GLuint(-1);
100 Result := True;
101 Exit;
102 end;
104 glGenTextures(1, @Texture);
105 tex.id := Texture;
106 glBindTexture(GL_TEXTURE_2D, Texture);
108 if (tex.glwidth <> tex.width) or (tex.glheight <> tex.height) then
109 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);
111 // texture blends with object background
112 glTexEnvi( GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_MODULATE);
113 // texture does NOT blend with object background
114 //glTexEnvi(GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_DECAL);
117 Select a filtering type.
118 BiLinear filtering produces very good results with little performance impact
120 GL_NEAREST - Basic texture (grainy looking texture)
121 GL_LINEAR - BiLinear filtering
122 GL_LINEAR_MIPMAP_NEAREST - Basic mipmapped texture
123 GL_LINEAR_MIPMAP_LINEAR - BiLinear Mipmapped texture
126 // for GL_TEXTURE_MAG_FILTER only first two can be used
127 glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_MAG_FILTER, TEXTUREFILTER);
128 // for GL_TEXTURE_MIN_FILTER all of the above can be used
129 glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_MIN_FILTER, TEXTUREFILTER);
131 // create empty texture
132 if aFormat = GL_RGBA then fmt := GL_RGBA else fmt := GL_RGB; // silly, yeah?
133 glTexImage2D(GL_TEXTURE_2D, 0, fmt, tex.glwidth, tex.glheight, 0, GL_RGBA, GL_UNSIGNED_BYTE, nil);
135 (*
136 GetMem(buf, tex.glwidth*4*tex.glheight);
137 try
138 FillChar(buf^, tex.glwidth*4*tex.glheight, 255);
139 glTexSubImage2D(GL_TEXTURE_2D, 0, 0, 0, tex.glwidth, tex.glheight, fmt, GL_UNSIGNED_BYTE, buf);
140 if (tex.glheight = 128) and (tex.height = 80) then
141 begin
142 for f := 0 to tex.glheight-1 do
143 begin
144 for c := 0 to tex.glwidth-1 do
145 begin
146 buf[f*(tex.glwidth*4)+c*4+0] := 255;
147 buf[f*(tex.glwidth*4)+c*4+1] := 127;
148 buf[f*(tex.glwidth*4)+c*4+2] := 0;
149 end;
150 end;
151 glTexSubImage2D(GL_TEXTURE_2D, 0, 0, 82, tex.glwidth, {tex.glheight}1, fmt, GL_UNSIGNED_BYTE, buf);
152 end;
153 finally
154 FreeMem(buf);
155 end;
156 *)
158 glTexSubImage2D(GL_TEXTURE_2D, 0, 0, 0, Width, Height, fmt, GL_UNSIGNED_BYTE, pData);
159 //glTexSubImage2D(GL_TEXTURE_2D, 0, 0, tex.glheight-tex.height, Width, Height, fmt, GL_UNSIGNED_BYTE, pData);
161 glBindTexture(GL_TEXTURE_2D, 0);
163 Result := true;
164 end;
166 // `img` must be valid!
167 function LoadTextureImg (var img: TImageData; var Texture: GLTexture; var pWidth, pHeight: Word; Fmt: PWord=nil): Boolean;
168 var
169 image, ii: PByte;
170 width, height: Integer;
171 imageSize: Integer;
172 x, y: Integer;
173 clr: TColor32Rec;
174 begin
175 result := false;
176 pWidth := 0;
177 pHeight := 0;
178 if Fmt <> nil then Fmt^ := GL_RGBA; // anyway
180 if (img.width < 1) or (img.width > 32768) or (img.height < 1) or (img.height > 32768) then
181 begin
182 e_WriteLog('Error loading texture: invalid image dimensions', MSG_WARNING);
183 exit;
184 end;
185 //ConvertImage(img, ifA8R8G8B8);
186 width := img.width;
187 height := img.height;
188 pWidth := width;
189 pHeight := height;
190 imageSize := Width*Height*4;
191 GetMem(image, imageSize);
192 try
193 // it's slow, but i don't care for now
194 ii := image;
195 for y := height-1 downto 0 do
196 begin
197 for x := 0 to width-1 do
198 begin
199 clr := GetPixel32(img, x, y);
200 ii^ := clr.r; Inc(ii);
201 ii^ := clr.g; Inc(ii);
202 ii^ := clr.b; Inc(ii);
203 ii^ := clr.a; Inc(ii);
204 end;
205 end;
206 CreateTexture(Texture, width, height, GL_RGBA, image);
207 result := true;
208 finally
209 FreeMem(image);
210 end;
211 end;
214 function LoadTextureMem (pData: Pointer; dataSize: LongInt; var Texture: GLTexture; var pWidth, pHeight: Word; Fmt: PWord=nil): Boolean;
215 var
216 img: TImageData;
217 begin
218 result := false;
219 pWidth := 0;
220 pHeight := 0;
221 if Fmt <> nil then Fmt^ := GL_RGBA; // anyway
223 InitImage(img);
224 if not LoadImageFromMemory(pData, dataSize, img) then
225 begin
226 e_WriteLog('Error loading texture: unknown image format', MSG_WARNING);
227 exit;
228 end;
229 try
230 result := LoadTextureImg(img, Texture, pWidth, pHeight, Fmt);
231 finally
232 FreeImage(img);
233 end;
234 end;
237 function LoadTextureMemEx (pData: Pointer; dataSize: LongInt; var Texture: GLTexture; fX, fY, fWidth, fHeight: Word; Fmt: PWord=nil): Boolean;
238 var
239 image, ii: PByte;
240 imageSize: Integer;
241 img: TImageData;
242 x, y: Integer;
243 clr: TColor32Rec;
244 begin
245 result := false;
246 if Fmt <> nil then Fmt^ := GL_RGBA; // anyway
248 InitImage(img);
249 if not LoadImageFromMemory(pData, dataSize, img) then
250 begin
251 e_WriteLog('Error loading texture: unknown image format', MSG_WARNING);
252 exit;
253 end;
254 try
255 if (img.width < 1) or (img.width > 32768) or (img.height < 1) or (img.height > 32768) then
256 begin
257 e_WriteLog('Error loading texture: invalid image dimensions', MSG_WARNING);
258 exit;
259 end;
260 //ConvertImage(img, ifA8R8G8B8);
261 if fX > img.width then exit;
262 if fY > img.height then exit;
263 if fX+fWidth > img.width then exit;
264 if fY+fHeight > img.height then exit;
265 //writeln('fX=', fX, '; fY=', fY, '; fWidth=', fWidth, '; fHeight=', fHeight);
266 imageSize := img.width*img.height*4;
267 GetMem(image, imageSize);
268 try
269 // it's slow, but i don't care for now
270 ii := image;
271 for y := fY+fHeight-1 downto fY do
272 begin
273 for x := fX to fX+fWidth-1 do
274 begin
275 clr := GetPixel32(img, x, y);
276 ii^ := clr.r; Inc(ii);
277 ii^ := clr.g; Inc(ii);
278 ii^ := clr.b; Inc(ii);
279 ii^ := clr.a; Inc(ii);
280 end;
281 end;
282 CreateTexture(Texture, fWidth, fHeight, GL_RGBA, image);
283 result := true;
284 finally
285 FreeMem(image);
286 end;
287 finally
288 FreeImage(img);
289 end;
290 end;
293 function LoadTexture (filename: AnsiString; var Texture: GLTexture; var pWidth, pHeight: Word; Fmt: PWord=nil): Boolean;
294 var
295 fs: TStream;
296 img: Pointer;
297 imageSize: LongInt;
298 begin
299 result := False;
300 pWidth := 0;
301 pHeight := 0;
302 if Fmt <> nil then Fmt^ := GL_RGBA; // anyway
303 fs := nil;
305 try
306 fs := openDiskFileRO(filename);
307 except
308 fs := nil;
309 end;
310 if fs = nil then
311 begin
312 e_WriteLog('Texture "'+filename+'" not found', MSG_WARNING);
313 exit;
314 end;
316 try
317 imageSize := fs.size;
318 GetMem(img, imageSize);
319 try
320 fs.readBuffer(img^, imageSize);
321 result := LoadTextureMem(img, imageSize, Texture, pWidth, pHeight, Fmt);
322 finally
323 FreeMem(img);
324 end;
325 finally
326 fs.Free();
327 end;
328 end;
331 function LoadTextureEx (filename: AnsiString; var Texture: GLTexture; fX, fY, fWidth, fHeight: Word; Fmt: PWord=nil): Boolean;
332 var
333 fs: TStream;
334 img: Pointer;
335 imageSize: LongInt;
336 begin
337 result := False;
338 if Fmt <> nil then Fmt^ := GL_RGBA; // anyway
339 fs := nil;
341 try
342 fs := openDiskFileRO(filename);
343 except
344 fs := nil;
345 end;
346 if fs = nil then
347 begin
348 e_WriteLog('Texture "'+filename+'" not found', MSG_WARNING);
349 exit;
350 end;
352 try
353 imageSize := fs.size;
354 GetMem(img, imageSize);
355 try
356 fs.readBuffer(img^, imageSize);
357 result := LoadTextureMemEx(img, imageSize, Texture, fX, fY, fWidth, fHeight, Fmt);
358 finally
359 FreeMem(img);
360 end;
361 finally
362 fs.Free();
363 end;
364 end;
366 end.