Smart pascal source code


type
  TMyFunc = function(s: String): String;

type
  TMyRec = record
    Proc1: TMyFunc;
    Proc2: TMyFunc;
  end;

type
  TMyClass = class
    FRec: TMyRec;
    FAFunc: TMyFunc;
    procedure WriteLn;
    function GetProc1: TMyFunc;
    procedure SetProc1(f: TMyFunc);
    property AFunc: TMyFunc read FAFunc write FAFunc;
  end;

procedure TMyClass.WriteLn;
begin
  WriteLn(FRec.Proc1('World'));
  WriteLn(FRec.Proc2('world!'));
  WriteLn(FAFunc('world'));
end;

function TMyClass.GetProc1: TMyFunc;
begin
  Result := FRec.Proc1;
end;

procedure TMyClass.SetProc1(f: TMyFunc);
begin
  FRec.Proc1 := f;
end;

function Func1(s: String): String;
begin
  Result := 'Hello ' + s;
end;

function Func2(str: String): String;
begin
  Result := 'ByeBye ' + str;
end;

function Func3(str: String): String;
begin
  Result := 'Ho ho ho ' + str;
end;

var
o := TMyClass.Create;

o.FRec.Proc1 := Func1;
o.FRec.Proc2 := Func2;
o.AFunc := Func3;

o.WriteLn;

WriteLn(o.GetProc1()('get'));

WriteLn(o.AFunc('direct prop'));

var old: TMyFunc := o.GetProc1();
o.SetProc1(Func2);

WriteLn(old('old'));
old := o.FRec.Proc1;
WriteLn(old('new'));

{<<< RESULT - CONSOLE LOG >>>
-----------------------------
Hello World
ByeBye world!
Ho ho ho world
Hello get
Ho ho ho direct prop
Hello old
ByeBye new
-----------------------------
{<<<<<<<<< THE END >>>>>>>>>}

var TObject={
	$ClassName: "TObject",
	$Parent: null,
	ClassName: function (s) { return s.$ClassName },
	ClassType: function (s) { return s },
	ClassParent: function (s) { return s.$Parent },
	$Init: function () {},
	Create: function (s) { return s },
	Destroy: function (s) { for (var prop in s) if (s.hasOwnProperty(prop)) delete s.prop },
	Destroy$: function(s) { return s.ClassType.Destroy(s) },
	Free: function (s) { if (s!==null) s.ClassType.Destroy(s) }
}
var Exception={
	$ClassName: "Exception",
	$Parent: TObject,
	$Init: function () { FMessage="" },
	Create: function (s,Msg) { s.FMessage=Msg; return s }
}
function $New(c) { var i={ClassType:c}; c.$Init(i); return i }
function $CheckFunc(i,z) { if (i) return i; throw Exception.Create($New(Exception),"Function pointer is nil"+z); }
function $Check(i,z) { if (i) return i; throw Exception.Create($New(Exception),"Object not instantiated"+z); }
function WriteLn(value) {
    if (window.console) { window.console.log(value); } };
function Copy$TMyRec(s,d) {
   d.Proc1=s.Proc1;
   d.Proc2=s.Proc2;
   return d;
}
function Clone$TMyRec($) {
   return {
      Proc1:$.Proc1,
      Proc2:$.Proc2
   }
}
var TMyClass = {
   $ClassName:"TMyClass",$Parent:TObject
   ,$Init:function ($) {
      TObject.$Init($);
      $.FRec = {Proc1:null,Proc2:null};
      $.FAFunc = null;
   }
   ,WriteLn2:function(Self) {
      WriteLn($CheckFunc($Check(Self,"").FRec.Proc1,"")("World"));
      WriteLn($CheckFunc($Check(Self,"").FRec.Proc2,"")("world!"));
      WriteLn($CheckFunc($Check(Self,"").FAFunc,"")("world"));
   }
   ,GetProc1:function(Self) {
      return $Check(Self,"").FRec.Proc1;
   }
   ,SetProc1:function(Self, f) {
      $Check(Self,"").FRec.Proc1 = f;
   }
   ,Destroy:TObject.Destroy
};
function Func3(str) {
   return "Ho ho ho "+str;
};
function Func2(str$1) {
   return "ByeBye "+str$1;
};
function Func1(s) {
   return "Hello "+s;
};
var o = null,
   old = null;

   /*   MAIN JS CODE  */

   o = TObject.Create($New(TMyClass));
   $Check(o,"").FRec.Proc1 = Func1;
   $Check(o,"").FRec.Proc2 = Func2;
   $Check(o,"").FAFunc = Func3;
   TMyClass.WriteLn2(o);
   WriteLn($CheckFunc(TMyClass.GetProc1(o),"")("get"));
   WriteLn($CheckFunc($Check(o,"").FAFunc,"")("direct prop"));
   old = TMyClass.GetProc1(o);
   TMyClass.SetProc1(o,Func2);
   WriteLn($CheckFunc(old,"")("old"));
   old = $Check(o,"").FRec.Proc1;
   WriteLn($CheckFunc(old,"")("new"));