unit UCovers; {******************** UCover Contains Class managing Covers.Cache File File Structure: TCC_FileHeader TextureData * Array of TCC_TextureData Indexes * TCC_FileIndex Header Block * TCC_FileIndex * String containing Filename of Last IndexEntry. Ending with #0 . . * TCC_FileIndex Footer Block *********************} interface {$IFDEF FPC} {$MODE Delphi} {$ENDIF} {$I switches.inc} uses OpenGL12, {$IFDEF win32} windows, {$ENDIF} Math, Classes, SysUtils, {$IFNDEF FPC} Graphics, {$ENDIF} UThemes; const cCC_CoverW = 128; cCC_CoverH = 128; cCC_CoverSize = cCC_CoverW * cCC_CoverH * 3; cCC_HeaderText = 'USDxCo' + #0 + #1; cCC_HeaderVersion = 1000; cCC_IndexIndicator= 'I' + 'N' + 'D' + #0; type TCover = record Name: string; W: word; H: word; Size: integer; Position: integer; //position of picture in the cache file // Data: array of byte; end; //------------------------------------------------------------------- //Covers.Cache File Parts TCC_Hash = Array [1..32] of Char; TCC_FileHeader = record FileTyp: Array [1..8] of Char; //Some String to detect if this is the file we want to open Version: DWord; //Version of Covers.Cache File Hash: TCC_Hash; //Some Randomly Created Alphanumeric String to Identify w/ SongDB CoverW: Word; //Width of all Covers in Cache CoverH: Word; //Height of all Covers in Cache DataStart: Cardinal; //Start Position in Bytes of Data Part DataLength: Cardinal; //Start Position in Bytes of Data Part IndexStart: Cardinal; //Start of Index Block in Bytes end; PCC_TextureData = ^TCC_TextureData; TCC_TextureData = Array [0..cCC_CoverSize - 1] of Byte; TCC_FileIndexHeader = record Indicator: Array [1..4] of Char; //Contains INDE HighestID: Cardinal; //Highest ID of a Cover end; TCC_FileIndex = record LastUpdated: Integer; //Time of LastFilechange DataStart: Cardinal; //Position of TextureData of this Cover in Bytes. //0 if this is empty slot(Deleted Cover)(Id not available) //1 if the Texture Data is not already loaded to Cache //High(Cardinal) if this is IndexFooter //Filename: String; end; TCC_IndexListItem = record Filename: String; TexID: Integer; FileIndex: TCC_FileIndex; end; TCC_IndexList = Array of TCC_IndexListItem; TCovers = class private Filename: String; Header: TCC_FileHeader; HighestID: Integer; Count: Cardinal; Index: TCC_IndexList; IndexNeedRewrite: Boolean; //Index in CacheFile is overwritten by other Data CacheReadOnly: Boolean; //Cache File is read only Function WriteHeader:Boolean; Function ReadHeader: Boolean; Function ReadIndex: Boolean; Function WriteIndex: Boolean; Function AddTexData(Data: PCC_TextureData): Cardinal; public W: word; H: word; Size: integer; Data: array of byte; Cover: array of TCover; property Hash: TCC_Hash read Header.Hash; constructor Create(const Filename: String); procedure Load(const Filename: String); Function AddCover(FileName: string): Integer; //Returns ID, Checks Cover for Change, Updates Cover if required function CoverExists(FileName: string): Integer; //Returns ID by FilePath procedure PrepareData(FileName: string); Procedure LoadTextures; Function ReWriteCache: Boolean; //Deletes old cover.cache file and writes new one end; var Covers: TCovers; // to - do : new Song management implementation uses UMain, // UFiles, ULog, UTexture, DateUtils; constructor TCovers.Create(const Filename: String); begin HighestID := -1; SetLength(Index, HighestID + 2); Load(Filename); end; //---------------------------------------------- // Some File handling helpers //-------- // Reads and Checks Header. Returns True if Header is correct //-------- Function TCovers.ReadHeader: Boolean; var F: File of TCC_FileHeader; begin try //Read Header AssignFile(F, Filename); try Reset(F); Read(F, Header); finally CloseFile(F); end; //Check Header If (Header.FileTyp = cCC_HeaderText) AND (Header.Version = cCC_HeaderVersion) then begin Result := True; IndexNeedRewrite := True; end Else Result := False; except Result := False; end; end; //-------- // Writes Header(Resets File). Returns True if Writing succeed //-------- Function TCovers.WriteHeader:Boolean; var F: File of TCC_FileHeader; begin try Result := True; //Read Header AssignFile(F, Filename); try If (not FileExists(Filename)) then ReWrite(F) else Reset(F); Write(F, Header); finally CloseFile(F); end; except Result := False; end; end; //-------- // Reads and Checks Index. Returns True if Index is correct //-------- Function TCovers.ReadIndex: Boolean; var F: File of Byte; IndexHeader: TCC_FileIndexHeader; I: Integer; Procedure mReadLn(var S: String); var J: Integer; begin S := ''; J := 0; Repeat Inc(J); SetLength(S, J); Read(F, Byte(S[J])); Until S[J] = #10 end; begin try //Read Header AssignFile(F, Filename); try Reset(F); Seek(F, Header.IndexStart); BlockRead(F, IndexHeader, SizeOf(TCC_FileIndexHeader)); If (IndexHeader.Indicator = cCC_IndexIndicator) then begin Result := False; HighestID := IndexHeader.HighestID; SetLength(Index, HighestID + 2); Count := 0; Result := True; If (HighestID > 0) then begin //Read File Infos until (Eof or Footer) I := 0; While (Not Eof(F)) AND ((I <= 0) OR (Index[I].FileIndex.DataStart <> High(Cardinal))) do begin If (I > HighestID) then begin //Header IndexCOunt was wrong, running out of array Inc(HighestID); IndexNeedReWrite := True; SetLength(Index, HighestID + 2); end; BlockRead(F, Index[I].FileIndex, SizeOf(TCC_FileIndex)); Index[I].TexID := -1; If (Index[I].FileIndex.DataStart <> High(Cardinal)) AND (Not Eof(F)) then begin //Read Filename mReadLn(Index[I].Filename); Inc(Count); end; Inc(I); end; If (Index[HighestID + 1].FileIndex.DataStart = High(Cardinal)) then begin //No Footer found IndexNeedReWrite := True; end; end; end; finally CloseFile(F); end; except Result := False; end; end; //-------- // Writes Index. Returns True if Writing succeed //-------- Function TCovers.WriteIndex: Boolean; var F: File of Byte; IndexHeader: TCC_FileIndexHeader; I: Integer; Procedure mWriteLn(var S: String); var N: Byte; begin BlockWrite(F, S, Length(S)); N := Byte(#10); Write(F, N); end; begin Result := WriteHeader; If (Result) then begin try //Read Header AssignFile(F, Filename); try Reset(F); Seek(F, Header.IndexStart); //Write Header IndexHeader.Indicator := cCC_IndexIndicator; IndexHeader.HighestID := HighestID; BlockWrite(F, IndexHeader, SizeOf(TCC_FileIndexHeader)); Count := 0; Result := True; //Prepare Footer Index[HighestID + 1].FileIndex.DataStart := High(Cardinal); // Write Fileinfo For I := 0 to HighestID+1 do begin BlockWrite(F, Index[I].FileIndex, SizeOf(TCC_FileIndex)); mWriteLn(Index[I].Filename); end; finally CloseFile(F); end; except Result := False; end; end; end; //-------- // Writes some Texture Data to the End of TextureData Block //-------- Function TCovers.AddTexData(Data: PCC_TextureData): Cardinal; var F: File of Byte; begin try AssignFile(F, Filename); try Reset(F); Seek(F, Header.DataStart + Header.DataLength); BlockWrite(F, Data, SizeOf(TCC_TextureData)); Result := Header.DataStart + Header.DataLength; Inc(Header.DataLength, SizeOf(TCC_TextureData)); Header.IndexStart := Header.DataStart + Header.DataLength + 1; IndexNeedReWrite := True; finally CloseFile(F); end; except Result := 0; end; end; procedure TCovers.Load(const Filename: String); var Succeed: Boolean; begin Self.Filename := Filename; Succeed := False; If (FileExists(Filename)) then begin CacheReadOnly := FileisReadOnly(Filename); If (ReadHeader) then begin //Header successful read If (ReadIndex) then begin Succeed := True; end; end; end; If not Succeed and not CacheReadOnly then If not (ReWriteCache) then CacheReadOnly := True; end; Function TCovers.AddCover(FileName: string): Integer; var I: Integer; begin Result := CoverExists(Filename); If (Result = -1) then begin //Add Cover(Does not exist) If (Count <= HighestID) then begin //There is an empty slot, Search It For I := 0 to HighestID do If (Index[I].FileIndex.DataStart = 0) then begin //Found the Slot Result := I; Break; end; end; If (Result = -1) then begin //Attach it to the End Inc(HighestID); SetLength(Index, HighestID + 2); Result := HighestID; end; Index[Result].Filename := Filename; Index[Result].TexID := -1; Index[Result].FileIndex.DataStart := 1; end else begin //Check if File has Changed If (Index[Result].FileIndex.LastUpdated < 0) then begin end; end; end; Function TCovers.CoverExists(FileName: string): integer; var I: integer; begin Result := -1; {$IFDEF MSWINDOWS} Filename := Uppercase(Filename); {$ENDIF} For I := 0 to HighestID do begin If (Index[I].FileIndex.DataStart <> 0) AND {$IFDEF MSWINDOWS} (Uppercase(Index[I].Filename) = Filename) {$ELSE} (Index[I].Filename = Filename) {$ENDIF} then begin Result := I; Exit; end; end; end; //-------- // Deletes old cover.cache file and writes new one //-------- Function TCovers.ReWriteCache: Boolean; Function MakeHash: TCC_Hash; const AlphaNumeric: Array[0..35] of Char = ('A', 'B', 'C', 'D', 'E', 'F', 'G', 'H', 'I', 'J', 'K', 'L', 'M', 'N', 'O', 'P', 'Q', 'R', 'S', 'T', 'U', 'V', 'W', 'X', 'Y', 'Z', '0', '1', '2', '3', '4', '5', '6', '7', '8', '9'); var I: Integer; begin For I := Low(Result) to High(Result) do Result[I] := AlphaNumeric[Random(Length(AlphaNumeric))]; end; begin If not CacheReadOnly then begin Header.FileTyp := cCC_HeaderText; Header.Version := cCC_HeaderVersion; Header.Hash := MakeHash; Header.CoverW := cCC_CoverW; Header.CoverH := cCC_CoverH; Header.DataStart := SizeOf(TCC_FileHeader) + 4; //Total of 64 Bytes (4 Bytes Space) Header.DataLength := 0; Header.IndexStart := Header.DataStart + Header.DataLength + 4; Result := WriteIndex; end else Result := False; end; procedure TCovers.PrepareData(FileName: string); var F: File; C: integer; begin if FileExists(GamePath + 'covers.cache') then begin AssignFile(F, GamePath + 'covers.cache'); Reset(F, 1); C := CoverExists(FileName); SetLength(Data, Cover[C].Size); if Length(Data) < 6 then Log.LogStatus('Length(Data) < 6', 'TCovers.PrepareData'); Seek(F, Cover[C].Position); BlockRead(F, Data[0], Cover[C].Size); CloseFile(F); end; end; Procedure TCovers.LoadTextures; var I: Integer; Function LoadCover: Integer; begin end; begin //Texture.SetCoverSize(cCC_CoverW, cCC_CoverH); For I := 0 to HighestID do begin //Load all the Covers {Index[I].TexID Index[I].FileIndex.} end; end; end.