Klass Module

wiki

-- $FILE klass.lua
-- $VERSION 0.0.2
-- $AUTHOR Ketmar
-- $DESCRIPTION
--   another one simple class engine %-)
--
-- $LICENSE
--   public domain
--
-- $DEPENDS
--
-- $USAGE
--   local newclass = class(nil, "baseclass")
--   function newclass:Method (...) print(self); end;
--
--   local class2 = class(newclass)
--   function class2:Method (...) print(self); inherited(self, ...); end;
--
--   local inst = class2("argument to Constructor!");
--
--   iherited() will do nothing if there's no inherited method. %-)
--   class can have 2 special methods:
--     :Constructor (...)
--     :Destructor ()
--   `Destructor' will be called when object is going to be destroyed by GC
--
--   DO NOT FORGET TO PASS `self' TO inherited()!
--
--   you can alter methods even in class instance!
--   this means that you can extend already defined classes and instantiated
--   objects. all class extensions are immediate visible to all instantiated
--   objects.
--
-- $HISTORY
--   [+] added :InstanceOf(class) method
--   [+] added :AncestorOf(class) method (true for c:AncestorOf(c)!)
--
-- $WARNING
--   this isn't a real module, but you can require() it! %-)


-- $DESCR
--   (method) find field in class of in parents
-- $IN
--   class
--     class definition or instance
--   fld
--     field name (of any type)
-- $OUT
--  $OR good
--   value
--  $OR bad
--   nil
local function FindField (class, fld)
  local res = rawget(class, fld); if res ~= nil then return res; end;
  local pl = rawget(class, "parent"); if pl == nil then return nil; end;
  return pl[fld];
end;


local seeallmt = { __index = _G };

-- $DESCR
--   (method) find field in class of in parents
-- $IN
--   class
--     class definition or instance
--   fld
--     field name (of any type)
-- $OUT
local function NewField (class, fld, value)
  if value == nil then return; end;
  if type(value) == "function" then
    -- new method, change envtable
    -- this trick allows use of "inherited(self, ...)"
    local inh = function (self, ...)
      local m = rawget(class, "parent"); if not m then return nil; end;
      m = m[method]; if m then return m(self, ...); end;
    end;
    local env = { method = fld };
    setmetatable(env, seeallmt); setfenv(inh, env);
    local env = { method = fld, inherited = inh };
    setmetatable(env, seeallmt); setfenv(value, env);
  end;
  rawset(class, fld, value);
end;


-- metatable for instances
local instmt = {
  __index = FindField,
  __newindex = NewField,
};


-- $DESCR
--   check if the given object/class is instance of a given class (or one of it's parents)
-- $IN
--   class obj
--     class/instantiated class (object)
--   class class
--     class defined thru class(...)/object
-- $OUT
--   true/false
local function InstanceOf (obj, class)
  -- check obj
  local mt = getmetatable(class);
  if mt == instmt then
    -- this is an instance, get class
    class = rawget(class, "parent");
  end;
  -- now go down to see if we are one of the sons of class
  while obj do
    if obj == class then return true; end;
    obj = rawget(obj, "parent");
  end;
  return false;
end;


-- $DESCR
--   (method) create new class instance
-- $IN
--   class
--     class definition
--   ...
--     constructor args
-- $OUT
--   class_instance
local function ClassNew (class, ...)
  local res = {
    classname = class.classname,
    parent = class,
    --__call = ClassNew, --??? my stupid bug? %-)
    InstanceOf = InstanceOf,
  };
  -- this trick registers "object finalizer"
  local proxy = newproxy(true); -- create proxy (userdata) with empty metatable
  local mt = getmetatable(proxy);
  mt.__gc = function ()
    local dd = res.Destructor; if dd then dd(res); end;
  end;
  res.__gc = proxy;
  -- end of "object finalizer" trick
  setmetatable(res, instmt);
  local cc = res.Constructor; if cc then cc(res, ...); end;
  return res;
end;


-- metatable for classes
local classmt = {
  __index = FindField,
  __call = ClassNew,
  __newindex = NewField,
};

-- $DESCR
--   create new class (with possible inheritance)
-- $IN
--   class parent
--     parent or nil
--   nil/str classname
--     class name (not used by klass)
-- $OUT
--   class
function class (parent, classname)
  local res = { classname = classname, parent = parent, New = ClassNew, AncestorOf = InstanceOf };
  setmetatable(res, classmt);
  return res;
end;


module("klass");

and a testcase:

require "klass";

print("\n\n===============================");


local BaseClass = class(nil, "base");
function BaseClass:Constructor (...)
  print("BaseClass."..method);
end;

function BaseClass:Me (...)
  print("BaseClass."..method);
  print(self);
end;

function BaseClass:ClassName (...)
  print("BaseClass."..method);
  return "BaseClass";
end;

function BaseClass:Test ()
  print("BaseClass."..method);
  inherited(self);
end;

function BaseClass:Destructor ()
  print("BaseClass."..method);
  print(self);
end;


local NewClass = class(BaseClass, "new");
function NewClass:Constructor (...)
  print("NewClass."..method);
  inherited(self);
end;

function NewClass:ClassName (...)
  print("NewClass."..method);
  return "NewClass";
end;

function NewClass:Destructor ()
  print("NewClass."..method);
  print(self);
  inherited(self);
  print("NewClass instance is dead");
end;


print("\27[37;1mcreating BaseClass instance...\27[0m");
local bc = BaseClass();
print("\27[37;1mcreating NewClass instance...\27[0m");
local nc = NewClass();

function nc:Test ()
  print("!!!");
  inherited(self);
end;

print("\27[37;1mbc:ClassName()\27[0m");
print(bc:ClassName());
print("\27[37;1mnc:ClassName()\27[0m");
print(nc:ClassName());

print("\27[37;1mbc:Me()\27[0m");
bc:Me();
print("\27[37;1mnc:Me()\27[0m");
nc:Me();
print("\27[37;1mnc:Test()\27[0m");
nc:Test();

--[[
print(BaseClass);
print(NewClass);
print(nc.parent);
print(nc.parent.parent);
]]
print("nc:InstanceOf(nc): "..tostring(nc:InstanceOf(bc)));
print("nc:InstanceOf(NewClass): "..tostring(nc:InstanceOf(BaseClass)));
print("nc:InstanceOf(bc): "..tostring(nc:InstanceOf(bc)));
print("nc:InstanceOf(BaseClass): "..tostring(nc:InstanceOf(BaseClass)));
print("bc:InstanceOf(bc): "..tostring(bc:InstanceOf(bc)));
print("bc:InstanceOf(BaseClass): "..tostring(bc:InstanceOf(BaseClass)));
print("bc:InstanceOf(nc): "..tostring(bc:InstanceOf(nc)));

print("NewClass:AncestorOf(BaseClass): "..tostring(NewClass:AncestorOf(BaseClass)));
print("BaseClass:AncestorOf(NewClass): "..tostring(BaseClass:AncestorOf(NewClass)));

print("\27[37;1mdone\27[0m");

--[[
bc = nil; nc = nil;
collectgarbage("collect");
collectgarbage("collect");
]]