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