path: root/Game/Code/Classes/UCovers.pas

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,
     UTexture;

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,
     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) then
   {$ELSE}
       (Index[I].Filename = Filename)
   {$ENDIF}
    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;
begin

end;

end.