[Back to OOP SWAG index]  [Back to Main SWAG index]  [Original]

{
>> There are advantages to linked lists, but I don't see ease of use as
>> one of them.  What could be easier to use than a TCollection?

> An array. I still can't figure out how to use TCollections.

Try this out. No TV, just a collection of stuff with a wee bit of streams....
}

Program CollectingStuff;
Uses Objects;
Type
  Stuff    = byte;  
  StuffPtr = ^Stuff;

  StuffCollection = Object(TCollection)
                      procedure FreeItem(Item:Pointer); virtual;
                      procedure PutItem(var S:TStream;Item:Pointer); virtual;
                      Function GetItem(var S:TStream):Pointer; virtual;
                    end;
  StuffCollectionPtr = ^StuffCollection;
Const
  RStuffCollection : TStreamRec =
                      (ObjType : $424B;
                       VMTLink : Ofs(TypeOf(StuffCollection)^);
                       Load    : @StuffCollection.Load;
                       Store   : @StuffCollection.Store);

Var
  StuffArray : StuffCollectionPtr;

procedure StuffCollection.FreeItem(Item:Pointer);
   begin
     dispose(StuffPtr(Item));
   end;
procedure StuffCollection.PutItem(var S:TStream;Item:Pointer);
   begin
     S.Write(StuffPtr(Item)^,SizeOf(Stuff));
   end;
Function StuffCollection.GetItem(var S:TStream):Pointer;
   var p:StuffPtr;
   Begin
     new(p);
     S.Read(p^,SizeOf(Stuff));
     GetItem := p;
   End;

Function SayWhat:Char;
   var s:String;
   Begin
     Writeln;
     if   StuffArray <> Nil
     then Writeln('Current Array has ',StuffArray^.Count,' elements');
     Writeln('[1] add stuff    [2] remove stuff   ',
             '[3] load stuff   [4] store stuff ');
     Writeln('[5] view stuff   [6] view all stuff ',
             '[7] match stuff  (anything else exits))');
     Readln(s);
     if s <> '' then SayWhat := s[1] else SayWhat := #0;
   End;

Procedure AddToStuff;
   var sp:StuffPtr;
        b:byte;
   Begin
     if   StuffArray = Nil
     then New(StuffArray,init(1,1));
     repeat
       write('enter a byte : ');
       Readln(b);
     until ioresult = 0;
     new(sp); sp^ := b;
     StuffArray^.insert(sp);
   End;

Procedure DelFromStuff;
   var w:word;
   Begin
     if (StuffArray = nil) or (StuffArray^.count = 0) then exit;
     repeat
       write('enter element number to delete : ');
       readln(w);
    until (ioresult = 0) and (w < StuffArray^.count);
    StuffArray^.AtFree(w);
   End;

Procedure NewStuff;
   var s:string;
       f:PDosStream;
   Begin
     write('Enter the stuff''s file name : ');
     readln(s);
     new(f,init(s,StOpenRead));
     if   f^.status = StOk
     then begin
            if StuffArray <> nil then dispose(StuffArray,done);
            new(StuffArray,load(f^));
          end;
     dispose(f,done);
   End;

Procedure SaveStuff;
   var s:string;
       f:PDosStream;
   Begin
     write('Enter the stuff''s file name : ');
     readln(s);
     new(f,init(s,StCreate));
     if   f^.status = StOk
     then begin
            if   StuffArray <> nil
            then StuffArray^.store(f^);
          end;
     dispose(f,done);
   End;

Procedure ShowStuff;
   var w:word;
   Begin
     if (StuffArray = nil) or (StuffArray^.count = 0) then exit;
     repeat
       write('enter element number to view : ');
       readln(w);
    until (ioresult = 0) and (w < StuffArray^.count);
    writeln('Element # ',w,' = ',byte(StuffArray^.at(w)^));
   End;

Procedure AllStuff;
   Procedure ShowEm(p:StuffPtr); far;
      begin
        writeln('Stuff Element = [',byte(p^),']');
      end;
   Begin
     if   (StuffArray <> Nil) and (StuffArray^.count > 0)
     then StuffArray^.ForEach(@ShowEm);
   End;

Procedure MatchStuff;
   var b:byte;
       p:StuffPtr;
   Function Matches(pb:StuffPtr):boolean; far;
      Begin
        Matches := pb^ = b;
      End;
   Begin
     if (StuffArray = Nil) or (StuffArray^.count = 0) then exit;
     repeat
       write('enter a byte to match : ');
       readln(b);
     until ioresult = 0;
     p := StuffArray^.FirstThat(@Matches);
     if   p <> nil
     then writeln('Element ',StuffArray^.indexof(p),
                  ' matches [',byte(p^),']')
     else writeln('no matches');
  End;

Procedure DoStuff;
   var stop:boolean;
   Begin
     stop := false;
     While not stop do
     Case SayWhat of
        '1' : AddToStuff;
        '2' : DelFromStuff;
        '3' : NewStuff;
        '4' : SaveStuff;
        '5' : ShowStuff;
        '6' : AllStuff;
        '7' : MatchStuff;
        else stop := true;
      end;
   End;

var m:longint;
begin
  m := memavail;
  registerType(RStuffCollection);
  StuffArray := Nil;
  DoStuff;
  if StuffArray <> Nil then Dispose(StuffArray,Done);
  if m <> memavail then writeln('heap ''a trouble');
end.

[Back to OOP SWAG index]  [Back to Main SWAG index]  [Original]