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;

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: Integer;                //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(const ReWriteCache: Boolean = false):Boolean;
      Function ReadHeader: Boolean;
      Function ReadIndex:  Boolean;
      Function WriteIndex(const ReWriteCache: Boolean = false): 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

      Function  GetTexbyID(ID: Cardinal): Integer;
  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(const ReWriteCache: Boolean):Boolean;
var
  F: File of TCC_FileHeader;
begin
  try
    Result := True;
    //Read Header
    AssignFile(F, Filename);
    try
      If (not FileExists(Filename)) OR (ReWriteCache) 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
    Len: Integer;
  begin
    S := '';

    BlockRead(F, Len, 4); //Read Len of Filename String

    //Read Filename String
    SetLength(S, Len);
    BlockRead(F, S[1], Len);
  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
          Log.LogError('TCovers: loading Cover Index Header. HighestID: ' + InttoStr(IndexHeader.HighestID));
          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-1].FileIndex.DataStart <> High(Cardinal))) do
            Repeat
              Log.LogError('TCovers: loading Cover Index. Position #' + InttoStr(I));
              If (I > HighestID + 1) then
              begin //Header IndexCOunt was wrong, running out of array
                Log.LogError('TCovers: Wrong HighestID in Index Header. Running out of Array at Postion #' + InttoStr(I));
                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)) then
              begin //Found Footer
                Log.LogError('TCovers: Found footer at Position #' + InttoStr(I));
                Break;
              end;

              If (Not Eof(F)) then
              begin
                //Read Filename
                mReadLn(Index[I].Filename);

                Log.LogError('TCovers: Cover loaded: ' + Index[I].Filename);
                If (Index[I].FileIndex.DataStart <> 0) AND (Index[I].FileIndex.DataStart <> 1) then
                  Inc(Count);
              end;

              Inc(I);
            Until Eof(F);

            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(const ReWriteCache: Boolean): Boolean;
var
  F: File of Byte;
  IndexHeader: TCC_FileIndexHeader;
  I: Integer;

  Procedure mWriteLn(var S: String);
  var Len: Integer;
  begin
    //Write Length of String
    Len := Length(S);
    BlockWrite(F, Len, 4);

    //Write String
    BlockWrite(F, S[1], Len);
  end;
begin
  Result := WriteHeader(ReWriteCache);

  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));
          If (I <= HighestID) then
            mWriteLn(Index[I].Filename);
        end;

        IndexNeedRewrite := False;

      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
  Log.LogError('TCovers: Load cache from file: ''' + Filename + '''');

  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
    begin
      CacheReadOnly := True;
      Log.LogError('TCovers: Cache readonly!');
    end;
end;

Function TCovers.AddCover(FileName: string): Integer;
var I: Integer;
begin
  Result := CoverExists(Filename);
  If (Result = -1) then
  begin //Add Cover(Does not exist)
    Log.LogError('TCovers: Adding cover: ''' + Filename + '''');
    If (Count <= HighestID) then
    begin //There is an empty slot, Search It
      Log.LogError('TCovers: Searching for Empty Slot');
      For I := 0 to HighestID do
        If (Index[I].FileIndex.DataStart = 0) then
        begin //Found that Slot
          Result := I;
          Break;
        end;
    end;

    If (Result = -1) then
    begin //Attach it to the End
      Log.LogError('TCovers: Attach Cover 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;
    Log.LogError('TCovers: Cover Added, ID: ' + InttoStr(Result));
  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
    Log.LogError('TCovers: Rewriting Cache');
    
    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;

    HighestID := -1;
    SetLength(Index, HighestID + 2);

    Result := WriteIndex(True);
  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;
  TexData: PCC_TextureData;
  CachedData: TCC_TextureData;
  F: File of Byte;

  Function LoadCover: Integer;
  begin
    Result := -1;
    
    If (Index[I].FileIndex.DataStart = 1) then
    begin //This Texture is new and has to be loaded
      TexData := Texture.GetCoverThumbnail(Index[I].Filename);
      If (TexData <> nil) then
      begin
        If not (CacheReadonly) then
        begin //Save this Tex to Cache
          Index[I].FileIndex.DataStart :=  AddTexData(TexData);
          If (Index[I].FileIndex.DataStart = 0) then
          begin
            CacheReadOnly := True; //Failed to write Data
            Log.LogError('Failed to Write TextureData to Cache');
          end;
        end;

        //Create Texture
        glGenTextures(1, @Result);

        glBindTexture(GL_TEXTURE_2D, Result);
        glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_MIN_FILTER, GL_LINEAR);
        glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_WRAP_S, GL_CLAMP_TO_EDGE);
        glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_WRAP_T, GL_CLAMP_TO_EDGE);

        //glTexImage2D(GL_TEXTURE_2D, 0, 3, cCC_CoverW, cCC_CoverH, 0, GL_RGB, GL_UNSIGNED_BYTE, Data);
        glTexImage2D(GL_TEXTURE_2D, 0, 3, cCC_CoverW, cCC_CoverH, 0, GL_RGB, GL_UNSIGNED_BYTE, TexData);
      end
      else
        Log.LogError('Couldn''t get Thumbnail Data');
    end
    Else If (Index[I].FileIndex.DataStart > 1) then
    begin //This texture is already in Cache, Load it from there
      try
        Log.LogError('TCovers: Loading Cover #' + InttoStr(I) + ' from Cache at Position: ' + InttoStr(Index[I].FileIndex.DataStart));
        Assign(F, Filename);
        try
          Reset(F);
          Seek(F, Index[I].FileIndex.DataStart);
          BlockRead(F, CachedData, SizeOf(TCC_TextureData));
        finally
          CloseFile(F);
        end;


        //Create Texture
        glGenTextures(1, @Result);

        if (Result > 0) then
        begin

          glBindTexture(GL_TEXTURE_2D, Result);
          glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_MIN_FILTER, GL_LINEAR);
          glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_WRAP_S, GL_CLAMP_TO_EDGE);
          glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_WRAP_T, GL_CLAMP_TO_EDGE);

          //glTexImage2D(GL_TEXTURE_2D, 0, 3, cCC_CoverW, cCC_CoverH, 0, GL_RGB, GL_UNSIGNED_BYTE, Data);
          glTexImage2D(GL_TEXTURE_2D, 0, 3, cCC_CoverW, cCC_CoverH, 0, GL_RGB, GL_UNSIGNED_BYTE, @CachedData[0]);
        end
        else
          Log.LogError('TCovers: Error Generating Texture');
      except
        Log.LogError('TCovers: Error during loading');
      end;
    end;
  end;
begin
  Texture.SetCoverSize(cCC_CoverW, cCC_CoverH);
  Log.LogError('TCovers: LoadingTextures');

  For I := 0 to HighestID do
  begin //Load all the Covers
    If (Index[I].FileIndex.DataStart > 0) then
      Index[I].TexID := LoadCover; //No empty SLot -> Load the Texture

    Log.LogError('TCovers: Texture for ID#' + InttoStr(I) + ': ' + InttoStr(Index[I].TexID));
  end;

  If IndexNeedRewrite then
    WriteIndex;
end;

Function  TCovers.GetTexbyID(ID: Cardinal): Integer;
begin
  If (ID <= HighestID) then
    Result := Index[ID].TexID
  else
    Result := -1;
end;

end.