1 (* Copyright (C) DooM 2D:Forever Developers
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.
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.
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/>.
16 {$INCLUDE ../shared/a_modes.inc}
23 e_graphics
, MAPDEF
, BinEditor
, ImagingTypes
, Imaging
, ImagingUtility
;
26 TLevelTexture
= record
31 False: (TextureID
: DWORD
;);
32 True: (FramesID
: DWORD
;
37 TLevelTextureArray
= Array of TLevelTexture
;
39 TAnimation
= class(TPoolObject
)
44 FCounter
: Byte; // Ñ÷åò÷èê îæèäàíèÿ ìåæäó êàäðàìè
45 FSpeed
: Byte; // Âðåìÿ îæèäàíèÿ ìåæäó êàäðàìè
46 FCurrentFrame
: Integer; // Òåêóùèé êàäð (íà÷èíàÿ ñ 0)
47 FLoop
: Boolean; // Ïåðåõîäèòü íà ïåðâûé êàäð ïîñëå ïîñëåäíåãî?
48 FEnabled
: Boolean; // Ðàáîòà ðàçðåøåíà?
49 FPlayed
: Boolean; // Ïðîèãðàíà âñÿ õîòÿ áû ðàç?
52 FMinLength
: Byte; // Îæèäàíèå ïîñëå ïðîèãðûâàíèÿ
53 FRevert
: Boolean; // Ñìåíà êàäðîâ îáðàòíàÿ?
56 constructor Create(FramesID
: DWORD
; Loop
: Boolean; Speed
: Byte);
57 destructor Destroy(); override;
58 procedure Draw(X
, Y
: Integer; Mirror
: TMirrorType
);
59 procedure DrawEx(X
, Y
: Integer; Mirror
: TMirrorType
; RPoint
: TDFPoint
;
65 procedure Revert(r
: Boolean);
66 procedure SaveState(Var Mem
: TBinMemoryWriter
);
67 procedure LoadState(Var Mem
: TBinMemoryReader
);
68 function TotalFrames(): Integer;
70 property Played
: Boolean read FPlayed
;
71 property Enabled
: Boolean read FEnabled
;
72 property IsReverse
: Boolean read FRevert
;
73 property Loop
: Boolean read FLoop write FLoop
;
74 property Speed
: Byte read FSpeed write FSpeed
;
75 property MinLength
: Byte read FMinLength write FMinLength
;
76 property CurrentFrame
: Integer read FCurrentFrame write FCurrentFrame
;
77 property CurrentCounter
: Byte read FCounter write FCounter
;
78 property Counter
: Byte read FCounter
;
79 property Blending
: Boolean read FBlending write FBlending
;
80 property Alpha
: Byte read FAlpha write FAlpha
;
81 property FramesID
: DWORD read ID
;
82 property Width
: Word read FWidth
;
83 property Height
: Word read FHeight
;
86 function g_Texture_CreateWAD(var ID
: DWORD
; Resource
: String): Boolean;
87 function g_Texture_CreateFile(var ID
: DWORD
; FileName
: String): Boolean;
88 function g_Texture_CreateWADEx(TextureName
: ShortString; Resource
: String; altrsrc
: AnsiString=''): Boolean;
89 function g_Texture_CreateFileEx(TextureName
: ShortString; FileName
: String): Boolean;
90 function g_Texture_Get(TextureName
: ShortString; var ID
: DWORD
): Boolean;
91 procedure g_Texture_Delete(TextureName
: ShortString);
92 procedure g_Texture_DeleteAll();
94 function g_CreateFramesImg (ia
: TDynImageDataArray
; ID
: PDWORD
; Name
: ShortString; BackAnimation
: Boolean = False): Boolean;
96 function g_Frames_CreateWAD(ID
: PDWORD
; Name
: ShortString; Resource
: String;
97 FWidth
, FHeight
, FCount
: Word; BackAnimation
: Boolean = False): Boolean;
98 function g_Frames_CreateFile(ID
: PDWORD
; Name
: ShortString; FileName
: String;
99 FWidth
, FHeight
, FCount
: Word; BackAnimation
: Boolean = False): Boolean;
100 function g_Frames_CreateMemory(ID
: PDWORD
; Name
: ShortString; pData
: Pointer; dataSize
: LongInt;
101 FWidth
, FHeight
, FCount
: Word; BackAnimation
: Boolean = False): Boolean;
102 function g_Frames_Dup(NewName
, OldName
: ShortString): Boolean;
103 //function g_Frames_CreateRevert(ID: PDWORD; Name: ShortString; Frames: string): Boolean;
104 function g_Frames_Get(out ID
: DWORD
; FramesName
: ShortString): Boolean;
105 function g_Frames_GetTexture(out ID
: DWORD
; FramesName
: ShortString; Frame
: Word): Boolean;
106 function g_Frames_Exists(FramesName
: String): Boolean;
107 procedure g_Frames_DeleteByName(FramesName
: ShortString);
108 procedure g_Frames_DeleteByID(ID
: DWORD
);
109 procedure g_Frames_DeleteAll();
111 procedure DumpTextureNames();
113 function g_Texture_Light(): Integer;
118 g_game
, e_log
, g_basic
, SysUtils
, g_console
, wadreader
,
129 TexturesID
: Array of DWORD
;
136 TexturesArray
: Array of _TTexture
= nil;
137 FramesArray
: Array of TFrames
= nil;
140 ANIM_SIGNATURE
= $4D494E41; // 'ANIM'
142 function FindTexture(): DWORD
;
146 if TexturesArray
<> nil then
147 for i
:= 0 to High(TexturesArray
) do
148 if TexturesArray
[i
].Name
= '' then
154 if TexturesArray
= nil then
156 SetLength(TexturesArray
, 8);
161 Result
:= High(TexturesArray
) + 1;
162 SetLength(TexturesArray
, Length(TexturesArray
) + 8);
166 function g_Texture_CreateWAD(var ID
: DWORD
; Resource
: String): Boolean;
170 TextureData
: Pointer;
171 ResourceLength
: Integer;
174 FileName
:= g_ExtractWadName(Resource
);
176 WAD
:= TWADFile
.Create
;
177 WAD
.ReadFile(FileName
);
179 if WAD
.GetResource(g_ExtractFilePathName(Resource
), TextureData
, ResourceLength
) then
181 if e_CreateTextureMem(TextureData
, ResourceLength
, ID
) then
184 FreeMem(TextureData
);
188 e_WriteLog(Format('Error loading texture %s', [Resource
]), MSG_WARNING
);
189 //e_WriteLog(Format('WAD Reader error: %s', [WAD.GetLastErrorStr]), MSG_WARNING);
194 function g_Texture_CreateFile(var ID
: DWORD
; FileName
: String): Boolean;
197 if not e_CreateTexture(FileName
, ID
) then
199 e_WriteLog(Format('Error loading texture %s', [FileName
]), MSG_WARNING
);
204 function texture_CreateWADExInternal (TextureName
: ShortString; Resource
: String; showmsg
: Boolean): Boolean;
208 TextureData
: Pointer;
210 ResourceLength
: Integer;
212 FileName
:= g_ExtractWadName(Resource
);
214 find_id
:= FindTexture();
216 WAD
:= TWADFile
.Create
;
217 WAD
.ReadFile(FileName
);
219 if WAD
.GetResource(g_ExtractFilePathName(Resource
), TextureData
, ResourceLength
) then
221 result
:= e_CreateTextureMem(TextureData
, ResourceLength
, TexturesArray
[find_id
].ID
);
224 e_GetTextureSize(TexturesArray
[find_id
].ID
, @TexturesArray
[find_id
].Width
, @TexturesArray
[find_id
].Height
);
225 TexturesArray
[find_id
].Name
:= LowerCase(TextureName
);
229 FreeMem(TextureData
);
236 e_WriteLog(Format('Error loading texture %s', [Resource
]), MSG_WARNING
);
238 //e_WriteLog(Format('WAD Reader error: %s', [WAD.GetLastErrorStr]), MSG_WARNING);
244 function g_Texture_CreateWADEx(TextureName
: ShortString; Resource
: String; altrsrc
: AnsiString=''): Boolean;
246 if (Length(altrsrc
) > 0) then
248 result
:= texture_CreateWADExInternal(TextureName
, altrsrc
, false);
251 result
:= texture_CreateWADExInternal(TextureName
, Resource
, true);
254 function g_Texture_CreateFileEx(TextureName
: ShortString; FileName
: String): Boolean;
258 find_id
:= FindTexture
;
260 Result
:= e_CreateTexture(FileName
, TexturesArray
[find_id
].ID
);
263 TexturesArray
[find_id
].Name
:= LowerCase(TextureName
);
264 e_GetTextureSize(TexturesArray
[find_id
].ID
, @TexturesArray
[find_id
].Width
,
265 @TexturesArray
[find_id
].Height
);
267 else e_WriteLog(Format('Error loading texture %s', [FileName
]), MSG_WARNING
);
270 function g_Texture_Get(TextureName
: ShortString; var ID
: DWORD
): Boolean;
276 if TexturesArray
= nil then Exit
;
278 if TextureName
= '' then Exit
;
280 TextureName
:= LowerCase(TextureName
);
282 for a
:= 0 to High(TexturesArray
) do
283 if TexturesArray
[a
].Name
= TextureName
then
285 ID
:= TexturesArray
[a
].ID
;
290 //if not Result then g_ConsoleAdd('Texture '+TextureName+' not found');
293 procedure g_Texture_Delete(TextureName
: ShortString);
297 if TexturesArray
= nil then Exit
;
299 TextureName
:= LowerCase(TextureName
);
301 for a
:= 0 to High(TexturesArray
) do
302 if TexturesArray
[a
].Name
= TextureName
then
304 e_DeleteTexture(TexturesArray
[a
].ID
);
305 TexturesArray
[a
].Name
:= '';
306 TexturesArray
[a
].ID
:= 0;
307 TexturesArray
[a
].Width
:= 0;
308 TexturesArray
[a
].Height
:= 0;
312 procedure g_Texture_DeleteAll();
316 if TexturesArray
= nil then Exit
;
318 for a
:= 0 to High(TexturesArray
) do
319 if TexturesArray
[a
].Name
<> '' then
320 e_DeleteTexture(TexturesArray
[a
].ID
);
322 TexturesArray
:= nil;
325 function FindFrame(): DWORD
;
329 if FramesArray
<> nil then
330 for i
:= 0 to High(FramesArray
) do
331 if FramesArray
[i
].TexturesID
= nil then
337 if FramesArray
= nil then
339 SetLength(FramesArray
, 64);
344 Result
:= High(FramesArray
) + 1;
345 SetLength(FramesArray
, Length(FramesArray
) + 64);
349 function g_Frames_CreateFile(ID
: PDWORD
; Name
: ShortString; FileName
: String;
350 FWidth
, FHeight
, FCount
: Word; BackAnimation
: Boolean = False): Boolean;
357 find_id
:= FindFrame
;
359 if FCount
<= 2 then BackAnimation
:= False;
361 if BackAnimation
then SetLength(FramesArray
[find_id
].TexturesID
, FCount
+FCount
-2)
362 else SetLength(FramesArray
[find_id
].TexturesID
, FCount
);
364 for a
:= 0 to FCount
-1 do
365 if not e_CreateTextureEx(FileName
, FramesArray
[find_id
].TexturesID
[a
],
366 a
*FWidth
, 0, FWidth
, FHeight
) then Exit
;
368 if BackAnimation
then
369 for a
:= 1 to FCount
-2 do
370 FramesArray
[find_id
].TexturesID
[FCount
+FCount
-2-a
] := FramesArray
[find_id
].TexturesID
[a
];
372 FramesArray
[find_id
].FrameWidth
:= FWidth
;
373 FramesArray
[find_id
].FrameHeight
:= FHeight
;
375 FramesArray
[find_id
].Name
:= LowerCase(Name
)
377 FramesArray
[find_id
].Name
:= '<noname>';
379 if ID
<> nil then ID
^ := find_id
;
384 function CreateFramesMem(pData
: Pointer; dataSize
: LongInt; ID
: PDWORD
; Name
: ShortString;
385 FWidth
, FHeight
, FCount
: Word; BackAnimation
: Boolean = False): Boolean;
392 find_id
:= FindFrame();
394 if FCount
<= 2 then BackAnimation
:= False;
396 if BackAnimation
then SetLength(FramesArray
[find_id
].TexturesID
, FCount
+FCount
-2)
397 else SetLength(FramesArray
[find_id
].TexturesID
, FCount
);
399 for a
:= 0 to FCount
-1 do
400 if not e_CreateTextureMemEx(pData
, dataSize
, FramesArray
[find_id
].TexturesID
[a
],
401 a
*FWidth
, 0, FWidth
, FHeight
) then
407 if BackAnimation
then
408 for a
:= 1 to FCount
-2 do
409 FramesArray
[find_id
].TexturesID
[FCount
+FCount
-2-a
] := FramesArray
[find_id
].TexturesID
[a
];
411 FramesArray
[find_id
].FrameWidth
:= FWidth
;
412 FramesArray
[find_id
].FrameHeight
:= FHeight
;
414 FramesArray
[find_id
].Name
:= LowerCase(Name
)
416 FramesArray
[find_id
].Name
:= '<noname>';
418 if ID
<> nil then ID
^ := find_id
;
423 function g_CreateFramesImg (ia
: TDynImageDataArray
; ID
: PDWORD
; Name
: ShortString; BackAnimation
: Boolean = False): Boolean;
429 find_id
:= FindFrame();
431 FCount
:= length(ia
);
433 //e_WriteLog(Format('+++ creating %d frames [%s]', [FCount, Name]), MSG_NOTIFY);
435 if FCount
< 1 then exit
;
436 if FCount
<= 2 then BackAnimation
:= False;
437 if BackAnimation
then
438 SetLength(FramesArray
[find_id
].TexturesID
, FCount
+FCount
-2)
440 SetLength(FramesArray
[find_id
].TexturesID
, FCount
);
442 //e_WriteLog(Format('+++ creating %d frames, %dx%d', [FCount, ia[0].width, ia[0].height]), MSG_NOTIFY);
444 for a
:= 0 to FCount
-1 do
446 if not e_CreateTextureImg(ia
[a
], FramesArray
[find_id
].TexturesID
[a
]) then exit
;
447 //e_WriteLog(Format('+++ frame %d, %dx%d', [a, ia[a].width, ia[a].height]), MSG_NOTIFY);
450 if BackAnimation
then
452 for a
:= 1 to FCount
-2 do
454 FramesArray
[find_id
].TexturesID
[FCount
+FCount
-2-a
] := FramesArray
[find_id
].TexturesID
[a
];
458 FramesArray
[find_id
].FrameWidth
:= ia
[0].width
;
459 FramesArray
[find_id
].FrameHeight
:= ia
[0].height
;
461 FramesArray
[find_id
].Name
:= LowerCase(Name
)
463 FramesArray
[find_id
].Name
:= '<noname>';
465 if ID
<> nil then ID
^ := find_id
;
470 function g_Frames_CreateWAD(ID
: PDWORD
; Name
: ShortString; Resource
: string;
471 FWidth
, FHeight
, FCount
: Word; BackAnimation
: Boolean = False): Boolean;
475 TextureData
: Pointer;
476 ResourceLength
: Integer;
480 // models without "advanced" animations asks for "nothing" like this; don't spam log
481 if (Length(Resource
) > 0) and ((Resource
[Length(Resource
)] = '/') or (Resource
[Length(Resource
)] = '\')) then exit
;
483 FileName
:= g_ExtractWadName(Resource
);
485 WAD
:= TWADFile
.Create();
486 WAD
.ReadFile(FileName
);
488 if not WAD
.GetResource(g_ExtractFilePathName(Resource
), TextureData
, ResourceLength
) then
491 e_WriteLog(Format('Error loading texture %s', [Resource
]), MSG_WARNING
);
492 //e_WriteLog(Format('WAD Reader error: %s', [WAD.GetLastErrorStr]), MSG_WARNING);
496 if not CreateFramesMem(TextureData
, ResourceLength
, ID
, Name
, FWidth
, FHeight
, FCount
, BackAnimation
) then
507 function g_Frames_CreateMemory(ID
: PDWORD
; Name
: ShortString; pData
: Pointer; dataSize
: LongInt;
508 FWidth
, FHeight
, FCount
: Word; BackAnimation
: Boolean = False): Boolean;
510 Result
:= CreateFramesMem(pData
, dataSize
, ID
, Name
, FWidth
, FHeight
, FCount
, BackAnimation
);
513 {function g_Frames_CreateRevert(ID: PDWORD; Name: ShortString; Frames: string): Boolean;
520 if not g_Frames_Get(b, Frames) then Exit;
522 find_id := FindFrame();
524 FramesArray[find_id].Name := Name;
525 FramesArray[find_id].FrameWidth := FramesArray[b].FrameWidth;
526 FramesArray[find_id].FrameHeight := FramesArray[b].FrameHeight;
528 c := High(FramesArray[find_id].TexturesID);
531 FramesArray[find_id].TexturesID[a] := FramesArray[b].TexturesID[c-a];
536 function g_Frames_Dup(NewName
, OldName
: ShortString): Boolean;
543 if not g_Frames_Get(b
, OldName
) then Exit
;
545 find_id
:= FindFrame();
547 FramesArray
[find_id
].Name
:= LowerCase(NewName
);
548 FramesArray
[find_id
].FrameWidth
:= FramesArray
[b
].FrameWidth
;
549 FramesArray
[find_id
].FrameHeight
:= FramesArray
[b
].FrameHeight
;
551 c
:= High(FramesArray
[b
].TexturesID
);
552 SetLength(FramesArray
[find_id
].TexturesID
, c
+1);
555 FramesArray
[find_id
].TexturesID
[a
] := FramesArray
[b
].TexturesID
[a
];
560 procedure g_Frames_DeleteByName(FramesName
: ShortString);
565 if FramesArray
= nil then Exit
;
567 FramesName
:= LowerCase(FramesName
);
569 for a
:= 0 to High(FramesArray
) do
570 if FramesArray
[a
].Name
= FramesName
then
572 if FramesArray
[a
].TexturesID
<> nil then
573 for b
:= 0 to High(FramesArray
[a
].TexturesID
) do
574 e_DeleteTexture(FramesArray
[a
].TexturesID
[b
]);
575 FramesArray
[a
].TexturesID
:= nil;
576 FramesArray
[a
].Name
:= '';
577 FramesArray
[a
].FrameWidth
:= 0;
578 FramesArray
[a
].FrameHeight
:= 0;
582 procedure g_Frames_DeleteByID(ID
: DWORD
);
586 if FramesArray
= nil then Exit
;
588 if FramesArray
[ID
].TexturesID
<> nil then
589 for b
:= 0 to High(FramesArray
[ID
].TexturesID
) do
590 e_DeleteTexture(FramesArray
[ID
].TexturesID
[b
]);
591 FramesArray
[ID
].TexturesID
:= nil;
592 FramesArray
[ID
].Name
:= '';
593 FramesArray
[ID
].FrameWidth
:= 0;
594 FramesArray
[ID
].FrameHeight
:= 0;
597 procedure g_Frames_DeleteAll
;
602 if FramesArray
= nil then Exit
;
604 for a
:= 0 to High(FramesArray
) do
605 if FramesArray
[a
].TexturesID
<> nil then
607 for b
:= 0 to High(FramesArray
[a
].TexturesID
) do
608 e_DeleteTexture(FramesArray
[a
].TexturesID
[b
]);
609 FramesArray
[a
].TexturesID
:= nil;
610 FramesArray
[a
].Name
:= '';
611 FramesArray
[a
].FrameWidth
:= 0;
612 FramesArray
[a
].FrameHeight
:= 0;
618 function g_Frames_Get(out ID
: DWORD
; FramesName
: ShortString): Boolean;
624 if FramesArray
= nil then
627 FramesName
:= LowerCase(FramesName
);
629 for a
:= 0 to High(FramesArray
) do
630 if FramesArray
[a
].Name
= FramesName
then
638 g_FatalError(Format(_lc
[I_GAME_ERROR_FRAMES
], [FramesName
]));
641 function g_Frames_GetTexture(out ID
: DWORD
; FramesName
: ShortString; Frame
: Word): Boolean;
647 if FramesArray
= nil then
650 FramesName
:= LowerCase(FramesName
);
652 for a
:= 0 to High(FramesArray
) do
653 if FramesArray
[a
].Name
= FramesName
then
654 if Frame
<= High(FramesArray
[a
].TexturesID
) then
656 ID
:= FramesArray
[a
].TexturesID
[Frame
];
662 g_FatalError(Format(_lc
[I_GAME_ERROR_FRAMES
], [FramesName
]));
665 function g_Frames_Exists(FramesName
: string): Boolean;
671 if FramesArray
= nil then Exit
;
673 FramesName
:= LowerCase(FramesName
);
675 for a
:= 0 to High(FramesArray
) do
676 if FramesArray
[a
].Name
= FramesName
then
683 procedure DumpTextureNames();
687 e_WriteLog('BEGIN Textures:', MSG_NOTIFY
);
688 for i
:= 0 to High(TexturesArray
) do
689 e_WriteLog(' '+IntToStr(i
)+'. '+TexturesArray
[i
].Name
, MSG_NOTIFY
);
690 e_WriteLog('END Textures.', MSG_NOTIFY
);
692 e_WriteLog('BEGIN Frames:', MSG_NOTIFY
);
693 for i
:= 0 to High(FramesArray
) do
694 e_WriteLog(' '+IntToStr(i
)+'. '+FramesArray
[i
].Name
, MSG_NOTIFY
);
695 e_WriteLog('END Frames.', MSG_NOTIFY
);
700 constructor TAnimation
.Create(FramesID
: DWORD
; Loop
: Boolean; Speed
: Byte);
711 FWidth
:= FramesArray
[ID
].FrameWidth
;
712 FHeight
:= FramesArray
[ID
].FrameHeight
;
715 destructor TAnimation
.Destroy
;
720 procedure TAnimation
.Draw(X
, Y
: Integer; Mirror
: TMirrorType
);
725 e_DrawAdv(FramesArray
[ID
].TexturesID
[FCurrentFrame
], X
, Y
, FAlpha
,
726 True, FBlending
, 0, nil, Mirror
);
727 //e_DrawQuad(X, Y, X+FramesArray[ID].FrameWidth-1, Y+FramesArray[ID].FrameHeight-1, 0, 255, 0);
730 procedure TAnimation
.Update();
735 FCounter
:= FCounter
+ 1;
737 if FCounter
>= FSpeed
then
738 begin // Îæèäàíèå ìåæäó êàäðàìè çàêîí÷èëîñü
740 begin // Îáðàòíûé ïîðÿäîê êàäðîâ
741 // Äîøëè äî êîíöà àíèìàöèè. Âîçìîæíî, æäåì åùå:
742 if FCurrentFrame
= 0 then
743 if Length(FramesArray
[ID
].TexturesID
) * FSpeed
+
744 FCounter
< FMinLength
then
747 FCurrentFrame
:= FCurrentFrame
- 1;
748 FPlayed
:= FCurrentFrame
< 0;
750 // Ïîâòîðÿòü ëè àíèìàöèþ ïî êðóãó:
753 FCurrentFrame
:= High(FramesArray
[ID
].TexturesID
)
755 FCurrentFrame
:= FCurrentFrame
+ 1;
760 begin // Ïðÿìîé ïîðÿäîê êàäðîâ
761 // Äîøëè äî êîíöà àíèìàöèè. Âîçìîæíî, æäåì åùå:
762 if FCurrentFrame
= High(FramesArray
[ID
].TexturesID
) then
763 if Length(FramesArray
[ID
].TexturesID
) * FSpeed
+
764 FCounter
< FMinLength
then
767 FCurrentFrame
:= FCurrentFrame
+ 1;
768 FPlayed
:= (FCurrentFrame
> High(FramesArray
[ID
].TexturesID
));
770 // Ïîâòîðÿòü ëè àíèìàöèþ ïî êðóãó:
775 FCurrentFrame
:= FCurrentFrame
- 1;
782 procedure TAnimation
.Reset();
785 FCurrentFrame
:= High(FramesArray
[ID
].TexturesID
)
793 procedure TAnimation
.Disable
;
798 procedure TAnimation
.Enable
;
803 procedure TAnimation
.DrawEx(X
, Y
: Integer; Mirror
: TMirrorType
; RPoint
: TDFPoint
;
809 e_DrawAdv(FramesArray
[ID
].TexturesID
[FCurrentFrame
], X
, Y
, FAlpha
,
810 True, FBlending
, Angle
, @RPoint
, Mirror
);
813 function TAnimation
.TotalFrames(): Integer;
815 Result
:= Length(FramesArray
[ID
].TexturesID
);
818 procedure TAnimation
.Revert(r
: Boolean);
824 procedure TAnimation
.SaveState(Var Mem
: TBinMemoryWriter
);
831 // Ñèãíàòóðà àíèìàöèè:
832 sig
:= ANIM_SIGNATURE
; // 'ANIM'
834 // Ñ÷åò÷èê îæèäàíèÿ ìåæäó êàäðàìè:
835 Mem
.WriteByte(FCounter
);
837 Mem
.WriteInt(FCurrentFrame
);
838 // Ïðîèãðàíà ëè àíèìàöèÿ öåëèêîì:
839 Mem
.WriteBoolean(FPlayed
);
840 // Alpha-êàíàë âñåé òåêñòóðû:
841 Mem
.WriteByte(FAlpha
);
842 // Ðàçìûòèå òåêñòóðû:
843 Mem
.WriteBoolean(FBlending
);
844 // Âðåìÿ îæèäàíèÿ ìåæäó êàäðàìè:
845 Mem
.WriteByte(FSpeed
);
846 // Çàöèêëåíà ëè àíèìàöèÿ:
847 Mem
.WriteBoolean(FLoop
);
849 Mem
.WriteBoolean(FEnabled
);
850 // Îæèäàíèå ïîñëå ïðîèãðûâàíèÿ:
851 Mem
.WriteByte(FMinLength
);
852 // Îáðàòíûé ëè ïîðÿäîê êàäðîâ:
853 Mem
.WriteBoolean(FRevert
);
856 procedure TAnimation
.LoadState(Var Mem
: TBinMemoryReader
);
863 // Ñèãíàòóðà àíèìàöèè:
865 if sig
<> ANIM_SIGNATURE
then // 'ANIM'
867 raise EBinSizeError
.Create('TAnimation.LoadState: Wrong Animation Signature');
869 // Ñ÷åò÷èê îæèäàíèÿ ìåæäó êàäðàìè:
870 Mem
.ReadByte(FCounter
);
872 Mem
.ReadInt(FCurrentFrame
);
873 // Ïðîèãðàíà ëè àíèìàöèÿ öåëèêîì:
874 Mem
.ReadBoolean(FPlayed
);
875 // Alpha-êàíàë âñåé òåêñòóðû:
876 Mem
.ReadByte(FAlpha
);
877 // Ðàçìûòèå òåêñòóðû:
878 Mem
.ReadBoolean(FBlending
);
879 // Âðåìÿ îæèäàíèÿ ìåæäó êàäðàìè:
880 Mem
.ReadByte(FSpeed
);
881 // Çàöèêëåíà ëè àíèìàöèÿ:
882 Mem
.ReadBoolean(FLoop
);
884 Mem
.ReadBoolean(FEnabled
);
885 // Îæèäàíèå ïîñëå ïðîèãðûâàíèÿ:
886 Mem
.ReadByte(FMinLength
);
887 // Îáðàòíûé ëè ïîðÿäîê êàäðîâ:
888 Mem
.ReadBoolean(FRevert
);
895 function g_Texture_Light(): Integer;
897 Radius
: Integer = 128;
905 GetMem(tex
, (Radius
*2)*(Radius
*2)*4);
907 for y
:= 0 to Radius
*2-1 do
909 for x
:= 0 to Radius
*2-1 do
911 dist
:= 1.0-sqrt((x
-Radius
)*(x
-Radius
)+(y
-Radius
)*(y
-Radius
))/Radius
;
921 //tc.setPixel(x, y, Color(cast(int)(dist*255), cast(int)(dist*255), cast(int)(dist*255)));
922 if (dist
> 0.5) then dist
:= 0.5;
923 a
:= round(dist
*255);
924 if (a
< 0) then a
:= 0 else if (a
> 255) then a
:= 255;
925 tpp
^ := 255; Inc(tpp
);
926 tpp
^ := 255; Inc(tpp
);
927 tpp
^ := 255; Inc(tpp
);
928 tpp
^ := Byte(a
); Inc(tpp
);
933 glGenTextures(1, @ltexid
);
934 //if (tid == 0) assert(0, "VGL: can't create screen texture");
936 glBindTexture(GL_TEXTURE_2D
, ltexid
);
937 glTexParameterf(GL_TEXTURE_2D
, GL_TEXTURE_WRAP_S
, GL_REPEAT
);
938 glTexParameterf(GL_TEXTURE_2D
, GL_TEXTURE_WRAP_T
, GL_REPEAT
);
939 glTexParameteri(GL_TEXTURE_2D
, GL_TEXTURE_MIN_FILTER
, GL_LINEAR
);
940 glTexParameteri(GL_TEXTURE_2D
, GL_TEXTURE_MAG_FILTER
, GL_LINEAR
);
942 //GLfloat[4] bclr = 0.0;
943 //glTexParameterfv(GL_TEXTURE_2D, GL_TEXTURE_BORDER_COLOR, bclr.ptr);
945 glTexImage2D(GL_TEXTURE_2D
, 0, GL_RGBA
, Radius
*2, Radius
*2, 0, GL_RGBA
{gltt}, GL_UNSIGNED_BYTE
, tex
);