stud_22-365/GLXEngine: GaLaXy Engine - пакеты компонентов GLScene & GXScene для Object Pascal и C++. Включает иерархию классов для создания 3D сцен с менеджерами поддержки физики Newton, звука BASS и шейдеров GLSL. Кросс-платформенный фреймворк с объектами на базе OpenGL и Vulkan.

Source/GLS.ApplicationFileIO.pas
262 строки8 KB
GLScene
Updated sources for v.2023
27 дек 2022, 21:44
27 дек 2022, 21:44324b206
//
// The multimedia graphics platform GLScene https://github.com/glscene
//
unit GLS.ApplicationFileIO;

(*
  Components and functions that abstract file I/O access for an application.
  Allows re-routing file reads to reads from a single archive file f.i.
*)

interface

{$I GLScene.inc}

uses
  Winapi.Windows,
  System.Classes,
  System.SysUtils,

  GLS.BaseClasses,
  GLS.Strings,
  GLS.Logger;

const
  GLS_RC_DDS_Type = RT_RCDATA;
  GLS_RC_JPG_Type = RT_RCDATA;
  GLS_RC_XML_Type = RT_RCDATA;
  GLS_RC_String_Type = RT_RCDATA;

type

  TGLApplicationResource = (aresNone, aresSplash, aresTexture, aresMaterial,
    aresSampler, aresFont, aresMesh);

  TAFIOCreateFileStream = function(const fileName: string; mode: Word): TStream;
  TAFIOFileStreamExists = function(const fileName: string): Boolean;
  TAFIOFileStreamEvent = procedure(const fileName: String; mode: Word;
    var Stream: TStream) of object;
  TAFIOFileStreamExistsEvent = function(const fileName: string)
    : Boolean of object;

  (* Allows specifying a custom behaviour for CreateFileStream.
    The component should be considered a helper only, you can directly specify
    a function via the vAFIOCreateFileStream variable.
    If multiple ApplicationFileIO components exist in the application,
    the last one created will be the active one. *)
  TGLApplicationFileIO = class(TComponent)
  private
    FOnFileStream: TAFIOFileStreamEvent;
    FOnFileStreamExists: TAFIOFileStreamExistsEvent;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
  published
    (* Event that allows you to specify a stream for the file.
      Destruction of the stream is at the discretion of the code that
      invoked CreateFileStream. Return nil to let the default mechanism
      take place (ie. attempt a regular file system access). *)
    property OnFileStream: TAFIOFileStreamEvent read FOnFileStream
      write FOnFileStream;
    // Event that allows you to specify if a stream for the file exists.
    property OnFileStreamExists: TAFIOFileStreamExistsEvent
      read FOnFileStreamExists write FOnFileStreamExists;
  end;

  TGLDataFileCapability = (dfcRead, dfcWrite);
  TGLDataFileCapabilities = set of TGLDataFileCapability;

  (* Abstract base class for data file formats interfaces.
    This class declares base file-related behaviours, ie. ability to load/save
    from a file or a stream.
    It is highly recommended to overload ONLY the stream based methods, as the
    file-based one just call these, and stream-based behaviours allow for more
    enhancement (such as other I/O abilities, compression, cacheing, etc.)
    to this class, without the need to rewrite subclasses. *)
  TGLDataFile = class(TGLUpdateAbleObject)
  private
    FResourceName: string;
    procedure SetResourceName(const AName: string);
  public
    // Describes what the TGLDataFile is capable of. Default value is [dfcRead].
    class function Capabilities: TGLDataFileCapabilities; virtual;
    // Duplicates Self and returns a copy. Subclasses should override this method to duplicate their data.
    function CreateCopy(AOwner: TPersistent): TGLDataFile; virtual;
    procedure LoadFromFile(const fileName: string); virtual;
    procedure SaveToFile(const fileName: string); virtual;
    procedure LoadFromStream(Stream: TStream); virtual;
    procedure SaveToStream(Stream: TStream); virtual;
    procedure Initialize; virtual;
    (* Optionnal resource name.
      When using LoadFromFile/SaveToFile, the filename is placed in it,
      when using the Stream variants, the caller may place the resource
      name in it for parser use. *)
    property ResourceName: string read FResourceName write SetResourceName;
  end;

  TGLDataFileClass = class of TGLDataFile;
  TGLResourceStream = TResourceStream;

// Returns true if an ApplicationFileIO has been defined
function ApplicationFileIODefined: Boolean;
// Queries is a file stream corresponding to the fileName exists.
function FileStreamExists(const fileName: string): Boolean;
function CreateResourceStream(const ResName: string; ResType: PChar)
  : TGLResourceStream;
function StrToGLSResType(const AStrRes: string): TGLApplicationResource;

var
  vAFIOCreateFileStream: TAFIOCreateFileStream = nil;
  vAFIOFileStreamExists: TAFIOFileStreamExists = nil;

// ---------------------------------------------------------------------
implementation
// ---------------------------------------------------------------------

var
  vAFIO: TGLApplicationFileIO = nil;

function ApplicationFileIODefined: Boolean;
begin
  Result := (Assigned(vAFIOCreateFileStream) and Assigned(vAFIOFileStreamExists)
    ) or Assigned(vAFIO);
end;

function FileStreamExists(const fileName: string): Boolean;
begin
  if Assigned(vAFIOFileStreamExists) then
    Result := vAFIOFileStreamExists(fileName)
  else
  begin
    if Assigned(vAFIO) and Assigned(vAFIO.FOnFileStreamExists) then
      Result := vAFIO.FOnFileStreamExists(fileName)
    else
      Result := FileExists(fileName);
  end;
end;

function CreateResourceStream(const ResName: string; ResType: PChar)
  : TGLResourceStream;
var
  InfoBlock: HRSRC;
begin
  Result := nil;
  InfoBlock := FindResource(HInstance, PChar(ResName), ResType);
  if InfoBlock <> 0 then
    Result := TResourceStream.Create(HInstance, ResName, ResType)
  else
    GLSLogger.LogError
      (Format('Can''t create stream of application resource "%s"', [ResName]));
end;

// ------------------
// ------------------ TGLApplicationFileIO ------------------
// ------------------

constructor TGLApplicationFileIO.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  vAFIO := Self;
end;

destructor TGLApplicationFileIO.Destroy;
begin
  vAFIO := nil;
  inherited Destroy;
end;

// ------------------
// ------------------ TGLDataFile ------------------
// ------------------

class function TGLDataFile.Capabilities: TGLDataFileCapabilities;
begin
  Result := [dfcRead];
end;

function TGLDataFile.CreateCopy(AOwner: TPersistent): TGLDataFile;
begin
  if Self <> nil then
    Result := TGLDataFileClass(Self.ClassType).Create(AOwner)
  else
    Result := nil;
end;

procedure TGLDataFile.LoadFromFile(const fileName: string);
var
  fs: TStream;
begin
  ResourceName := ExtractFileName(fileName);
  fs := TFileStream.Create(fileName, fmOpenRead + fmShareDenyNone);
  try
    LoadFromStream(fs);
  finally
    fs.Free;
  end;
end;

procedure TGLDataFile.SaveToFile(const fileName: string);
var
  fs: TStream;
begin
  ResourceName := ExtractFileName(fileName);
  fs := TFileStream.Create(fileName, fmCreate);
  try
    SaveToStream(fs);
  finally
    fs.Free;
  end;
end;

procedure TGLDataFile.LoadFromStream(Stream: TStream);
begin
  Assert(False, 'Import for ' + ClassName + ' to ' + Stream.ClassName +
    ' not available.');
end;

procedure TGLDataFile.SaveToStream(Stream: TStream);
begin
  Assert(False, 'Export for ' + ClassName + ' to ' + Stream.ClassName +
    ' not available.');
end;

procedure TGLDataFile.Initialize;
begin
end;

procedure TGLDataFile.SetResourceName(const AName: string);
begin
  FResourceName := AName;
end;

function StrToGLSResType(const AStrRes: string): TGLApplicationResource;
begin
  if AStrRes = '[SAMPLERS]' then
  begin
    Result := aresSampler;
  end
  else if AStrRes = '[TEXTURES]' then
  begin
    Result := aresTexture;
  end
  else if AStrRes = '[MATERIALS]' then
  begin
    Result := aresMaterial;
  end
  else if AStrRes = '[STATIC MESHES]' then
  begin
    Result := aresMesh;
  end
  else if AStrRes = '[SPLASH]' then
  begin
    Result := aresSplash;
  end
  else if AStrRes = '[FONTS]' then
  begin
    Result := aresFont;
  end
  else
    Result := aresNone;
end;

end.