DEADSOFTWARE

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