DEADSOFTWARE

svrlist: fix local server ip decoding on big endian machines
[d2df-sdl.git] / src / game / g_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 g_textures;
18 interface
20 uses
21 SysUtils, Classes,
22 {$IFDEF USE_MEMPOOL}mempool,{$ENDIF}
23 e_graphics, MAPDEF, ImagingTypes, Imaging, ImagingUtility;
25 type
26 TLevelTexture = record
27 textureName: AnsiString;
28 width, height: Word;
29 case anim: Boolean of
30 false: (textureID: LongWord);
31 true: (framesID: LongWord; framesCount: Byte; speed: Byte);
32 end;
34 TLevelTextureArray = array of TLevelTexture;
36 TAnimation = class{$IFDEF USE_MEMPOOL}(TPoolObject){$ENDIF}
37 private
38 mId: LongWord;
39 mAlpha: Byte;
40 mBlending: Boolean;
41 mCounter: Byte; // Ñ÷åò÷èê îæèäàíèÿ ìåæäó êàäðàìè
42 mSpeed: Byte; // Âðåìÿ îæèäàíèÿ ìåæäó êàäðàìè
43 mCurrentFrame: Integer; // Òåêóùèé êàäð (íà÷èíàÿ ñ 0)
44 mLoop: Boolean; // Ïåðåõîäèòü íà ïåðâûé êàäð ïîñëå ïîñëåäíåãî?
45 mEnabled: Boolean; // Ðàáîòà ðàçðåøåíà?
46 mPlayed: Boolean; // Ïðîèãðàíà âñÿ õîòÿ áû ðàç?
47 mHeight: Word;
48 mWidth: Word;
49 mMinLength: Byte; // Îæèäàíèå ïîñëå ïðîèãðûâàíèÿ
50 mRevert: Boolean; // Ñìåíà êàäðîâ îáðàòíàÿ?
52 public
53 constructor Create (aframesID: LongWord; aloop: Boolean; aspeed: Byte);
54 destructor Destroy (); override;
56 procedure draw (x, y: Integer; mirror: TMirrorType);
57 procedure drawEx (x, y: Integer; mirror: TMirrorType; rpoint: TDFPoint; angle: SmallInt);
59 procedure reset ();
60 procedure update ();
61 procedure enable ();
62 procedure disable ();
63 procedure revert (r: Boolean);
65 procedure saveState (st: TStream);
66 procedure loadState (st: TStream);
68 function totalFrames (): Integer; inline;
70 public
71 property played: Boolean read mPlayed;
72 property enabled: Boolean read mEnabled;
73 property isReverse: Boolean read mRevert;
74 property loop: Boolean read mLoop write mLoop;
75 property speed: Byte read mSpeed write mSpeed;
76 property minLength: Byte read mMinLength write mMinLength;
77 property currentFrame: Integer read mCurrentFrame write mCurrentFrame;
78 property currentCounter: Byte read mCounter write mCounter;
79 property counter: Byte read mCounter;
80 property blending: Boolean read mBlending write mBlending;
81 property alpha: Byte read mAlpha write mAlpha;
82 property framesId: LongWord read mId;
83 property width: Word read mWidth;
84 property height: Word read mHeight;
85 end;
88 function g_Texture_CreateWAD (var ID: LongWord; const Resource: AnsiString): Boolean;
89 function g_Texture_CreateFile (var ID: LongWord; const FileName: AnsiString): Boolean;
90 function g_Texture_CreateWADEx (const textureName, Resource: AnsiString): Boolean;
91 function g_Texture_CreateFileEx (const textureName, FileName: AnsiString): Boolean;
92 function g_Texture_Get (const textureName: AnsiString; var ID: LongWord): Boolean;
93 function g_Texture_GetSize (const textureName: AnsiString; var w, h: Integer): Boolean; overload;
94 function g_Texture_GetSize (ID: LongWord; var w, h: Integer): Boolean; overload;
95 procedure g_Texture_Delete (const textureName: AnsiString);
96 procedure g_Texture_DeleteAll ();
98 function g_CreateFramesImg (ia: TDynImageDataArray; ID: PDWORD; const Name: AnsiString; BackAnimation: Boolean=false): Boolean;
100 function g_Frames_CreateWAD (ID: PDWORD; const Name, Resource: AnsiString; mWidth, mHeight, mCount: Word; BackAnimation: Boolean=false): Boolean;
101 function g_Frames_CreateFile (ID: PDWORD; const Name, FileName: AnsiString; mWidth, mHeight, mCount: Word; BackAnimation: Boolean=false): Boolean;
102 function g_Frames_CreateMemory (ID: PDWORD; const Name: AnsiString; pData: Pointer; dataSize: LongInt;
103 mWidth, mHeight, mCount: Word; BackAnimation: Boolean=false): Boolean;
104 function g_Frames_Dup (const NewName, OldName: AnsiString): Boolean;
105 //function g_Frames_CreateRevert(ID: PDWORD; Name: ShortString; Frames: string): Boolean;
106 function g_Frames_Get (out ID: LongWord; const FramesName: AnsiString): Boolean;
107 function g_Frames_GetTexture (out ID: LongWord; const FramesName: AnsiString; Frame: Word): Boolean;
108 function g_Frames_Exists (const FramesName: AnsiString): Boolean;
109 procedure g_Frames_DeleteByName (const FramesName: AnsiString);
110 procedure g_Frames_DeleteByID (ID: LongWord);
111 procedure g_Frames_DeleteAll ();
113 procedure DumpTextureNames ();
115 function g_Texture_Light (): Integer;
118 implementation
120 uses
121 {$INCLUDE ../nogl/noGLuses.inc}
122 g_game, e_log, g_basic, g_console, wadreader,
123 g_language, utils, xstreams;
125 type
126 _TTexture = record
127 name: AnsiString;
128 id: LongWord;
129 width, height: Word;
130 used: Boolean;
131 end;
133 TFrames = record
134 texturesID: array of LongWord;
135 name: AnsiString;
136 frameWidth, frameHeight: Word;
137 used: Boolean;
138 end;
140 var
141 texturesArray: array of _TTexture = nil;
142 framesArray: array of TFrames = nil;
145 const
146 ANIM_SIGNATURE = $4D494E41; // 'ANIM'
149 function allocTextureSlot (): LongWord;
150 var
151 f: integer;
152 begin
153 for f := 0 to High(texturesArray) do
154 begin
155 if (not texturesArray[f].used) then
156 begin
157 result := f;
158 exit;
159 end;
160 end;
162 result := Length(texturesArray);
163 SetLength(texturesArray, result+64);
164 for f := result to High(texturesArray) do
165 begin
166 with texturesArray[f] do
167 begin
168 name := '';
169 id := 0;
170 width := 0;
171 height := 0;
172 used := false;
173 end;
174 end;
175 end;
178 function allocFrameSlot (): LongWord;
179 var
180 f: integer;
181 begin
182 for f := 0 to High(framesArray) do
183 begin
184 if (not framesArray[f].used) then
185 begin
186 result := f;
187 exit;
188 end;
189 end;
191 result := Length(framesArray);
192 SetLength(framesArray, result+64);
193 for f := result to High(framesArray) do
194 begin
195 with framesArray[f] do
196 begin
197 texturesID := nil;
198 name := '';
199 frameWidth := 0;
200 frameHeight := 0;
201 used := false;
202 end;
203 end;
204 end;
207 // ////////////////////////////////////////////////////////////////////////// //
208 function g_Texture_CreateWAD (var ID: LongWord; const Resource: AnsiString): Boolean;
209 var
210 WAD: TWADFile;
211 FileName: AnsiString;
212 TextureData: Pointer;
213 ResourceLength: Integer;
214 begin
215 result := false;
216 FileName := g_ExtractWadName(Resource);
218 WAD := TWADFile.Create;
219 WAD.ReadFile(FileName);
221 if WAD.GetResource(g_ExtractFilePathName(Resource), TextureData, ResourceLength) then
222 begin
223 if e_CreateTextureMem(TextureData, ResourceLength, ID) then
224 result := true;
225 FreeMem(TextureData)
226 end
227 else
228 begin
229 e_WriteLog(Format('Error loading texture %s', [Resource]), TMsgType.Warning);
230 //e_WriteLog(Format('WAD Reader error: %s', [WAD.GetLastErrorStr]), MSG_WARNING);
231 end;
232 WAD.Free();
233 end;
236 function g_Texture_CreateFile (var ID: LongWord; const FileName: AnsiString): Boolean;
237 begin
238 result := true;
239 if not e_CreateTexture(FileName, ID) then
240 begin
241 e_WriteLog(Format('Error loading texture %s', [FileName]), TMsgType.Warning);
242 result := false;
243 end;
244 end;
247 function g_Texture_CreateWADEx (const textureName, Resource: AnsiString): Boolean;
248 var
249 WAD: TWADFile;
250 FileName: AnsiString;
251 TextureData: Pointer;
252 find_id: LongWord;
253 ResourceLength: Integer;
254 begin
255 FileName := g_ExtractWadName(Resource);
257 find_id := allocTextureSlot();
259 WAD := TWADFile.Create;
260 WAD.ReadFile(FileName);
262 if WAD.GetResource(g_ExtractFilePathName(Resource), TextureData, ResourceLength) then
263 begin
264 result := e_CreateTextureMem(TextureData, ResourceLength, texturesArray[find_id].ID);
265 if result then
266 begin
267 e_GetTextureSize(texturesArray[find_id].ID, @texturesArray[find_id].width, @texturesArray[find_id].height);
268 texturesArray[find_id].used := true;
269 texturesArray[find_id].Name := textureName;
270 end;
271 FreeMem(TextureData)
272 end
273 else
274 begin
275 e_WriteLog(Format('Error loading texture %s', [Resource]), TMsgType.Warning);
276 //e_WriteLog(Format('WAD Reader error: %s', [WAD.GetLastErrorStr]), MSG_WARNING);
277 result := false;
278 end;
279 WAD.Free();
280 end;
283 function g_Texture_CreateFileEx (const textureName, FileName: AnsiString): Boolean;
284 var
285 find_id: LongWord;
286 begin
287 find_id := allocTextureSlot();
288 result := e_CreateTexture(FileName, texturesArray[find_id].ID);
289 if result then
290 begin
291 texturesArray[find_id].used := true;
292 texturesArray[find_id].Name := textureName;
293 e_GetTextureSize(texturesArray[find_id].ID, @texturesArray[find_id].width, @texturesArray[find_id].height);
294 end
295 else e_WriteLog(Format('Error loading texture %s', [FileName]), TMsgType.Warning);
296 end;
299 function g_Texture_Get (const textureName: AnsiString; var id: LongWord): Boolean;
300 var
301 a: Integer;
302 begin
303 result := false;
304 if (Length(texturesArray) = 0) or (Length(textureName) = 0) then exit;
305 for a := 0 to High(texturesArray) do
306 begin
307 if (StrEquCI1251(texturesArray[a].name, textureName)) then
308 begin
309 id := texturesArray[a].id;
310 result := true;
311 break;
312 end;
313 end;
314 //if not Result then g_ConsoleAdd('Texture '+TextureName+' not found');
315 end;
318 function g_Texture_GetSize (const textureName: AnsiString; var w, h: Integer): Boolean; overload;
319 var
320 a: Integer;
321 begin
322 result := false;
323 w := 0;
324 h := 0;
325 if (Length(texturesArray) = 0) or (Length(textureName) = 0) then exit;
326 for a := 0 to High(texturesArray) do
327 begin
328 if (StrEquCI1251(texturesArray[a].name, textureName)) then
329 begin
330 w := texturesArray[a].width;
331 h := texturesArray[a].height;
332 result := true;
333 break;
334 end;
335 end;
336 end;
339 function g_Texture_GetSize (ID: LongWord; var w, h: Integer): Boolean; overload;
340 var
341 a: Integer;
342 begin
343 result := false;
344 w := 0;
345 h := 0;
346 if (Length(texturesArray) = 0) then exit;
347 for a := 0 to High(texturesArray) do
348 begin
349 if (texturesArray[a].id = ID) then
350 begin
351 w := texturesArray[a].width;
352 h := texturesArray[a].height;
353 result := true;
354 break;
355 end;
356 end;
357 end;
360 procedure g_Texture_Delete (const textureName: AnsiString);
361 var
362 a: Integer;
363 begin
364 if (Length(texturesArray) = 0) or (Length(textureName) = 0) then exit;
365 for a := 0 to High(texturesArray) do
366 begin
367 if (StrEquCI1251(texturesArray[a].name, textureName)) then
368 begin
369 e_DeleteTexture(texturesArray[a].ID);
370 texturesArray[a].used := false;
371 texturesArray[a].name := '';
372 texturesArray[a].id := 0;
373 texturesArray[a].width := 0;
374 texturesArray[a].height := 0;
375 end;
376 end;
377 end;
380 procedure g_Texture_DeleteAll ();
381 var
382 a: Integer;
383 begin
384 for a := 0 to High(texturesArray) do
385 begin
386 if (texturesArray[a].used) then e_DeleteTexture(texturesArray[a].ID);
387 end;
388 texturesArray := nil;
389 end;
392 function g_Frames_CreateFile (ID: PDWORD; const Name, FileName: AnsiString;
393 mWidth, mHeight, mCount: Word; BackAnimation: Boolean = false): Boolean;
394 var
395 a: Integer;
396 find_id: LongWord;
397 begin
398 result := false;
400 find_id := allocFrameSlot();
402 if (mCount <= 2) then BackAnimation := false;
404 if BackAnimation then SetLength(framesArray[find_id].TexturesID, mCount+mCount-2)
405 else SetLength(framesArray[find_id].TexturesID, mCount);
407 for a := 0 to mCount-1 do
408 begin
409 if not e_CreateTextureEx(FileName, framesArray[find_id].TexturesID[a], a*mWidth, 0, mWidth, mHeight) then exit;
410 end;
412 if BackAnimation then
413 begin
414 for a := 1 to mCount-2 do framesArray[find_id].TexturesID[mCount+mCount-2-a] := framesArray[find_id].TexturesID[a];
415 end;
417 framesArray[find_id].used := true;
418 framesArray[find_id].FrameWidth := mWidth;
419 framesArray[find_id].FrameHeight := mHeight;
420 if (Name <> '') then framesArray[find_id].Name := Name else framesArray[find_id].Name := '<noname>';
422 if (ID <> nil) then ID^ := find_id;
424 result := true;
425 end;
428 function CreateFramesMem (pData: Pointer; dataSize: LongInt; ID: PDWORD; Name: AnsiString;
429 mWidth, mHeight, mCount: Word; BackAnimation: Boolean = false): Boolean;
430 var
431 find_id: LongWord;
432 a: Integer;
433 begin
434 result := false;
436 find_id := allocFrameSlot();
438 if (mCount <= 2) then BackAnimation := false;
440 if BackAnimation then SetLength(framesArray[find_id].TexturesID, mCount+mCount-2)
441 else SetLength(framesArray[find_id].TexturesID, mCount);
443 for a := 0 to mCount-1 do
444 if not e_CreateTextureMemEx(pData, dataSize, framesArray[find_id].TexturesID[a], a*mWidth, 0, mWidth, mHeight) then
445 begin
446 //!!!FreeMem(pData);
447 exit;
448 end;
450 if BackAnimation then
451 begin
452 for a := 1 to mCount-2 do framesArray[find_id].TexturesID[mCount+mCount-2-a] := framesArray[find_id].TexturesID[a];
453 end;
455 framesArray[find_id].used := true;
456 framesArray[find_id].FrameWidth := mWidth;
457 framesArray[find_id].FrameHeight := mHeight;
458 if (Name <> '') then framesArray[find_id].Name := Name else framesArray[find_id].Name := '<noname>';
460 if (ID <> nil) then ID^ := find_id;
462 result := true;
463 end;
466 function g_CreateFramesImg (ia: TDynImageDataArray; ID: PDWORD; const Name: AnsiString; BackAnimation: Boolean = false): Boolean;
467 var
468 find_id: LongWord;
469 a, mCount: Integer;
470 begin
471 result := false;
472 find_id := allocFrameSlot();
474 mCount := Length(ia);
476 //e_WriteLog(Format('+++ creating %d frames [%s]', [FCount, Name]), MSG_NOTIFY);
478 if (mCount < 1) then exit;
479 if (mCount <= 2) then BackAnimation := false;
481 if BackAnimation then SetLength(framesArray[find_id].TexturesID, mCount+mCount-2)
482 else SetLength(framesArray[find_id].TexturesID, mCount);
484 //e_WriteLog(Format('+++ creating %d frames, %dx%d', [FCount, ia[0].width, ia[0].height]), MSG_NOTIFY);
486 for a := 0 to mCount-1 do
487 begin
488 if not e_CreateTextureImg(ia[a], framesArray[find_id].TexturesID[a]) then exit;
489 //e_WriteLog(Format('+++ frame %d, %dx%d', [a, ia[a].width, ia[a].height]), MSG_NOTIFY);
490 end;
492 if BackAnimation then
493 begin
494 for a := 1 to mCount-2 do framesArray[find_id].TexturesID[mCount+mCount-2-a] := framesArray[find_id].TexturesID[a];
495 end;
497 framesArray[find_id].used := true;
498 framesArray[find_id].FrameWidth := ia[0].width;
499 framesArray[find_id].FrameHeight := ia[0].height;
500 if (Name <> '') then framesArray[find_id].Name := Name else framesArray[find_id].Name := '<noname>';
502 if (ID <> nil) then ID^ := find_id;
504 result := true;
505 end;
508 function g_Frames_CreateWAD (ID: PDWORD; const Name, Resource: AnsiString;
509 mWidth, mHeight, mCount: Word; BackAnimation: Boolean=false): Boolean;
510 var
511 WAD: TWADFile;
512 FileName: AnsiString;
513 TextureData: Pointer;
514 ResourceLength: Integer;
515 begin
516 result := false;
518 // models without "advanced" animations asks for "nothing" like this; don't spam log
519 if (Length(Resource) > 0) and ((Resource[Length(Resource)] = '/') or (Resource[Length(Resource)] = '\')) then exit;
521 FileName := g_ExtractWadName(Resource);
523 WAD := TWADFile.Create();
524 WAD.ReadFile(FileName);
526 if not WAD.GetResource(g_ExtractFilePathName(Resource), TextureData, ResourceLength) then
527 begin
528 WAD.Free();
529 e_WriteLog(Format('Error loading texture %s', [Resource]), TMsgType.Warning);
530 //e_WriteLog(Format('WAD Reader error: %s', [WAD.GetLastErrorStr]), MSG_WARNING);
531 exit;
532 end;
534 if not CreateFramesMem(TextureData, ResourceLength, ID, Name, mWidth, mHeight, mCount, BackAnimation) then
535 begin
536 FreeMem(TextureData);
537 WAD.Free();
538 exit;
539 end;
541 FreeMem(TextureData);
542 WAD.Free();
544 result := true;
545 end;
548 function g_Frames_CreateMemory (ID: PDWORD; const Name: AnsiString; pData: Pointer; dataSize: LongInt;
549 mWidth, mHeight, mCount: Word; BackAnimation: Boolean = false): Boolean;
550 begin
551 result := CreateFramesMem(pData, dataSize, ID, Name, mWidth, mHeight, mCount, BackAnimation);
552 end;
555 {function g_Frames_CreateRevert(ID: PDWORD; Name: ShortString; Frames: string): Boolean;
556 var
557 find_id, b: DWORD;
558 a, c: Integer;
559 begin
560 Result := False;
562 if not g_Frames_Get(b, Frames) then Exit;
564 find_id := FindFrame();
566 FramesArray[find_id].Name := Name;
567 FramesArray[find_id].FrameWidth := FramesArray[b].FrameWidth;
568 FramesArray[find_id].FrameHeight := FramesArray[b].FrameHeight;
570 c := High(FramesArray[find_id].TexturesID);
572 for a := 0 to c do
573 FramesArray[find_id].TexturesID[a] := FramesArray[b].TexturesID[c-a];
575 Result := True;
576 end;}
579 function g_Frames_Dup (const NewName, OldName: AnsiString): Boolean;
580 var
581 find_id, b: LongWord;
582 a, c: Integer;
583 begin
584 result := false;
586 if not g_Frames_Get(b, OldName) then exit;
588 find_id := allocFrameSlot();
590 framesArray[find_id].used := true;
591 framesArray[find_id].Name := NewName;
592 framesArray[find_id].FrameWidth := framesArray[b].FrameWidth;
593 framesArray[find_id].FrameHeight := framesArray[b].FrameHeight;
595 c := High(framesArray[b].TexturesID);
596 SetLength(framesArray[find_id].TexturesID, c+1);
598 for a := 0 to c do framesArray[find_id].TexturesID[a] := framesArray[b].TexturesID[a];
600 result := true;
601 end;
604 procedure g_Frames_DeleteByName (const FramesName: AnsiString);
605 var
606 a, b: Integer;
607 begin
608 if (Length(framesArray) = 0) then exit;
609 for a := 0 to High(framesArray) do
610 begin
611 if (StrEquCI1251(framesArray[a].Name, FramesName)) then
612 begin
613 if framesArray[a].TexturesID <> nil then
614 begin
615 for b := 0 to High(framesArray[a].TexturesID) do e_DeleteTexture(framesArray[a].TexturesID[b]);
616 end;
617 framesArray[a].used := false;
618 framesArray[a].TexturesID := nil;
619 framesArray[a].Name := '';
620 framesArray[a].FrameWidth := 0;
621 framesArray[a].FrameHeight := 0;
622 end;
623 end;
624 end;
627 procedure g_Frames_DeleteByID (ID: LongWord);
628 var
629 b: Integer;
630 begin
631 if (Length(framesArray) = 0) then exit;
632 if (framesArray[ID].TexturesID <> nil) then
633 begin
634 for b := 0 to High(framesArray[ID].TexturesID) do e_DeleteTexture(framesArray[ID].TexturesID[b]);
635 end;
636 framesArray[ID].used := false;
637 framesArray[ID].TexturesID := nil;
638 framesArray[ID].Name := '';
639 framesArray[ID].FrameWidth := 0;
640 framesArray[ID].FrameHeight := 0;
641 end;
644 procedure g_Frames_DeleteAll ();
645 var
646 a, b: Integer;
647 begin
648 for a := 0 to High(framesArray) do
649 begin
650 if (framesArray[a].used) then
651 begin
652 for b := 0 to High(framesArray[a].TexturesID) do e_DeleteTexture(framesArray[a].TexturesID[b]);
653 end;
654 framesArray[a].used := false;
655 framesArray[a].TexturesID := nil;
656 framesArray[a].Name := '';
657 framesArray[a].FrameWidth := 0;
658 framesArray[a].FrameHeight := 0;
659 end;
660 framesArray := nil;
661 end;
664 function g_Frames_Get (out ID: LongWord; const FramesName: AnsiString): Boolean;
665 var
666 a: Integer;
667 begin
668 result := false;
669 if (Length(framesArray) = 0) then exit;
670 for a := 0 to High(framesArray) do
671 begin
672 if (StrEquCI1251(framesArray[a].Name, FramesName)) then
673 begin
674 ID := a;
675 result := true;
676 break;
677 end;
678 end;
679 if not result then g_FatalError(Format(_lc[I_GAME_ERROR_FRAMES], [FramesName]));
680 end;
683 function g_Frames_GetTexture (out ID: LongWord; const FramesName: AnsiString; Frame: Word): Boolean;
684 var
685 a: Integer;
686 begin
687 result := false;
688 if (Length(framesArray) = 0) then exit;
689 for a := 0 to High(framesArray) do
690 begin
691 if (StrEquCI1251(framesArray[a].Name, FramesName)) then
692 begin
693 if (Frame < Length(framesArray[a].TexturesID)) then
694 begin
695 ID := framesArray[a].TexturesID[Frame];
696 result := true;
697 break;
698 end;
699 end;
700 end;
701 if not result then g_FatalError(Format(_lc[I_GAME_ERROR_FRAMES], [FramesName]));
702 end;
705 function g_Frames_Exists (const FramesName: AnsiString): Boolean;
706 var
707 a: Integer;
708 begin
709 result := false;
710 if (Length(framesArray) = 0) then exit;
711 for a := 0 to High(framesArray) do
712 begin
713 if (StrEquCI1251(framesArray[a].Name, FramesName)) then
714 begin
715 result := true;
716 exit;
717 end;
718 end;
719 end;
722 procedure DumpTextureNames ();
723 var
724 i: Integer;
725 begin
726 e_WriteLog('BEGIN Textures:', TMsgType.Notify);
727 for i := 0 to High(texturesArray) do e_WriteLog(' '+IntToStr(i)+'. '+texturesArray[i].Name, TMsgType.Notify);
728 e_WriteLog('END Textures.', TMsgType.Notify);
730 e_WriteLog('BEGIN Frames:', TMsgType.Notify);
731 for i := 0 to High(framesArray) do e_WriteLog(' '+IntToStr(i)+'. '+framesArray[i].Name, TMsgType.Notify);
732 e_WriteLog('END Frames.', TMsgType.Notify);
733 end;
736 { TAnimation }
738 constructor TAnimation.Create (aframesID: LongWord; aloop: Boolean; aspeed: Byte);
739 begin
740 if (aframesID >= Length(framesArray)) then
741 begin
742 //raise Exception.Create('trying to create inexisting frame: something is very wrong here');
743 e_LogWritefln('trying to create inexisting frame %u of %u: something is very wrong here', [aframesID, LongWord(Length(framesArray))], TMsgType.Warning);
744 aframesID := 0;
745 if (Length(framesArray) = 0) then raise Exception.Create('trying to create inexisting frame: something is very wrong here');
746 end;
747 mId := aframesID;
748 mMinLength := 0;
749 mLoop := aloop;
750 mSpeed := aspeed;
751 mEnabled := true;
752 mCurrentFrame := 0;
753 mPlayed := false;
754 mAlpha := 0;
755 mWidth := framesArray[mId].FrameWidth;
756 mHeight := framesArray[mId].FrameHeight;
757 end;
760 destructor TAnimation.Destroy ();
761 begin
762 inherited;
763 end;
766 procedure TAnimation.draw (x, y: Integer; mirror: TMirrorType);
767 begin
768 if (not mEnabled) then exit;
769 e_DrawAdv(framesArray[mId].TexturesID[mCurrentFrame], x, y, mAlpha, true, mBlending, 0, nil, mirror);
770 //e_DrawQuad(X, Y, X+FramesArray[ID].FrameWidth-1, Y+FramesArray[ID].FrameHeight-1, 0, 255, 0);
771 end;
774 procedure TAnimation.update ();
775 begin
776 if (not mEnabled) then exit;
778 mCounter += 1;
780 if (mCounter >= mSpeed) then
781 begin
782 // Îæèäàíèå ìåæäó êàäðàìè çàêîí÷èëîñü
783 // Îáðàòíûé ïîðÿäîê êàäðîâ?
784 if mRevert then
785 begin
786 // Äîøëè äî êîíöà àíèìàöèè. Âîçìîæíî, æäåì åùå
787 if (mCurrentFrame = 0) then
788 begin
789 if (Length(framesArray[mId].TexturesID)*mSpeed+mCounter < mMinLength) then exit;
790 end;
792 mCurrentFrame -= 1;
793 mPlayed := (mCurrentFrame < 0);
795 // Ïîâòîðÿòü ëè àíèìàöèþ ïî êðóãó?
796 if mPlayed then
797 begin
798 if mLoop then mCurrentFrame := High(framesArray[mId].TexturesID) else mCurrentFrame += 1;
799 end;
801 mCounter := 0;
802 end
803 else
804 begin
805 // Ïðÿìîé ïîðÿäîê êàäðîâ
806 // Äîøëè äî êîíöà àíèìàöèè. Âîçìîæíî, æäåì åùå
807 if (mCurrentFrame = High(framesArray[mId].TexturesID)) then
808 begin
809 if (Length(framesArray[mId].TexturesID)*mSpeed+mCounter < mMinLength) then exit;
810 end;
812 mCurrentFrame += 1;
813 mPlayed := (mCurrentFrame > High(framesArray[mId].TexturesID));
815 // Ïîâòîðÿòü ëè àíèìàöèþ ïî êðóãó?
816 if mPlayed then
817 begin
818 if mLoop then mCurrentFrame := 0 else mCurrentFrame -= 1;
819 end;
821 mCounter := 0;
822 end;
823 end;
824 end;
827 procedure TAnimation.reset ();
828 begin
829 if mRevert then mCurrentFrame := High(framesArray[mId].TexturesID) else mCurrentFrame := 0;
830 mCounter := 0;
831 mPlayed := false;
832 end;
835 procedure TAnimation.disable (); begin mEnabled := false; end;
836 procedure TAnimation.enable (); begin mEnabled := true; end;
839 procedure TAnimation.drawEx (x, y: Integer; mirror: TMirrorType; rpoint: TDFPoint; angle: SmallInt);
840 begin
841 if (not mEnabled) then exit;
842 e_DrawAdv(framesArray[mId].TexturesID[mCurrentFrame], x, y, mAlpha, true, mBlending, angle, @rpoint, mirror);
843 end;
846 function TAnimation.totalFrames (): Integer; inline; begin result := Length(framesArray[mId].TexturesID); end;
849 procedure TAnimation.revert (r: Boolean);
850 begin
851 mRevert := r;
852 reset();
853 end;
856 procedure TAnimation.saveState (st: TStream);
857 begin
858 if (st = nil) then exit;
860 utils.writeSign(st, 'ANIM');
861 utils.writeInt(st, Byte(0)); // version
862 // Ñ÷åò÷èê îæèäàíèÿ ìåæäó êàäðàìè
863 utils.writeInt(st, Byte(mCounter));
864 // Òåêóùèé êàäð
865 utils.writeInt(st, LongInt(mCurrentFrame));
866 // Ïðîèãðàíà ëè àíèìàöèÿ öåëèêîì
867 utils.writeBool(st, mPlayed);
868 // Alpha-êàíàë âñåé òåêñòóðû
869 utils.writeInt(st, Byte(mAlpha));
870 // Ðàçìûòèå òåêñòóðû
871 utils.writeInt(st, Byte(mBlending));
872 // Âðåìÿ îæèäàíèÿ ìåæäó êàäðàìè
873 utils.writeInt(st, Byte(mSpeed));
874 // Çàöèêëåíà ëè àíèìàöèÿ
875 utils.writeBool(st, mLoop);
876 // Âêëþ÷åíà ëè
877 utils.writeBool(st, mEnabled);
878 // Îæèäàíèå ïîñëå ïðîèãðûâàíèÿ
879 utils.writeInt(st, Byte(mMinLength));
880 // Îáðàòíûé ëè ïîðÿäîê êàäðîâ
881 utils.writeBool(st, mRevert);
882 end;
885 procedure TAnimation.loadState (st: TStream);
886 begin
887 if (st = nil) then exit;
889 if not utils.checkSign(st, 'ANIM') then raise XStreamError.Create('animation chunk expected');
890 if (utils.readByte(st) <> 0) then raise XStreamError.Create('invalid animation chunk version');
891 // Ñ÷åò÷èê îæèäàíèÿ ìåæäó êàäðàìè
892 mCounter := utils.readByte(st);
893 // Òåêóùèé êàäð
894 mCurrentFrame := utils.readLongInt(st);
895 // Ïðîèãðàíà ëè àíèìàöèÿ öåëèêîì
896 mPlayed := utils.readBool(st);
897 // Alpha-êàíàë âñåé òåêñòóðû
898 mAlpha := utils.readByte(st);
899 // Ðàçìûòèå òåêñòóðû
900 mBlending := utils.readBool(st);
901 // Âðåìÿ îæèäàíèÿ ìåæäó êàäðàìè
902 mSpeed := utils.readByte(st);
903 // Çàöèêëåíà ëè àíèìàöèÿ
904 mLoop := utils.readBool(st);
905 // Âêëþ÷åíà ëè
906 mEnabled := utils.readBool(st);
907 // Îæèäàíèå ïîñëå ïðîèãðûâàíèÿ
908 mMinLength := utils.readByte(st);
909 // Îáðàòíûé ëè ïîðÿäîê êàäðîâ
910 mRevert := utils.readBool(st);
911 end;
914 // ////////////////////////////////////////////////////////////////////////// //
915 var
916 ltexid: GLuint = 0;
918 function g_Texture_Light (): Integer;
919 const
920 Radius: Integer = 128;
921 var
922 tex, tpp: PByte;
923 x, y, a: Integer;
924 dist: Double;
925 begin
926 if ltexid = 0 then
927 begin
928 GetMem(tex, (Radius*2)*(Radius*2)*4);
929 tpp := tex;
930 for y := 0 to Radius*2-1 do
931 begin
932 for x := 0 to Radius*2-1 do
933 begin
934 dist := 1.0-sqrt((x-Radius)*(x-Radius)+(y-Radius)*(y-Radius))/Radius;
935 if (dist < 0) then
936 begin
937 tpp^ := 0; Inc(tpp);
938 tpp^ := 0; Inc(tpp);
939 tpp^ := 0; Inc(tpp);
940 tpp^ := 0; Inc(tpp);
941 end
942 else
943 begin
944 //tc.setPixel(x, y, Color(cast(int)(dist*255), cast(int)(dist*255), cast(int)(dist*255)));
945 if (dist > 0.5) then dist := 0.5;
946 a := round(dist*255);
947 if (a < 0) then a := 0 else if (a > 255) then a := 255;
948 tpp^ := 255; Inc(tpp);
949 tpp^ := 255; Inc(tpp);
950 tpp^ := 255; Inc(tpp);
951 tpp^ := Byte(a); Inc(tpp);
952 end;
953 end;
954 end;
956 glGenTextures(1, @ltexid);
957 //if (tid == 0) assert(0, "VGL: can't create screen texture");
959 glBindTexture(GL_TEXTURE_2D, ltexid);
960 glTexParameterf(GL_TEXTURE_2D, GL_TEXTURE_WRAP_S, GL_REPEAT);
961 glTexParameterf(GL_TEXTURE_2D, GL_TEXTURE_WRAP_T, GL_REPEAT);
962 glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_MIN_FILTER, GL_LINEAR);
963 glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_MAG_FILTER, GL_LINEAR);
965 //GLfloat[4] bclr = 0.0;
966 //glTexParameterfv(GL_TEXTURE_2D, GL_TEXTURE_BORDER_COLOR, bclr.ptr);
968 glTexImage2D(GL_TEXTURE_2D, 0, GL_RGBA, Radius*2, Radius*2, 0, GL_RGBA{gltt}, GL_UNSIGNED_BYTE, tex);
969 end;
971 result := ltexid;
972 end;
975 end.