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 {$IFDEF USE_MEMPOOL}mempool
,{$ENDIF}
24 e_graphics
, MAPDEF
, ImagingTypes
, Imaging
, ImagingUtility
;
27 TLevelTexture
= record
32 False: (TextureID
: DWORD
;);
33 True: (FramesID
: DWORD
;
38 TLevelTextureArray
= Array of TLevelTexture
;
40 TAnimation
= class{$IFDEF USE_MEMPOOL}(TPoolObject
){$ENDIF}
45 FCounter
: Byte; // Ñ÷åò÷èê îæèäàíèÿ ìåæäó êàäðàìè
46 FSpeed
: Byte; // Âðåìÿ îæèäàíèÿ ìåæäó êàäðàìè
47 FCurrentFrame
: Integer; // Òåêóùèé êàäð (íà÷èíàÿ ñ 0)
48 FLoop
: Boolean; // Ïåðåõîäèòü íà ïåðâûé êàäð ïîñëå ïîñëåäíåãî?
49 FEnabled
: Boolean; // Ðàáîòà ðàçðåøåíà?
50 FPlayed
: Boolean; // Ïðîèãðàíà âñÿ õîòÿ áû ðàç?
53 FMinLength
: Byte; // Îæèäàíèå ïîñëå ïðîèãðûâàíèÿ
54 FRevert
: Boolean; // Ñìåíà êàäðîâ îáðàòíàÿ?
57 constructor Create(FramesID
: DWORD
; Loop
: Boolean; Speed
: Byte);
58 destructor Destroy(); override;
59 procedure Draw(X
, Y
: Integer; Mirror
: TMirrorType
);
60 procedure DrawEx(X
, Y
: Integer; Mirror
: TMirrorType
; RPoint
: TDFPoint
;
66 procedure Revert(r
: Boolean);
67 procedure SaveState(st
: TStream
);
68 procedure LoadState(st
: TStream
);
69 function TotalFrames(): Integer;
71 property Played
: Boolean read FPlayed
;
72 property Enabled
: Boolean read FEnabled
;
73 property IsReverse
: Boolean read FRevert
;
74 property Loop
: Boolean read FLoop write FLoop
;
75 property Speed
: Byte read FSpeed write FSpeed
;
76 property MinLength
: Byte read FMinLength write FMinLength
;
77 property CurrentFrame
: Integer read FCurrentFrame write FCurrentFrame
;
78 property CurrentCounter
: Byte read FCounter write FCounter
;
79 property Counter
: Byte read FCounter
;
80 property Blending
: Boolean read FBlending write FBlending
;
81 property Alpha
: Byte read FAlpha write FAlpha
;
82 property FramesID
: DWORD read ID
;
83 property Width
: Word read FWidth
;
84 property Height
: Word read FHeight
;
87 function g_Texture_CreateWAD(var ID
: DWORD
; Resource
: String): Boolean;
88 function g_Texture_CreateFile(var ID
: DWORD
; FileName
: String): Boolean;
89 function g_Texture_CreateWADEx(TextureName
: ShortString
; Resource
: String; altrsrc
: AnsiString
=''): Boolean;
90 function g_Texture_CreateFileEx(TextureName
: ShortString
; FileName
: String): Boolean;
91 function g_Texture_Get(TextureName
: ShortString
; var ID
: DWORD
): Boolean;
92 procedure g_Texture_Delete(TextureName
: ShortString
);
93 procedure g_Texture_DeleteAll();
95 function g_CreateFramesImg (ia
: TDynImageDataArray
; ID
: PDWORD
; Name
: ShortString
; BackAnimation
: Boolean = False): Boolean;
97 function g_Frames_CreateWAD(ID
: PDWORD
; Name
: ShortString
; Resource
: String;
98 FWidth
, FHeight
, FCount
: Word; BackAnimation
: Boolean = False): Boolean;
99 function g_Frames_CreateFile(ID
: PDWORD
; Name
: ShortString
; FileName
: String;
100 FWidth
, FHeight
, FCount
: Word; BackAnimation
: Boolean = False): Boolean;
101 function g_Frames_CreateMemory(ID
: PDWORD
; Name
: ShortString
; pData
: Pointer; dataSize
: LongInt;
102 FWidth
, FHeight
, FCount
: Word; BackAnimation
: Boolean = False): Boolean;
103 function g_Frames_Dup(NewName
, OldName
: ShortString
): Boolean;
104 //function g_Frames_CreateRevert(ID: PDWORD; Name: ShortString; Frames: string): Boolean;
105 function g_Frames_Get(out ID
: DWORD
; FramesName
: ShortString
): Boolean;
106 function g_Frames_GetTexture(out ID
: DWORD
; FramesName
: ShortString
; Frame
: Word): Boolean;
107 function g_Frames_Exists(FramesName
: String): Boolean;
108 procedure g_Frames_DeleteByName(FramesName
: ShortString
);
109 procedure g_Frames_DeleteByID(ID
: DWORD
);
110 procedure g_Frames_DeleteAll();
112 procedure DumpTextureNames();
114 function g_Texture_Light(): Integer;
119 g_game
, e_log
, g_basic
, g_console
, wadreader
,
120 g_language
, GL
, utils
, xstreams
;
130 TexturesID
: Array of DWORD
;
137 TexturesArray
: Array of _TTexture
= nil;
138 FramesArray
: Array of TFrames
= nil;
141 ANIM_SIGNATURE
= $4D494E41; // 'ANIM'
143 function FindTexture(): DWORD
;
147 if TexturesArray
<> nil then
148 for i
:= 0 to High(TexturesArray
) do
149 if TexturesArray
[i
].Name
= '' then
155 if TexturesArray
= nil then
157 SetLength(TexturesArray
, 8);
162 Result
:= High(TexturesArray
) + 1;
163 SetLength(TexturesArray
, Length(TexturesArray
) + 8);
167 function g_Texture_CreateWAD(var ID
: DWORD
; Resource
: String): Boolean;
171 TextureData
: Pointer;
172 ResourceLength
: Integer;
175 FileName
:= g_ExtractWadName(Resource
);
177 WAD
:= TWADFile
.Create
;
178 WAD
.ReadFile(FileName
);
180 if WAD
.GetResource(g_ExtractFilePathName(Resource
), TextureData
, ResourceLength
) then
182 if e_CreateTextureMem(TextureData
, ResourceLength
, ID
) then
185 FreeMem(TextureData
);
189 e_WriteLog(Format('Error loading texture %s', [Resource
]), TMsgType
.Warning
);
190 //e_WriteLog(Format('WAD Reader error: %s', [WAD.GetLastErrorStr]), MSG_WARNING);
195 function g_Texture_CreateFile(var ID
: DWORD
; FileName
: String): Boolean;
198 if not e_CreateTexture(FileName
, ID
) then
200 e_WriteLog(Format('Error loading texture %s', [FileName
]), TMsgType
.Warning
);
205 function texture_CreateWADExInternal (TextureName
: ShortString
; Resource
: String; showmsg
: Boolean): Boolean;
209 TextureData
: Pointer;
211 ResourceLength
: Integer;
213 FileName
:= g_ExtractWadName(Resource
);
215 find_id
:= FindTexture();
217 WAD
:= TWADFile
.Create
;
218 WAD
.ReadFile(FileName
);
220 if WAD
.GetResource(g_ExtractFilePathName(Resource
), TextureData
, ResourceLength
) then
222 result
:= e_CreateTextureMem(TextureData
, ResourceLength
, TexturesArray
[find_id
].ID
);
225 e_GetTextureSize(TexturesArray
[find_id
].ID
, @TexturesArray
[find_id
].Width
, @TexturesArray
[find_id
].Height
);
226 TexturesArray
[find_id
].Name
:= LowerCase(TextureName
);
230 FreeMem(TextureData
);
237 e_WriteLog(Format('Error loading texture %s', [Resource
]), TMsgType
.Warning
);
239 //e_WriteLog(Format('WAD Reader error: %s', [WAD.GetLastErrorStr]), MSG_WARNING);
245 function g_Texture_CreateWADEx(TextureName
: ShortString
; Resource
: String; altrsrc
: AnsiString
=''): Boolean;
247 if (Length(altrsrc
) > 0) then
249 result
:= texture_CreateWADExInternal(TextureName
, altrsrc
, false);
252 result
:= texture_CreateWADExInternal(TextureName
, Resource
, true);
255 function g_Texture_CreateFileEx(TextureName
: ShortString
; FileName
: String): Boolean;
259 find_id
:= FindTexture
;
261 Result
:= e_CreateTexture(FileName
, TexturesArray
[find_id
].ID
);
264 TexturesArray
[find_id
].Name
:= LowerCase(TextureName
);
265 e_GetTextureSize(TexturesArray
[find_id
].ID
, @TexturesArray
[find_id
].Width
,
266 @TexturesArray
[find_id
].Height
);
268 else e_WriteLog(Format('Error loading texture %s', [FileName
]), TMsgType
.Warning
);
271 function g_Texture_Get(TextureName
: ShortString
; var ID
: DWORD
): Boolean;
277 if TexturesArray
= nil then Exit
;
279 if TextureName
= '' then Exit
;
281 TextureName
:= LowerCase(TextureName
);
283 for a
:= 0 to High(TexturesArray
) do
284 if TexturesArray
[a
].Name
= TextureName
then
286 ID
:= TexturesArray
[a
].ID
;
291 //if not Result then g_ConsoleAdd('Texture '+TextureName+' not found');
294 procedure g_Texture_Delete(TextureName
: ShortString
);
298 if TexturesArray
= nil then Exit
;
300 TextureName
:= LowerCase(TextureName
);
302 for a
:= 0 to High(TexturesArray
) do
303 if TexturesArray
[a
].Name
= TextureName
then
305 e_DeleteTexture(TexturesArray
[a
].ID
);
306 TexturesArray
[a
].Name
:= '';
307 TexturesArray
[a
].ID
:= 0;
308 TexturesArray
[a
].Width
:= 0;
309 TexturesArray
[a
].Height
:= 0;
313 procedure g_Texture_DeleteAll();
317 if TexturesArray
= nil then Exit
;
319 for a
:= 0 to High(TexturesArray
) do
320 if TexturesArray
[a
].Name
<> '' then
321 e_DeleteTexture(TexturesArray
[a
].ID
);
323 TexturesArray
:= nil;
326 function FindFrame(): DWORD
;
330 if FramesArray
<> nil then
331 for i
:= 0 to High(FramesArray
) do
332 if FramesArray
[i
].TexturesID
= nil then
338 if FramesArray
= nil then
340 SetLength(FramesArray
, 64);
345 Result
:= High(FramesArray
) + 1;
346 SetLength(FramesArray
, Length(FramesArray
) + 64);
350 function g_Frames_CreateFile(ID
: PDWORD
; Name
: ShortString
; FileName
: String;
351 FWidth
, FHeight
, FCount
: Word; BackAnimation
: Boolean = False): Boolean;
358 find_id
:= FindFrame
;
360 if FCount
<= 2 then BackAnimation
:= False;
362 if BackAnimation
then SetLength(FramesArray
[find_id
].TexturesID
, FCount
+FCount
-2)
363 else SetLength(FramesArray
[find_id
].TexturesID
, FCount
);
365 for a
:= 0 to FCount
-1 do
366 if not e_CreateTextureEx(FileName
, FramesArray
[find_id
].TexturesID
[a
],
367 a
*FWidth
, 0, FWidth
, FHeight
) then Exit
;
369 if BackAnimation
then
370 for a
:= 1 to FCount
-2 do
371 FramesArray
[find_id
].TexturesID
[FCount
+FCount
-2-a
] := FramesArray
[find_id
].TexturesID
[a
];
373 FramesArray
[find_id
].FrameWidth
:= FWidth
;
374 FramesArray
[find_id
].FrameHeight
:= FHeight
;
376 FramesArray
[find_id
].Name
:= LowerCase(Name
)
378 FramesArray
[find_id
].Name
:= '<noname>';
380 if ID
<> nil then ID
^ := find_id
;
385 function CreateFramesMem(pData
: Pointer; dataSize
: LongInt; ID
: PDWORD
; Name
: ShortString
;
386 FWidth
, FHeight
, FCount
: Word; BackAnimation
: Boolean = False): Boolean;
393 find_id
:= FindFrame();
395 if FCount
<= 2 then BackAnimation
:= False;
397 if BackAnimation
then SetLength(FramesArray
[find_id
].TexturesID
, FCount
+FCount
-2)
398 else SetLength(FramesArray
[find_id
].TexturesID
, FCount
);
400 for a
:= 0 to FCount
-1 do
401 if not e_CreateTextureMemEx(pData
, dataSize
, FramesArray
[find_id
].TexturesID
[a
],
402 a
*FWidth
, 0, FWidth
, FHeight
) then
408 if BackAnimation
then
409 for a
:= 1 to FCount
-2 do
410 FramesArray
[find_id
].TexturesID
[FCount
+FCount
-2-a
] := FramesArray
[find_id
].TexturesID
[a
];
412 FramesArray
[find_id
].FrameWidth
:= FWidth
;
413 FramesArray
[find_id
].FrameHeight
:= FHeight
;
415 FramesArray
[find_id
].Name
:= LowerCase(Name
)
417 FramesArray
[find_id
].Name
:= '<noname>';
419 if ID
<> nil then ID
^ := find_id
;
424 function g_CreateFramesImg (ia
: TDynImageDataArray
; ID
: PDWORD
; Name
: ShortString
; BackAnimation
: Boolean = False): Boolean;
430 find_id
:= FindFrame();
432 FCount
:= length(ia
);
434 //e_WriteLog(Format('+++ creating %d frames [%s]', [FCount, Name]), MSG_NOTIFY);
436 if FCount
< 1 then exit
;
437 if FCount
<= 2 then BackAnimation
:= False;
438 if BackAnimation
then
439 SetLength(FramesArray
[find_id
].TexturesID
, FCount
+FCount
-2)
441 SetLength(FramesArray
[find_id
].TexturesID
, FCount
);
443 //e_WriteLog(Format('+++ creating %d frames, %dx%d', [FCount, ia[0].width, ia[0].height]), MSG_NOTIFY);
445 for a
:= 0 to FCount
-1 do
447 if not e_CreateTextureImg(ia
[a
], FramesArray
[find_id
].TexturesID
[a
]) then exit
;
448 //e_WriteLog(Format('+++ frame %d, %dx%d', [a, ia[a].width, ia[a].height]), MSG_NOTIFY);
451 if BackAnimation
then
453 for a
:= 1 to FCount
-2 do
455 FramesArray
[find_id
].TexturesID
[FCount
+FCount
-2-a
] := FramesArray
[find_id
].TexturesID
[a
];
459 FramesArray
[find_id
].FrameWidth
:= ia
[0].width
;
460 FramesArray
[find_id
].FrameHeight
:= ia
[0].height
;
462 FramesArray
[find_id
].Name
:= LowerCase(Name
)
464 FramesArray
[find_id
].Name
:= '<noname>';
466 if ID
<> nil then ID
^ := find_id
;
471 function g_Frames_CreateWAD(ID
: PDWORD
; Name
: ShortString
; Resource
: string;
472 FWidth
, FHeight
, FCount
: Word; BackAnimation
: Boolean = False): Boolean;
476 TextureData
: Pointer;
477 ResourceLength
: Integer;
481 // models without "advanced" animations asks for "nothing" like this; don't spam log
482 if (Length(Resource
) > 0) and ((Resource
[Length(Resource
)] = '/') or (Resource
[Length(Resource
)] = '\')) then exit
;
484 FileName
:= g_ExtractWadName(Resource
);
486 WAD
:= TWADFile
.Create();
487 WAD
.ReadFile(FileName
);
489 if not WAD
.GetResource(g_ExtractFilePathName(Resource
), TextureData
, ResourceLength
) then
492 e_WriteLog(Format('Error loading texture %s', [Resource
]), TMsgType
.Warning
);
493 //e_WriteLog(Format('WAD Reader error: %s', [WAD.GetLastErrorStr]), MSG_WARNING);
497 if not CreateFramesMem(TextureData
, ResourceLength
, ID
, Name
, FWidth
, FHeight
, FCount
, BackAnimation
) then
508 function g_Frames_CreateMemory(ID
: PDWORD
; Name
: ShortString
; pData
: Pointer; dataSize
: LongInt;
509 FWidth
, FHeight
, FCount
: Word; BackAnimation
: Boolean = False): Boolean;
511 Result
:= CreateFramesMem(pData
, dataSize
, ID
, Name
, FWidth
, FHeight
, FCount
, BackAnimation
);
514 {function g_Frames_CreateRevert(ID: PDWORD; Name: ShortString; Frames: string): Boolean;
521 if not g_Frames_Get(b, Frames) then Exit;
523 find_id := FindFrame();
525 FramesArray[find_id].Name := Name;
526 FramesArray[find_id].FrameWidth := FramesArray[b].FrameWidth;
527 FramesArray[find_id].FrameHeight := FramesArray[b].FrameHeight;
529 c := High(FramesArray[find_id].TexturesID);
532 FramesArray[find_id].TexturesID[a] := FramesArray[b].TexturesID[c-a];
537 function g_Frames_Dup(NewName
, OldName
: ShortString
): Boolean;
544 if not g_Frames_Get(b
, OldName
) then Exit
;
546 find_id
:= FindFrame();
548 FramesArray
[find_id
].Name
:= LowerCase(NewName
);
549 FramesArray
[find_id
].FrameWidth
:= FramesArray
[b
].FrameWidth
;
550 FramesArray
[find_id
].FrameHeight
:= FramesArray
[b
].FrameHeight
;
552 c
:= High(FramesArray
[b
].TexturesID
);
553 SetLength(FramesArray
[find_id
].TexturesID
, c
+1);
556 FramesArray
[find_id
].TexturesID
[a
] := FramesArray
[b
].TexturesID
[a
];
561 procedure g_Frames_DeleteByName(FramesName
: ShortString
);
566 if FramesArray
= nil then Exit
;
568 FramesName
:= LowerCase(FramesName
);
570 for a
:= 0 to High(FramesArray
) do
571 if FramesArray
[a
].Name
= FramesName
then
573 if FramesArray
[a
].TexturesID
<> nil then
574 for b
:= 0 to High(FramesArray
[a
].TexturesID
) do
575 e_DeleteTexture(FramesArray
[a
].TexturesID
[b
]);
576 FramesArray
[a
].TexturesID
:= nil;
577 FramesArray
[a
].Name
:= '';
578 FramesArray
[a
].FrameWidth
:= 0;
579 FramesArray
[a
].FrameHeight
:= 0;
583 procedure g_Frames_DeleteByID(ID
: DWORD
);
587 if FramesArray
= nil then Exit
;
589 if FramesArray
[ID
].TexturesID
<> nil then
590 for b
:= 0 to High(FramesArray
[ID
].TexturesID
) do
591 e_DeleteTexture(FramesArray
[ID
].TexturesID
[b
]);
592 FramesArray
[ID
].TexturesID
:= nil;
593 FramesArray
[ID
].Name
:= '';
594 FramesArray
[ID
].FrameWidth
:= 0;
595 FramesArray
[ID
].FrameHeight
:= 0;
598 procedure g_Frames_DeleteAll
;
603 if FramesArray
= nil then Exit
;
605 for a
:= 0 to High(FramesArray
) do
606 if FramesArray
[a
].TexturesID
<> nil then
608 for b
:= 0 to High(FramesArray
[a
].TexturesID
) do
609 e_DeleteTexture(FramesArray
[a
].TexturesID
[b
]);
610 FramesArray
[a
].TexturesID
:= nil;
611 FramesArray
[a
].Name
:= '';
612 FramesArray
[a
].FrameWidth
:= 0;
613 FramesArray
[a
].FrameHeight
:= 0;
619 function g_Frames_Get(out ID
: DWORD
; FramesName
: ShortString
): Boolean;
625 if FramesArray
= nil then
628 FramesName
:= LowerCase(FramesName
);
630 for a
:= 0 to High(FramesArray
) do
631 if FramesArray
[a
].Name
= FramesName
then
639 g_FatalError(Format(_lc
[I_GAME_ERROR_FRAMES
], [FramesName
]));
642 function g_Frames_GetTexture(out ID
: DWORD
; FramesName
: ShortString
; Frame
: Word): Boolean;
648 if FramesArray
= nil then
651 FramesName
:= LowerCase(FramesName
);
653 for a
:= 0 to High(FramesArray
) do
654 if FramesArray
[a
].Name
= FramesName
then
655 if Frame
<= High(FramesArray
[a
].TexturesID
) then
657 ID
:= FramesArray
[a
].TexturesID
[Frame
];
663 g_FatalError(Format(_lc
[I_GAME_ERROR_FRAMES
], [FramesName
]));
666 function g_Frames_Exists(FramesName
: string): Boolean;
672 if FramesArray
= nil then Exit
;
674 FramesName
:= LowerCase(FramesName
);
676 for a
:= 0 to High(FramesArray
) do
677 if FramesArray
[a
].Name
= FramesName
then
684 procedure DumpTextureNames();
688 e_WriteLog('BEGIN Textures:', TMsgType
.Notify
);
689 for i
:= 0 to High(TexturesArray
) do
690 e_WriteLog(' '+IntToStr(i
)+'. '+TexturesArray
[i
].Name
, TMsgType
.Notify
);
691 e_WriteLog('END Textures.', TMsgType
.Notify
);
693 e_WriteLog('BEGIN Frames:', TMsgType
.Notify
);
694 for i
:= 0 to High(FramesArray
) do
695 e_WriteLog(' '+IntToStr(i
)+'. '+FramesArray
[i
].Name
, TMsgType
.Notify
);
696 e_WriteLog('END Frames.', TMsgType
.Notify
);
701 constructor TAnimation
.Create(FramesID
: DWORD
; Loop
: Boolean; Speed
: Byte);
712 FWidth
:= FramesArray
[ID
].FrameWidth
;
713 FHeight
:= FramesArray
[ID
].FrameHeight
;
716 destructor TAnimation
.Destroy
;
721 procedure TAnimation
.Draw(X
, Y
: Integer; Mirror
: TMirrorType
);
726 e_DrawAdv(FramesArray
[ID
].TexturesID
[FCurrentFrame
], X
, Y
, FAlpha
,
727 True, FBlending
, 0, nil, Mirror
);
728 //e_DrawQuad(X, Y, X+FramesArray[ID].FrameWidth-1, Y+FramesArray[ID].FrameHeight-1, 0, 255, 0);
731 procedure TAnimation
.Update();
736 FCounter
:= FCounter
+ 1;
738 if FCounter
>= FSpeed
then
739 begin // Îæèäàíèå ìåæäó êàäðàìè çàêîí÷èëîñü
741 begin // Îáðàòíûé ïîðÿäîê êàäðîâ
742 // Äîøëè äî êîíöà àíèìàöèè. Âîçìîæíî, æäåì åùå:
743 if FCurrentFrame
= 0 then
744 if Length(FramesArray
[ID
].TexturesID
) * FSpeed
+
745 FCounter
< FMinLength
then
748 FCurrentFrame
:= FCurrentFrame
- 1;
749 FPlayed
:= FCurrentFrame
< 0;
751 // Ïîâòîðÿòü ëè àíèìàöèþ ïî êðóãó:
754 FCurrentFrame
:= High(FramesArray
[ID
].TexturesID
)
756 FCurrentFrame
:= FCurrentFrame
+ 1;
761 begin // Ïðÿìîé ïîðÿäîê êàäðîâ
762 // Äîøëè äî êîíöà àíèìàöèè. Âîçìîæíî, æäåì åùå:
763 if FCurrentFrame
= High(FramesArray
[ID
].TexturesID
) then
764 if Length(FramesArray
[ID
].TexturesID
) * FSpeed
+
765 FCounter
< FMinLength
then
768 FCurrentFrame
:= FCurrentFrame
+ 1;
769 FPlayed
:= (FCurrentFrame
> High(FramesArray
[ID
].TexturesID
));
771 // Ïîâòîðÿòü ëè àíèìàöèþ ïî êðóãó:
776 FCurrentFrame
:= FCurrentFrame
- 1;
783 procedure TAnimation
.Reset();
786 FCurrentFrame
:= High(FramesArray
[ID
].TexturesID
)
794 procedure TAnimation
.Disable
;
799 procedure TAnimation
.Enable
;
804 procedure TAnimation
.DrawEx(X
, Y
: Integer; Mirror
: TMirrorType
; RPoint
: TDFPoint
;
810 e_DrawAdv(FramesArray
[ID
].TexturesID
[FCurrentFrame
], X
, Y
, FAlpha
,
811 True, FBlending
, Angle
, @RPoint
, Mirror
);
814 function TAnimation
.TotalFrames(): Integer;
816 Result
:= Length(FramesArray
[ID
].TexturesID
);
819 procedure TAnimation
.Revert(r
: Boolean);
825 procedure TAnimation
.SaveState (st
: TStream
);
827 if (st
= nil) then exit
;
829 utils
.writeSign(st
, 'ANIM');
830 utils
.writeInt(st
, Byte(0)); // version
831 // Ñ÷åò÷èê îæèäàíèÿ ìåæäó êàäðàìè
832 utils
.writeInt(st
, Byte(FCounter
));
834 utils
.writeInt(st
, LongInt(FCurrentFrame
));
835 // Ïðîèãðàíà ëè àíèìàöèÿ öåëèêîì
836 utils
.writeBool(st
, FPlayed
);
837 // Alpha-êàíàë âñåé òåêñòóðû
838 utils
.writeInt(st
, Byte(FAlpha
));
840 utils
.writeInt(st
, Byte(FBlending
));
841 // Âðåìÿ îæèäàíèÿ ìåæäó êàäðàìè
842 utils
.writeInt(st
, Byte(FSpeed
));
843 // Çàöèêëåíà ëè àíèìàöèÿ
844 utils
.writeBool(st
, FLoop
);
846 utils
.writeBool(st
, FEnabled
);
847 // Îæèäàíèå ïîñëå ïðîèãðûâàíèÿ
848 utils
.writeInt(st
, Byte(FMinLength
));
849 // Îáðàòíûé ëè ïîðÿäîê êàäðîâ
850 utils
.writeBool(st
, FRevert
);
853 procedure TAnimation
.LoadState (st
: TStream
);
855 if (st
= nil) then exit
;
857 if not utils
.checkSign(st
, 'ANIM') then raise XStreamError
.Create('animation chunk expected');
858 if (utils
.readByte(st
) <> 0) then raise XStreamError
.Create('invalid animation chunk version');
859 // Ñ÷åò÷èê îæèäàíèÿ ìåæäó êàäðàìè
860 FCounter
:= utils
.readByte(st
);
862 FCurrentFrame
:= utils
.readLongInt(st
);
863 // Ïðîèãðàíà ëè àíèìàöèÿ öåëèêîì
864 FPlayed
:= utils
.readBool(st
);
865 // Alpha-êàíàë âñåé òåêñòóðû
866 FAlpha
:= utils
.readByte(st
);
868 FBlending
:= utils
.readBool(st
);
869 // Âðåìÿ îæèäàíèÿ ìåæäó êàäðàìè
870 FSpeed
:= utils
.readByte(st
);
871 // Çàöèêëåíà ëè àíèìàöèÿ
872 FLoop
:= utils
.readBool(st
);
874 FEnabled
:= utils
.readBool(st
);
875 // Îæèäàíèå ïîñëå ïðîèãðûâàíèÿ
876 FMinLength
:= utils
.readByte(st
);
877 // Îáðàòíûé ëè ïîðÿäîê êàäðîâ
878 FRevert
:= utils
.readBool(st
);
885 function g_Texture_Light(): Integer;
887 Radius
: Integer = 128;
895 GetMem(tex
, (Radius
*2)*(Radius
*2)*4);
897 for y
:= 0 to Radius
*2-1 do
899 for x
:= 0 to Radius
*2-1 do
901 dist
:= 1.0-sqrt((x
-Radius
)*(x
-Radius
)+(y
-Radius
)*(y
-Radius
))/Radius
;
911 //tc.setPixel(x, y, Color(cast(int)(dist*255), cast(int)(dist*255), cast(int)(dist*255)));
912 if (dist
> 0.5) then dist
:= 0.5;
913 a
:= round(dist
*255);
914 if (a
< 0) then a
:= 0 else if (a
> 255) then a
:= 255;
915 tpp
^ := 255; Inc(tpp
);
916 tpp
^ := 255; Inc(tpp
);
917 tpp
^ := 255; Inc(tpp
);
918 tpp
^ := Byte(a
); Inc(tpp
);
923 glGenTextures(1, @ltexid
);
924 //if (tid == 0) assert(0, "VGL: can't create screen texture");
926 glBindTexture(GL_TEXTURE_2D
, ltexid
);
927 glTexParameterf(GL_TEXTURE_2D
, GL_TEXTURE_WRAP_S
, GL_REPEAT
);
928 glTexParameterf(GL_TEXTURE_2D
, GL_TEXTURE_WRAP_T
, GL_REPEAT
);
929 glTexParameteri(GL_TEXTURE_2D
, GL_TEXTURE_MIN_FILTER
, GL_LINEAR
);
930 glTexParameteri(GL_TEXTURE_2D
, GL_TEXTURE_MAG_FILTER
, GL_LINEAR
);
932 //GLfloat[4] bclr = 0.0;
933 //glTexParameterfv(GL_TEXTURE_2D, GL_TEXTURE_BORDER_COLOR, bclr.ptr);
935 glTexImage2D(GL_TEXTURE_2D
, 0, GL_RGBA
, Radius
*2, Radius
*2, 0, GL_RGBA
{gltt}, GL_UNSIGNED_BYTE
, tex
);