DEADSOFTWARE

GIT / REPO / FRED-BOY
Projects / d2df-sdl.git / blob


93d8c63d056e93ad0fc5fef015b1b637173b6ad6
[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, either version 3 of the License, or
6 * (at your option) any later version.
7 *
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.
12 *
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/>.
15 *)
16 {$MODE DELPHI}
17 unit g_textures;
18
19 interface
20
21 uses
22 e_graphics, BinEditor, ImagingTypes, Imaging, ImagingUtility;
23
24 Type
25 TLevelTexture = record
26 TextureName: String;
27 Width,
28 Height: Word;
29 case Anim: Boolean of
30 False: (TextureID: DWORD;);
31 True: (FramesID: DWORD;
32 FramesCount: Byte;
33 Speed: Byte);
34 end;
35
36 TLevelTextureArray = Array of TLevelTexture;
37
38 TAnimation = class(TObject)
39 private
40 ID: DWORD;
41 FAlpha: Byte;
42 FBlending: Boolean;
43 FCounter: Byte; // Ñ÷åò÷èê îæèäàíèÿ ìåæäó êàäðàìè
44 FSpeed: Byte; // Âðåìÿ îæèäàíèÿ ìåæäó êàäðàìè
45 FCurrentFrame: Integer; // Òåêóùèé êàäð (íà÷èíàÿ ñ 0)
46 FLoop: Boolean; // Ïåðåõîäèòü íà ïåðâûé êàäð ïîñëå ïîñëåäíåãî?
47 FEnabled: Boolean; // Ðàáîòà ðàçðåøåíà?
48 FPlayed: Boolean; // Ïðîèãðàíà âñÿ õîòÿ áû ðàç?
49 FHeight: Word;
50 FWidth: Word;
51 FMinLength: Byte; // Îæèäàíèå ïîñëå ïðîèãðûâàíèÿ
52 FRevert: Boolean; // Ñìåíà êàäðîâ îáðàòíàÿ?
53
54 public
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: TPoint;
59 Angle: SmallInt);
60 procedure Reset();
61 procedure Update();
62 procedure Enable();
63 procedure Disable();
64 procedure Revert(r: Boolean);
65 procedure SaveState(Var Mem: TBinMemoryWriter);
66 procedure LoadState(Var Mem: TBinMemoryReader);
67 function TotalFrames(): Integer;
68
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;
83 end;
84
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();
92
93 function g_CreateFramesImg (ia: TDynImageDataArray; ID: PDWORD; Name: ShortString; BackAnimation: Boolean = False): Boolean;
94
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_CreateRevert(ID: PDWORD; Name: ShortString; Frames: string): Boolean;
102 function g_Frames_Get(var ID: DWORD; FramesName: ShortString): Boolean;
103 function g_Frames_GetTexture(var ID: DWORD; FramesName: ShortString; Frame: Word): Boolean;
104 function g_Frames_Exists(FramesName: String): Boolean;
105 procedure g_Frames_DeleteByName(FramesName: ShortString);
106 procedure g_Frames_DeleteByID(ID: DWORD);
107 procedure g_Frames_DeleteAll();
108
109 procedure DumpTextureNames();
110
111 implementation
112
113 uses
114 g_game, e_log, g_basic, SysUtils, g_console, wadreader,
115 g_language;
116
117 type
118 _TTexture = record
119 Name: ShortString;
120 ID: DWORD;
121 Width, Height: Word;
122 end;
123
124 TFrames = record
125 TexturesID: Array of DWORD;
126 Name: ShortString;
127 FrameWidth,
128 FrameHeight: Word;
129 end;
130
131 var
132 TexturesArray: Array of _TTexture = nil;
133 FramesArray: Array of TFrames = nil;
134
135 const
136 ANIM_SIGNATURE = $4D494E41; // 'ANIM'
137
138 function FindTexture(): DWORD;
139 var
140 i: integer;
141 begin
142 if TexturesArray <> nil then
143 for i := 0 to High(TexturesArray) do
144 if TexturesArray[i].Name = '' then
145 begin
146 Result := i;
147 Exit;
148 end;
149
150 if TexturesArray = nil then
151 begin
152 SetLength(TexturesArray, 8);
153 Result := 0;
154 end
155 else
156 begin
157 Result := High(TexturesArray) + 1;
158 SetLength(TexturesArray, Length(TexturesArray) + 8);
159 end;
160 end;
161
162 function g_Texture_CreateWAD(var ID: DWORD; Resource: String): Boolean;
163 var
164 WAD: TWADFile;
165 FileName: String;
166 TextureData: Pointer;
167 ResourceLength: Integer;
168 begin
169 Result := False;
170 FileName := g_ExtractWadName(Resource);
171
172 WAD := TWADFile.Create;
173 WAD.ReadFile(FileName);
174
175 if WAD.GetResource(g_ExtractFilePathName(Resource), TextureData, ResourceLength) then
176 begin
177 if e_CreateTextureMem(TextureData, ResourceLength, ID) then
178 Result := True
179 else
180 FreeMem(TextureData);
181 end
182 else
183 begin
184 e_WriteLog(Format('Error loading texture %s', [Resource]), MSG_WARNING);
185 //e_WriteLog(Format('WAD Reader error: %s', [WAD.GetLastErrorStr]), MSG_WARNING);
186 end;
187 WAD.Free();
188 end;
189
190 function g_Texture_CreateFile(var ID: DWORD; FileName: String): Boolean;
191 begin
192 Result := True;
193 if not e_CreateTexture(FileName, ID) then
194 begin
195 e_WriteLog(Format('Error loading texture %s', [FileName]), MSG_WARNING);
196 Result := False;
197 end;
198 end;
199
200 function g_Texture_CreateWADEx(TextureName: ShortString; Resource: String): Boolean;
201 var
202 WAD: TWADFile;
203 FileName: String;
204 TextureData: Pointer;
205 find_id: DWORD;
206 ResourceLength: Integer;
207 begin
208 FileName := g_ExtractWadName(Resource);
209
210 find_id := FindTexture();
211
212 WAD := TWADFile.Create;
213 WAD.ReadFile(FileName);
214
215 if WAD.GetResource(g_ExtractFilePathName(Resource), TextureData, ResourceLength) then
216 begin
217 Result := e_CreateTextureMem(TextureData, ResourceLength, TexturesArray[find_id].ID);
218 if Result then
219 begin
220 e_GetTextureSize(TexturesArray[find_id].ID, @TexturesArray[find_id].Width,
221 @TexturesArray[find_id].Height);
222 TexturesArray[find_id].Name := LowerCase(TextureName);
223 end
224 else
225 FreeMem(TextureData);
226 end
227 else
228 begin
229 e_WriteLog(Format('Error loading texture %s', [Resource]), MSG_WARNING);
230 //e_WriteLog(Format('WAD Reader error: %s', [WAD.GetLastErrorStr]), MSG_WARNING);
231 Result := False;
232 end;
233 WAD.Free();
234 end;
235
236 function g_Texture_CreateFileEx(TextureName: ShortString; FileName: String): Boolean;
237 var
238 find_id: DWORD;
239 begin
240 find_id := FindTexture;
241
242 Result := e_CreateTexture(FileName, TexturesArray[find_id].ID);
243 if Result then
244 begin
245 TexturesArray[find_id].Name := LowerCase(TextureName);
246 e_GetTextureSize(TexturesArray[find_id].ID, @TexturesArray[find_id].Width,
247 @TexturesArray[find_id].Height);
248 end
249 else e_WriteLog(Format('Error loading texture %s', [FileName]), MSG_WARNING);
250 end;
251
252 function g_Texture_Get(TextureName: ShortString; var ID: DWORD): Boolean;
253 var
254 a: DWORD;
255 begin
256 Result := False;
257
258 if TexturesArray = nil then Exit;
259
260 if TextureName = '' then Exit;
261
262 TextureName := LowerCase(TextureName);
263
264 for a := 0 to High(TexturesArray) do
265 if TexturesArray[a].Name = TextureName then
266 begin
267 ID := TexturesArray[a].ID;
268 Result := True;
269 Break;
270 end;
271
272 //if not Result then g_ConsoleAdd('Texture '+TextureName+' not found');
273 end;
274
275 procedure g_Texture_Delete(TextureName: ShortString);
276 var
277 a: DWORD;
278 begin
279 if TexturesArray = nil then Exit;
280
281 TextureName := LowerCase(TextureName);
282
283 for a := 0 to High(TexturesArray) do
284 if TexturesArray[a].Name = TextureName then
285 begin
286 e_DeleteTexture(TexturesArray[a].ID);
287 TexturesArray[a].Name := '';
288 TexturesArray[a].ID := 0;
289 TexturesArray[a].Width := 0;
290 TexturesArray[a].Height := 0;
291 end;
292 end;
293
294 procedure g_Texture_DeleteAll();
295 var
296 a: DWORD;
297 begin
298 if TexturesArray = nil then Exit;
299
300 for a := 0 to High(TexturesArray) do
301 if TexturesArray[a].Name <> '' then
302 e_DeleteTexture(TexturesArray[a].ID);
303
304 TexturesArray := nil;
305 end;
306
307 function FindFrame(): DWORD;
308 var
309 i: integer;
310 begin
311 if FramesArray <> nil then
312 for i := 0 to High(FramesArray) do
313 if FramesArray[i].TexturesID = nil then
314 begin
315 Result := i;
316 Exit;
317 end;
318
319 if FramesArray = nil then
320 begin
321 SetLength(FramesArray, 64);
322 Result := 0;
323 end
324 else
325 begin
326 Result := High(FramesArray) + 1;
327 SetLength(FramesArray, Length(FramesArray) + 64);
328 end;
329 end;
330
331 function g_Frames_CreateFile(ID: PDWORD; Name: ShortString; FileName: String;
332 FWidth, FHeight, FCount: Word; BackAnimation: Boolean = False): Boolean;
333 var
334 a: Integer;
335 find_id: DWORD;
336 begin
337 Result := False;
338
339 find_id := FindFrame;
340
341 if FCount <= 2 then BackAnimation := False;
342
343 if BackAnimation then SetLength(FramesArray[find_id].TexturesID, FCount+FCount-2)
344 else SetLength(FramesArray[find_id].TexturesID, FCount);
345
346 for a := 0 to FCount-1 do
347 if not e_CreateTextureEx(FileName, FramesArray[find_id].TexturesID[a],
348 a*FWidth, 0, FWidth, FHeight) then Exit;
349
350 if BackAnimation then
351 for a := 1 to FCount-2 do
352 FramesArray[find_id].TexturesID[FCount+FCount-2-a] := FramesArray[find_id].TexturesID[a];
353
354 FramesArray[find_id].FrameWidth := FWidth;
355 FramesArray[find_id].FrameHeight := FHeight;
356 if Name <> '' then
357 FramesArray[find_id].Name := LowerCase(Name)
358 else
359 FramesArray[find_id].Name := '<noname>';
360
361 if ID <> nil then ID^ := find_id;
362
363 Result := True;
364 end;
365
366 function CreateFramesMem(pData: Pointer; dataSize: LongInt; ID: PDWORD; Name: ShortString;
367 FWidth, FHeight, FCount: Word; BackAnimation: Boolean = False): Boolean;
368 var
369 find_id: DWORD;
370 a: Integer;
371 begin
372 Result := False;
373
374 find_id := FindFrame();
375
376 if FCount <= 2 then BackAnimation := False;
377
378 if BackAnimation then SetLength(FramesArray[find_id].TexturesID, FCount+FCount-2)
379 else SetLength(FramesArray[find_id].TexturesID, FCount);
380
381 for a := 0 to FCount-1 do
382 if not e_CreateTextureMemEx(pData, dataSize, FramesArray[find_id].TexturesID[a],
383 a*FWidth, 0, FWidth, FHeight) then
384 begin
385 //!!!FreeMem(pData);
386 Exit;
387 end;
388
389 if BackAnimation then
390 for a := 1 to FCount-2 do
391 FramesArray[find_id].TexturesID[FCount+FCount-2-a] := FramesArray[find_id].TexturesID[a];
392
393 FramesArray[find_id].FrameWidth := FWidth;
394 FramesArray[find_id].FrameHeight := FHeight;
395 if Name <> '' then
396 FramesArray[find_id].Name := LowerCase(Name)
397 else
398 FramesArray[find_id].Name := '<noname>';
399
400 if ID <> nil then ID^ := find_id;
401
402 Result := True;
403 end;
404
405 function g_CreateFramesImg (ia: TDynImageDataArray; ID: PDWORD; Name: ShortString; BackAnimation: Boolean = False): Boolean;
406 var
407 find_id: DWORD;
408 a, FCount: Integer;
409 begin
410 result := false;
411 find_id := FindFrame();
412
413 FCount := length(ia);
414
415 //e_WriteLog(Format('+++ creating %d frames [%s]', [FCount, Name]), MSG_NOTIFY);
416
417 if FCount < 1 then exit;
418 if FCount <= 2 then BackAnimation := False;
419 if BackAnimation then
420 SetLength(FramesArray[find_id].TexturesID, FCount+FCount-2)
421 else
422 SetLength(FramesArray[find_id].TexturesID, FCount);
423
424 //e_WriteLog(Format('+++ creating %d frames, %dx%d', [FCount, ia[0].width, ia[0].height]), MSG_NOTIFY);
425
426 for a := 0 to FCount-1 do
427 begin
428 if not e_CreateTextureImg(ia[a], FramesArray[find_id].TexturesID[a]) then exit;
429 //e_WriteLog(Format('+++ frame %d, %dx%d', [a, ia[a].width, ia[a].height]), MSG_NOTIFY);
430 end;
431
432 if BackAnimation then
433 begin
434 for a := 1 to FCount-2 do
435 begin
436 FramesArray[find_id].TexturesID[FCount+FCount-2-a] := FramesArray[find_id].TexturesID[a];
437 end;
438 end;
439
440 FramesArray[find_id].FrameWidth := ia[0].width;
441 FramesArray[find_id].FrameHeight := ia[0].height;
442 if Name <> '' then
443 FramesArray[find_id].Name := LowerCase(Name)
444 else
445 FramesArray[find_id].Name := '<noname>';
446
447 if ID <> nil then ID^ := find_id;
448
449 result := true;
450 end;
451
452 function g_Frames_CreateWAD(ID: PDWORD; Name: ShortString; Resource: string;
453 FWidth, FHeight, FCount: Word; BackAnimation: Boolean = False): Boolean;
454 var
455 WAD: TWADFile;
456 FileName: string;
457 TextureData: Pointer;
458 ResourceLength: Integer;
459 begin
460 Result := False;
461
462 FileName := g_ExtractWadName(Resource);
463
464 WAD := TWADFile.Create();
465 WAD.ReadFile(FileName);
466
467 if not WAD.GetResource(g_ExtractFilePathName(Resource), TextureData, ResourceLength) then
468 begin
469 WAD.Free();
470 e_WriteLog(Format('Error loading texture %s', [Resource]), MSG_WARNING);
471 //e_WriteLog(Format('WAD Reader error: %s', [WAD.GetLastErrorStr]), MSG_WARNING);
472 Exit;
473 end;
474
475 if not CreateFramesMem(TextureData, ResourceLength, ID, Name, FWidth, FHeight, FCount, BackAnimation) then
476 begin
477 WAD.Free();
478 Exit;
479 end;
480
481 WAD.Free();
482
483 Result := True;
484 end;
485
486 function g_Frames_CreateMemory(ID: PDWORD; Name: ShortString; pData: Pointer; dataSize: LongInt;
487 FWidth, FHeight, FCount: Word; BackAnimation: Boolean = False): Boolean;
488 begin
489 Result := CreateFramesMem(pData, dataSize, ID, Name, FWidth, FHeight, FCount, BackAnimation);
490 end;
491
492 {function g_Frames_CreateRevert(ID: PDWORD; Name: ShortString; Frames: string): Boolean;
493 var
494 find_id, b: DWORD;
495 a, c: Integer;
496 begin
497 Result := False;
498
499 if not g_Frames_Get(b, Frames) then Exit;
500
501 find_id := FindFrame();
502
503 FramesArray[find_id].Name := Name;
504 FramesArray[find_id].FrameWidth := FramesArray[b].FrameWidth;
505 FramesArray[find_id].FrameHeight := FramesArray[b].FrameHeight;
506
507 c := High(FramesArray[find_id].TexturesID);
508
509 for a := 0 to c do
510 FramesArray[find_id].TexturesID[a] := FramesArray[b].TexturesID[c-a];
511
512 Result := True;
513 end;}
514
515 procedure g_Frames_DeleteByName(FramesName: ShortString);
516 var
517 a: DWORD;
518 b: Integer;
519 begin
520 if FramesArray = nil then Exit;
521
522 FramesName := LowerCase(FramesName);
523
524 for a := 0 to High(FramesArray) do
525 if FramesArray[a].Name = FramesName then
526 begin
527 if FramesArray[a].TexturesID <> nil then
528 for b := 0 to High(FramesArray[a].TexturesID) do
529 e_DeleteTexture(FramesArray[a].TexturesID[b]);
530 FramesArray[a].TexturesID := nil;
531 FramesArray[a].Name := '';
532 FramesArray[a].FrameWidth := 0;
533 FramesArray[a].FrameHeight := 0;
534 end;
535 end;
536
537 procedure g_Frames_DeleteByID(ID: DWORD);
538 var
539 b: Integer;
540 begin
541 if FramesArray = nil then Exit;
542
543 if FramesArray[ID].TexturesID <> nil then
544 for b := 0 to High(FramesArray[ID].TexturesID) do
545 e_DeleteTexture(FramesArray[ID].TexturesID[b]);
546 FramesArray[ID].TexturesID := nil;
547 FramesArray[ID].Name := '';
548 FramesArray[ID].FrameWidth := 0;
549 FramesArray[ID].FrameHeight := 0;
550 end;
551
552 procedure g_Frames_DeleteAll;
553 var
554 a: DWORD;
555 b: DWORD;
556 begin
557 if FramesArray = nil then Exit;
558
559 for a := 0 to High(FramesArray) do
560 if FramesArray[a].TexturesID <> nil then
561 begin
562 for b := 0 to High(FramesArray[a].TexturesID) do
563 e_DeleteTexture(FramesArray[a].TexturesID[b]);
564 FramesArray[a].TexturesID := nil;
565 FramesArray[a].Name := '';
566 FramesArray[a].FrameWidth := 0;
567 FramesArray[a].FrameHeight := 0;
568 end;
569
570 FramesArray := nil;
571 end;
572
573 function g_Frames_Get(var ID: DWORD; FramesName: ShortString): Boolean;
574 var
575 a: DWORD;
576 begin
577 Result := False;
578
579 if FramesArray = nil then
580 Exit;
581
582 FramesName := LowerCase(FramesName);
583
584 for a := 0 to High(FramesArray) do
585 if FramesArray[a].Name = FramesName then
586 begin
587 ID := a;
588 Result := True;
589 Break;
590 end;
591
592 if not Result then
593 g_FatalError(Format(_lc[I_GAME_ERROR_FRAMES], [FramesName]));
594 end;
595
596 function g_Frames_GetTexture(var ID: DWORD; FramesName: ShortString; Frame: Word): Boolean;
597 var
598 a: DWORD;
599 begin
600 Result := False;
601
602 if FramesArray = nil then
603 Exit;
604
605 FramesName := LowerCase(FramesName);
606
607 for a := 0 to High(FramesArray) do
608 if FramesArray[a].Name = FramesName then
609 if Frame <= High(FramesArray[a].TexturesID) then
610 begin
611 ID := FramesArray[a].TexturesID[Frame];
612 Result := True;
613 Break;
614 end;
615
616 if not Result then
617 g_FatalError(Format(_lc[I_GAME_ERROR_FRAMES], [FramesName]));
618 end;
619
620 function g_Frames_Exists(FramesName: string): Boolean;
621 var
622 a: DWORD;
623 begin
624 Result := False;
625
626 if FramesArray = nil then Exit;
627
628 FramesName := LowerCase(FramesName);
629
630 for a := 0 to High(FramesArray) do
631 if FramesArray[a].Name = FramesName then
632 begin
633 Result := True;
634 Exit;
635 end;
636 end;
637
638 procedure DumpTextureNames();
639 var
640 i: Integer;
641 begin
642 e_WriteLog('BEGIN Textures:', MSG_NOTIFY);
643 for i := 0 to High(TexturesArray) do
644 e_WriteLog(' '+IntToStr(i)+'. '+TexturesArray[i].Name, MSG_NOTIFY);
645 e_WriteLog('END Textures.', MSG_NOTIFY);
646
647 e_WriteLog('BEGIN Frames:', MSG_NOTIFY);
648 for i := 0 to High(FramesArray) do
649 e_WriteLog(' '+IntToStr(i)+'. '+FramesArray[i].Name, MSG_NOTIFY);
650 e_WriteLog('END Frames.', MSG_NOTIFY);
651 end;
652
653 { TAnimation }
654
655 constructor TAnimation.Create(FramesID: DWORD; Loop: Boolean; Speed: Byte);
656 begin
657 ID := FramesID;
658
659 FMinLength := 0;
660 FLoop := Loop;
661 FSpeed := Speed;
662 FEnabled := True;
663 FCurrentFrame := 0;
664 FPlayed := False;
665 FAlpha := 0;
666 FWidth := FramesArray[ID].FrameWidth;
667 FHeight := FramesArray[ID].FrameHeight;
668 end;
669
670 destructor TAnimation.Destroy;
671 begin
672 inherited;
673 end;
674
675 procedure TAnimation.Draw(X, Y: Integer; Mirror: TMirrorType);
676 begin
677 if not FEnabled then
678 Exit;
679
680 e_DrawAdv(FramesArray[ID].TexturesID[FCurrentFrame], X, Y, FAlpha,
681 True, FBlending, 0, nil, Mirror);
682 //e_DrawQuad(X, Y, X+FramesArray[ID].FrameWidth-1, Y+FramesArray[ID].FrameHeight-1, 0, 255, 0);
683 end;
684
685 procedure TAnimation.Update();
686 begin
687 if not FEnabled then
688 Exit;
689
690 FCounter := FCounter + 1;
691
692 if FCounter >= FSpeed then
693 begin // Îæèäàíèå ìåæäó êàäðàìè çàêîí÷èëîñü
694 if FRevert then
695 begin // Îáðàòíûé ïîðÿäîê êàäðîâ
696 // Äîøëè äî êîíöà àíèìàöèè. Âîçìîæíî, æäåì åùå:
697 if FCurrentFrame = 0 then
698 if Length(FramesArray[ID].TexturesID) * FSpeed +
699 FCounter < FMinLength then
700 Exit;
701
702 FCurrentFrame := FCurrentFrame - 1;
703 FPlayed := FCurrentFrame < 0;
704
705 // Ïîâòîðÿòü ëè àíèìàöèþ ïî êðóãó:
706 if FPlayed then
707 if FLoop then
708 FCurrentFrame := High(FramesArray[ID].TexturesID)
709 else
710 FCurrentFrame := FCurrentFrame + 1;
711
712 FCounter := 0;
713 end
714 else
715 begin // Ïðÿìîé ïîðÿäîê êàäðîâ
716 // Äîøëè äî êîíöà àíèìàöèè. Âîçìîæíî, æäåì åùå:
717 if FCurrentFrame = High(FramesArray[ID].TexturesID) then
718 if Length(FramesArray[ID].TexturesID) * FSpeed +
719 FCounter < FMinLength then
720 Exit;
721
722 FCurrentFrame := FCurrentFrame + 1;
723 FPlayed := (FCurrentFrame > High(FramesArray[ID].TexturesID));
724
725 // Ïîâòîðÿòü ëè àíèìàöèþ ïî êðóãó:
726 if FPlayed then
727 if FLoop then
728 FCurrentFrame := 0
729 else
730 FCurrentFrame := FCurrentFrame - 1;
731
732 FCounter := 0;
733 end;
734 end;
735 end;
736
737 procedure TAnimation.Reset();
738 begin
739 if FRevert then
740 FCurrentFrame := High(FramesArray[ID].TexturesID)
741 else
742 FCurrentFrame := 0;
743
744 FCounter := 0;
745 FPlayed := False;
746 end;
747
748 procedure TAnimation.Disable;
749 begin
750 FEnabled := False;
751 end;
752
753 procedure TAnimation.Enable;
754 begin
755 FEnabled := True;
756 end;
757
758 procedure TAnimation.DrawEx(X, Y: Integer; Mirror: TMirrorType; RPoint: TPoint;
759 Angle: SmallInt);
760 begin
761 if not FEnabled then
762 Exit;
763
764 e_DrawAdv(FramesArray[ID].TexturesID[FCurrentFrame], X, Y, FAlpha,
765 True, FBlending, Angle, @RPoint, Mirror);
766 end;
767
768 function TAnimation.TotalFrames(): Integer;
769 begin
770 Result := Length(FramesArray[ID].TexturesID);
771 end;
772
773 procedure TAnimation.Revert(r: Boolean);
774 begin
775 FRevert := r;
776 Reset();
777 end;
778
779 procedure TAnimation.SaveState(Var Mem: TBinMemoryWriter);
780 var
781 sig: DWORD;
782 begin
783 if Mem = nil then
784 Exit;
785
786 // Ñèãíàòóðà àíèìàöèè:
787 sig := ANIM_SIGNATURE; // 'ANIM'
788 Mem.WriteDWORD(sig);
789 // Ñ÷åò÷èê îæèäàíèÿ ìåæäó êàäðàìè:
790 Mem.WriteByte(FCounter);
791 // Òåêóùèé êàäð:
792 Mem.WriteInt(FCurrentFrame);
793 // Ïðîèãðàíà ëè àíèìàöèÿ öåëèêîì:
794 Mem.WriteBoolean(FPlayed);
795 // Alpha-êàíàë âñåé òåêñòóðû:
796 Mem.WriteByte(FAlpha);
797 // Ðàçìûòèå òåêñòóðû:
798 Mem.WriteBoolean(FBlending);
799 // Âðåìÿ îæèäàíèÿ ìåæäó êàäðàìè:
800 Mem.WriteByte(FSpeed);
801 // Çàöèêëåíà ëè àíèìàöèÿ:
802 Mem.WriteBoolean(FLoop);
803 // Âêëþ÷åíà ëè:
804 Mem.WriteBoolean(FEnabled);
805 // Îæèäàíèå ïîñëå ïðîèãðûâàíèÿ:
806 Mem.WriteByte(FMinLength);
807 // Îáðàòíûé ëè ïîðÿäîê êàäðîâ:
808 Mem.WriteBoolean(FRevert);
809 end;
810
811 procedure TAnimation.LoadState(Var Mem: TBinMemoryReader);
812 var
813 sig: DWORD;
814 begin
815 if Mem = nil then
816 Exit;
817
818 // Ñèãíàòóðà àíèìàöèè:
819 Mem.ReadDWORD(sig);
820 if sig <> ANIM_SIGNATURE then // 'ANIM'
821 begin
822 raise EBinSizeError.Create('TAnimation.LoadState: Wrong Animation Signature');
823 end;
824 // Ñ÷åò÷èê îæèäàíèÿ ìåæäó êàäðàìè:
825 Mem.ReadByte(FCounter);
826 // Òåêóùèé êàäð:
827 Mem.ReadInt(FCurrentFrame);
828 // Ïðîèãðàíà ëè àíèìàöèÿ öåëèêîì:
829 Mem.ReadBoolean(FPlayed);
830 // Alpha-êàíàë âñåé òåêñòóðû:
831 Mem.ReadByte(FAlpha);
832 // Ðàçìûòèå òåêñòóðû:
833 Mem.ReadBoolean(FBlending);
834 // Âðåìÿ îæèäàíèÿ ìåæäó êàäðàìè:
835 Mem.ReadByte(FSpeed);
836 // Çàöèêëåíà ëè àíèìàöèÿ:
837 Mem.ReadBoolean(FLoop);
838 // Âêëþ÷åíà ëè:
839 Mem.ReadBoolean(FEnabled);
840 // Îæèäàíèå ïîñëå ïðîèãðûâàíèÿ:
841 Mem.ReadByte(FMinLength);
842 // Îáðàòíûé ëè ïîðÿäîê êàäðîâ:
843 Mem.ReadBoolean(FRevert);
844 end;
845
846 end.
[MIRROR] a port of Doom 2D Forever to FPC/SDL
[25/02/2024 19:55:35]
DEADSOFTWARE 2012-2024