DEADSOFTWARE

add build info
[d2df-editor.git] / src / editor / g_textures.pas
1 unit g_textures;
3 {$INCLUDE ../shared/a_modes.inc}
5 interface
7 uses LCLIntf, LCLType, LMessages, e_graphics, utils;
9 function g_SimpleCreateTextureWAD(var ID: DWORD; Resource: string): Boolean;
10 function g_SimpleCreateTextureWADSize(var ID: DWORD; Resource: string;
11 X, Y, Width, Height: Word): Boolean;
13 function g_CreateTextureWAD(TextureName: ShortString; Resource: string; flag: Byte = 0): Boolean;
14 function g_CreateTextureWADSize(TextureName: ShortString; Resource: string;
15 X, Y, Width, Height: Word; flag: Byte = 0): Boolean;
16 function g_CreateTextureMemorySize(pData: Pointer; dataLen: Integer; Name: ShortString; X, Y,
17 Width, Height: Word; flag: Byte = 0): Boolean;
19 function g_GetTexture(TextureName: ShortString; var ID: DWORD): Boolean;
20 function g_GetTextureFlagByName(TextureName: ShortString): Byte;
21 function g_GetTextureFlagByID(ID: DWORD): Byte;
22 procedure g_GetTextureSizeByName(TextureName: ShortString; var Width, Height: Word);
23 procedure g_GetTextureSizeByID(ID: DWORD; var Width, Height: Word);
25 procedure g_DeleteTexture(TextureName: ShortString);
26 procedure g_DeleteAllTextures();
28 implementation
30 uses
31 e_log, WADEDITOR, g_basic, SysUtils, g_resources;
33 type
34 _TTexture = record
35 Name: ShortString;
36 ID: DWORD;
37 Width, Height: Word;
38 flag: Byte;
39 end;
41 var
42 TexturesArray: array of _TTexture = nil;
44 function FindTexture: DWORD;
45 var
46 i: integer;
47 begin
48 if TexturesArray <> nil then
49 for i := 0 to High(TexturesArray) do
50 if TexturesArray[i].Name = '' then
51 begin
52 Result := i;
53 Exit;
54 end;
56 if TexturesArray = nil then
57 begin
58 SetLength(TexturesArray, 8);
59 Result := 0;
60 end
61 else
62 begin
63 Result := High(TexturesArray) + 1;
64 SetLength(TexturesArray, Length(TexturesArray) + 8);
65 end;
66 end;
68 function g_SimpleCreateTextureWAD (var ID: DWORD; Resource: string): Boolean;
69 var
70 TextureData: Pointer;
71 ResourceLength: Integer;
72 FileName, SectionName, ResourceName: string;
73 begin
74 Result := False;
75 g_ProcessResourceStr(Resource, FileName, SectionName, ResourceName);
76 g_ReadResource(FileName, SectionName, ResourceName, TextureData, ResourceLength);
77 if TextureData <> nil then
78 begin
79 if e_CreateTextureMem(TextureData, ResourceLength, ID) then
80 Result := True;
81 FreeMem(TextureData)
82 end
83 else
84 begin
85 e_WriteLog(Format('Error loading texture %s', [Resource]), MSG_WARNING)
86 //e_WriteLog(Format('WAD Reader error: %s', [WAD.GetLastErrorStr]), MSG_WARNING);
87 end;
88 end;
90 function g_CreateTextureMemorySize(pData: Pointer; dataLen: Integer; Name: ShortString; X, Y,
91 Width, Height: Word; flag: Byte = 0): Boolean;
92 var
93 find_id: DWORD;
94 begin
95 Result := False;
96 if pData = nil then
97 Exit;
99 find_id := FindTexture;
101 if not e_CreateTextureMemEx(pData, dataLen, TexturesArray[find_id].ID, X, Y, Width, Height) then
102 begin
103 FreeMem(pData);
104 Exit;
105 end;
107 TexturesArray[find_id].Width := Width;
108 TexturesArray[find_id].Height := Height;
109 TexturesArray[find_id].Name := Name;
110 TexturesArray[find_id].flag := flag;
112 FreeMem(pData);
114 Result := True;
115 end;
117 function g_CreateTextureWAD(TextureName: ShortString; Resource: string; flag: Byte = 0): Boolean;
118 var
119 TextureData: Pointer;
120 ResourceLength: Integer;
121 FileName, SectionName, ResourceName: string;
122 find_id: DWORD;
123 begin
124 find_id := FindTexture;
125 g_ProcessResourceStr(Resource, FileName, SectionName, ResourceName);
126 g_ReadResource(FileName, SectionName, ResourceName, TextureData, ResourceLength);
127 if TextureData <> nil then
128 begin
129 Result := e_CreateTextureMem(TextureData, ResourceLength, TexturesArray[find_id].ID);
130 FreeMem(TextureData);
131 if Result then
132 begin
133 e_GetTextureSize(
134 TexturesArray[find_id].ID,
135 @TexturesArray[find_id].Width,
136 @TexturesArray[find_id].Height
137 );
138 TexturesArray[find_id].Name := TextureName;
139 TexturesArray[find_id].flag := flag
140 end
141 end
142 else
143 begin
144 e_WriteLog(Format('Error loading texture %s', [Resource]), MSG_WARNING);
145 //e_WriteLog(Format('WAD Reader error: %s', [WAD.GetLastErrorStr]), MSG_WARNING);
146 Result := False
147 end
148 end;
150 function g_SimpleCreateTextureWADSize(var ID: DWORD; Resource: String; X, Y, Width, Height: Word): Boolean;
151 var
152 TextureData: Pointer;
153 ResourceLength: Integer;
154 FileName, SectionName, ResourceName: String;
155 begin
156 Result := False;
157 g_ProcessResourceStr(Resource, FileName, SectionName, ResourceName);
158 g_ReadResource(FileName, SectionName, ResourceName, TextureData, ResourceLength);
159 if TextureData <> nil then
160 begin
161 if e_CreateTextureMemEx(TextureData, ResourceLength, ID, X, Y, Width, Height) then
162 Result := True;
163 FreeMem(TextureData)
164 end
165 else
166 begin
167 e_WriteLog(Format('Error loading texture %s', [Resource]), MSG_WARNING)
168 //e_WriteLog(Format('WAD Reader error: %s', [WAD.GetLastErrorStr]), MSG_WARNING)
169 end
170 end;
172 function g_CreateTextureWADSize(TextureName: ShortString; Resource: String; X, Y, Width, Height: Word; flag: Byte = 0): Boolean;
173 var
174 TextureData: Pointer;
175 ResourceLength: Integer;
176 FileName, SectionName, ResourceName: String;
177 find_id: DWORD;
178 begin
179 find_id := FindTexture;
180 g_ProcessResourceStr(Resource, FileName, SectionName, ResourceName);
181 g_ReadResource(FileName, SectionName, ResourceName, TextureData, ResourceLength);
182 if TextureData <> nil then
183 begin
184 Result := e_CreateTextureMemEx(TextureData, ResourceLength, TexturesArray[find_id].ID, X, Y, Width, Height);
185 FreeMem(TextureData);
186 if Result then
187 begin
188 TexturesArray[find_id].Width := Width;
189 TexturesArray[find_id].Height := Height;
190 TexturesArray[find_id].Name := TextureName;
191 TexturesArray[find_id].flag := flag
192 end
193 end
194 else
195 begin
196 e_WriteLog(Format('Error loading texture %s', [Resource]), MSG_WARNING);
197 //e_WriteLog(Format('WAD Reader error: %s', [WAD.GetLastErrorStr]), MSG_WARNING);
198 Result := False
199 end
200 end;
202 function g_GetTexture(TextureName: ShortString; var ID: DWORD): Boolean;
203 var
204 a: DWORD;
205 begin
206 Result := False;
208 if TexturesArray = nil then Exit;
210 if TextureName = '' then Exit;
212 for a := 0 to High(TexturesArray) do
213 if TexturesArray[a].Name = TextureName then
214 begin
215 ID := TexturesArray[a].ID;
216 Result := True;
217 Break;
218 end;
219 end;
221 function g_GetTextureFlagByName(TextureName: ShortString): Byte;
222 var
223 ID: DWORD;
224 begin
225 Result := 0;
227 if not g_GetTexture(TextureName, ID) then Exit;
229 Result := TexturesArray[ID].flag;
230 end;
232 function g_GetTextureFlagByID(ID: DWORD): Byte;
233 begin
234 Result := TexturesArray[ID].flag;
235 end;
237 procedure g_GetTextureSizeByName(TextureName: ShortString; var Width, Height: Word);
238 var
239 ID: DWORD;
240 begin
241 Width := 0;
242 Height := 0;
244 if not g_GetTexture(TextureName, ID) then Exit;
246 e_GetTextureSize(ID, @Width, @Height);
247 end;
249 procedure g_GetTextureSizeByID(ID: DWORD; var Width, Height: Word);
250 begin
251 e_GetTextureSize(ID, @Width, @Height);
252 end;
254 procedure g_DeleteTexture(TextureName: ShortString);
255 var
256 a: DWORD;
257 begin
258 if TexturesArray = nil then Exit;
260 for a := 0 to High(TexturesArray) do
261 if TexturesArray[a].Name = TextureName then
262 begin
263 e_DeleteTexture(TexturesArray[a].ID);
264 TexturesArray[a].Name := '';
265 TexturesArray[a].ID := 0;
266 TexturesArray[a].Width := 0;
267 TexturesArray[a].Height := 0;
268 end;
269 end;
271 procedure g_DeleteAllTextures;
272 var
273 a: DWORD;
274 begin
275 if TexturesArray = nil then Exit;
277 for a := 0 to High(TexturesArray) do
278 if TexturesArray[a].Name <> '' then
279 e_DeleteTexture(TexturesArray[a].ID);
281 TexturesArray := nil;
282 end;
284 end.