{
    This file is part of Chentrah,
    Copyright (C) 2004-2010 Anton Rzheshevski (chebmaster@mail.ru).

    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, either version 2 of the License, or
    (at your option) any later version.

    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 http://www.gnu.org/licenses/

 **********************************************************************}


unit mo_resources;

{$include mo_globaldefs.h}

interface

uses
  sysutils, Classes, math, md5,  chepersy, mo_hub, typinfo, mo_classes, mo_gmathbase;

  procedure RegisterResourceClasses;

  procedure StoreResourceClassesList;
  procedure DeleteUnclaimedResources;


type
  TGenericResource = class;
  TResourceArray = array of TGenericResource;

  { TGenericResource is a class that is ancestor for ALL the classes
      that represent the external resources whose handles are passed
      to the mother module for safekeeping when the game module reloads.
      
    Examples are images, textures, sounds, vertex buffers and so on.
   }

  CGenericResource = class of TGenericResource;
  TGenericResource = class (TManagedObject)
  protected
    _handle: ptruint;  //may be used to contain glUint or pointer type values
    
    WasLost: boolean; {gets set to true if resource was lost OR was just created.
       only the process of saving resets this field to false.}
       
    Discarded: boolean; {gets set to true by the Discard() method,
       cleared by OnReload().

       The discarded resource becomes lost but doesn't count as such
       for the purposes of determining if the resources dependent on it
       need to reload. Affects the ReloadRequired() method.

       Used for static resources like images
       or models that can be loaded directly from a specific file but aren't
       needed after they are converted into OpenGL resources (e.g.
       image being loaded into the texture memory
        - see also the Discard() method below}

    Depends: TResourceArray; {for complex resources built from other resources.
       Used to determine if the resource should be reloaded if one
       of the resources it is based upon does change}
    
    Hash: TResourceHash; {a 16-bit hash it can be either a MD5 hash,
       or a unique timestamp hash - see the GenHash() function
       exported by the core module}
    
    procedure CreateRes(t: integer);  //to be used by constructor

    constructor CreateToDestroy(h: DWORD);    {This constructor is used
      to delete the unclaimed resources of appropriate type,
      it is followed immediately by the TechnicalDestroy destructor.
      Calls the FreeResource method. }

  public
    //there is no constructor, this is an abstract base class
    destructor Destroy; override;
    procedure UpdateHash;
    property Handle: ptruint read _handle;
    property GetWasLost: boolean read WasLost;
    Function ReloadRequired: boolean;
    procedure FreeResource; virtual; abstract;
    procedure GenResource; virtual; abstract;
    
    procedure RegisterFields; override;
    procedure AfterLoading; override;
    procedure BeforeSaving; override;
    procedure OnReload; virtual;
    procedure Discard; virtual;
  end;

  TGenericDynamicResource = class(TGenericResource) //still mostly abstract
  private
    f_runhash: TResourceHash;
  public
    procedure AfterLoading; override;
    procedure RegisterFields; override;
    procedure OnReload; override;
    procedure BeforeSaving; override;
  end;


  CImage = class of TImage;
  TImage = class(TGenericResource)
  private
//    f_stored: TArrayofDword;
    f_storedwidth,
    f_storedheight: integer;
    f_storedfmt: glUint;
    f_filename: string;
  public
    Store,
    Delayed: boolean;
    constructor CreateEmpty;
    constructor Create(width, height: integer; format: glUint); overload;
    constructor Create(FileName: string); overload;
    function Width: integer;
    function Height: integer;
    function Format: glUint;
    function Pixels: pointer;
    procedure Resize(newwidth, newheight: integer);
    procedure Resample(newwidth, newheight: integer; wrap: boolean);
    function Clone: TImage;
    function ClonePow2Down(p: integer; warp: boolean): TImage;
    function CloneNextMipmapLevel(warp: boolean): TImage; //resamples
//    procedure ResampleToPow2(wrap: boolean);
    procedure OnReload; override;
    procedure RegisterFields; override;
    procedure FreeResource; override;
    procedure GenResource; override;
  end;


type

  { TTexture }

  CTexture = class of TTexture;
  TTexture = class(TGenericResource) {the abstract ancestor
                                        for all texture classes}
  protected
    f_warped: boolean;
    f_target: glEnum;
    f_minfilter,
    f_magfilter: integer;
    function AssWeight: float; virtual; abstract; { assessed weight
      for QualityFactor degradation. Returns assumed texture memory in magabytes }
  public
    procedure Bind; //not even virtual.
    function OptimalFormat: gluint; virtual; abstract;
    procedure RebuildMips; virtual; abstract;
    
//    procedure OnReload; override; //doesn't need it.
    procedure RegisterFields; override;
    procedure FreeResource; override;
    procedure GenResource; override;
    procedure Discard; override; {raises an error since texture is
       a type of resource that should never be discarded}
    function IsResident: boolean;
  end;
  
  TStatic2dTexture = class (TTexture)
  protected
    f_source: TImage;
    function AssWeight: float; override;
  public
    Constructor Create(
       Source: TImage; warped: boolean; minfilter, magfilter: integer); {
         "warped" here does not only switch to GL_REPEAT from GL_CLAMP,
         but is also passed to the resampling filter,
         which needs to be aware of the texture repeat mode. }

    Constructor CreateFromFile(FileName: AnsiString;
           warped: boolean; minfilter, magfilter: integer); {
      this one creates the image by itself.
      Only for the cases where you're absolutely sure
      that only this one texture will be based on that image}
      
    function OptimalFormat: gluint; override;
    procedure RebuildMips; override; {
      The *real* texture dimensions may not match its reported Width and Height:
      - if your video card doesn't support NPOT then the image gets resampled to highest power of two
      - if the image is larger than the allowed texture size it gets resampled down

      It is organized this way for compatibility: a texture object created once
        exists forever and may be loaded on different systems with different video cards
    }

    procedure OnReload; override;
    procedure RegisterFields; override;
  end;
  
  TDynamic2dTexture = class (TTexture){ this one generates a new hash
     each time it saves, thus causing to be re-created if a different session
     is loaded

     it duplicates some functionality of TGenericDynamicResource
     , as it cannot inherit from it }
  protected
    f_width, f_height: integer;
    f_format,
    f_imgformat: glUint;
    f_runhash: TResourceHash;
    function AssWeight: float; override;
  public
    Constructor Create(_width, _height: integer; format: glUint;
                             warped: boolean; minfilter, magfilter: integer;
                             ImageFormat: glUint = GL_RGB);

    procedure ReSize(newwidth, newheight: integer; newformat: glUint); virtual; {
      Width and Height get passed through ValidateTextureDimension()
        to check for NPOT support and maximum allowed size
      Read Width and Height after calling this, to be sure.
    }


    function OptimalFormat: gluint; override;
    procedure RebuildMips; override;

    procedure OnReload; override;
    procedure RegisterFields; override;
    procedure BeforeSaving; override;
    property Width: integer read f_width;
    property Height: integer read f_height;
  end;




    
  { THostMemoryChunk }

  THostMemoryChunk = class (TGenericResource) {this is the abstract ancestor
    for the classes whose main data is too big to fit in the
    session.
    Good example of this are models (MD2 and so on)}
  protected
    f_size: integer;
  public
    property Size: integer read f_size;
    constructor Create(sz: integer);
    procedure RegisterFields; override;
    
    procedure FreeResource; override;
    procedure GenResource; override;
  end;
  
  { TMemoryMappedFile }

  TMemoryMappedFile = class (TGenericResource)
  protected
    f_sz: integer;
    f_mem: THostMemoryChunk;
    f_filename: ansistring;
  public
    property Size: integer read f_sz;
    constructor Create(FileName: AnsiString);
    procedure RegisterFields; override;
    procedure OnReload; override;
    procedure FreeResource; override;
    procedure GenResource; override;
    procedure Discard; override;
  end;
  
  

  //  TODO: move it the hell outta here into a separate header!
  PVertex = ^TVertex;
  TVertex = packed record
    x, y, z,
    nx, ny, nz,
    s, t, u: glFloat;
  end;
  PVertexArray = ^TVertexArray;
  TVertexArray = array [0..0] of TVertex;



  { TAbstractVertexBuffer }

  TAbstractVertexBuffer = class (TGenericResource)
  protected
    f_sz: integer;
  public
    property Size: integer read f_sz;
    constructor Create(sz: integer);
    procedure RegisterFields; override;
    function Buffer(): PVertexArray; virtual; abstract;
  end;
  
  { THwVertexBuffer }

  THwVertexBuffer = class (TAbstractVertexBuffer)
  public
    procedure FreeResource; override;
    procedure GenResource; override;
    procedure RegisterFields; override;
    function Buffer(): PVertexArray; override;
  end;
  
  TGLfloatArray = array of GLfloat;

  { TSoftwareVertexBuffer }

  TSoftwareVertexBuffer = class (TAbstractVertexBuffer)
  protected
    va: TGLfloatArray;
  public
    procedure FreeResource; override;
    procedure GenResource; override;
    procedure RegisterFields; override;
    function Buffer(): PVertexArray; override;
  end;
  

implementation

  uses mo_module, mo_fbo, mo_glsl;

  procedure TGenericResource.RegisterFields;
  begin
    RegType('*TResourceHash', typeinfo(dword), [0,3]); //size set in concrete
    RegType(typeinfo(TResourceArray), typeinfo(TGenericResource));
    Inherited;
    ListFields([
      '_handle', @_handle, typeinfo(dword),
      'WasLost', @WasLost,
      'Discarded', @Discarded, typeinfo(boolean),
      'Depends', @Depends, typeinfo(TResourceArray),
      'hash', @Hash, '*TResourceHash'
    ]);
  end;

  procedure TGenericResource.AfterLoading;
  var
    i: integer;
    pr: PRes;
  begin
    if not Discarded then begin
      pr:= ClaimResource(@Hash);
      AfterEfCheck; //throw an exception if there was an error
      if not Assigned(pr) then begin
        //  The resource is lost, we need to re-create it.
        WasLost:= Yes;
      end
      else
        //  The handle could have changed, for example the texture
        //    we created during the yesterday session from the same image
        //    (thus the same hash) had different index in OpenGL.
        //  So we reload it with the value received from the mother module.
        _handle:=pr^.Handle;
    end;
    if ReloadRequired
      // The resource OR any of the resources it depends on
      //   (for example, images for a texture) have to be reloaded.
      then OnReload;
  end;

  procedure TGenericResource.BeforeSaving;
  begin
    WasLost:= Discarded; //is usually set to No
    if not Discarded then begin
      StoreResource(@_handle, @hash);
      AfterEfCheck;
    end;
  end;
  
  constructor TGenericResource.CreateToDestroy(h: DWORD);
  begin
    _handle:=h;
    FreeResource;
  end;

  procedure TGenericResource.OnReload;
  var
    i: integer;
  begin
    { We don't need to worry about the resources that are *just* lost
      because the order in which Chepersy calls their OnAfterLoading()
      methods takes care of that for us.
      
      The discarded resources, on the other hand, won't reload
      when their OnAfterLoading is called.}
    For i:=0 to high(Depends) do
      if Assigned(Depends[i]) and (Depends[i].Discarded)
        then Depends[i].OnReload;
    WasLost:=Yes;
    Discarded:=No;
  end;

  procedure TGenericResource.UpdateHash;
  begin
    GenHash(@hash);
    AfterEfCheck;
  end;

  function TGenericResource.ReloadRequired: boolean;
  var i: integer;
  begin
    Result:=WasLost and not Discarded;
    if not Result then
      For i:=0 to high(Depends) do
        if Depends[i].WasLost and not Depends[i].Discarded
          then Exit(Yes);
  end;
  
  procedure TGenericResource.CreateRes(t: integer);
  begin

  end;
  
  procedure TGenericResource.Discard;
  begin
    if Discarded then exit;
    Discarded:=Yes;
    WasLost:=Yes;
    FreeResource;
  end;

  destructor TGenericResource.Destroy;
  begin
    FreeResource;
    inherited;
  end;

   procedure TGenericDynamicResource.AfterLoading;
   begin
     if f_runhash <> TResourceHash(MotherState^.RunSessionHash) then WasLost:= Yes;
     inherited;
   end;

   procedure TGenericDynamicResource.OnReload;
   begin
     inherited;
     if not WasLost then FreeResource;
     GenResource;
     WasLost:= false;
   end;

   procedure TGenericDynamicResource.BeforeSaving;
   begin
     GenHash(@hash);
     AfterEfCheck;
     inherited;
   end;

   procedure TGenericDynamicResource.RegisterFields;
   begin
     inherited;
     ListFields(['f_runhash', @f_runhash, typeinfo(TResourceHash)]);
   end;
  
// ******************************************************

    constructor TImage.Create(width, height: integer; format: glUint);
    begin
      inherited Create;
      pointer(_handle):= CreatePic(width, height, format);
      AfterEfCheck;
    end;
    
    constructor TImage.CreateEmpty;
    begin
      inherited Create;
      WasLost:=True;
    end;

    function TImage.Clone: TImage;
    begin
      Result:=CImage(Self.ClassType).CreateEmpty;
      pointer(Result._handle):=ClonePic(pointer(_handle));
      AfterEfCheck;
    end;
    
    function TImage.ClonePow2Down(p: integer; warp: boolean): TImage;
    begin
      Result:=Cimage(Self.ClassType).CreateEmpty;
      pointer(Result._handle):=  CloneResamplePic(
          pointer(_handle)
        , max(2, GetHigherPowerOf2(Width div (1 shl p)))
        , max(2, GetHigherPowerOf2(Height div (1 shl p)))
        , warp);
      AfterEfCheck;
    end;

    function TImage.CloneNextMipmapLevel(warp: boolean): TImage;
    var nextW, nextH: integer;
    begin
      nextW:= Width div 2;
      nextH:= Height div 2;
      if (nextW < 1) or (nextH < 1) then Exit(NIL);

      Result:=Cimage(Self.ClassType).CreateEmpty;
      pointer(Result._handle):=  CloneResamplePic(
          pointer(_handle)
        , nextW
        , nextH
        , warp);
      AfterEfCheck;
    end;

{
    procedure TImage.ResampleToPow2(wrap: boolean);
    var
      x,y: integer;
    begin
      x:= GetHigherPowerOf2(Width);
      y:= GetHigherPowerOf2(Height);
      if (x <> Width) or (y <> Height) then Resample(x, y, wrap);
    end;
}
    constructor TImage.Create(FileName: string);
    begin
      inherited Create;
      _GetFileHash(PAnsiChar(FileName), @Hash);
      AfterEfCheck;
      GenResource;
      f_filename:=FileName;
      OnReload;
    end;


    function TImage.Width: integer;
    begin
      Result:= GetPicWidth(pointer(_handle));
      AfterEfCheck;
    end;


    function TImage.Height: integer;
    begin
      Result:= GetPicHeight(pointer(_handle));
      AfterEfCheck;
    end;


    function TImage.Format: glUint;
    begin
      Result:= GetPicFmt(pointer(_handle));
      AfterEfCheck;
    end;


    function TImage.Pixels: pointer;
    begin
      Result:= GetPicPixels(pointer(_handle));
      AfterEfCheck;
    end;


    procedure TImage.Resize(newwidth, newheight: integer);
    begin
      ResizePic(pointer(_handle), newwidth, newheight);
      AfterEfCheck;
    end;


    procedure TImage.Resample(newwidth, newheight: integer; wrap: boolean);
    begin
      ResamplePic(pointer(_handle), newwidth, newheight, wrap);
      AfterEfCheck;
    end;


    procedure TImage.OnReload;
    begin
      inherited;
        if f_filename <> '' then begin
          pointer(_handle) := LoadPic(PChar(f_filename));
          AfterEfCheck;
          _GetFileHash(PAnsiChar(f_FileName), @Hash.Md5Hash);
          AfterEfCheck;
        end;
    end;
    
    procedure TImage.FreeResource;
    begin
      if _handle > 0 then DeletePic(pointer(_handle));
    end;
    
    procedure TImage.GenResource;
    begin
      { Does nothing. It's here only to console the compiler
         who would otherwise whine about creating instance of a class
         with abstract methods}
    end;

    procedure TImage.RegisterFields;
    begin
      inherited;
      ListFields([
        'f_storedwidth', @f_storedwidth,
        'f_storedheight', @f_storedheight, typeinfo(integer),
        'f_storedfmt', @f_storedfmt, typeinfo(gluint),
        'f_filename', @f_filename, typeinfo(string),
        'Store', @Store,
        'Delayed', @Delayed, typeinfo(boolean)
      ]);
    end;



//***************************  TTEXTURE **************************************

{ TTexture }

    function TTexture.IsResident: boolean;
    var
      isres: GLBoolean = GL_TRUE;
    begin
      if not Assigned(glAreTexturesResident) then Exit(Yes);
      Result:= glAreTexturesResident(1, @_handle, @isres) = GL_TRUE;
    end;

    procedure TTexture.Bind;
    var
      isres: GLBoolean = GL_TRUE;
    begin
      if Module.QualityAssurer.Enabled and Assigned(glAreTexturesResident)
        then if glAreTexturesResident(1, @_handle, @isres) <> GL_TRUE
               then Module.QualityAssurer.TextureIsNotInTextureMemory(Self.AssWeight());
//addlog('TTexture.Bind(%0, %1)',[f_target, _handle]);
      glBindTexture(f_target, _handle);
      CheckGlError;
    end;
    
    procedure TTexture.FreeResource;
    begin
      glDeleteTextures(1, @_handle);
    end;

    procedure TTexture.GenResource;
    begin
      glGenTextures(1, @_handle);
    end;
    
    procedure TTexture.RegisterFields;
    begin
      inherited;
      ListFields([
        'f_warped', @f_warped, typeinfo(boolean),
        'f_target', @f_target, typeinfo(glEnum),
        'f_minfilter', @f_minfilter,
        'f_magfilter', @f_magfilter, typeinfo(integer)
      ]);
    end;
    
    procedure TTexture.Discard;
    begin
      Die(MI_ERROR_PROGRAMMER_NO_BAKA,
         [Self.ClassName +'.Discard() should never be called!']);
    end;



{ TStatic2dTexture }


    constructor TStatic2dTexture.Create(Source: TImage;
                             warped: boolean; minfilter, magfilter: integer);
    begin
      inherited Create;
      SetLength(Depends, 1);
      Depends[0]:=Source;
      f_warped:=warped;
      f_target:=GL_TEXTURE_2D;
      f_minfilter:=minfilter;
      f_magfilter:=magfilter;
      f_source:=Source;
      OnReload;
    end;
    
    Constructor TStatic2dTexture.CreateFromFile(FileName: AnsiString;
                             warped: boolean; minfilter, magfilter: integer);
    begin
      Self.Create(TImage.Create(FileName), warped, minfilter, magfilter);
      Self.f_source.Discard;
    end;


    function TStatic2dTexture.OptimalFormat: gluint;
    begin
      case f_source.Format of
        GL_BGRA: Result:=GL_RGBA;
        GL_BGR: Result:=GL_RGB;
      else
        Result:=f_source.Format;
      end;
    end;

    procedure TStatic2dTexture.RebuildMips;
    var
      m: integer = 0;
      i1, i2: TImage;
    begin
      i1:= f_source;
      while Assigned(i1) do begin
        glTexImage2D (
          GL_TEXTURE_2D, m, OptimalFormat(), i1.Width, i1.Height,
                       0, i1.Format, GL_UNSIGNED_BYTE, i1.Pixels);

        //only build mip maps if texture is specified with them
        if (f_minfilter <> GL_LINEAR_MIPMAP_LINEAR)
          and (f_minfilter <> GL_LINEAR_MIPMAP_NEAREST)
          and (f_minfilter <> GL_NEAREST_MIPMAP_LINEAR)
          and (f_minfilter <> GL_NEAREST_MIPMAP_NEAREST)
          then Exit;

        i2:= i1.CloneNextMipmapLevel(f_warped);
        if (i1 <> f_source) then i1.Free;
        i1:= i2;
        Inc(m);
      end;
    end;
    
    procedure TStatic2dTexture.OnReload;
    var
      rep: glUint;
      vW, vH: glInt;
    begin
      inherited;
      if not WasLost then FreeResource;
      GenResource;
      vW:= ValidateTextureDimension(f_source.Width);
      vH:= ValidateTextureDimension(f_source.Height);
      if (vW <> f_source.Width) or (vH <> f_source.Height)
        then f_source.Resample(vW, vH, f_warped);
      glEnable(GL_TEXTURE_2D);
      glBindTexture(GL_TEXTURE_2D, _handle);
      glTexParameterf(GL_TEXTURE_2D, GL_TEXTURE_MIN_FILTER, f_minfilter);
      glTexParameterf(GL_TEXTURE_2D, GL_TEXTURE_MAG_FILTER, f_magfilter);
      if f_warped
        then rep:= GL_REPEAT
        else rep:= GL_CLAMP;
      glTexParameterf(GL_TEXTURE_2D, GL_TEXTURE_WRAP_S, rep);
      glTexParameterf(GL_TEXTURE_2D, GL_TEXTURE_WRAP_T, rep);

      RebuildMips;
      f_source.Discard;
      Hash.Md5Hash:=Md5String(Md5Print(f_source.hash.Md5Hash));
      WasLost:=false;
    end;

    procedure TStatic2dTexture.RegisterFields;
    begin
      inherited;
      ListFields(['f_source', @f_source, typeinfo(TImage)]);
    end;

    function TStatic2dTexture.AssWeight: float;
    begin
      Result:= 0;
      if (_handle = 0) or not Assigned(f_source) then Exit;
      Result:= ValidateTextureDimension(f_source.Width) * ValidateTextureDimension(f_source.Height) * ( 1 / (1024 * 1024));
    end;

{ TDynamic2dTexture }

    procedure TDynamic2dTexture.RegisterFields;
    begin
      inherited;
      ListFields([
        'f_width', @f_width,
        'f_height', @f_height, typeinfo(integer),
        'f_format', @f_format, 'f_imgformat', @f_imgformat, typeinfo(glUint),
        'f_runhash', @f_runhash, typeinfo(TResourceHash)
      ]);
    end;

    Constructor TDynamic2dTexture.Create(_width, _height: integer; format: glUint;
                             warped: boolean; minfilter, magfilter: integer;
                             ImageFormat: glUint = GL_RGB);
    begin
//addlog('TDynamic2dTexture.Create(%0, %1,',[_width, _height]) ;
      inherited Create;
      f_width:= _width;
      f_height:= _height;
      f_warped:=warped;
      f_format:=format;
      f_imgformat:= ImageFormat; //required for legacy-compatible FBO
      f_target:=GL_TEXTURE_2D;
      f_minfilter:=minfilter;
      f_magfilter:=magfilter;
      OnReload;
    end;
                             
    procedure TDynamic2dTexture.ReSize(newwidth, newheight: integer; newformat: glUint);
    begin
      FreeResource;
      f_width:= ValidateTextureDimension(newwidth);
      f_height:= ValidateTextureDimension(newheight);
      f_format:=newformat;
      GenResource;
      OnReload;
    end;
    
    procedure TDynamic2dTexture.OnReload;
    var rep: glUint;
    begin
      inherited;
      if not WasLost then FreeResource;
      GenResource;
      glEnable(GL_TEXTURE_2D);
      glBindTexture(GL_TEXTURE_2D, _handle);
      glTexParameterf(GL_TEXTURE_2D, GL_TEXTURE_MIN_FILTER, f_minfilter);
      glTexParameterf(GL_TEXTURE_2D, GL_TEXTURE_MAG_FILTER, f_magfilter);
      if f_warped
        then rep:= GL_REPEAT
        else rep:= GL_CLAMP;
      glTexParameterf(GL_TEXTURE_2D, GL_TEXTURE_WRAP_S, rep);
      glTexParameterf(GL_TEXTURE_2D, GL_TEXTURE_WRAP_T, rep);

      RebuildMips;
      WasLost:=false;
    end;
    
    function TDynamic2dTexture.OptimalFormat: gluint;
    begin
      result:=f_format;
    end;

    procedure TDynamic2dTexture.RebuildMips;
    begin
      //creates a blank, uninitialized texture image
      glTexImage2D (
        GL_TEXTURE_2D, 0, f_format, f_width, f_height,
                     0, f_imgformat, GL_UNSIGNED_BYTE, NIL);
      CheckGlError;
    end;

    procedure TDynamic2dTexture.BeforeSaving;
    begin
      GenHash(@hash);
      AfterEfCheck;
      inherited;
    end;

    function TDynamic2dTexture.AssWeight: float;
    begin
      if (_handle = 0) then Exit(0);
      Result:= f_width * f_height * ( 1 / (1024 * 1024));
    end;


    
{*******************************************}

    constructor THostMemoryChunk.Create(sz: integer);
    begin
      inherited Create;
      f_size:=sz;
      GenResource;
    end;

    procedure THostMemoryChunk.RegisterFields;
    begin
      inherited;
      ListFields(['f_size', @f_size, typeinfo(integer)]);
    end;


    procedure THostMemoryChunk.FreeResource;
    begin
      CgeFreeHostMem(pointer(_handle));
      AfterEfCheck;
      f_size:=0;
    end;

    procedure THostMemoryChunk.GenResource;
    begin
      if f_size = 0 then Exit;
      pointer(_handle):= CgeGetHostMem(f_size);
      AfterEfCheck;
    end;
    

{*****************************************************************************}
    
  { Now these two functions are used to cleanup any resources
    left unclaimed after the module is loaded.
    
    To do that properly, we need to know the resource type,
      to tell a vertex buffer from a chainsaw.
    This is implemented using the class information
      that Chepersy does already have. The list of TGenericResource
      descendants and their class indices is stored in the core module
      and used later to tell which class is which.
      
    We cannot store the metaclasses themselves (which would be a lot simpler)
      because their pointers move from compile to compile
      and may even move if the module Dll base address changes between loadings.
  }
  
  procedure StoreResourceClassesList;
  var
    s: pointer;
    L1, L2: TStringList;
    i: ptruint;
    o: TManagedObject;
    c: CManagedObject;
  begin
    s:=CgeGetCiMemoryStream();
    AfterEfCheck;
    if Assigned(s) then begin
      CgeSetCiMemoryStream(NIL);
      AfterEfCheck;
      CgeDeleteMemoryStream(s);
      AfterEfCheck;
    end;
    s:= CgeCreateMemoryStream();
    AfterEfCheck;
    CgeSetCiMemoryStream(s);
//addlog('s = %0',[s]);

//addlog('g = %0',[CgeGetCiMemoryStream()]);
    AfterEfCheck;
    L1:=ExportChepersyClassList;
    L2:=TStringList.Create;
    For i:=0 to L1.Count - 1 do begin
      c:=CManagedObject(L1.Objects[i]);
      o:=c.Generate; {вот эту херню наду давить к бениной матери, вся информация
                       о предках уже есть в chepersy, надо только выковырять!}
      if o is TGenericResource
        then L2.AddObject(L1[i], TObject(i));
      o.TechnicalDestroy;
    end;
    CgeWriteIntToMemoryStream(s, L1.Count);
    AfterEfCheck;
    L1.Free;
    CgeWriteIntToMemoryStream(s, L2.Count);
    AfterEfCheck;
    For i:=0 to L2.Count - 1 do begin
      CgeWriteIntToMemoryStream(s, Length(L2[i]));
      AfterEfCheck;
      CgeWriteToMemoryStream(s, @L2[i][1], Length(L2[i]));
      AfterEfCheck;
      CgeWriteIntToMemoryStream(s, ptruint(L2.Objects[i])); //index
      AfterEfCheck;
    end;
    L2.Free;
  end;
  

  procedure DeleteUnclaimedResources;
  var
    L1, L2: TStringList;
    i, j, B_IndCount, g: integer;
    n: array of integer;
    K: array of CGenericResource;
    names: array of string;
    a: AnsiString;
    ct: CManagedObject;
    c: CGenericResource;
    ot: TManagedObject;
    o: TGenericResource;
    r: PRes;
    s: pointer;
  begin
    s:=CgeGetCiMemoryStream();
//addlog('s = %0',[s]);
    AfterEfCheck;
    if not Assigned(s) then Exit; //nothing to do, the module was never saved
    
    r:= GetFirstResource();
    AfterEfCheck;
    if not Assigned(r) then Exit; //there are no lost resources to cleanup.

    //Load the table of TGenericResource descendants
    CgeSeekMemoryStream(s, 0);
    AfterEfCheck;
    B_IndCount:=CgeReadIntFromMemoryStream(s);
    AfterEfCheck;
    g:=CgeReadIntFromMemoryStream(s); //number of entries
    AfterEfCheck;
    SetLength(n, g);
    L2:=TStringList.Create;
    For i:=0 to g - 1 do begin
      j:=CgeReadIntFromMemoryStream(s);
      AfterEfCheck;
      SetLength(a, j);
      CgeReadFromMemoryStream(s, @a[1], j);
      AfterEfCheck;
      L2.Add(a);
      n[i]:=CgeReadIntFromMemoryStream(s);
      AfterEfCheck;
    end;

    //Build the translation table (stored index to current metaclass)
    L1:=ExportChepersyClassList;
    SetLength(K, B_IndCount);
    SetLength(names, B_IndCount);
    For i:=0 to high(K) do begin
      K[i]:= nil;
      names[i]:='<n/a>';
    end;
    For i:=0 to L1.Count - 1 do begin
      ct:=CManagedObject(L1.Objects[i]);
      ot:=ct.Generate;
      if ot is TGenericResource then begin
        For j:=0 to L2.Count - 1 do
          if L2[j] = L1[i] then K[ptruint(L2.Objects[j])]:=CGenericResource(ct);
      end;
      ot.TechnicalDestroy;
    end;
    L1.Free;
    L2.Free;
    
    //Now delete the unclaimed resources
    while Assigned(r) do begin
      c:=K[r^.kind];
      if Assigned(c) then begin
        o:=c.CreateToDestroy(r^.Handle);
        o.TechnicalDestroy;
      end
      else
        Die(RuEn(
          'Не удалось освободить ничейный ресурс:'#10#13'  не найден класс, создавший его!'#10#13'  (индекс %0, имя %1, хэндл %2, хэш %3)',
          'Unable to free the unclaimed resource:'#10#13'  cannot find the class that created it!'#10#13'  (index %0, name %1, handle %2, hash %3)'),
          [r^.kind, names[r^.kind], pointer(r^.Handle), HashToString(@r^.Hash)]);
      r:=GetNextResource();
      AfterEfCheck;
    end;
    ClearResourceList;
    AfterEfCheck;
  end;
  



  { TAbstractVertexBuffer }

  constructor TAbstractVertexBuffer.Create(sz: integer);
  begin
    f_sz:= sz;
    GenResource;
  end;

  procedure TAbstractVertexBuffer.RegisterFields;
  begin
    inherited;
    ListFields(['f_sz', @f_sz, typeinfo(integer)]);
  end;

  { THwVertexBuffer }

  procedure THwVertexBuffer.FreeResource;
  begin

  end;

  procedure THwVertexBuffer.GenResource;
  begin

  end;

  procedure THwVertexBuffer.RegisterFields;
  begin
    inherited;
    
    
  end;

  function THwVertexBuffer.Buffer(): PVertexArray;
  begin

  end;

{ TSoftwareVertexBuffer }

  procedure TSoftwareVertexBuffer.FreeResource;
  begin
    SetLength(va, 0);
  end;

  procedure TSoftwareVertexBuffer.GenResource;
  begin
    SetLength(va, f_sz * (sizeof(TVertex) div sizeof(GLfloat)));
  end;

  procedure TSoftwareVertexBuffer.RegisterFields;
  begin
    RegType(typeinfo(TGlFloatArray), typeinfo(glFloat));
    inherited;
    ListFields(['va', @va, typeinfo(TGlFloatArray)]);
  end;

  function TSoftwareVertexBuffer.Buffer(): PVertexArray;
  begin
    Result:=@va[0];
  end;

{ TMemoryMappedFile }

  constructor TMemoryMappedFile.Create(FileName: AnsiString);
  var
    ufn: ansistring;
  begin
    inherited Create;
    f_filename:= FileName;
    AfterEfCheck;
  end;

  procedure TMemoryMappedFile.RegisterFields;
  begin
    inherited;
    ListFields([
      'f_sz', @f_sz, typeinfo(integer),
      'f_mem', @f_mem, typeinfo(THostMemoryChunk),
      'f_filename', @f_filename, typeinfo(ansistring)
    ]);
  end;

  procedure TMemoryMappedFile.OnReload;
  var
    ufn: ansistring;
    fs: TFileStream;
  begin
    inherited;
      if f_filename <> '' then begin
        ufn:=PCharToString(_UnmangleFileName(PChar(f_filename)));
        AfterEfCheck;
        try
          fs:=TFileStream.Create(ufn, fmOpenRead);
        except
          Die(MI_CGEFILE_ERROR_READ, [ufn]);
        end;
        f_mem:= THostMemoryChunk.Create(fs.Size);
        fs.Read(pointer(f_mem._handle)^, f_mem.Size);
        pointer(_handle) := LoadPic(PChar(f_filename));
        AfterEfCheck;
        _GetFileHash(PAnsiChar(f_FileName), @Hash.Md5Hash);
        AfterEfCheck;
      end;
  end;

  procedure TMemoryMappedFile.FreeResource;
  begin
//    inherited FreeResource;
  end;

  procedure TMemoryMappedFile.GenResource;
  begin
//    inherited GenResource;
  end;

  procedure TMemoryMappedFile.Discard;
  begin
    inherited Discard;
  end;



  procedure RegisterResourceClasses;
  begin
    RegClass(TImage);
	  RegClass(TStatic2dTexture);
	  RegClass(TDynamic2dTexture);
	  RegClass(THostMemoryChunk);
	  RegClass(TMemoryMappedFile);
	  RegClass(THwVertexBuffer);
	  RegClass(TSoftwareVertexBuffer);
    mo_fbo.RegClasses;
    mo_glsl.RegClasses;
  end;


end.

