X-Git-Url: http://deadsoftware.ru/gitweb?a=blobdiff_plain;f=src%2Fgame%2Fg_textures.pas;h=7d8ad75283212881d9f40d4963ab75de5ef27b1c;hb=305dd578c69d930bdbb89a11d7e564b74f34378a;hp=613419e21e451e1f0793126bdbf9c67fe174eaf3;hpb=8b87c4d3552073bc1dd71381553fa9973adbe260;p=d2df-sdl.git diff --git a/src/game/g_textures.pas b/src/game/g_textures.pas index 613419e..7d8ad75 100644 --- a/src/game/g_textures.pas +++ b/src/game/g_textures.pas @@ -1,157 +1,218 @@ -{$MODE DELPHI} +(* Copyright (C) Doom 2D: Forever Developers + * + * This program is free software: you can redistribute it and/or modify + * it under the terms of the GNU General Public License as published by + * the Free Software Foundation, version 3 of the License ONLY. + * + * This program is distributed in the hope that it will be useful, + * but WITHOUT ANY WARRANTY; without even the implied warranty of + * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + * GNU General Public License for more details. + * + * You should have received a copy of the GNU General Public License + * along with this program. If not, see . + *) +{$INCLUDE ../shared/a_modes.inc} unit g_textures; interface uses - e_graphics, BinEditor, ImagingTypes, Imaging, ImagingUtility; + SysUtils, Classes, + {$IFDEF USE_MEMPOOL}mempool,{$ENDIF} + e_graphics, MAPDEF, ImagingTypes, Imaging, ImagingUtility; -Type +type TLevelTexture = record - TextureName: String; - Width, - Height: Word; - case Anim: Boolean of - False: (TextureID: DWORD;); - True: (FramesID: DWORD; - FramesCount: Byte; - Speed: Byte); + textureName: AnsiString; + width, height: Word; + case anim: Boolean of + false: (textureID: LongWord); + true: (framesID: LongWord; framesCount: Byte; speed: Byte); end; - TLevelTextureArray = Array of TLevelTexture; + TLevelTextureArray = array of TLevelTexture; - TAnimation = class(TObject) + TAnimation = class{$IFDEF USE_MEMPOOL}(TPoolObject){$ENDIF} private - ID: DWORD; - FAlpha: Byte; - FBlending: Boolean; - FCounter: Byte; // Ñ÷åò÷èê îæèäàíèÿ ìåæäó êàäðàìè - FSpeed: Byte; // Âðåìÿ îæèäàíèÿ ìåæäó êàäðàìè - FCurrentFrame: Integer; // Òåêóùèé êàäð (íà÷èíàÿ ñ 0) - FLoop: Boolean; // Ïåðåõîäèòü íà ïåðâûé êàäð ïîñëå ïîñëåäíåãî? - FEnabled: Boolean; // Ðàáîòà ðàçðåøåíà? - FPlayed: Boolean; // Ïðîèãðàíà âñÿ õîòÿ áû ðàç? - FHeight: Word; - FWidth: Word; - FMinLength: Byte; // Îæèäàíèå ïîñëå ïðîèãðûâàíèÿ - FRevert: Boolean; // Ñìåíà êàäðîâ îáðàòíàÿ? + mId: LongWord; + mAlpha: Byte; + mBlending: Boolean; + mCounter: Byte; // Ñ÷åò÷èê îæèäàíèÿ ìåæäó êàäðàìè + mSpeed: Byte; // Âðåìÿ îæèäàíèÿ ìåæäó êàäðàìè + mCurrentFrame: Integer; // Òåêóùèé êàäð (íà÷èíàÿ ñ 0) + mLoop: Boolean; // Ïåðåõîäèòü íà ïåðâûé êàäð ïîñëå ïîñëåäíåãî? + mEnabled: Boolean; // Ðàáîòà ðàçðåøåíà? + mPlayed: Boolean; // Ïðîèãðàíà âñÿ õîòÿ áû ðàç? + mHeight: Word; + mWidth: Word; + mMinLength: Byte; // Îæèäàíèå ïîñëå ïðîèãðûâàíèÿ + mRevert: Boolean; // Ñìåíà êàäðîâ îáðàòíàÿ? + + public + constructor Create (aframesID: LongWord; aloop: Boolean; aspeed: Byte); + destructor Destroy (); override; + + procedure draw (x, y: Integer; mirror: TMirrorType); + procedure drawEx (x, y: Integer; mirror: TMirrorType; rpoint: TDFPoint; angle: SmallInt); + + procedure reset (); + procedure update (); + procedure enable (); + procedure disable (); + procedure revert (r: Boolean); + + procedure saveState (st: TStream); + procedure loadState (st: TStream); + + function totalFrames (): Integer; inline; public - constructor Create(FramesID: DWORD; Loop: Boolean; Speed: Byte); - destructor Destroy(); override; - procedure Draw(X, Y: Integer; Mirror: TMirrorType); - procedure DrawEx(X, Y: Integer; Mirror: TMirrorType; RPoint: TPoint; - Angle: SmallInt); - procedure Reset(); - procedure Update(); - procedure Enable(); - procedure Disable(); - procedure Revert(r: Boolean); - procedure SaveState(Var Mem: TBinMemoryWriter); - procedure LoadState(Var Mem: TBinMemoryReader); - function TotalFrames(): Integer; - - property Played: Boolean read FPlayed; - property Enabled: Boolean read FEnabled; - property IsReverse: Boolean read FRevert; - property Loop: Boolean read FLoop write FLoop; - property Speed: Byte read FSpeed write FSpeed; - property MinLength: Byte read FMinLength write FMinLength; - property CurrentFrame: Integer read FCurrentFrame write FCurrentFrame; - property CurrentCounter: Byte read FCounter write FCounter; - property Counter: Byte read FCounter; - property Blending: Boolean read FBlending write FBlending; - property Alpha: Byte read FAlpha write FAlpha; - property FramesID: DWORD read ID; - property Width: Word read FWidth; - property Height: Word read FHeight; - end; - -function g_Texture_CreateWAD(var ID: DWORD; Resource: String): Boolean; -function g_Texture_CreateFile(var ID: DWORD; FileName: String): Boolean; -function g_Texture_CreateWADEx(TextureName: ShortString; Resource: String): Boolean; -function g_Texture_CreateFileEx(TextureName: ShortString; FileName: String): Boolean; -function g_Texture_Get(TextureName: ShortString; var ID: DWORD): Boolean; -procedure g_Texture_Delete(TextureName: ShortString); -procedure g_Texture_DeleteAll(); - -function g_CreateFramesImg (ia: TDynImageDataArray; ID: PDWORD; Name: ShortString; BackAnimation: Boolean = False): Boolean; - -function g_Frames_CreateWAD(ID: PDWORD; Name: ShortString; Resource: String; - FWidth, FHeight, FCount: Word; BackAnimation: Boolean = False): Boolean; -function g_Frames_CreateFile(ID: PDWORD; Name: ShortString; FileName: String; - FWidth, FHeight, FCount: Word; BackAnimation: Boolean = False): Boolean; -function g_Frames_CreateMemory(ID: PDWORD; Name: ShortString; pData: Pointer; dataSize: LongInt; - FWidth, FHeight, FCount: Word; BackAnimation: Boolean = False): Boolean; + property played: Boolean read mPlayed; + property enabled: Boolean read mEnabled; + property isReverse: Boolean read mRevert; + property loop: Boolean read mLoop write mLoop; + property speed: Byte read mSpeed write mSpeed; + property minLength: Byte read mMinLength write mMinLength; + property currentFrame: Integer read mCurrentFrame write mCurrentFrame; + property currentCounter: Byte read mCounter write mCounter; + property counter: Byte read mCounter; + property blending: Boolean read mBlending write mBlending; + property alpha: Byte read mAlpha write mAlpha; + property framesId: LongWord read mId; + property width: Word read mWidth; + property height: Word read mHeight; + end; + + +function g_Texture_CreateWAD (var ID: LongWord; const Resource: AnsiString): Boolean; +function g_Texture_CreateFile (var ID: LongWord; const FileName: AnsiString): Boolean; +function g_Texture_CreateWADEx (const textureName, Resource: AnsiString): Boolean; +function g_Texture_CreateFileEx (const textureName, FileName: AnsiString): Boolean; +function g_Texture_Get (const textureName: AnsiString; var ID: LongWord): Boolean; +function g_Texture_GetSize (const textureName: AnsiString; var w, h: Integer): Boolean; overload; +function g_Texture_GetSize (ID: LongWord; var w, h: Integer): Boolean; overload; +procedure g_Texture_Delete (const textureName: AnsiString); +procedure g_Texture_DeleteAll (); + +function g_CreateFramesImg (ia: TDynImageDataArray; ID: PDWORD; const Name: AnsiString; BackAnimation: Boolean=false): Boolean; + +function g_Frames_CreateWAD (ID: PDWORD; const Name, Resource: AnsiString; mWidth, mHeight, mCount: Word; BackAnimation: Boolean=false): Boolean; +function g_Frames_CreateFile (ID: PDWORD; const Name, FileName: AnsiString; mWidth, mHeight, mCount: Word; BackAnimation: Boolean=false): Boolean; +function g_Frames_CreateMemory (ID: PDWORD; const Name: AnsiString; pData: Pointer; dataSize: LongInt; + mWidth, mHeight, mCount: Word; BackAnimation: Boolean=false): Boolean; +function g_Frames_Dup (const NewName, OldName: AnsiString): Boolean; //function g_Frames_CreateRevert(ID: PDWORD; Name: ShortString; Frames: string): Boolean; -function g_Frames_Get(var ID: DWORD; FramesName: ShortString): Boolean; -function g_Frames_GetTexture(var ID: DWORD; FramesName: ShortString; Frame: Word): Boolean; -function g_Frames_Exists(FramesName: String): Boolean; -procedure g_Frames_DeleteByName(FramesName: ShortString); -procedure g_Frames_DeleteByID(ID: DWORD); -procedure g_Frames_DeleteAll(); +function g_Frames_Get (out ID: LongWord; const FramesName: AnsiString): Boolean; +function g_Frames_GetTexture (out ID: LongWord; const FramesName: AnsiString; Frame: Word): Boolean; +function g_Frames_Exists (const FramesName: AnsiString): Boolean; +procedure g_Frames_DeleteByName (const FramesName: AnsiString); +procedure g_Frames_DeleteByID (ID: LongWord); +procedure g_Frames_DeleteAll (); + +procedure DumpTextureNames (); + +function g_Texture_Light (): Integer; -procedure DumpTextureNames(); implementation uses - g_game, e_log, g_basic, SysUtils, g_console, wadreader, - g_language; + {$INCLUDE ../nogl/noGLuses.inc} + g_game, e_log, g_basic, g_console, wadreader, + g_language, utils, xstreams; type _TTexture = record - Name: ShortString; - ID: DWORD; - Width, Height: Word; + name: AnsiString; + id: LongWord; + width, height: Word; + used: Boolean; end; TFrames = record - TexturesID: Array of DWORD; - Name: ShortString; - FrameWidth, - FrameHeight: Word; + texturesID: array of LongWord; + name: AnsiString; + frameWidth, frameHeight: Word; + used: Boolean; end; var - TexturesArray: Array of _TTexture = nil; - FramesArray: Array of TFrames = nil; + texturesArray: array of _TTexture = nil; + framesArray: array of TFrames = nil; + const ANIM_SIGNATURE = $4D494E41; // 'ANIM' -function FindTexture(): DWORD; + +function allocTextureSlot (): LongWord; var - i: integer; + f: integer; begin - if TexturesArray <> nil then - for i := 0 to High(TexturesArray) do - if TexturesArray[i].Name = '' then + for f := 0 to High(texturesArray) do + begin + if (not texturesArray[f].used) then begin - Result := i; - Exit; + result := f; + exit; end; + end; - if TexturesArray = nil then + result := Length(texturesArray); + SetLength(texturesArray, result+64); + for f := result to High(texturesArray) do begin - SetLength(TexturesArray, 8); - Result := 0; - end - else + with texturesArray[f] do + begin + name := ''; + id := 0; + width := 0; + height := 0; + used := false; + end; + end; +end; + + +function allocFrameSlot (): LongWord; +var + f: integer; +begin + for f := 0 to High(framesArray) do begin - Result := High(TexturesArray) + 1; - SetLength(TexturesArray, Length(TexturesArray) + 8); + if (not framesArray[f].used) then + begin + result := f; + exit; + end; + end; + + result := Length(framesArray); + SetLength(framesArray, result+64); + for f := result to High(framesArray) do + begin + with framesArray[f] do + begin + texturesID := nil; + name := ''; + frameWidth := 0; + frameHeight := 0; + used := false; + end; end; end; -function g_Texture_CreateWAD(var ID: DWORD; Resource: String): Boolean; + +// ////////////////////////////////////////////////////////////////////////// // +function g_Texture_CreateWAD (var ID: LongWord; const Resource: AnsiString): Boolean; var WAD: TWADFile; - FileName: String; + FileName: AnsiString; TextureData: Pointer; ResourceLength: Integer; begin - Result := False; + result := false; FileName := g_ExtractWadName(Resource); WAD := TWADFile.Create; @@ -160,289 +221,302 @@ begin if WAD.GetResource(g_ExtractFilePathName(Resource), TextureData, ResourceLength) then begin if e_CreateTextureMem(TextureData, ResourceLength, ID) then - Result := True - else - FreeMem(TextureData); + result := true; + FreeMem(TextureData) end else begin - e_WriteLog(Format('Error loading texture %s', [Resource]), MSG_WARNING); + e_WriteLog(Format('Error loading texture %s', [Resource]), TMsgType.Warning); //e_WriteLog(Format('WAD Reader error: %s', [WAD.GetLastErrorStr]), MSG_WARNING); end; WAD.Free(); end; -function g_Texture_CreateFile(var ID: DWORD; FileName: String): Boolean; + +function g_Texture_CreateFile (var ID: LongWord; const FileName: AnsiString): Boolean; begin - Result := True; + result := true; if not e_CreateTexture(FileName, ID) then begin - e_WriteLog(Format('Error loading texture %s', [FileName]), MSG_WARNING); - Result := False; + e_WriteLog(Format('Error loading texture %s', [FileName]), TMsgType.Warning); + result := false; end; end; -function g_Texture_CreateWADEx(TextureName: ShortString; Resource: String): Boolean; + +function g_Texture_CreateWADEx (const textureName, Resource: AnsiString): Boolean; var WAD: TWADFile; - FileName: String; + FileName: AnsiString; TextureData: Pointer; - find_id: DWORD; + find_id: LongWord; ResourceLength: Integer; begin FileName := g_ExtractWadName(Resource); - find_id := FindTexture(); + find_id := allocTextureSlot(); WAD := TWADFile.Create; WAD.ReadFile(FileName); if WAD.GetResource(g_ExtractFilePathName(Resource), TextureData, ResourceLength) then begin - Result := e_CreateTextureMem(TextureData, ResourceLength, TexturesArray[find_id].ID); - if Result then + result := e_CreateTextureMem(TextureData, ResourceLength, texturesArray[find_id].ID); + if result then begin - e_GetTextureSize(TexturesArray[find_id].ID, @TexturesArray[find_id].Width, - @TexturesArray[find_id].Height); - TexturesArray[find_id].Name := LowerCase(TextureName); - end - else - FreeMem(TextureData); + e_GetTextureSize(texturesArray[find_id].ID, @texturesArray[find_id].width, @texturesArray[find_id].height); + texturesArray[find_id].used := true; + texturesArray[find_id].Name := textureName; + end; + FreeMem(TextureData) end else begin - e_WriteLog(Format('Error loading texture %s', [Resource]), MSG_WARNING); + e_WriteLog(Format('Error loading texture %s', [Resource]), TMsgType.Warning); //e_WriteLog(Format('WAD Reader error: %s', [WAD.GetLastErrorStr]), MSG_WARNING); - Result := False; + result := false; end; WAD.Free(); end; -function g_Texture_CreateFileEx(TextureName: ShortString; FileName: String): Boolean; + +function g_Texture_CreateFileEx (const textureName, FileName: AnsiString): Boolean; var - find_id: DWORD; + find_id: LongWord; begin - find_id := FindTexture; - - Result := e_CreateTexture(FileName, TexturesArray[find_id].ID); - if Result then + find_id := allocTextureSlot(); + result := e_CreateTexture(FileName, texturesArray[find_id].ID); + if result then begin - TexturesArray[find_id].Name := LowerCase(TextureName); - e_GetTextureSize(TexturesArray[find_id].ID, @TexturesArray[find_id].Width, - @TexturesArray[find_id].Height); + texturesArray[find_id].used := true; + texturesArray[find_id].Name := textureName; + e_GetTextureSize(texturesArray[find_id].ID, @texturesArray[find_id].width, @texturesArray[find_id].height); end - else e_WriteLog(Format('Error loading texture %s', [FileName]), MSG_WARNING); + else e_WriteLog(Format('Error loading texture %s', [FileName]), TMsgType.Warning); end; -function g_Texture_Get(TextureName: ShortString; var ID: DWORD): Boolean; + +function g_Texture_Get (const textureName: AnsiString; var id: LongWord): Boolean; var - a: DWORD; + a: Integer; begin - Result := False; - - if TexturesArray = nil then Exit; - - if TextureName = '' then Exit; - - TextureName := LowerCase(TextureName); - - for a := 0 to High(TexturesArray) do - if TexturesArray[a].Name = TextureName then + result := false; + if (Length(texturesArray) = 0) or (Length(textureName) = 0) then exit; + for a := 0 to High(texturesArray) do + begin + if (StrEquCI1251(texturesArray[a].name, textureName)) then begin - ID := TexturesArray[a].ID; - Result := True; - Break; + id := texturesArray[a].id; + result := true; + break; end; - + end; //if not Result then g_ConsoleAdd('Texture '+TextureName+' not found'); end; -procedure g_Texture_Delete(TextureName: ShortString); + +function g_Texture_GetSize (const textureName: AnsiString; var w, h: Integer): Boolean; overload; var - a: DWORD; + a: Integer; begin - if TexturesArray = nil then Exit; - - TextureName := LowerCase(TextureName); - - for a := 0 to High(TexturesArray) do - if TexturesArray[a].Name = TextureName then + result := false; + w := 0; + h := 0; + if (Length(texturesArray) = 0) or (Length(textureName) = 0) then exit; + for a := 0 to High(texturesArray) do + begin + if (StrEquCI1251(texturesArray[a].name, textureName)) then begin - e_DeleteTexture(TexturesArray[a].ID); - TexturesArray[a].Name := ''; - TexturesArray[a].ID := 0; - TexturesArray[a].Width := 0; - TexturesArray[a].Height := 0; + w := texturesArray[a].width; + h := texturesArray[a].height; + result := true; + break; end; + end; end; -procedure g_Texture_DeleteAll(); + +function g_Texture_GetSize (ID: LongWord; var w, h: Integer): Boolean; overload; var - a: DWORD; + a: Integer; begin - if TexturesArray = nil then Exit; + result := false; + w := 0; + h := 0; + if (Length(texturesArray) = 0) then exit; + for a := 0 to High(texturesArray) do + begin + if (texturesArray[a].id = ID) then + begin + w := texturesArray[a].width; + h := texturesArray[a].height; + result := true; + break; + end; + end; +end; - for a := 0 to High(TexturesArray) do - if TexturesArray[a].Name <> '' then - e_DeleteTexture(TexturesArray[a].ID); - TexturesArray := nil; +procedure g_Texture_Delete (const textureName: AnsiString); +var + a: Integer; +begin + if (Length(texturesArray) = 0) or (Length(textureName) = 0) then exit; + for a := 0 to High(texturesArray) do + begin + if (StrEquCI1251(texturesArray[a].name, textureName)) then + begin + e_DeleteTexture(texturesArray[a].ID); + texturesArray[a].used := false; + texturesArray[a].name := ''; + texturesArray[a].id := 0; + texturesArray[a].width := 0; + texturesArray[a].height := 0; + end; + end; end; -function FindFrame(): DWORD; + +procedure g_Texture_DeleteAll (); var - i: integer; + a: Integer; begin - if FramesArray <> nil then - for i := 0 to High(FramesArray) do - if FramesArray[i].TexturesID = nil then - begin - Result := i; - Exit; - end; - - if FramesArray = nil then + for a := 0 to High(texturesArray) do begin - SetLength(FramesArray, 64); - Result := 0; - end - else - begin - Result := High(FramesArray) + 1; - SetLength(FramesArray, Length(FramesArray) + 64); + if (texturesArray[a].used) then e_DeleteTexture(texturesArray[a].ID); end; + texturesArray := nil; end; -function g_Frames_CreateFile(ID: PDWORD; Name: ShortString; FileName: String; - FWidth, FHeight, FCount: Word; BackAnimation: Boolean = False): Boolean; + +function g_Frames_CreateFile (ID: PDWORD; const Name, FileName: AnsiString; + mWidth, mHeight, mCount: Word; BackAnimation: Boolean = false): Boolean; var a: Integer; - find_id: DWORD; + find_id: LongWord; begin - Result := False; + result := false; - find_id := FindFrame; + find_id := allocFrameSlot(); - if FCount <= 2 then BackAnimation := False; + if (mCount <= 2) then BackAnimation := false; - if BackAnimation then SetLength(FramesArray[find_id].TexturesID, FCount+FCount-2) - else SetLength(FramesArray[find_id].TexturesID, FCount); + if BackAnimation then SetLength(framesArray[find_id].TexturesID, mCount+mCount-2) + else SetLength(framesArray[find_id].TexturesID, mCount); - for a := 0 to FCount-1 do - if not e_CreateTextureEx(FileName, FramesArray[find_id].TexturesID[a], - a*FWidth, 0, FWidth, FHeight) then Exit; + for a := 0 to mCount-1 do + begin + if not e_CreateTextureEx(FileName, framesArray[find_id].TexturesID[a], a*mWidth, 0, mWidth, mHeight) then exit; + end; if BackAnimation then - for a := 1 to FCount-2 do - FramesArray[find_id].TexturesID[FCount+FCount-2-a] := FramesArray[find_id].TexturesID[a]; + begin + for a := 1 to mCount-2 do framesArray[find_id].TexturesID[mCount+mCount-2-a] := framesArray[find_id].TexturesID[a]; + end; - FramesArray[find_id].FrameWidth := FWidth; - FramesArray[find_id].FrameHeight := FHeight; - if Name <> '' then - FramesArray[find_id].Name := LowerCase(Name) - else - FramesArray[find_id].Name := ''; + framesArray[find_id].used := true; + framesArray[find_id].FrameWidth := mWidth; + framesArray[find_id].FrameHeight := mHeight; + if (Name <> '') then framesArray[find_id].Name := Name else framesArray[find_id].Name := ''; - if ID <> nil then ID^ := find_id; + if (ID <> nil) then ID^ := find_id; - Result := True; + result := true; end; -function CreateFramesMem(pData: Pointer; dataSize: LongInt; ID: PDWORD; Name: ShortString; - FWidth, FHeight, FCount: Word; BackAnimation: Boolean = False): Boolean; + +function CreateFramesMem (pData: Pointer; dataSize: LongInt; ID: PDWORD; Name: AnsiString; + mWidth, mHeight, mCount: Word; BackAnimation: Boolean = false): Boolean; var - find_id: DWORD; + find_id: LongWord; a: Integer; begin - Result := False; + result := false; - find_id := FindFrame(); + find_id := allocFrameSlot(); - if FCount <= 2 then BackAnimation := False; + if (mCount <= 2) then BackAnimation := false; - if BackAnimation then SetLength(FramesArray[find_id].TexturesID, FCount+FCount-2) - else SetLength(FramesArray[find_id].TexturesID, FCount); + if BackAnimation then SetLength(framesArray[find_id].TexturesID, mCount+mCount-2) + else SetLength(framesArray[find_id].TexturesID, mCount); - for a := 0 to FCount-1 do - if not e_CreateTextureMemEx(pData, dataSize, FramesArray[find_id].TexturesID[a], - a*FWidth, 0, FWidth, FHeight) then + for a := 0 to mCount-1 do + if not e_CreateTextureMemEx(pData, dataSize, framesArray[find_id].TexturesID[a], a*mWidth, 0, mWidth, mHeight) then begin - FreeMem(pData); - Exit; + //!!!FreeMem(pData); + exit; end; if BackAnimation then - for a := 1 to FCount-2 do - FramesArray[find_id].TexturesID[FCount+FCount-2-a] := FramesArray[find_id].TexturesID[a]; + begin + for a := 1 to mCount-2 do framesArray[find_id].TexturesID[mCount+mCount-2-a] := framesArray[find_id].TexturesID[a]; + end; - FramesArray[find_id].FrameWidth := FWidth; - FramesArray[find_id].FrameHeight := FHeight; - if Name <> '' then - FramesArray[find_id].Name := LowerCase(Name) - else - FramesArray[find_id].Name := ''; + framesArray[find_id].used := true; + framesArray[find_id].FrameWidth := mWidth; + framesArray[find_id].FrameHeight := mHeight; + if (Name <> '') then framesArray[find_id].Name := Name else framesArray[find_id].Name := ''; - if ID <> nil then ID^ := find_id; + if (ID <> nil) then ID^ := find_id; - Result := True; + result := true; end; -function g_CreateFramesImg (ia: TDynImageDataArray; ID: PDWORD; Name: ShortString; BackAnimation: Boolean = False): Boolean; + +function g_CreateFramesImg (ia: TDynImageDataArray; ID: PDWORD; const Name: AnsiString; BackAnimation: Boolean = false): Boolean; var - find_id: DWORD; - a, FCount: Integer; + find_id: LongWord; + a, mCount: Integer; begin result := false; - find_id := FindFrame(); + find_id := allocFrameSlot(); - FCount := length(ia); + mCount := Length(ia); //e_WriteLog(Format('+++ creating %d frames [%s]', [FCount, Name]), MSG_NOTIFY); - if FCount < 1 then exit; - if FCount <= 2 then BackAnimation := False; - if BackAnimation then - SetLength(FramesArray[find_id].TexturesID, FCount+FCount-2) - else - SetLength(FramesArray[find_id].TexturesID, FCount); + if (mCount < 1) then exit; + if (mCount <= 2) then BackAnimation := false; + + if BackAnimation then SetLength(framesArray[find_id].TexturesID, mCount+mCount-2) + else SetLength(framesArray[find_id].TexturesID, mCount); //e_WriteLog(Format('+++ creating %d frames, %dx%d', [FCount, ia[0].width, ia[0].height]), MSG_NOTIFY); - for a := 0 to FCount-1 do + for a := 0 to mCount-1 do begin - if not e_CreateTextureImg(ia[a], FramesArray[find_id].TexturesID[a]) then exit; + if not e_CreateTextureImg(ia[a], framesArray[find_id].TexturesID[a]) then exit; //e_WriteLog(Format('+++ frame %d, %dx%d', [a, ia[a].width, ia[a].height]), MSG_NOTIFY); end; if BackAnimation then begin - for a := 1 to FCount-2 do - begin - FramesArray[find_id].TexturesID[FCount+FCount-2-a] := FramesArray[find_id].TexturesID[a]; - end; + for a := 1 to mCount-2 do framesArray[find_id].TexturesID[mCount+mCount-2-a] := framesArray[find_id].TexturesID[a]; end; - FramesArray[find_id].FrameWidth := ia[0].width; - FramesArray[find_id].FrameHeight := ia[0].height; - if Name <> '' then - FramesArray[find_id].Name := LowerCase(Name) - else - FramesArray[find_id].Name := ''; + framesArray[find_id].used := true; + framesArray[find_id].FrameWidth := ia[0].width; + framesArray[find_id].FrameHeight := ia[0].height; + if (Name <> '') then framesArray[find_id].Name := Name else framesArray[find_id].Name := ''; - if ID <> nil then ID^ := find_id; + if (ID <> nil) then ID^ := find_id; result := true; end; -function g_Frames_CreateWAD(ID: PDWORD; Name: ShortString; Resource: string; - FWidth, FHeight, FCount: Word; BackAnimation: Boolean = False): Boolean; + +function g_Frames_CreateWAD (ID: PDWORD; const Name, Resource: AnsiString; + mWidth, mHeight, mCount: Word; BackAnimation: Boolean=false): Boolean; var WAD: TWADFile; - FileName: string; + FileName: AnsiString; TextureData: Pointer; ResourceLength: Integer; begin - Result := False; + result := false; + + // models without "advanced" animations asks for "nothing" like this; don't spam log + if (Length(Resource) > 0) and ((Resource[Length(Resource)] = '/') or (Resource[Length(Resource)] = '\')) then exit; FileName := g_ExtractWadName(Resource); @@ -452,28 +526,32 @@ begin if not WAD.GetResource(g_ExtractFilePathName(Resource), TextureData, ResourceLength) then begin WAD.Free(); - e_WriteLog(Format('Error loading texture %s', [Resource]), MSG_WARNING); + e_WriteLog(Format('Error loading texture %s', [Resource]), TMsgType.Warning); //e_WriteLog(Format('WAD Reader error: %s', [WAD.GetLastErrorStr]), MSG_WARNING); - Exit; + exit; end; - if not CreateFramesMem(TextureData, ResourceLength, ID, Name, FWidth, FHeight, FCount, BackAnimation) then + if not CreateFramesMem(TextureData, ResourceLength, ID, Name, mWidth, mHeight, mCount, BackAnimation) then begin + FreeMem(TextureData); WAD.Free(); - Exit; + exit; end; + FreeMem(TextureData); WAD.Free(); - Result := True; + result := true; end; -function g_Frames_CreateMemory(ID: PDWORD; Name: ShortString; pData: Pointer; dataSize: LongInt; - FWidth, FHeight, FCount: Word; BackAnimation: Boolean = False): Boolean; + +function g_Frames_CreateMemory (ID: PDWORD; const Name: AnsiString; pData: Pointer; dataSize: LongInt; + mWidth, mHeight, mCount: Word; BackAnimation: Boolean = false): Boolean; begin - Result := CreateFramesMem(pData, dataSize, ID, Name, FWidth, FHeight, FCount, BackAnimation); + result := CreateFramesMem(pData, dataSize, ID, Name, mWidth, mHeight, mCount, BackAnimation); end; + {function g_Frames_CreateRevert(ID: PDWORD; Name: ShortString; Frames: string): Boolean; var find_id, b: DWORD; @@ -497,335 +575,401 @@ begin Result := True; end;} -procedure g_Frames_DeleteByName(FramesName: ShortString); + +function g_Frames_Dup (const NewName, OldName: AnsiString): Boolean; var - a: DWORD; - b: Integer; + find_id, b: LongWord; + a, c: Integer; begin - if FramesArray = nil then Exit; + result := false; + + if not g_Frames_Get(b, OldName) then exit; + + find_id := allocFrameSlot(); + + framesArray[find_id].used := true; + framesArray[find_id].Name := NewName; + framesArray[find_id].FrameWidth := framesArray[b].FrameWidth; + framesArray[find_id].FrameHeight := framesArray[b].FrameHeight; + + c := High(framesArray[b].TexturesID); + SetLength(framesArray[find_id].TexturesID, c+1); + + for a := 0 to c do framesArray[find_id].TexturesID[a] := framesArray[b].TexturesID[a]; + + result := true; +end; - FramesName := LowerCase(FramesName); - for a := 0 to High(FramesArray) do - if FramesArray[a].Name = FramesName then +procedure g_Frames_DeleteByName (const FramesName: AnsiString); +var + a, b: Integer; +begin + if (Length(framesArray) = 0) then exit; + for a := 0 to High(framesArray) do + begin + if (StrEquCI1251(framesArray[a].Name, FramesName)) then begin - if FramesArray[a].TexturesID <> nil then - for b := 0 to High(FramesArray[a].TexturesID) do - e_DeleteTexture(FramesArray[a].TexturesID[b]); - FramesArray[a].TexturesID := nil; - FramesArray[a].Name := ''; - FramesArray[a].FrameWidth := 0; - FramesArray[a].FrameHeight := 0; + if framesArray[a].TexturesID <> nil then + begin + for b := 0 to High(framesArray[a].TexturesID) do e_DeleteTexture(framesArray[a].TexturesID[b]); + end; + framesArray[a].used := false; + framesArray[a].TexturesID := nil; + framesArray[a].Name := ''; + framesArray[a].FrameWidth := 0; + framesArray[a].FrameHeight := 0; end; + end; end; -procedure g_Frames_DeleteByID(ID: DWORD); + +procedure g_Frames_DeleteByID (ID: LongWord); var b: Integer; begin - if FramesArray = nil then Exit; - - if FramesArray[ID].TexturesID <> nil then - for b := 0 to High(FramesArray[ID].TexturesID) do - e_DeleteTexture(FramesArray[ID].TexturesID[b]); - FramesArray[ID].TexturesID := nil; - FramesArray[ID].Name := ''; - FramesArray[ID].FrameWidth := 0; - FramesArray[ID].FrameHeight := 0; + if (Length(framesArray) = 0) then exit; + if (framesArray[ID].TexturesID <> nil) then + begin + for b := 0 to High(framesArray[ID].TexturesID) do e_DeleteTexture(framesArray[ID].TexturesID[b]); + end; + framesArray[ID].used := false; + framesArray[ID].TexturesID := nil; + framesArray[ID].Name := ''; + framesArray[ID].FrameWidth := 0; + framesArray[ID].FrameHeight := 0; end; -procedure g_Frames_DeleteAll; + +procedure g_Frames_DeleteAll (); var - a: DWORD; - b: DWORD; + a, b: Integer; begin - if FramesArray = nil then Exit; - - for a := 0 to High(FramesArray) do - if FramesArray[a].TexturesID <> nil then + for a := 0 to High(framesArray) do + begin + if (framesArray[a].used) then begin - for b := 0 to High(FramesArray[a].TexturesID) do - e_DeleteTexture(FramesArray[a].TexturesID[b]); - FramesArray[a].TexturesID := nil; - FramesArray[a].Name := ''; - FramesArray[a].FrameWidth := 0; - FramesArray[a].FrameHeight := 0; + for b := 0 to High(framesArray[a].TexturesID) do e_DeleteTexture(framesArray[a].TexturesID[b]); end; - - FramesArray := nil; + framesArray[a].used := false; + framesArray[a].TexturesID := nil; + framesArray[a].Name := ''; + framesArray[a].FrameWidth := 0; + framesArray[a].FrameHeight := 0; + end; + framesArray := nil; end; -function g_Frames_Get(var ID: DWORD; FramesName: ShortString): Boolean; + +function g_Frames_Get (out ID: LongWord; const FramesName: AnsiString): Boolean; var - a: DWORD; + a: Integer; begin - Result := False; - - if FramesArray = nil then - Exit; - - FramesName := LowerCase(FramesName); - - for a := 0 to High(FramesArray) do - if FramesArray[a].Name = FramesName then + result := false; + if (Length(framesArray) = 0) then exit; + for a := 0 to High(framesArray) do + begin + if (StrEquCI1251(framesArray[a].Name, FramesName)) then begin ID := a; - Result := True; - Break; + result := true; + break; end; - - if not Result then - g_FatalError(Format(_lc[I_GAME_ERROR_FRAMES], [FramesName])); + end; + if not result then g_FatalError(Format(_lc[I_GAME_ERROR_FRAMES], [FramesName])); end; -function g_Frames_GetTexture(var ID: DWORD; FramesName: ShortString; Frame: Word): Boolean; + +function g_Frames_GetTexture (out ID: LongWord; const FramesName: AnsiString; Frame: Word): Boolean; var - a: DWORD; + a: Integer; begin - Result := False; - - if FramesArray = nil then - Exit; - - FramesName := LowerCase(FramesName); - - for a := 0 to High(FramesArray) do - if FramesArray[a].Name = FramesName then - if Frame <= High(FramesArray[a].TexturesID) then + result := false; + if (Length(framesArray) = 0) then exit; + for a := 0 to High(framesArray) do + begin + if (StrEquCI1251(framesArray[a].Name, FramesName)) then + begin + if (Frame < Length(framesArray[a].TexturesID)) then begin - ID := FramesArray[a].TexturesID[Frame]; - Result := True; - Break; + ID := framesArray[a].TexturesID[Frame]; + result := true; + break; end; - - if not Result then - g_FatalError(Format(_lc[I_GAME_ERROR_FRAMES], [FramesName])); + end; + end; + if not result then g_FatalError(Format(_lc[I_GAME_ERROR_FRAMES], [FramesName])); end; -function g_Frames_Exists(FramesName: string): Boolean; + +function g_Frames_Exists (const FramesName: AnsiString): Boolean; var - a: DWORD; + a: Integer; begin - Result := False; - - if FramesArray = nil then Exit; - - FramesName := LowerCase(FramesName); - - for a := 0 to High(FramesArray) do - if FramesArray[a].Name = FramesName then + result := false; + if (Length(framesArray) = 0) then exit; + for a := 0 to High(framesArray) do + begin + if (StrEquCI1251(framesArray[a].Name, FramesName)) then begin - Result := True; - Exit; + result := true; + exit; end; + end; end; -procedure DumpTextureNames(); + +procedure DumpTextureNames (); var i: Integer; begin - e_WriteLog('BEGIN Textures:', MSG_NOTIFY); - for i := 0 to High(TexturesArray) do - e_WriteLog(' '+IntToStr(i)+'. '+TexturesArray[i].Name, MSG_NOTIFY); - e_WriteLog('END Textures.', MSG_NOTIFY); + e_WriteLog('BEGIN Textures:', TMsgType.Notify); + for i := 0 to High(texturesArray) do e_WriteLog(' '+IntToStr(i)+'. '+texturesArray[i].Name, TMsgType.Notify); + e_WriteLog('END Textures.', TMsgType.Notify); - e_WriteLog('BEGIN Frames:', MSG_NOTIFY); - for i := 0 to High(FramesArray) do - e_WriteLog(' '+IntToStr(i)+'. '+FramesArray[i].Name, MSG_NOTIFY); - e_WriteLog('END Frames.', MSG_NOTIFY); + e_WriteLog('BEGIN Frames:', TMsgType.Notify); + for i := 0 to High(framesArray) do e_WriteLog(' '+IntToStr(i)+'. '+framesArray[i].Name, TMsgType.Notify); + e_WriteLog('END Frames.', TMsgType.Notify); end; + { TAnimation } -constructor TAnimation.Create(FramesID: DWORD; Loop: Boolean; Speed: Byte); +constructor TAnimation.Create (aframesID: LongWord; aloop: Boolean; aspeed: Byte); begin - ID := FramesID; - - FMinLength := 0; - FLoop := Loop; - FSpeed := Speed; - FEnabled := True; - FCurrentFrame := 0; - FPlayed := False; - FAlpha := 0; - FWidth := FramesArray[ID].FrameWidth; - FHeight := FramesArray[ID].FrameHeight; + if (aframesID >= Length(framesArray)) then + begin + //raise Exception.Create('trying to create inexisting frame: something is very wrong here'); + e_LogWritefln('trying to create inexisting frame %u of %u: something is very wrong here', [aframesID, LongWord(Length(framesArray))], TMsgType.Warning); + aframesID := 0; + if (Length(framesArray) = 0) then raise Exception.Create('trying to create inexisting frame: something is very wrong here'); + end; + mId := aframesID; + mMinLength := 0; + mLoop := aloop; + mSpeed := aspeed; + mEnabled := true; + mCurrentFrame := 0; + mPlayed := false; + mAlpha := 0; + mWidth := framesArray[mId].FrameWidth; + mHeight := framesArray[mId].FrameHeight; end; -destructor TAnimation.Destroy; + +destructor TAnimation.Destroy (); begin inherited; end; -procedure TAnimation.Draw(X, Y: Integer; Mirror: TMirrorType); -begin - if not FEnabled then - Exit; - e_DrawAdv(FramesArray[ID].TexturesID[FCurrentFrame], X, Y, FAlpha, - True, FBlending, 0, nil, Mirror); +procedure TAnimation.draw (x, y: Integer; mirror: TMirrorType); +begin + if (not mEnabled) then exit; + e_DrawAdv(framesArray[mId].TexturesID[mCurrentFrame], x, y, mAlpha, true, mBlending, 0, nil, mirror); //e_DrawQuad(X, Y, X+FramesArray[ID].FrameWidth-1, Y+FramesArray[ID].FrameHeight-1, 0, 255, 0); end; -procedure TAnimation.Update(); + +procedure TAnimation.update (); begin - if not FEnabled then - Exit; + if (not mEnabled) then exit; - FCounter := FCounter + 1; + mCounter += 1; - if FCounter >= FSpeed then - begin // Îæèäàíèå ìåæäó êàäðàìè çàêîí÷èëîñü - if FRevert then - begin // Îáðàòíûé ïîðÿäîê êàäðîâ - // Äîøëè äî êîíöà àíèìàöèè. Âîçìîæíî, æäåì åùå: - if FCurrentFrame = 0 then - if Length(FramesArray[ID].TexturesID) * FSpeed + - FCounter < FMinLength then - Exit; + if (mCounter >= mSpeed) then + begin + // Îæèäàíèå ìåæäó êàäðàìè çàêîí÷èëîñü + // Îáðàòíûé ïîðÿäîê êàäðîâ? + if mRevert then + begin + // Äîøëè äî êîíöà àíèìàöèè. Âîçìîæíî, æäåì åùå + if (mCurrentFrame = 0) then + begin + if (Length(framesArray[mId].TexturesID)*mSpeed+mCounter < mMinLength) then exit; + end; - FCurrentFrame := FCurrentFrame - 1; - FPlayed := FCurrentFrame < 0; + mCurrentFrame -= 1; + mPlayed := (mCurrentFrame < 0); - // Ïîâòîðÿòü ëè àíèìàöèþ ïî êðóãó: - if FPlayed then - if FLoop then - FCurrentFrame := High(FramesArray[ID].TexturesID) - else - FCurrentFrame := FCurrentFrame + 1; + // Ïîâòîðÿòü ëè àíèìàöèþ ïî êðóãó? + if mPlayed then + begin + if mLoop then mCurrentFrame := High(framesArray[mId].TexturesID) else mCurrentFrame += 1; + end; - FCounter := 0; - end + mCounter := 0; + end else - begin // Ïðÿìîé ïîðÿäîê êàäðîâ - // Äîøëè äî êîíöà àíèìàöèè. Âîçìîæíî, æäåì åùå: - if FCurrentFrame = High(FramesArray[ID].TexturesID) then - if Length(FramesArray[ID].TexturesID) * FSpeed + - FCounter < FMinLength then - Exit; - - FCurrentFrame := FCurrentFrame + 1; - FPlayed := (FCurrentFrame > High(FramesArray[ID].TexturesID)); - - // Ïîâòîðÿòü ëè àíèìàöèþ ïî êðóãó: - if FPlayed then - if FLoop then - FCurrentFrame := 0 - else - FCurrentFrame := FCurrentFrame - 1; - - FCounter := 0; + begin + // Ïðÿìîé ïîðÿäîê êàäðîâ + // Äîøëè äî êîíöà àíèìàöèè. Âîçìîæíî, æäåì åùå + if (mCurrentFrame = High(framesArray[mId].TexturesID)) then + begin + if (Length(framesArray[mId].TexturesID)*mSpeed+mCounter < mMinLength) then exit; end; + + mCurrentFrame += 1; + mPlayed := (mCurrentFrame > High(framesArray[mId].TexturesID)); + + // Ïîâòîðÿòü ëè àíèìàöèþ ïî êðóãó? + if mPlayed then + begin + if mLoop then mCurrentFrame := 0 else mCurrentFrame -= 1; + end; + + mCounter := 0; + end; end; end; -procedure TAnimation.Reset(); -begin - if FRevert then - FCurrentFrame := High(FramesArray[ID].TexturesID) - else - FCurrentFrame := 0; - FCounter := 0; - FPlayed := False; +procedure TAnimation.reset (); +begin + if mRevert then mCurrentFrame := High(framesArray[mId].TexturesID) else mCurrentFrame := 0; + mCounter := 0; + mPlayed := false; end; -procedure TAnimation.Disable; + +procedure TAnimation.disable (); begin mEnabled := false; end; +procedure TAnimation.enable (); begin mEnabled := true; end; + + +procedure TAnimation.drawEx (x, y: Integer; mirror: TMirrorType; rpoint: TDFPoint; angle: SmallInt); begin - FEnabled := False; + if (not mEnabled) then exit; + e_DrawAdv(framesArray[mId].TexturesID[mCurrentFrame], x, y, mAlpha, true, mBlending, angle, @rpoint, mirror); end; -procedure TAnimation.Enable; + +function TAnimation.totalFrames (): Integer; inline; begin result := Length(framesArray[mId].TexturesID); end; + + +procedure TAnimation.revert (r: Boolean); begin - FEnabled := True; + mRevert := r; + reset(); end; -procedure TAnimation.DrawEx(X, Y: Integer; Mirror: TMirrorType; RPoint: TPoint; - Angle: SmallInt); + +procedure TAnimation.saveState (st: TStream); begin - if not FEnabled then - Exit; + if (st = nil) then exit; - e_DrawAdv(FramesArray[ID].TexturesID[FCurrentFrame], X, Y, FAlpha, - True, FBlending, Angle, @RPoint, Mirror); + utils.writeSign(st, 'ANIM'); + utils.writeInt(st, Byte(0)); // version + // Ñ÷åò÷èê îæèäàíèÿ ìåæäó êàäðàìè + utils.writeInt(st, Byte(mCounter)); + // Òåêóùèé êàäð + utils.writeInt(st, LongInt(mCurrentFrame)); + // Ïðîèãðàíà ëè àíèìàöèÿ öåëèêîì + utils.writeBool(st, mPlayed); + // Alpha-êàíàë âñåé òåêñòóðû + utils.writeInt(st, Byte(mAlpha)); + // Ðàçìûòèå òåêñòóðû + utils.writeInt(st, Byte(mBlending)); + // Âðåìÿ îæèäàíèÿ ìåæäó êàäðàìè + utils.writeInt(st, Byte(mSpeed)); + // Çàöèêëåíà ëè àíèìàöèÿ + utils.writeBool(st, mLoop); + // Âêëþ÷åíà ëè + utils.writeBool(st, mEnabled); + // Îæèäàíèå ïîñëå ïðîèãðûâàíèÿ + utils.writeInt(st, Byte(mMinLength)); + // Îáðàòíûé ëè ïîðÿäîê êàäðîâ + utils.writeBool(st, mRevert); end; -function TAnimation.TotalFrames(): Integer; -begin - Result := Length(FramesArray[ID].TexturesID); -end; -procedure TAnimation.Revert(r: Boolean); +procedure TAnimation.loadState (st: TStream); begin - FRevert := r; - Reset(); + if (st = nil) then exit; + + if not utils.checkSign(st, 'ANIM') then raise XStreamError.Create('animation chunk expected'); + if (utils.readByte(st) <> 0) then raise XStreamError.Create('invalid animation chunk version'); + // Ñ÷åò÷èê îæèäàíèÿ ìåæäó êàäðàìè + mCounter := utils.readByte(st); + // Òåêóùèé êàäð + mCurrentFrame := utils.readLongInt(st); + // Ïðîèãðàíà ëè àíèìàöèÿ öåëèêîì + mPlayed := utils.readBool(st); + // Alpha-êàíàë âñåé òåêñòóðû + mAlpha := utils.readByte(st); + // Ðàçìûòèå òåêñòóðû + mBlending := utils.readBool(st); + // Âðåìÿ îæèäàíèÿ ìåæäó êàäðàìè + mSpeed := utils.readByte(st); + // Çàöèêëåíà ëè àíèìàöèÿ + mLoop := utils.readBool(st); + // Âêëþ÷åíà ëè + mEnabled := utils.readBool(st); + // Îæèäàíèå ïîñëå ïðîèãðûâàíèÿ + mMinLength := utils.readByte(st); + // Îáðàòíûé ëè ïîðÿäîê êàäðîâ + mRevert := utils.readBool(st); end; -procedure TAnimation.SaveState(Var Mem: TBinMemoryWriter); + +// ////////////////////////////////////////////////////////////////////////// // var - sig: DWORD; -begin - if Mem = nil then - Exit; - -// Ñèãíàòóðà àíèìàöèè: - sig := ANIM_SIGNATURE; // 'ANIM' - Mem.WriteDWORD(sig); -// Ñ÷åò÷èê îæèäàíèÿ ìåæäó êàäðàìè: - Mem.WriteByte(FCounter); -// Òåêóùèé êàäð: - Mem.WriteInt(FCurrentFrame); -// Ïðîèãðàíà ëè àíèìàöèÿ öåëèêîì: - Mem.WriteBoolean(FPlayed); -// Alpha-êàíàë âñåé òåêñòóðû: - Mem.WriteByte(FAlpha); -// Ðàçìûòèå òåêñòóðû: - Mem.WriteBoolean(FBlending); -// Âðåìÿ îæèäàíèÿ ìåæäó êàäðàìè: - Mem.WriteByte(FSpeed); -// Çàöèêëåíà ëè àíèìàöèÿ: - Mem.WriteBoolean(FLoop); -// Âêëþ÷åíà ëè: - Mem.WriteBoolean(FEnabled); -// Îæèäàíèå ïîñëå ïðîèãðûâàíèÿ: - Mem.WriteByte(FMinLength); -// Îáðàòíûé ëè ïîðÿäîê êàäðîâ: - Mem.WriteBoolean(FRevert); -end; - -procedure TAnimation.LoadState(Var Mem: TBinMemoryReader); + ltexid: GLuint = 0; + +function g_Texture_Light (): Integer; +const + Radius: Integer = 128; var - sig: DWORD; + tex, tpp: PByte; + x, y, a: Integer; + dist: Double; begin - if Mem = nil then - Exit; - -// Ñèãíàòóðà àíèìàöèè: - Mem.ReadDWORD(sig); - if sig <> ANIM_SIGNATURE then // 'ANIM' + if ltexid = 0 then begin - raise EBinSizeError.Create('TAnimation.LoadState: Wrong Animation Signature'); - end; -// Ñ÷åò÷èê îæèäàíèÿ ìåæäó êàäðàìè: - Mem.ReadByte(FCounter); -// Òåêóùèé êàäð: - Mem.ReadInt(FCurrentFrame); -// Ïðîèãðàíà ëè àíèìàöèÿ öåëèêîì: - Mem.ReadBoolean(FPlayed); -// Alpha-êàíàë âñåé òåêñòóðû: - Mem.ReadByte(FAlpha); -// Ðàçìûòèå òåêñòóðû: - Mem.ReadBoolean(FBlending); -// Âðåìÿ îæèäàíèÿ ìåæäó êàäðàìè: - Mem.ReadByte(FSpeed); -// Çàöèêëåíà ëè àíèìàöèÿ: - Mem.ReadBoolean(FLoop); -// Âêëþ÷åíà ëè: - Mem.ReadBoolean(FEnabled); -// Îæèäàíèå ïîñëå ïðîèãðûâàíèÿ: - Mem.ReadByte(FMinLength); -// Îáðàòíûé ëè ïîðÿäîê êàäðîâ: - Mem.ReadBoolean(FRevert); + GetMem(tex, (Radius*2)*(Radius*2)*4); + tpp := tex; + for y := 0 to Radius*2-1 do + begin + for x := 0 to Radius*2-1 do + begin + dist := 1.0-sqrt((x-Radius)*(x-Radius)+(y-Radius)*(y-Radius))/Radius; + if (dist < 0) then + begin + tpp^ := 0; Inc(tpp); + tpp^ := 0; Inc(tpp); + tpp^ := 0; Inc(tpp); + tpp^ := 0; Inc(tpp); + end + else + begin + //tc.setPixel(x, y, Color(cast(int)(dist*255), cast(int)(dist*255), cast(int)(dist*255))); + if (dist > 0.5) then dist := 0.5; + a := round(dist*255); + if (a < 0) then a := 0 else if (a > 255) then a := 255; + tpp^ := 255; Inc(tpp); + tpp^ := 255; Inc(tpp); + tpp^ := 255; Inc(tpp); + tpp^ := Byte(a); Inc(tpp); + end; + end; + end; + + glGenTextures(1, @ltexid); + //if (tid == 0) assert(0, "VGL: can't create screen texture"); + + glBindTexture(GL_TEXTURE_2D, ltexid); + glTexParameterf(GL_TEXTURE_2D, GL_TEXTURE_WRAP_S, GL_REPEAT); + glTexParameterf(GL_TEXTURE_2D, GL_TEXTURE_WRAP_T, GL_REPEAT); + glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_MIN_FILTER, GL_LINEAR); + glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_MAG_FILTER, GL_LINEAR); + + //GLfloat[4] bclr = 0.0; + //glTexParameterfv(GL_TEXTURE_2D, GL_TEXTURE_BORDER_COLOR, bclr.ptr); + + glTexImage2D(GL_TEXTURE_2D, 0, GL_RGBA, Radius*2, Radius*2, 0, GL_RGBA{gltt}, GL_UNSIGNED_BYTE, tex); + end; + + result := ltexid; end; + end.