[fpc-pascal]Linked List/ pointers/ casting/ OOP Question

[Anton Tichawa]

Hello!

Ron Weidner wrote:

>>Your design is the right one for the problem, -and-
>>FreePascal supports 
>>this design very well. What you seem to miss is the
>>correspondence 
>>between your design ideas and FreePascal's syntax
>>and semantics.
>>
>>Sorry, but before proceeding I ask you to make a
>>decision (because else 
>>writing any code examples might be wasting our
>>time):
>>
>>FreePascal offers two different approaches to your
>>design: Objects and 
>>Classes. Objects is what you're using now. Classes
>>are essentially 
>>pointers to Objects, but they also simplify the
>>syntax, and they allow 
>>pointer types to inherit from each other. This
>>latter capability 
>>perfectly addresses the problem of choosing the
>>right type for the 
>>parameter X in AddWidget(X). So, before proceeding,
>>please decide if you 
>>want to continue using good old Objects, or if you
>>want to switch to the 
>>newer and more powerful Classes. If unsure, choose
>>Objects. Also, if you 
>>cannot easily change the declaration of a widget
>>because it's legacy 
>>software, choose Objects. I'll then post code
>>examples using the 
>>approach you choose.
>>
>>Anton.
>>
>>    
>>
>
>When you put it like that, it seems silly to use
>Objects over Classes.  I've only written 4 files for
>this project, and they could probably be easily ported
>from Objects to Classes.  So if what you are saying is
>that the Classes way of solving this (and like)
>problem, and since I have no legacy software to
>support, I would love to see a working example of this
>code done with Classes.
>
>Thankyou.
>
>Ron_W
>
>
>  
>
<snip>

program widgets; // free demo of a list of class instances, by Anton 
Tichawa.


// first, the common ancestor class, CWidget, is declared.

type CWidget = class(TObject) // TObject is, despite it's name, a class 
type here
Tag: String;
constructor Create(ATag: String);
// the destructor, Destroy, defaults to TObject.Destroy
end;


// next, the list. It's still a record, i. e. smaller and faster 
compared to classes.

type PWidgetList = ^TWidgetList; TWidgetList = record
Widget: CWidget; // a pointer to an instance of CWidget or a descendant
Next: PWidgetList;
end;


// next, the two descendants of CWidget (inheriting all data and methods 
from CWidget):

type CWidgetEntity = class(CWidget) // maybe unused now?
end;

type CWidgetContainer = class(CWidget)
HeadWidgetPtr: PWidgetList;
CurWidgetPtr: PWidgetList;
constructor Create(ATag:string); // constructors need no 'override'
destructor Destroy; override; // overrides, i. e. replaces TObject.Destroy
procedure AddWidget(AWidget: CWidget); // might be a container, too
procedure Print(ALevel: integer);
end;

// 'the' widget container

var TheWidgetContainer: CWidgetContainer; // a pointer to an instance on 
the heap


// CWidget methods:

constructor CWidget.Create(ATag: String);
begin
inherited Create; // this calls TObject.Create
Tag := ATag;
end;


// CWidgetContainer methods:

constructor CWidgetContainer.Create(ATag: String);
begin
inherited Create(ATag); // = CWidget.Create, assigns ATag to Tag etc.
CurWidgetPtr := nil;
HeadWidgetPtr := nil;
end;

destructor CWidgetContainer.Destroy;
begin

// caution: here, all deallocation / destruction should be done

inherited Destroy; // call to the inherited Destructor, TObject.Destroy
end;

procedure CWidgetContainer.AddWidget(AWidget: CWidget);
var MyNewListPtr: PWidgetList;
begin
new(MyNewListPtr);

// AWidget might be a widget or a container, but we don't care here

MyNewListPtr^.Widget := AWidget;
MyNewListPtr^.Next := HeadWidgetPtr;
HeadWidgetPtr := MyNewListPtr;
end;

procedure CWidgetContainer.Print(ALevel: integer);
var i: integer;
var indent: String;
var MyWidget: CWidget; // might be a CWidget or CWidgetContainer
begin

// for the sake of simplicity, the printout is reversed. But it's indented:

indent := '';
for i := 0 to ALevel - 1 do begin
indent := indent + ' ';
end;
writeln(indent + 'widget container ' + Tag + ':' );
CurWidgetPtr := HeadWidgetPtr;

repeat
if CurWidgetPtr = nil then break;
MyWidget := CurWidgetPtr^.Widget;
if MyWidget = nil then begin // just to be sure

// InheritsFrom is a method of TObject. This is runtime type info (RTTI).
// We have to check for the more specialized CWidgetContainer first:

end else if MyWidget.InheritsFrom(CWidgetContainer) then begin

// InheritsFrom just told us it's a CWidgetContainer (at runtime). The
// compiler does not know this, and would normally reject the Print
// method. So, we need a type cast:

CWidgetContainer(MyWidget).Print(ALevel + 1);

end else if MyWidget.InheritsFrom(CWidget) then begin
writeln(indent + ' ordinary widget ''' + MyWidget.Tag + ':');
end;
CurWidgetPtr := CurWidgetPtr^.Next;
until false;
end;

var MyWidgetContainer: CWidgetContainer; // a temporary buffer for 
sub-containers

begin

// create 'the' widget container

TheWidgetContainer := CWidgetContainer.Create('TheWidgetContainer');

// add some widgets and containers

TheWidgetContainer.AddWidget(CWidget.Create('Widget-A'));

MyWidgetContainer := CWidgetContainer.Create('WidgetContainer-B');
MyWidgetContainer.AddWidget(CWidget.Create('Widget-B1'));
MyWidgetContainer.AddWidget(CWidget.Create('Widget-B2'));

// among other things, a CWidgetContainer is still a CWidget, so the 
compiler
// accepts passing MyWidgetContainer without type cast.

TheWidgetContainer.AddWidget(MyWidgetContainer);
TheWidgetContainer.AddWidget(CWidget.Create('Widget-C'));

// print

TheWidgetContainer.Print(0);

// caution: cleaning up (dispose, destroy) not yet implemented ..

end.

//
// the printout reads (GNU/Linux, fpc 1.0.10, sequence of members is 
reversed):
//
// widget container TheWidgetContainer:
// ordinary widget 'Widget-C:
// widget container WidgetContainer-B:
// ordinary widget 'Widget-B2:
// ordinary widget 'Widget-B1:
// ordinary widget 'Widget-A:
//

hth,

Anton.