home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / PASCAL / LISTS30.ZIP / LISTDEMO.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1988-08-24  |  6.4 KB  |  223 lines
  1. {$R-,S-,I-,D-,T-,F-,V-,B-,N-,L+ }
  2. {$M 16384,0,655360 }
  3. Uses Lists, Crt;
  4.  
  5. Type
  6.    ItemRec                   =   Record
  7.                                     Size:Byte;
  8.                                  Case _Type:(Number, Str) of
  9.                                     Number   :   (Num:Real);
  10.                                     Str      :   (St:String);
  11.                                  End;
  12.    CharSet                   =   Set of Char;
  13.  
  14.  
  15.  
  16.  
  17. Procedure Menu(St:String; ReturnSet:CharSet; Var Ch:Char);
  18. Begin
  19.    GotoXY(1,3); Write(St); ClrEol;
  20.    Repeat
  21.       Ch:=UpCase(ReadKey);
  22.    Until Ch in ReturnSet;
  23. End;
  24.  
  25. Function LocationMenu:Char;
  26. Var
  27.    Ch                        :   Char;
  28.  
  29. Begin
  30.    Menu('(C)urrent entry   (F)irst entry   (L)ast entry   '+
  31.         '(N)ext entry   (P)rev entry', ['C','F','L','N','P',#27], Ch);
  32.    LocationMenu:=Ch;
  33. End;
  34.  
  35.  
  36.  
  37.  
  38. Function GetNumOrStr(Var Item:ItemRec):Boolean;
  39.    Procedure GetNumber(Var N:Real);
  40.    Begin
  41.       GotoXY(1,3); Write('Enter Number:'); ClrEol;
  42.       Readln(N);
  43.    End;
  44.  
  45.    Procedure GetString(Var S:String);
  46.    Begin
  47.       GotoXY(1,3); Write('Enter String:'); ClrEol;
  48.       Readln(S);
  49.    End;
  50.  
  51. Var
  52.    Ch                        :   Char;
  53.  
  54. Begin
  55.    Menu('(N)umber or (S)tring',['N','S',#27],Ch);
  56.    Case Ch of
  57.       'N'   :   Begin
  58.                    GetNumber(Item.Num);
  59.                    Item._Type:=Number;
  60.                    Item.Size:=SizeOf(Real)+1+1;
  61.                    {+1 for Item._Type, +1 for Item.Size}
  62.                 End;
  63.       'S'   :   Begin
  64.                    GetString(Item.St);
  65.                    Item._Type:=Str;
  66.                    Item.Size:=Length(Item.St)+1+1+1;
  67.                    {See above, and +1 to account for St[0] (length byte)}
  68.                 End;
  69.    End;
  70.    GetNumOrStr:=Not (Ch=#27);
  71. End;
  72.  
  73.  
  74. Procedure MoveToMenu(Var L:ListRec);
  75. Begin
  76.    Case LocationMenu of
  77.       'F'   :   MoveToEntry(FirstEntry(L));
  78.       'L'   :   MoveToEntry(LastEntry(L));
  79.       'N'   :   MoveToEntry(NextEntry(CurrentEntry(L)));
  80.       'P'   :   MoveToEntry(PrevEntry(CurrentEntry(L)));
  81.       'C'   :   MoveToEntry(CurrentEntry(L));
  82.    End;
  83.    If L.C_Entry=nil Then Write(^G);
  84. End;
  85.  
  86. Procedure DeleteMenu(Var L:ListRec);
  87. Var
  88.    Ch                        :   Char;
  89.  
  90. Begin
  91.    Menu('(L)ist deletion   (I)tem deletion',['L','I',#27],Ch);
  92.  
  93.    Case Ch of
  94.       'L'   :   DeleteList(L);
  95.       'I'   :   Begin
  96.                    Case LocationMenu of
  97.                       'C'   :   DeleteEntry(CurrentEntry(L));
  98.                       'N'   :   DeleteEntry(NextEntry(CurrentEntry(L)));
  99.                       'P'   :   DeleteEntry(PrevEntry(CurrentEntry(L)));
  100.                       'F'   :   DeleteEntry(FirstEntry(L));
  101.                       'L'   :   DeleteEntry(LastEntry(L));
  102.                    End;
  103.                 End;
  104.    End;
  105. End;
  106.  
  107. Procedure GetMenu(Var L:ListRec);
  108. Var
  109.    Item                      :   ItemRec;
  110.    Ch                        :   Char;
  111.  
  112. Begin
  113.    Ch:=LocationMenu;
  114.    Case Ch of
  115.       'C'   :   GetItem(CurrentEntry(L), Item);
  116.       'N'   :   GetItem(NextEntry(CurrentEntry(L)), Item);
  117.       'P'   :   GetItem(PrevEntry(CurrentEntry(L)), Item);
  118.       'F'   :   GetItem(FirstEntry(L), Item);
  119.       'L'   :   GetItem(LastEntry(L), Item);
  120.    End;
  121.  
  122.    If L.OK Then Begin
  123.       If Not (Ch=#27) Then Begin
  124.          GotoXY(1,3);
  125.          Case Item._Type of
  126.             Number   :   Write(Item.Num);
  127.             Str      :   Write(Item.St);
  128.          End;
  129.          ClrEol;
  130.          Delay(2000);
  131.       End;
  132.    End;
  133. End;
  134.  
  135. Procedure DisplayList(L:ListRec; _CurrentEntry:EntryPtr);
  136. Var
  137.    Item                      :   ItemRec;
  138.    I                         :   Byte;
  139.  
  140. Begin
  141.    GotoXY(1,5);
  142.  
  143.    For I:=1 To 20 Do DelLine;
  144.  
  145.    MoveToEntry(FirstEntry(L));
  146.    While L.OK Do Begin
  147.       GetItem(CurrentEntry(L), Item);
  148.  
  149.       If CurrentEntry(L)=_CurrentEntry Then TextColor(White)
  150.       Else TextColor(Black);
  151.  
  152.       Case Item._Type of
  153.          Number   :   Write(Item.Num:1:9);
  154.          Str      :   Write(Item.St);
  155.       End;
  156.       ClrEol;
  157.       Writeln;
  158.  
  159.       MoveToEntry(NextEntry(CurrentEntry(L)));
  160.    End;
  161.    TextColor(Black);
  162. End;
  163.  
  164.  
  165.  
  166. Var
  167.    L                         :   ListRec;
  168.    Item                      :   ItemRec;
  169.    Ch                        :   Char;
  170.  
  171. Begin
  172.    InitList(L);
  173.  
  174.    TextColor(Black); TextBackground(LightGray);
  175.    ClrScr;
  176.    Writeln('List Demo v3.0 - Demo for Lists.Tpu v3.0');
  177.  
  178.    Repeat
  179.       GotoXY(1,4);
  180.       If L.C_Entry=nil Then Write('List is unaccessed')
  181.       Else
  182.       If L.OK Then Write('List is fine')
  183.       Else Write(^G,'Illegal operation');
  184.       Write('   Memory available:',MemAvail);
  185.       ClrEol;
  186.  
  187.       L.OK:=True;
  188.  
  189.       DisplayList(L, CurrentEntry(L));
  190.  
  191.       Menu('(A)dd entry   (I)nsert entry   (M)ove to   '+
  192.            '(D)elete  (G)et item   (Q)uit',['A','I','M','D','G','Q'],Ch);
  193.  
  194.       Case Ch of
  195.          'A'   :   If GetNumOrStr(Item) Then AddEntry(L, Item, Item.Size);
  196.          'I'   :   If GetNumOrStr(Item) Then Begin
  197.                       Case LocationMenu of
  198.                          'C'   :   InsertEntry(CurrentEntry(L), Item, Item.Size);
  199.                          'N'   :   InsertEntry(NextEntry(CurrentEntry(L)), Item, Item.Size);
  200.                          'P'   :   InsertEntry(PrevEntry(CurrentEntry(L)),Item, Item.Size);
  201.                          'F'   :   InsertEntry(FirstEntry(L), Item, Item.Size);
  202.                          'L'   :   InsertEntry(LastEntry(L), Item, Item.Size);
  203.                       End;
  204.                    End;
  205.          'D'   :   DeleteMenu(L);
  206.          'G'   :   GetMenu(L);
  207.          'M'   :   Begin
  208.                       Menu('(T)o entry   (E)ntry',['T','E',#27],Ch);
  209.                       Case Ch of
  210.                          'T'   :   MoveToMenu(L);
  211.                          'E'   :   Case LocationMenu of
  212.                                       'F'   :   MoveEntry(CurrentEntry(L), FirstEntry(L));
  213.                                       'L'   :   MoveEntry(CurrentEntry(L), LastEntry(L));
  214.                                       'P'   :   MoveEntry(CurrentEntry(L), PrevEntry(CurrentEntry(L)));
  215.                                       'N'   :   MoveEntry(CurrentEntry(L), NextEntry(CurrentEntry(L)));
  216.                                    End;
  217.                       End;
  218.                       If L.C_Entry=nil Then Write(^G);
  219.                    End;
  220.       End;
  221.    Until Ch='Q';
  222. End.
  223.