--[[ Movable and Named Objects on the Cartesian Plane
     Improved Version Using Class-Support Module
     H. Conrad Cunningham, Professor
     Computer and Information Science
     University of Mississippi

This case study examines issues related to the design and
implementation of inheritance hierarchies and multiple inheritance in
Lua.  It is based on a similar Haskell case study given in Section
14.6 of the textbook:

    Simon Thompson. Haskell: The Craft of Functional Programming,
    Third Edition, Addison Wesley, 2011.

Developed for CSci 658, Software Language Engineering, Fall 2013

1234567890123456789012345678901234567890123456789012345678901234567890

2013-10-09: Extracted "class_support" into separate module
            Modified this code to use "class-support"
            Made these classes into module, separating test driver

The class structure for code in this case study is as follows.
Indentation indicates subclasses.

  concrete class Vector
  abstract class Movable
      concrete subclass Point
      abstract subclass Figure
          concrete subclass Line
          concrete subclass Circle
      concrete subclass MovableList
      concrete class NamedMovable (ALSO UNDER Name)
  abstract class Named
      concrete subclass Name
          concrete class NamedMovable

--]]

-- Load class support module
local classup = require "class_support"

-- Local names for functions in class_support module
local makeClass, isInstanceOf = classup.makeClass, classup.isInstanceOf

-- Type tag constants for the classes in this package
local VECTOR       = "Vector"
local MOVABLE      = "Movable"
local POINT        = "Point"
local FIGURE       = "Figure"
local LINE         = "Line"
local CIRCLE       = "Circle"
local MOVABLELIST  = "MovableList"
local NAMED        = "Named"
local NAME         = "Name"
local MOVABLENAME  = "MovableName"


-- NOT CURRENTLY USED
-- Function "map" applies function "f" to every element of array-style
-- table "t" and returns a new table holding the values.

local function map(f,t)
  assert(type(f) == "function",
         "First argument of map must be a single-argument function.")
  assert(type(t) == "table",
         "Second argument of map must be an array-style table.")
  local newt = {}
  for i = 1, #t do
    newt[i] = f(t[i])
  end
  return newt
end


--[[ CONCRETE CLASS Vector prototype

An object of the "Vector" class represents a displacement on the
Cartesian plane.  It has two fields: the "x" (horizontal) and "y"
(vertical) components of the displacement.

The Haskell definition for the Vector algebraic data type is: 

    data Vector = Vec Float Float

--]]

local Vector = makeClass(VECTOR)

-- Vector factory (constructor/initializer) method
function Vector:make(xc,yc)
  assert(type(xc) == "number" and type(yc) == "number",
         "Vector objects must have numeric x and y coordinates.")
  local o = { x = xc, y = yc }
  return Vector:new(o)
end

-- Vector accessors
function Vector:getX()   return self.x   end
function Vector:getY()   return self.y   end

-- Override default definition
function Vector:toString()
  return tostring(self:getTag()) .. "(" .. 
         tostring(self:getX()) .. ", " .. 
         tostring(self:getY()) .. ")"
end


--[[ ABSTRACT CLASS Movable prototype

Movable objects represent entities that can be moved on the Cartesian
plane. The Haskell class declaration for Movable is as follows:

     class Movable a where
       move      :: Vector -> a -> a
       reflectX  :: a -> a
       reflectY  :: a -> a
       rotate180 :: a -> a
       rotate180 = reflectX . reflectY

The Lua code makes "move" a one-parameter mutator method and
"reflectX", "reflectY", and "rotate180" parameterless mutator methods.
The Movable object (i.e., the first parameter of the Haskell
functions) is the implicit parameter (i.e., the receiver or target of
the method).

--]]

local Movable = makeClass(MOVABLE)

-- Movable mutators (most are deferred, rotate180 has default body)
function Movable:move(v)
  error("Error: Call of move for abstract class " .. 
        self:getTag(), 2)
end

function Movable:reflectX()
  error("Error: Call of reflectX for abstract class " .. 
        self:getTag(), 2)
end

function Movable:reflectY() 
  error("Error: Call of reflectY for abstract class " .. 
        self:getTag(), 2)
end

function Movable:rotate180()
  return (self:reflectX()):reflectY()
end


--[[ CONCRETE SUBCLASS Point prototype (subclass of Movable)

A Point object represents a single point on the Cartesian plane with
the given x and y coordinates. 

The Haskell definition for the Point algebraic data type is as
follows:

     data Point = Point Float Float
                  deriving Show

The Haskell instance declaration for making Point a subclass of
Movable is as follows:

    instance Movable Point where
      move (Vec v1 v2) (Point c1 c2) = Point (c1+v1) (c2+v2)
      reflectX (Point c1 c2)  = Point c1 (-c2)
      reflectY (Point c1 c2)  = Point (-c1) c2
      rotate180 (Point c1 c2) = Point (-c1) (-c2)

Constructor Point:new and the accessor and mutator methods are
inherited from superclass Movable unless overridden below.

--]]

local Point = makeClass(POINT,Movable)

-- Point factory (constructor/initializer) function
function Point:make(xc,yc)
  assert(type(xc) == "number" and type(yc) == "number",
         "Point objects must have numeric x and y coordinates.")
  local o = { x = xc, y = yc }
  return Point:new(o)
end

-- Accessors
function Point:getX()  return self.x  end
function Point:getY()  return self.y  end

function Point:equals(p)
  return isInstanceOf(p,POINT) and 
         self:getX() == p:getX() and self:getY() == p:getY()
end

function Point:lt(p)
  if not isInstanceOf(p,POINT) then
    return false
  else 
    local x1, x2 = self:getX(), p:getX()
    local y1, y2 = self:getY(), p:getY()
    return x1 < x2 or (x1 == x2 and y1 < y2)
  end
end

-- Define the methods deferred from Movable

function Point:showValues()
  return { tostring(self:getX()), tostring(self:getY()) }
end

function Point:move(v)
  assert(isInstanceOf(v,VECTOR),"Argument to move must be a Vector.")
  return Point:make(self:getX()+v:getX(), self:getY()+v:getY())
end

function Point:reflectX()
  return Point:make(self:getX(), -self:getY()) 
end

function Point:reflectY()
  return Point:make(-self:getX(), self:getY()) 
end

-- Override and redefine "rotate180" efficiently for Points
function Point:rotate180()
  return Point:make(-self:getX(), -self:getY())
end


--[[ ABSTRACT SUBCLASS Figure prototype (subclass of Movable)

A Figure object represents a geometric figure on the Cartesian plane.

The Haskell definition of the Figure algebraic data type is as
follows:

     data Figure = Line Point Point |
                   Circle Point Float
                   deriving Show

The Haskell instance declarations for making Figure a subclass of
Movable is as follows:

    instance Movable Figure where
      move v (Line p1 p2) = Line (move v p1) (move v p2)
      move v (Circle p r) = Circle (move v p) r

      reflectX (Line p1 p2) = Line (reflectX p1) (reflectX p2)
      reflectX (Circle p r) = Circle (reflectX p) r

      reflectY (Line p1 p2) = Line (reflectY p1) (reflectY p2)
      reflectY (Circle p r) = Circle (reflectY p) r

This package defines the Figure class hierarchy with subclasses Line
and Circle for the two Haskell data type constructors used.  Figure is
made a subclass of the abstract class Movable.

Constructor Figure:new and the accessor and mutator methods are
inherited from superclass Movable.

--]]

local Figure = makeClass(FIGURE,Movable)


--[[ CONCRETE SUBCLASS Line prototype (subclass of Figure)

A Line object represents a line passing through the two given distinct
points on the Cartesian plane.  The Haskell code for Line is given
above in the description of Figure.

Constructor Line:new and the accessor and mutator methods are
inherited from superclass Figure unless overridden below.

The Line:make factory method creates a new Line object with a
representation in which point1 < point2.

--]]

local Line = makeClass(LINE,Figure)

-- Line factory (constructor/initializer) function
function Line:make(point1,point2)
  assert(isInstanceOf(point1,POINT) and isInstanceOf(point2,POINT) 
         and not point1:equals(point2),
         "Line:make arguments must be two distinct Points.")
  if point1:lt(point2) then
    o = { p1 = point1, p2 = point2 }
  else 
    o = { p1 = point2, p2 = point1 }
  end
  return Line:new(o)
end

-- Accessors
function Line:getP1()  return self.p1  end
function Line:getP2()  return self.p2  end

-- Define the methods deferred from Figure (and Movable)

function Line:showValues()
  return { (self:getP1()):toString(), (self:getP2()):toString() }
end

function Line:move(v)
  assert(isInstanceOf(v,VECTOR),
         "Argument to move must be a Vector.")
  return Line:make( (self:getP1()):move(v), 
                    (self:getP2()):move(v) )
end

function Line:reflectX()
  return Line:make( (self:getP1()):reflectX(), 
                    (self:getP2()):reflectX() )
end

function Line:reflectY()
  return Line:make( (self:getP1()):reflectY(), 
                    (self:getP2()):reflectY() )
end


--[[ CONCRETE SUBCLASS Circle prototype (subclass of Figure)

A Circle object represents a circle on the Cartesian plane with the
given center point and radius. The Haskell code for Circle is given
above in the description of Figure.

Constructor Circle:new and the accessor and mutator methods are
inherited from superclass Figure unless overridden below.

--]]

local Circle = makeClass(CIRCLE,Figure)

-- Circle factory (constructor/initializer) function
function Circle:make(cp,r)
  assert(isInstanceOf(cp,POINT) and r >= 0.0,
    "Circle:make arguments are a Point and a nonnegative radius.")
  local o = { center = cp, radius = r }
  return Circle:new(o)
end

-- Accessors
function Circle:getCenter()  return self.center  end
function Circle:getRadius()  return self.radius  end

-- Define the methods deferred from Figure (and Movable)

function Circle:showValues()
  return { (self:getCenter()):toString(), tostring(self:getRadius()) }
end

function Circle:move(v)
  assert(isInstanceOf(v,VECTOR),
         "Argument to move must be a Vector.")
  return Circle:make( (self:getCenter()):move(v), 
                      self:getRadius()           )
end

function Circle:reflectX()
  return Circle:make( (self:getCenter()):reflectX(), 
                      self:getRadius()              )
end

function Circle:reflectY()
  return Circle:make( (self:getCenter()):reflectY(), 
                      self:getRadius()              )
end


--[[ CONCRETE SUBCLASS MovableList prototype (subclass of Movable)

A MovableList object holds a sequence of Movable objects of any
subclass. 

The Haskell instance declaration for making the builtin Haskell lists
a subclass of Movable is as follows:

    instance Movable a => Movable [a] where
        move v   = map (move v)
        reflectX = map reflectX
        reflectY = map reflectY

A Lua array-style table is the data structure used to implement this
class.

--]]

local MovableList = makeClass(MOVABLELIST,Movable)

-- MovableList factory (constructor/initializer) function
function MovableList:make(l)
  assert(type(l) == "table",
         "MovableList:make argument must be an array-style table.")
  local o = { list = l }
  return MovableList:new(o)
end

-- Accessors
function MovableList:getList()  return self.list  end

-- Define the methods deferred from Movable

function MovableList:showValues()
  local list = self:getList()
  local res = {}
  for i = 1, #list do
    res[i] = list[i]:toString()
  end
  return res
end

function MovableList:move(v)
  assert(isInstanceOf(v,VECTOR),
         "Argument to move must be a Vector.")
  local list = self:getList()
  local res = {}
  for i = 1, #list do
    res[i] = list[i]:move(v)
  end
  return MovableList:make(res)
end 

function MovableList:reflectX()
  local list = self:getList()
  local res  = {}
  for i = 1, #list do
    res[i] = list[i]:reflectX()
  end
  return MovableList:make(res)
end

function MovableList:reflectY()
  local list = self:getList()
  local res  = {}
  for i = 1, #list do
    res[i] = list[i]:reflectY()
  end
  return MovableList:make(res)
end


--[[ ABSTRACT CLASS Named prototype 

Named objects are objects with associated name strings.

The Haskell class declaration for Named is as follows:

    class Named a where
      lookName :: a -> String
      giveName :: String -> a -> a

--]]

local Named = makeClass(NAMED)

-- Accessors
function Named:lookName()
  error("ERROR: Abstract method Named:lookName called.", 2)
end

-- Mutators
function Named:giveName(n)
  error("ERROR: Method Named:giveName called.", 2)
end


--[[ CONCRETE CLASS Name prototype (subclass of Named)

The Name class defines a concrete representation for the Named
abstract class.

The Haskell algebraic data type and instance declarations for Name are
as follows:

     data Name = Pair a String
 
     instance Named (Name a) where]
       lookName (Pair obj nm)   = nm
       giveName nm (Pair obj _) = (Pair obj nm)

     mapName :: (a -> b) -> Name a -> Name b
     mapName f (Pair obj nm) = Pair (f obj) nm

The Lua code incorporates mapName into the Name class as a mutator
method that takes the element transformation function as its
explicit parameter.

--]]

local Name = makeClass(NAME,Named)

-- Named factory (constructor/initializer) function
function Name:make(nm,obj)
  assert(type(nm) == "string",
         "First argument of Name:make must be a name string.")
  local o = { name = nm, object = obj }
  return Name:new(o)
end

-- Accessors
function Name:lookName()
  return self.name  
end

function Name:getObject()
  return self.object
end

function Name:showValues()
  return { self:lookName(), (self:getObject()):toString() }
end

-- Mutators
function Name:giveName(nm)
  assert(type(nm) == "string",
         "Name:giveName argument must be a name string.")
  return Name:make(nm,self:getObject())
end

-- This function is not currently used
function Name:mapName(f)
  return Name:make(self:lookName(),f(self:getObject()))
end


--[[ CONCRETE MULTIPLE INHERITANCE SUBCLASS NamedMovable

MovableNames are Names that are also Movable.

The Haskell class and instance declarations for "movable names" are as
follows:

  instance Movable a => Movable (Name a) where
      move v   = mapName (move v)
      reflectX = mapName reflectX
      reflectY = mapName reflectY

  class (Movable b, Named b) => NamedMovable b

  instance Movable a => NamedMovable (Name a)

Currently, the NamedMovable class and its instance are not
implemented.

The Lua code causes a MovableName object to be created that wraps
the Name object. 

--]]

local MovableName = makeClass(MOVABLENAME,Name,Movable)

-- Factory method for MovableName
function MovableName:make(namedObj)
  assert(type(namedObj) == "table" and isInstanceOf(namedObj,NAME),
         "Argument of MovableName:make must be Name.")
  local obj = namedObj:getObject()
  assert(type(obj) == "table" and isInstanceOf(obj,MOVABLE),
         "MovableName's object must be Movable.")
  return MovableName:new(namedObj)
end

-- Define the methods deferred from Movable

function MovableName:showValues()
  return Name.showValues(self) -- use showValues in Name (not Movable)
end

function MovableName:move(v)
  assert(isInstanceOf(v,VECTOR),"Argument to move must be a Vector.")
  local newObj = (self:getObject()):move(v) 
  return MovableName:make(Name:make( self:lookName(), newObj ))
end

function MovableName:reflectX()
  local newObj = (self:getObject()):reflectX() 
  return MovableName:make(Name:make( self:lookName(), newObj ))
end

function MovableName:reflectY()
  local newObj = (self:getObject()):reflectY() 
  return MovableName:make(Name:make( self:lookName(), newObj ))
end


-- MODULE EXPORT

return { Vector       = Vector,
         Movable      = Movable,
         Point        = Point,
         Figure       = Figure,
         Line         = Line,
         Circle       = Circle,
         MovableList  = MovableList,
         Named        = Named,
         Name         = Name,
         MovableName  = MovableName,
         makeClass    = makeClass,   -- from class_support
         isInstanceOf = isInstanceOf -- from class_support
       }