--******************************************************************************
--*                                                                            *
--*  File:        Lua_03_Lib.lua                        Revision:  1.0         *
--*                                                                            *
--*  Purpose:     provides functions from "Lua_03" for other scripts           *
--*                                                                            *
--*  Creation:    06.03.2002                   Last Modification:  06.03.2002  *
--*                                                                            *
--*  Platform:    IBM-compatible PC running Windows 98SE                       *
--*                                                                            *
--*  Environment: Lua 4.0, TkLua 4.0                                           *
--*                                                                            *
--*  Author:      Andreas Rozek           Phone:  ++49 (711) 6770682           *
--*               Kirschblütenweg 15      Fax:    -                            *
--*             D-70569 Stuttgart         EMail:  Andreas.Rozek@T-Online.De    *
--*               Germany                                                      *
--*                                                                            *
--*  URL:         http://www.Andreas-Rozek.de/                                 *
--*                                                                            *
--*  Copyright:   the software is published under the "GNU Lesser General Pub- *
--*               lic  License" (see "http://www.fsf.org/copyleft/lesser.html" *
--*               for additional information)                                  *
--*                                                                            *
--*  Comments:    (none)                                                       *
--*                                                                            *
--******************************************************************************

  dofile("Lua_02_Lib.lua");

--**** provide single inheritance for "objects" (rather than tables) ****

  Object = {};                 -- (global) "Object" starts the inheritance chain

  local ObjectTag = newtag();                -- gets an unique tag for "objects"
    local ObjectIndexer = function (Table,Index)
      local Prototype = rawget(Table,"_prototype");
      if (type(Prototype) == "table") then
        return Prototype[Index];    -- may fail if prototypes form a closed loop
      elseif (Prototype == nil) then
        return %Object[Index];-- doesn't loop since "Object" is not an "object"!
      else
        return nil;
      end;
    end;
  settagmethod(ObjectTag,"index",ObjectIndexer);       -- "installs" inheritance

  settag(Object,ObjectTag);-- makes "ObjectTag" accessible through "tag(Object)"
  Object._prototype = 0;       -- allows prototype chain traversals to terminate

--**** extend the built-in global "type"-function to handle "objects" ****

  local _type = type;                          -- preserve the built-in function

  function type (Candidate, ObjectSavvy)
    if (ObjectSavvy) then
      if (tag(Candidate) == %ObjectTag) then
        return "object";   -- assuming that only tables get this tag assigned to
      else
        return %_type(Candidate);
      end;
    else
      return %_type(Candidate);
    end;
  end;

--**** provide some basic methods (available for every "object") ****

  function Object:clone ()                               -- generic clone method
    local Result = {};
      for Key,Value in self do              -- copy all fields (even _prototype)
        Result[Key] = Value;
      end;

      settag(Result,tag(Object));      -- effectively makes 'Result' an "object"
    return Result;
  end;

  function Object:inheritsfrom (Candidate)
    if (self == Candidate) then return true; end;   -- stops prototype traversal

    if (type(Candidate) ~= "table") then return false; end;             -- oops!

    local Prototype = rawget(self,"_prototype");
    if (type(Prototype) == "table") then        -- only tables may be considered
      if (tag(Prototype) == %ObjectTag) then
        return Prototype:inheritsfrom (Candidate);         -- continue traversal
      else
        return (Candidate == Prototype);           -- prototype chain stops here
      end;
    elseif (Prototype == nil) then  -- "Object" may not be explicitly registered
      return (Candidate == %Object);
    else
      return false;
    end;
  end;
  Object.inheritsFrom = Object.inheritsfrom;       -- allow alternative spelling

  function Object:new (...)                             -- generic "constructor"
    local Result = {};
      if (type(arg[1]) == "table") then
        if (tag(arg[1]) == %ObjectTag) then          -- "objects" will be copied
          Result = arg[1]:clone();
        else             -- plain tables are taken themselves (common Lua habit)
          Result = arg[1];
        end;

        for i = 2,getn(arg) do   -- additional arguments represent list elements
          Result[i] = arg[i];
        end;
      else
        for i = 1,getn(arg) do              -- arguments represent list elements
          Result[i] = arg[i];
        end;
      end;

      if (Result._prototype == nil) then       -- allows prototypes to be preset
        if (self == Object) then
          Result._prototype = Object;
        else
          Result._prototype = self._prototype;-- binds 'Result' to its prototype
        end;
      end;

      settag(Result,tag(Object));      -- effectively makes 'Result' an "object"
    return Result;
  end;

--**** allow objects to be "invoked" (as a shortcut for their own constructors) ****

  local ObjectConstructor = function (Target,...)
    if ((type(Target) == "table") and (tag(Target) == tag(Object))) then
      local Constructor = rawget(Target,"new"); -- don't "inherit" constructors!
      if (type(Constructor) == "function") then
        tinsert(arg,1,Target);    -- since "Constructor" needs a "self" argument
        return call(Constructor,arg);
      else
        error("error: missing (or inappropriate) constructor");
      end;
    else
      error("error: trying to invoke a non-function value");
    end;
  end;

  settagmethod(ObjectTag,"function",ObjectConstructor);