DEADSOFTWARE

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