Programmer 7500/MAX_PROGRAMMERS.iso/PASCAL/LISTS4.ZIP/LISTDEMO.PAS

Pascal/Delphi Source File | 1989-06-25 | 6.5 KB | 268 lines

{$A-,B-,D+,E-,F-,I-,L+,N-,O-,R-,S-,V-}
{$M 16384,0,655360}
Uses Lists, Crt;

Type
   EntryTypes                =   (NumType, StrType);

   DemoListObj               =   Object (ListObj)
                                    C_Entry      :   EntryPtr;

                                    Function     CurrentEntry:EntryPtr;
                                    Procedure    MoveTo(Loc:EntryPtr);
                                    Procedure    Display;

                                    Constructor  Init;
                                 End;

   DemoEntryObj              =   Object (EntryObj)
                                    EntryType    :   EntryTypes;

                                    Constructor  Add;
                                    Constructor  Insert;
                                    Destructor   RemoveFromList;
                                 End;
   StringObj                 =   Object (DemoEntryObj)
                                    Str          :   String;

                                    Constructor  Add;
                                    Constructor  Insert(Loc:EntryPtr);
                                    Destructor   RemoveFromList;
                                    Procedure    Input; virtual;
                                 End;
   NumberObj                 =   Object (DemoEntryObj)
                                    Num          :   Real;

                                    Constructor  Add;
                                    Constructor  Insert(Loc:EntryPtr);
                                    Destructor   RemoveFromList;
                                    Procedure    Input; virtual;
                                 End;

   DemoEntryObjPtr           =   ^DemoEntryObj;
   NumberObjPtr              =   ^NumberObj;
   StringObjPtr              =   ^StringObj;

   CharSet                   =   Set of Char;


Var
   List                      :   DemoListObj;


Procedure Menu(St:String; ReturnSet:CharSet; Var Ch:Char);
Begin
   GotoXY(1,3); Write(St); ClrEol;
   Repeat
      Ch:=UpCase(ReadKey);
   Until Ch in ReturnSet;
End;

Function Location:DemoEntryObjPtr;
Var
   Ch                        :   Char;

Begin
   Menu('(C)urrent entry   (F)irst entry   (L)ast entry   '+
        '(N)ext entry   (P)rev entry', ['C','F','L','N','P',#27], Ch);
   Case Ch of
     'C'   :   Location:=DemoEntryObjPtr(List.CurrentEntry);
     'F'   :   Location:=DemoEntryObjPtr(List.FirstEntry);
     'L'   :   Location:=DemoEntryObjPtr(List.LastEntry);
     'N'   :   Location:=DemoEntryObjPtr(List.CurrentEntry^.NextEntry);
     'P'   :   Location:=DemoEntryObjPtr(List.CurrentEntry^.PrevEntry);
   End;
End;

Function GetEntryType:EntryTypes;
Var
   Ch                     :   Char;

Begin
   Menu('(N)umber   (S)tring', ['N','S',#27], Ch);
   Case Ch of
      'N'   :   GetEntryType:=NumType;
      'S'   :   GetEntryType:=StrType;
   End;
End;

Function DemoListObj.CurrentEntry;
Begin
   CurrentEntry:=C_Entry;
End;

Procedure DemoListObj.MoveTo;
Begin
   If Loc=nil Then
      Write(^G)
   Else
      C_Entry:=Loc;
End;

Procedure DemoListObj.Display;
Var
   Pos                       :   EntryPtr;
   I                         :   Byte;

Begin
   GotoXY(1,5);

   For I:=1 To 20 Do DelLine;

   Pos:=List.FirstEntry;

   With List Do
   While Not (Pos=nil) Do Begin
      If Pos=CurrentEntry Then
         TextColor(White)
      Else
         TextColor(Cyan);

         Case DemoEntryObjPtr(Pos)^.EntryType of
            NumType   :   Write(NumberObjPtr(Pos)^.Num:1:9);
            StrType   :   Write(StringObjPtr(Pos)^.Str);
         End;
      ClrEol;
      Writeln;
      Pos:=Pos^.NextEntry;
   End;
End;

Constructor DemoListObj.Init;
Begin
   Lists.ListObj.Init;

   C_Entry:=nil;
End;

Constructor DemoEntryObj.Add;
Var
   Number                    :   NumberObjPtr;
   Str                       :   StringObjPtr;
   Entry                     :   DemoEntryObj;

Begin
   Case GetEntryType of
      NumType   :   New(Number, Add);
      StrType   :   New(Str, Add);
   End;
End;

Constructor DemoEntryObj.Insert;
Var
   Number                    :   NumberObjPtr;
   Str                       :   StringObjPtr;
   Entry                     :   DemoEntryObj;

Begin
   Case GetEntryType of
      NumType   :   New(Number, Insert(Location));
      StrType   :   New(Str, Insert(Location));
   End;
End;

Destructor DemoEntryObj.RemoveFromList;
Begin
   If @Self=nil Then
      Write(^G)
   Else Begin
      Case EntryType of
         NumType   :   Dispose(NumberObjPtr(@Self), RemoveFromList);
         StrType   :   Dispose(StringObjPtr(@Self), RemoveFromList);
      End;
   End;
End;

Constructor StringObj.Add;
Begin
   Input;
   EntryObj.Add(List);
End;

Constructor StringObj.Insert;
Begin
   If Loc=nil Then
      Write(^G)
   Else Begin
      Input;
      Lists.EntryObj.Insert(List, Loc);
   End;
End;

Destructor StringObj.RemoveFromList;
Begin
   Lists.EntryObj.Remove(List);
End;

Procedure StringObj.Input;
Begin
   EntryType:=StrType;
   GotoXY(1,3); Write('Enter string:'); ClrEol;
   Readln(Str);
End;

Constructor NumberObj.Add;
Begin
   Input;
   EntryObj.Add(List);
End;

Constructor NumberObj.Insert;
Begin
   If Loc=nil Then
      Write(^G)
   Else Begin
      Input;
      Lists.EntryObj.Insert(List, Loc);
   End;
End;

Destructor NumberObj.RemoveFromList;
Begin
   Lists.EntryObj.Remove(List);
End;

Procedure NumberObj.Input;
Begin
   EntryType:=NumType;
   GotoXY(1,3); Write('Enter number:'); ClrEol;
   Readln(Num);
End;

Var
   Ch                        :   Char;
   Entry                     :   DemoEntryObj;

Begin
   List.Init;
   TextColor(Red); TextBackground(Blue);
   ClrScr;
   Writeln('ListDemo - Demo for LISTS v4.0');

   Repeat
      GotoXY(1,4);
      TextColor(LightGray);
      If List.CurrentEntry=nil Then
         Write('List is unaccessed')
      Else
         Write('List is fine');

      Write('    Memory available:', MemAvail);
      ClrEol;

      List.Display;

      TextColor(Green);
      Menu('(A)dd entry   (I)nsert entry   (M)ove to entry   '+
           '(R)emove entry   (Q)uit', ['A','I','M','R','Q'], Ch);

      Case Ch of
         'A'   :   Entry.Add;
         'I'   :   Entry.Insert;
         'R'   :   Location^.RemoveFromList;
         'M'   :   List.MoveTo(Location);
      End;
   Until Ch='Q';
   GotoXY(1,23);
End.