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}
22 e_graphics
, MAPDEF
, BinEditor
, ImagingTypes
, Imaging
, ImagingUtility
;
25 TLevelTexture
= record
30 False: (TextureID
: DWORD
;);
31 True: (FramesID
: DWORD
;
36 TLevelTextureArray
= Array of TLevelTexture
;
38 TAnimation
= class(TObject
)
43 FCounter
: Byte; // Ñ÷åò÷èê îæèäàíèÿ ìåæäó êàäðàìè
44 FSpeed
: Byte; // Âðåìÿ îæèäàíèÿ ìåæäó êàäðàìè
45 FCurrentFrame
: Integer; // Òåêóùèé êàäð (íà÷èíàÿ ñ 0)
46 FLoop
: Boolean; // Ïåðåõîäèòü íà ïåðâûé êàäð ïîñëå ïîñëåäíåãî?
47 FEnabled
: Boolean; // Ðàáîòà ðàçðåøåíà?
48 FPlayed
: Boolean; // Ïðîèãðàíà âñÿ õîòÿ áû ðàç?
51 FMinLength
: Byte; // Îæèäàíèå ïîñëå ïðîèãðûâàíèÿ
52 FRevert
: Boolean; // Ñìåíà êàäðîâ îáðàòíàÿ?
55 constructor Create(FramesID
: DWORD
; Loop
: Boolean; Speed
: Byte);
56 destructor Destroy(); override;
57 procedure Draw(X
, Y
: Integer; Mirror
: TMirrorType
);
58 procedure DrawEx(X
, Y
: Integer; Mirror
: TMirrorType
; RPoint
: TDFPoint
;
64 procedure Revert(r
: Boolean);
65 procedure SaveState(Var Mem
: TBinMemoryWriter
);
66 procedure LoadState(Var Mem
: TBinMemoryReader
);
67 function TotalFrames(): Integer;
69 property Played
: Boolean read FPlayed
;
70 property Enabled
: Boolean read FEnabled
;
71 property IsReverse
: Boolean read FRevert
;
72 property Loop
: Boolean read FLoop write FLoop
;
73 property Speed
: Byte read FSpeed write FSpeed
;
74 property MinLength
: Byte read FMinLength write FMinLength
;
75 property CurrentFrame
: Integer read FCurrentFrame write FCurrentFrame
;
76 property CurrentCounter
: Byte read FCounter write FCounter
;
77 property Counter
: Byte read FCounter
;
78 property Blending
: Boolean read FBlending write FBlending
;
79 property Alpha
: Byte read FAlpha write FAlpha
;
80 property FramesID
: DWORD read ID
;
81 property Width
: Word read FWidth
;
82 property Height
: Word read FHeight
;
85 function g_Texture_CreateWAD(var ID
: DWORD
; Resource
: String): Boolean;
86 function g_Texture_CreateFile(var ID
: DWORD
; FileName
: String): Boolean;
87 function g_Texture_CreateWADEx(TextureName
: ShortString; Resource
: String): Boolean;
88 function g_Texture_CreateFileEx(TextureName
: ShortString; FileName
: String): Boolean;
89 function g_Texture_Get(TextureName
: ShortString; var ID
: DWORD
): Boolean;
90 procedure g_Texture_Delete(TextureName
: ShortString);
91 procedure g_Texture_DeleteAll();
93 function g_CreateFramesImg (ia
: TDynImageDataArray
; ID
: PDWORD
; Name
: ShortString; BackAnimation
: Boolean = False): Boolean;
95 function g_Frames_CreateWAD(ID
: PDWORD
; Name
: ShortString; Resource
: String;
96 FWidth
, FHeight
, FCount
: Word; BackAnimation
: Boolean = False): Boolean;
97 function g_Frames_CreateFile(ID
: PDWORD
; Name
: ShortString; FileName
: String;
98 FWidth
, FHeight
, FCount
: Word; BackAnimation
: Boolean = False): Boolean;
99 function g_Frames_CreateMemory(ID
: PDWORD
; Name
: ShortString; pData
: Pointer; dataSize
: LongInt;
100 FWidth
, FHeight
, FCount
: Word; BackAnimation
: Boolean = False): Boolean;
101 function g_Frames_Dup(NewName
, OldName
: ShortString): Boolean;
102 //function g_Frames_CreateRevert(ID: PDWORD; Name: ShortString; Frames: string): Boolean;
103 function g_Frames_Get(out ID
: DWORD
; FramesName
: ShortString): Boolean;
104 function g_Frames_GetTexture(out ID
: DWORD
; FramesName
: ShortString; Frame
: Word): Boolean;
105 function g_Frames_Exists(FramesName
: String): Boolean;
106 procedure g_Frames_DeleteByName(FramesName
: ShortString);
107 procedure g_Frames_DeleteByID(ID
: DWORD
);
108 procedure g_Frames_DeleteAll();
110 procedure DumpTextureNames();
112 function g_Texture_Light(): Integer;
117 g_game
, e_log
, g_basic
, SysUtils
, g_console
, wadreader
,
128 TexturesID
: Array of DWORD
;
135 TexturesArray
: Array of _TTexture
= nil;
136 FramesArray
: Array of TFrames
= nil;
139 ANIM_SIGNATURE
= $4D494E41; // 'ANIM'
141 function FindTexture(): DWORD
;
145 if TexturesArray
<> nil then
146 for i
:= 0 to High(TexturesArray
) do
147 if TexturesArray
[i
].Name
= '' then
153 if TexturesArray
= nil then
155 SetLength(TexturesArray
, 8);
160 Result
:= High(TexturesArray
) + 1;
161 SetLength(TexturesArray
, Length(TexturesArray
) + 8);
165 function g_Texture_CreateWAD(var ID
: DWORD
; Resource
: String): Boolean;
169 TextureData
: Pointer;
170 ResourceLength
: Integer;
173 FileName
:= g_ExtractWadName(Resource
);
175 WAD
:= TWADFile
.Create
;
176 WAD
.ReadFile(FileName
);
178 if WAD
.GetResource(g_ExtractFilePathName(Resource
), TextureData
, ResourceLength
) then
180 if e_CreateTextureMem(TextureData
, ResourceLength
, ID
) then
183 FreeMem(TextureData
);
187 e_WriteLog(Format('Error loading texture %s', [Resource
]), MSG_WARNING
);
188 //e_WriteLog(Format('WAD Reader error: %s', [WAD.GetLastErrorStr]), MSG_WARNING);
193 function g_Texture_CreateFile(var ID
: DWORD
; FileName
: String): Boolean;
196 if not e_CreateTexture(FileName
, ID
) then
198 e_WriteLog(Format('Error loading texture %s', [FileName
]), MSG_WARNING
);
203 function g_Texture_CreateWADEx(TextureName
: ShortString; Resource
: String): Boolean;
207 TextureData
: Pointer;
209 ResourceLength
: Integer;
211 FileName
:= g_ExtractWadName(Resource
);
213 find_id
:= FindTexture();
215 WAD
:= TWADFile
.Create
;
216 WAD
.ReadFile(FileName
);
218 if WAD
.GetResource(g_ExtractFilePathName(Resource
), TextureData
, ResourceLength
) then
220 Result
:= e_CreateTextureMem(TextureData
, ResourceLength
, TexturesArray
[find_id
].ID
);
223 e_GetTextureSize(TexturesArray
[find_id
].ID
, @TexturesArray
[find_id
].Width
,
224 @TexturesArray
[find_id
].Height
);
225 TexturesArray
[find_id
].Name
:= LowerCase(TextureName
);
228 FreeMem(TextureData
);
232 e_WriteLog(Format('Error loading texture %s', [Resource
]), MSG_WARNING
);
233 //e_WriteLog(Format('WAD Reader error: %s', [WAD.GetLastErrorStr]), MSG_WARNING);
239 function g_Texture_CreateFileEx(TextureName
: ShortString; FileName
: String): Boolean;
243 find_id
:= FindTexture
;
245 Result
:= e_CreateTexture(FileName
, TexturesArray
[find_id
].ID
);
248 TexturesArray
[find_id
].Name
:= LowerCase(TextureName
);
249 e_GetTextureSize(TexturesArray
[find_id
].ID
, @TexturesArray
[find_id
].Width
,
250 @TexturesArray
[find_id
].Height
);
252 else e_WriteLog(Format('Error loading texture %s', [FileName
]), MSG_WARNING
);
255 function g_Texture_Get(TextureName
: ShortString; var ID
: DWORD
): Boolean;
261 if TexturesArray
= nil then Exit
;
263 if TextureName
= '' then Exit
;
265 TextureName
:= LowerCase(TextureName
);
267 for a
:= 0 to High(TexturesArray
) do
268 if TexturesArray
[a
].Name
= TextureName
then
270 ID
:= TexturesArray
[a
].ID
;
275 //if not Result then g_ConsoleAdd('Texture '+TextureName+' not found');
278 procedure g_Texture_Delete(TextureName
: ShortString);
282 if TexturesArray
= nil then Exit
;
284 TextureName
:= LowerCase(TextureName
);
286 for a
:= 0 to High(TexturesArray
) do
287 if TexturesArray
[a
].Name
= TextureName
then
289 e_DeleteTexture(TexturesArray
[a
].ID
);
290 TexturesArray
[a
].Name
:= '';
291 TexturesArray
[a
].ID
:= 0;
292 TexturesArray
[a
].Width
:= 0;
293 TexturesArray
[a
].Height
:= 0;
297 procedure g_Texture_DeleteAll();
301 if TexturesArray
= nil then Exit
;
303 for a
:= 0 to High(TexturesArray
) do
304 if TexturesArray
[a
].Name
<> '' then
305 e_DeleteTexture(TexturesArray
[a
].ID
);
307 TexturesArray
:= nil;
310 function FindFrame(): DWORD
;
314 if FramesArray
<> nil then
315 for i
:= 0 to High(FramesArray
) do
316 if FramesArray
[i
].TexturesID
= nil then
322 if FramesArray
= nil then
324 SetLength(FramesArray
, 64);
329 Result
:= High(FramesArray
) + 1;
330 SetLength(FramesArray
, Length(FramesArray
) + 64);
334 function g_Frames_CreateFile(ID
: PDWORD
; Name
: ShortString; FileName
: String;
335 FWidth
, FHeight
, FCount
: Word; BackAnimation
: Boolean = False): Boolean;
342 find_id
:= FindFrame
;
344 if FCount
<= 2 then BackAnimation
:= False;
346 if BackAnimation
then SetLength(FramesArray
[find_id
].TexturesID
, FCount
+FCount
-2)
347 else SetLength(FramesArray
[find_id
].TexturesID
, FCount
);
349 for a
:= 0 to FCount
-1 do
350 if not e_CreateTextureEx(FileName
, FramesArray
[find_id
].TexturesID
[a
],
351 a
*FWidth
, 0, FWidth
, FHeight
) then Exit
;
353 if BackAnimation
then
354 for a
:= 1 to FCount
-2 do
355 FramesArray
[find_id
].TexturesID
[FCount
+FCount
-2-a
] := FramesArray
[find_id
].TexturesID
[a
];
357 FramesArray
[find_id
].FrameWidth
:= FWidth
;
358 FramesArray
[find_id
].FrameHeight
:= FHeight
;
360 FramesArray
[find_id
].Name
:= LowerCase(Name
)
362 FramesArray
[find_id
].Name
:= '<noname>';
364 if ID
<> nil then ID
^ := find_id
;
369 function CreateFramesMem(pData
: Pointer; dataSize
: LongInt; ID
: PDWORD
; Name
: ShortString;
370 FWidth
, FHeight
, FCount
: Word; BackAnimation
: Boolean = False): Boolean;
377 find_id
:= FindFrame();
379 if FCount
<= 2 then BackAnimation
:= False;
381 if BackAnimation
then SetLength(FramesArray
[find_id
].TexturesID
, FCount
+FCount
-2)
382 else SetLength(FramesArray
[find_id
].TexturesID
, FCount
);
384 for a
:= 0 to FCount
-1 do
385 if not e_CreateTextureMemEx(pData
, dataSize
, FramesArray
[find_id
].TexturesID
[a
],
386 a
*FWidth
, 0, FWidth
, FHeight
) then
392 if BackAnimation
then
393 for a
:= 1 to FCount
-2 do
394 FramesArray
[find_id
].TexturesID
[FCount
+FCount
-2-a
] := FramesArray
[find_id
].TexturesID
[a
];
396 FramesArray
[find_id
].FrameWidth
:= FWidth
;
397 FramesArray
[find_id
].FrameHeight
:= FHeight
;
399 FramesArray
[find_id
].Name
:= LowerCase(Name
)
401 FramesArray
[find_id
].Name
:= '<noname>';
403 if ID
<> nil then ID
^ := find_id
;
408 function g_CreateFramesImg (ia
: TDynImageDataArray
; ID
: PDWORD
; Name
: ShortString; BackAnimation
: Boolean = False): Boolean;
414 find_id
:= FindFrame();
416 FCount
:= length(ia
);
418 //e_WriteLog(Format('+++ creating %d frames [%s]', [FCount, Name]), MSG_NOTIFY);
420 if FCount
< 1 then exit
;
421 if FCount
<= 2 then BackAnimation
:= False;
422 if BackAnimation
then
423 SetLength(FramesArray
[find_id
].TexturesID
, FCount
+FCount
-2)
425 SetLength(FramesArray
[find_id
].TexturesID
, FCount
);
427 //e_WriteLog(Format('+++ creating %d frames, %dx%d', [FCount, ia[0].width, ia[0].height]), MSG_NOTIFY);
429 for a
:= 0 to FCount
-1 do
431 if not e_CreateTextureImg(ia
[a
], FramesArray
[find_id
].TexturesID
[a
]) then exit
;
432 //e_WriteLog(Format('+++ frame %d, %dx%d', [a, ia[a].width, ia[a].height]), MSG_NOTIFY);
435 if BackAnimation
then
437 for a
:= 1 to FCount
-2 do
439 FramesArray
[find_id
].TexturesID
[FCount
+FCount
-2-a
] := FramesArray
[find_id
].TexturesID
[a
];
443 FramesArray
[find_id
].FrameWidth
:= ia
[0].width
;
444 FramesArray
[find_id
].FrameHeight
:= ia
[0].height
;
446 FramesArray
[find_id
].Name
:= LowerCase(Name
)
448 FramesArray
[find_id
].Name
:= '<noname>';
450 if ID
<> nil then ID
^ := find_id
;
455 function g_Frames_CreateWAD(ID
: PDWORD
; Name
: ShortString; Resource
: string;
456 FWidth
, FHeight
, FCount
: Word; BackAnimation
: Boolean = False): Boolean;
460 TextureData
: Pointer;
461 ResourceLength
: Integer;
465 // models without "advanced" animations asks for "nothing" like this; don't spam log
466 if (Length(Resource
) > 0) and ((Resource
[Length(Resource
)] = '/') or (Resource
[Length(Resource
)] = '\')) then exit
;
468 FileName
:= g_ExtractWadName(Resource
);
470 WAD
:= TWADFile
.Create();
471 WAD
.ReadFile(FileName
);
473 if not WAD
.GetResource(g_ExtractFilePathName(Resource
), TextureData
, ResourceLength
) then
476 e_WriteLog(Format('Error loading texture %s', [Resource
]), MSG_WARNING
);
477 //e_WriteLog(Format('WAD Reader error: %s', [WAD.GetLastErrorStr]), MSG_WARNING);
481 if not CreateFramesMem(TextureData
, ResourceLength
, ID
, Name
, FWidth
, FHeight
, FCount
, BackAnimation
) then
492 function g_Frames_CreateMemory(ID
: PDWORD
; Name
: ShortString; pData
: Pointer; dataSize
: LongInt;
493 FWidth
, FHeight
, FCount
: Word; BackAnimation
: Boolean = False): Boolean;
495 Result
:= CreateFramesMem(pData
, dataSize
, ID
, Name
, FWidth
, FHeight
, FCount
, BackAnimation
);
498 {function g_Frames_CreateRevert(ID: PDWORD; Name: ShortString; Frames: string): Boolean;
505 if not g_Frames_Get(b, Frames) then Exit;
507 find_id := FindFrame();
509 FramesArray[find_id].Name := Name;
510 FramesArray[find_id].FrameWidth := FramesArray[b].FrameWidth;
511 FramesArray[find_id].FrameHeight := FramesArray[b].FrameHeight;
513 c := High(FramesArray[find_id].TexturesID);
516 FramesArray[find_id].TexturesID[a] := FramesArray[b].TexturesID[c-a];
521 function g_Frames_Dup(NewName
, OldName
: ShortString): Boolean;
528 if not g_Frames_Get(b
, OldName
) then Exit
;
530 find_id
:= FindFrame();
532 FramesArray
[find_id
].Name
:= LowerCase(NewName
);
533 FramesArray
[find_id
].FrameWidth
:= FramesArray
[b
].FrameWidth
;
534 FramesArray
[find_id
].FrameHeight
:= FramesArray
[b
].FrameHeight
;
536 c
:= High(FramesArray
[b
].TexturesID
);
537 SetLength(FramesArray
[find_id
].TexturesID
, c
+1);
540 FramesArray
[find_id
].TexturesID
[a
] := FramesArray
[b
].TexturesID
[a
];
545 procedure g_Frames_DeleteByName(FramesName
: ShortString);
550 if FramesArray
= nil then Exit
;
552 FramesName
:= LowerCase(FramesName
);
554 for a
:= 0 to High(FramesArray
) do
555 if FramesArray
[a
].Name
= FramesName
then
557 if FramesArray
[a
].TexturesID
<> nil then
558 for b
:= 0 to High(FramesArray
[a
].TexturesID
) do
559 e_DeleteTexture(FramesArray
[a
].TexturesID
[b
]);
560 FramesArray
[a
].TexturesID
:= nil;
561 FramesArray
[a
].Name
:= '';
562 FramesArray
[a
].FrameWidth
:= 0;
563 FramesArray
[a
].FrameHeight
:= 0;
567 procedure g_Frames_DeleteByID(ID
: DWORD
);
571 if FramesArray
= nil then Exit
;
573 if FramesArray
[ID
].TexturesID
<> nil then
574 for b
:= 0 to High(FramesArray
[ID
].TexturesID
) do
575 e_DeleteTexture(FramesArray
[ID
].TexturesID
[b
]);
576 FramesArray
[ID
].TexturesID
:= nil;
577 FramesArray
[ID
].Name
:= '';
578 FramesArray
[ID
].FrameWidth
:= 0;
579 FramesArray
[ID
].FrameHeight
:= 0;
582 procedure g_Frames_DeleteAll
;
587 if FramesArray
= nil then Exit
;
589 for a
:= 0 to High(FramesArray
) do
590 if FramesArray
[a
].TexturesID
<> nil then
592 for b
:= 0 to High(FramesArray
[a
].TexturesID
) do
593 e_DeleteTexture(FramesArray
[a
].TexturesID
[b
]);
594 FramesArray
[a
].TexturesID
:= nil;
595 FramesArray
[a
].Name
:= '';
596 FramesArray
[a
].FrameWidth
:= 0;
597 FramesArray
[a
].FrameHeight
:= 0;
603 function g_Frames_Get(out ID
: DWORD
; FramesName
: ShortString): Boolean;
609 if FramesArray
= nil then
612 FramesName
:= LowerCase(FramesName
);
614 for a
:= 0 to High(FramesArray
) do
615 if FramesArray
[a
].Name
= FramesName
then
623 g_FatalError(Format(_lc
[I_GAME_ERROR_FRAMES
], [FramesName
]));
626 function g_Frames_GetTexture(out ID
: DWORD
; FramesName
: ShortString; Frame
: Word): Boolean;
632 if FramesArray
= nil then
635 FramesName
:= LowerCase(FramesName
);
637 for a
:= 0 to High(FramesArray
) do
638 if FramesArray
[a
].Name
= FramesName
then
639 if Frame
<= High(FramesArray
[a
].TexturesID
) then
641 ID
:= FramesArray
[a
].TexturesID
[Frame
];
647 g_FatalError(Format(_lc
[I_GAME_ERROR_FRAMES
], [FramesName
]));
650 function g_Frames_Exists(FramesName
: string): Boolean;
656 if FramesArray
= nil then Exit
;
658 FramesName
:= LowerCase(FramesName
);
660 for a
:= 0 to High(FramesArray
) do
661 if FramesArray
[a
].Name
= FramesName
then
668 procedure DumpTextureNames();
672 e_WriteLog('BEGIN Textures:', MSG_NOTIFY
);
673 for i
:= 0 to High(TexturesArray
) do
674 e_WriteLog(' '+IntToStr(i
)+'. '+TexturesArray
[i
].Name
, MSG_NOTIFY
);
675 e_WriteLog('END Textures.', MSG_NOTIFY
);
677 e_WriteLog('BEGIN Frames:', MSG_NOTIFY
);
678 for i
:= 0 to High(FramesArray
) do
679 e_WriteLog(' '+IntToStr(i
)+'. '+FramesArray
[i
].Name
, MSG_NOTIFY
);
680 e_WriteLog('END Frames.', MSG_NOTIFY
);
685 constructor TAnimation
.Create(FramesID
: DWORD
; Loop
: Boolean; Speed
: Byte);
696 FWidth
:= FramesArray
[ID
].FrameWidth
;
697 FHeight
:= FramesArray
[ID
].FrameHeight
;
700 destructor TAnimation
.Destroy
;
705 procedure TAnimation
.Draw(X
, Y
: Integer; Mirror
: TMirrorType
);
710 e_DrawAdv(FramesArray
[ID
].TexturesID
[FCurrentFrame
], X
, Y
, FAlpha
,
711 True, FBlending
, 0, nil, Mirror
);
712 //e_DrawQuad(X, Y, X+FramesArray[ID].FrameWidth-1, Y+FramesArray[ID].FrameHeight-1, 0, 255, 0);
715 procedure TAnimation
.Update();
720 FCounter
:= FCounter
+ 1;
722 if FCounter
>= FSpeed
then
723 begin // Îæèäàíèå ìåæäó êàäðàìè çàêîí÷èëîñü
725 begin // Îáðàòíûé ïîðÿäîê êàäðîâ
726 // Äîøëè äî êîíöà àíèìàöèè. Âîçìîæíî, æäåì åùå:
727 if FCurrentFrame
= 0 then
728 if Length(FramesArray
[ID
].TexturesID
) * FSpeed
+
729 FCounter
< FMinLength
then
732 FCurrentFrame
:= FCurrentFrame
- 1;
733 FPlayed
:= FCurrentFrame
< 0;
735 // Ïîâòîðÿòü ëè àíèìàöèþ ïî êðóãó:
738 FCurrentFrame
:= High(FramesArray
[ID
].TexturesID
)
740 FCurrentFrame
:= FCurrentFrame
+ 1;
745 begin // Ïðÿìîé ïîðÿäîê êàäðîâ
746 // Äîøëè äî êîíöà àíèìàöèè. Âîçìîæíî, æäåì åùå:
747 if FCurrentFrame
= High(FramesArray
[ID
].TexturesID
) then
748 if Length(FramesArray
[ID
].TexturesID
) * FSpeed
+
749 FCounter
< FMinLength
then
752 FCurrentFrame
:= FCurrentFrame
+ 1;
753 FPlayed
:= (FCurrentFrame
> High(FramesArray
[ID
].TexturesID
));
755 // Ïîâòîðÿòü ëè àíèìàöèþ ïî êðóãó:
760 FCurrentFrame
:= FCurrentFrame
- 1;
767 procedure TAnimation
.Reset();
770 FCurrentFrame
:= High(FramesArray
[ID
].TexturesID
)
778 procedure TAnimation
.Disable
;
783 procedure TAnimation
.Enable
;
788 procedure TAnimation
.DrawEx(X
, Y
: Integer; Mirror
: TMirrorType
; RPoint
: TDFPoint
;
794 e_DrawAdv(FramesArray
[ID
].TexturesID
[FCurrentFrame
], X
, Y
, FAlpha
,
795 True, FBlending
, Angle
, @RPoint
, Mirror
);
798 function TAnimation
.TotalFrames(): Integer;
800 Result
:= Length(FramesArray
[ID
].TexturesID
);
803 procedure TAnimation
.Revert(r
: Boolean);
809 procedure TAnimation
.SaveState(Var Mem
: TBinMemoryWriter
);
816 // Ñèãíàòóðà àíèìàöèè:
817 sig
:= ANIM_SIGNATURE
; // 'ANIM'
819 // Ñ÷åò÷èê îæèäàíèÿ ìåæäó êàäðàìè:
820 Mem
.WriteByte(FCounter
);
822 Mem
.WriteInt(FCurrentFrame
);
823 // Ïðîèãðàíà ëè àíèìàöèÿ öåëèêîì:
824 Mem
.WriteBoolean(FPlayed
);
825 // Alpha-êàíàë âñåé òåêñòóðû:
826 Mem
.WriteByte(FAlpha
);
827 // Ðàçìûòèå òåêñòóðû:
828 Mem
.WriteBoolean(FBlending
);
829 // Âðåìÿ îæèäàíèÿ ìåæäó êàäðàìè:
830 Mem
.WriteByte(FSpeed
);
831 // Çàöèêëåíà ëè àíèìàöèÿ:
832 Mem
.WriteBoolean(FLoop
);
834 Mem
.WriteBoolean(FEnabled
);
835 // Îæèäàíèå ïîñëå ïðîèãðûâàíèÿ:
836 Mem
.WriteByte(FMinLength
);
837 // Îáðàòíûé ëè ïîðÿäîê êàäðîâ:
838 Mem
.WriteBoolean(FRevert
);
841 procedure TAnimation
.LoadState(Var Mem
: TBinMemoryReader
);
848 // Ñèãíàòóðà àíèìàöèè:
850 if sig
<> ANIM_SIGNATURE
then // 'ANIM'
852 raise EBinSizeError
.Create('TAnimation.LoadState: Wrong Animation Signature');
854 // Ñ÷åò÷èê îæèäàíèÿ ìåæäó êàäðàìè:
855 Mem
.ReadByte(FCounter
);
857 Mem
.ReadInt(FCurrentFrame
);
858 // Ïðîèãðàíà ëè àíèìàöèÿ öåëèêîì:
859 Mem
.ReadBoolean(FPlayed
);
860 // Alpha-êàíàë âñåé òåêñòóðû:
861 Mem
.ReadByte(FAlpha
);
862 // Ðàçìûòèå òåêñòóðû:
863 Mem
.ReadBoolean(FBlending
);
864 // Âðåìÿ îæèäàíèÿ ìåæäó êàäðàìè:
865 Mem
.ReadByte(FSpeed
);
866 // Çàöèêëåíà ëè àíèìàöèÿ:
867 Mem
.ReadBoolean(FLoop
);
869 Mem
.ReadBoolean(FEnabled
);
870 // Îæèäàíèå ïîñëå ïðîèãðûâàíèÿ:
871 Mem
.ReadByte(FMinLength
);
872 // Îáðàòíûé ëè ïîðÿäîê êàäðîâ:
873 Mem
.ReadBoolean(FRevert
);
880 function g_Texture_Light(): Integer;
882 Radius
: Integer = 128;
890 GetMem(tex
, (Radius
*2)*(Radius
*2)*4);
892 for y
:= 0 to Radius
*2-1 do
894 for x
:= 0 to Radius
*2-1 do
896 dist
:= 1.0-sqrt((x
-Radius
)*(x
-Radius
)+(y
-Radius
)*(y
-Radius
))/Radius
;
906 //tc.setPixel(x, y, Color(cast(int)(dist*255), cast(int)(dist*255), cast(int)(dist*255)));
907 if (dist
> 0.5) then dist
:= 0.5;
908 a
:= round(dist
*255);
909 if (a
< 0) then a
:= 0 else if (a
> 255) then a
:= 255;
910 tpp
^ := 255; Inc(tpp
);
911 tpp
^ := 255; Inc(tpp
);
912 tpp
^ := 255; Inc(tpp
);
913 tpp
^ := Byte(a
); Inc(tpp
);
918 glGenTextures(1, @ltexid
);
919 //if (tid == 0) assert(0, "VGL: can't create screen texture");
921 glBindTexture(GL_TEXTURE_2D
, ltexid
);
922 glTexParameterf(GL_TEXTURE_2D
, GL_TEXTURE_WRAP_S
, GL_REPEAT
);
923 glTexParameterf(GL_TEXTURE_2D
, GL_TEXTURE_WRAP_T
, GL_REPEAT
);
924 glTexParameteri(GL_TEXTURE_2D
, GL_TEXTURE_MIN_FILTER
, GL_LINEAR
);
925 glTexParameteri(GL_TEXTURE_2D
, GL_TEXTURE_MAG_FILTER
, GL_LINEAR
);
927 //GLfloat[4] bclr = 0.0;
928 //glTexParameterfv(GL_TEXTURE_2D, GL_TEXTURE_BORDER_COLOR, bclr.ptr);
930 glTexImage2D(GL_TEXTURE_2D
, 0, GL_RGBA
, Radius
*2, Radius
*2, 0, GL_RGBA
{gltt}, GL_UNSIGNED_BYTE
, tex
);