General array using abstract or polymorphism

[PaulSquires]

Hi everyone, trying to wrap my brain around a way to create an array of polymorphic class instances. I tried first using abstract methods but what I really need (I think) is a way to make the base class truly abstract. The code below creates a base class for a Shape. Two classes are derived from Shape called Rectangle and Triangle. My goal is to create an array that will hold both the Rectangles and Triangles and allow me access the properties and call the methods of those shapes. I wrote comments in the source code kind of explain better what I am trying to accomplish. Maybe FreeBasic is too strongly typed to allow this type of programming?

Code: Select all

''
'' Inheritance Class test
''

enum
   SHAPE_RECTANGLE = 1, SHAPE_TRIANGLE
end enum
   

''
''  SHAPE CLASS (BASE)
''
type clsShape extends object
   protected:
      _shapeType   as long 
      _shapeWidth  as LONG
      _shapeHeight as LONG
   Public:
      declare property shapeType() as LONG
      declare property shapeType( byval nValue as long )
      declare property shapeWidth() as LONG
      declare property shapeWidth( byval nValue as long )
      declare property shapeHeight() as LONG
      declare property shapeHeight( byval nValue as long )
      declare virtual function shapeArea() as double 
      Declare Constructor ()                       '' to avoid user construction from root
      Declare Constructor (ByRef rhs As clsShape) '' to avoid user copy-construction from root
END TYPE
constructor clsShape()
end constructor
property clsShape.shapeType() as LONG
   property = _shapeType
end property
property clsShape.shapeType( byval nValue as long )
   _shapeType = nValue
end property
property clsShape.shapeWidth() as LONG
   property = _shapeWidth
end property
property clsShape.shapeWidth( byval nValue as long )
   _shapeWidth = nValue
end property
property clsShape.shapeHeight() as LONG
   property = _shapeHeight
end property
property clsShape.shapeHeight( byval nValue as long )
   _shapeHeight = nValue
end property
function clsShape.shapeArea() as double 
   print "Called shapeArea in BASE class"
   function = 0
END FUNCTION

''
''  RECTANGLE CLASS
''
type clsRectangle extends clsShape
   Public:
      declare constructor
      declare function shapeArea() as double override 
END TYPE
constructor clsRectangle
   this.shapeType = SHAPE_RECTANGLE
end constructor
function clsRectangle.shapeArea() as double
   function = this.shapeWidth * this.ShapeHeight
end function


''
''  TRIANGLE CLASS
''
type clsTriangle extends clsShape
   Public:
      declare constructor
      declare function shapeArea() as double override 
END TYPE
constructor clsTriangle
   this.shapeType = SHAPE_TRIANGLE
end constructor
function clsTriangle.shapeArea() as double
   function = .5 * (this.shapeWidth * this.ShapeHeight)
end function


''
'' Create two new shapes
''
dim rect as clsRectangle
rect.shapeWidth = 100:  rect.shapeHeight = 200
print "RECTANGLE area = "; rect.shapeArea
   
dim tri as clsTriangle
tri.shapeWidth = 100:  tri.shapeHeight = 200
print "TRIANGLE area = "; tri.shapeArea

' Create a generic array of shapes
dim arr(1) as clsShape
arr(0) = rect
arr(1) = tri

for i as long = lbound(arr) to ubound(arr)
   ' The following seems to correctly identify the shape so it referencing
   ' the properties seem to work okay, however, calling a Method will call
   ' the method defined on the base class rather than the derived class.
   ' That's too bad.
   print "Shape type: "; arr(i).shapeType; " Area of shape = "; arr(i).shapeArea
next   

for i as long = lbound(arr) to ubound(arr)
   ' Workaround: It is kludgy but works.
   select case arr(i).shapeType
      case SHAPE_RECTANGLE
         dim p as clsRectangle ptr = cast(clsRectangle ptr, @arr(i)) 
         print "Using Pointer. Shape type: "; p->shapeType; " Area of shape = "; p->shapeArea
      case SHAPE_TRIANGLE   
         dim p as clsTriangle ptr = cast(clsTriangle ptr, @arr(i)) 
         print "Using Pointer. Shape type: "; p->shapeType; " Area of shape = "; p->shapeArea
   end select      
NEXT


''
'' The following would be even nicer to be able to so. Basically
'' instantiate the rect and triangles as the generic abstract
'' base class clsShape. That way I would be able to create arrays
'' of type clsShape and determine their areas.

'dim as clsShape rect = new clsRectangle
'rect.shapeWidth = 100:  rect.shapeHeight = 200
'
'dim as clsShape tri = new clsTriangle
'tri.shapeWidth = 100:  tri.shapeHeight = 200
'
'dim arr(1) as CLSSHAPE
'arr(0) = rect
'arr(1) = tri
'
'for i as long = lbound(arr) to ubound(arr)
'   print "Shape type: "; arr(i).shapeType; " Area of shape = "; arr(i).shapeArea
'NEXT


sleep

[fxm]

For solving your problem, you must create an array of CLSSHAPE PTR for referring all derived objects.
(remark: clsShape.shapeArea() function can be abstract, because none clsShape object is constructed)

Example:

Code: Select all

''
'' Inheritance Class test
''

enum
   SHAPE_RECTANGLE = 1, SHAPE_TRIANGLE
end enum
   

''
''  SHAPE CLASS (BASE)
''
type clsShape extends object
   protected:
      _shapeType   as long
      _shapeWidth  as LONG
      _shapeHeight as LONG
   Public:
      declare property shapeType() as LONG
      declare property shapeType( byval nValue as long )
      declare property shapeWidth() as LONG
      declare property shapeWidth( byval nValue as long )
      declare property shapeHeight() as LONG
      declare property shapeHeight( byval nValue as long )
      declare abstract function shapeArea() as double
   protected:
      Declare Constructor ()                       '' to avoid user construction from root
      Declare Constructor (ByRef rhs As clsShape) '' to avoid user copy-construction from root
END TYPE
constructor clsShape()
end constructor
property clsShape.shapeType() as LONG
   property = _shapeType
end property
property clsShape.shapeType( byval nValue as long )
   _shapeType = nValue
end property
property clsShape.shapeWidth() as LONG
   property = _shapeWidth
end property
property clsShape.shapeWidth( byval nValue as long )
   _shapeWidth = nValue
end property
property clsShape.shapeHeight() as LONG
   property = _shapeHeight
end property
property clsShape.shapeHeight( byval nValue as long )
   _shapeHeight = nValue
end property


''
''  RECTANGLE CLASS
''
type clsRectangle extends clsShape
   Public:
      declare constructor
      declare function shapeArea() as double override
END TYPE
constructor clsRectangle
   this.shapeType = SHAPE_RECTANGLE
end constructor
function clsRectangle.shapeArea() as double
   function = this.shapeWidth * this.ShapeHeight
end function


''
''  TRIANGLE CLASS
''
type clsTriangle extends clsShape
   Public:
      declare constructor
      declare function shapeArea() as double override
END TYPE
constructor clsTriangle
   this.shapeType = SHAPE_TRIANGLE
end constructor
function clsTriangle.shapeArea() as double
   function = .5 * (this.shapeWidth * this.ShapeHeight)
end function


''
'' The following would be even nicer to be able to so. Basically
'' instantiate the rect and triangles as the generic abstract
'' base class clsShape. That way I would be able to create arrays
'' of type clsShape and determine their areas.

dim parr() as CLSSHAPE PTR

redim preserve parr(ubound(parr)+1)
parr(ubound(parr)) = new clsRectangle
parr(ubound(parr))->shapeWidth = 100:  parr(ubound(parr))->shapeHeight = 200

redim preserve parr(ubound(parr)+1)
parr(ubound(parr)) = new clsTriangle
parr(ubound(parr))->shapeWidth = 100:  parr(ubound(parr))->shapeHeight = 200

for i as long = lbound(parr) to ubound(parr)
   print "Shape type: "; parr(i)->shapeType; " Area of shape = "; parr(i)->shapeArea
next

sleep

for i as long = lbound(parr) to ubound(parr)
   delete parr(i)
next
erase parr

[PaulSquires]

Thanks fxm, really appreciate the code and it seems to work perfectly. Thanks so much. I have been trying to learn more about polymorphism and abstract/virtual methods so this has been very educational for me.

Would be cool if it could be done without having to use the pointer syntax. Regular dot notation would "look better" but as long as it works as a pointer then I can certainly live with that.

[fxm]

Polymorphism works also with base typed references to derived objects:

Code: Select all

dim byref rarr0 as CLSSHAPE = *new clsRectangle
rarr0.shapeWidth = 100:  rarr0.shapeHeight = 200

dim byref rarr1 as CLSSHAPE = *new clsTriangle
rarr1.shapeWidth = 100:  rarr1.shapeHeight = 200

print "Shape type: "; rarr0.shapeType; " Area of shape = "; rarr0.shapeArea
print "Shape type: "; rarr1.shapeType; " Area of shape = "; rarr1.shapeArea

sleep
delete @rarr0
delete @rarr1

But arrays of references are not supported yet by FreeBASIC !
I always hope it for soon, but ... :-(

[Drago]

Would be cool if it could be done without having to use the pointer syntax. Regular dot notation would "look better" but as long as it works as a pointer then I can certainly live with that.

That's also my opinion..coudn't we get rid of this <ugly>....sorry for that..... ->
Is there any chance to constuct that sort of classes which will result in a somthing more dottet way :-)

Code: Select all

   print "Shape type: "; arr(i).shape.Area; " Area of shape = "; arr(i).shapeArea
   print "CellColor "; arr(i).cell.row.backcolor; " CellContent = "; arr(i).cell(5,3).value

[PaulSquires]

fxm, that is pretty cool. I didn't realize the full extent of the power of DIM BYREF.
Looks like I can store the derived objects in an array using pointers and when I want to use dot notation I can simply do the following:

Code: Select all

dim byref myShape as CLSSHAPE = *parr(1)
print "myShape type: "; myShape.shapeType; " Area of shape = "; myShape.shapeArea

Of course, having an array of BYREF objects would be the best solution but as you mentioned, looks like that is not available yet.

[fxm]

That depends on the free time and priorities of dkl.

[fxm]

Code: Select all

dim byref myShape as CLSSHAPE = *parr(1)
print "myShape type: "; myShape.shapeType; " Area of shape = "; myShape.shapeArea

One time a CLSSHAPE typed reference is created, you can reuse it on other derived object by only re-initializing it:

Code: Select all

@myShape = parr(2)

[fxm]

Would be cool if it could be done without having to use the pointer syntax. Regular dot notation would "look better" but as long as it works as a pointer then I can certainly live with that.

That's also my opinion..coudn't we get rid of this <ugly>....sorry for that..... ->

I do not understand this reluctance to use object pointers with the '->' operator.
Yet that's really quite easy to use, as the object instances with the '.' operator.