//  Filename: ifs_obj.pas
//  Author: Carlo Kok (ckok.1@hccnet.nl)
//
// Innerfuse Pascal Script Custom Objects
//
// When created properly, it will free itself.

unit ifs_obj;

interface
{$I ifs_def.inc}

uses
  ifs_var, ifs_utl;

type
  TIfsCustomObject = class;
  TIFsCustomObjectType = class of TIfsCustomObject;
  PCreatedCustomObject = ^TCreatedCustomObject;
  TCreatedCustomObject = packed record
    AlreadyFreed: Boolean;
    P: TIfsCustomObject;
  end;
  TIfsCustomObject = class
  private
    FScriptEngine: Pointer;
    FCCO: PCreatedCustomObject;
  protected
    property CreatedCustomObject: PCreatedCustomObject read FCCo write FCCO;
  public
    property ScriptEngine: Pointer read FScriptEngine;

    constructor Create(ScriptEngine: Pointer);

    function GetPropertyType(I: Longint): PTypeRec; virtual;
    function SetProperty(I: Longint; P: PIfVariant): Boolean; virtual;
    function GetProperty(I: Longint; Dest: PIfVariant): Boolean; virtual;
    function FindProperty(const Name: string): Longint; virtual;
    function GetPropertyCount: Longint; virtual;

    function FindProc(const Name: string): Longint; virtual;
    function GetProcHeader(I: Longint): string; virtual;
    function CallProc(I: Longint; Params: PVariableManager): PIFVariant; virtual;
    function GetProcCount: Longint; virtual;
  end;

function CreateResource(S: TIfsCustomObject): PCreatedCustomObject;
{ Add it to the resource list, so it will be automaticly freed. }
procedure FreeResource(S: PCreatedCustomObject);
{ Free the class, but not the PCreatedCustomObject type. } 

implementation
uses
 ifspas;

procedure RealFreeResource(id: Pointer; Data: PCreatedCustomObject);
begin
  if not Data.AlreadyFreed then
    Data.P.Free;
  Dispose(Data);
end;

function CreateResource(S: TIfsCustomObject): PCreatedCustomObject;
begin
  New(Result);
  Result.AlreadyFreed := False;
  Result.P := S;
  s.FCCO := Result;
  TIFPasScript(s.FScriptEngine).AddResource(@RealFreeResource, Result);
end;

procedure FreeResource(S: PCreatedCustomObject);
{ Free the class, but not the PCreatedCustomObject type. }
begin
  if not s.AlreadyFreed then
  begin
    S.AlreadyFreed := True;
    s.P.Free;
  end;
end;


constructor TIfsCustomObject.Create(ScriptEngine: Pointer);
begin
  inherited Create;
  FScriptEngine := ScriptEngine;
end;

function TIfsCustomObject.GetPropertyType(I: Longint): PTypeRec;
begin
  Result := nil;
end;

function TIfsCustomObject.FindProc(const Name: string): Longint;
begin
  Result := -1;
end;
    
function TIfsCustomObject.SetProperty(I: Longint; P: PIfVariant): Boolean;
begin
  Result := False;
end;

function TIfsCustomObject.GetProperty(I: Longint; Dest: PIfVariant): Boolean;
begin
  Result := False;
end;

function TIfsCustomObject.FindProperty(const Name: string): Longint;
begin
  Result := -1;
end;

function TIfsCustomObject.GetPropertyCount: Longint;
begin
  Result := 0;
end;

function TIfsCustomObject.GetProcHeader(I: Longint): string;
begin
  Result := '';
end;

function TIfsCustomObject.CallProc(I: Longint; Params: PVariableManager): PIFVariant;
begin
  Result := nil;
end;

function TIfsCustomObject.GetProcCount: Longint;
begin
  Result := 0;
end;

end.
