home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / PASCAL / GENERI.ZIP / FLXARRAY.ARC / GENSTACK.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1989-07-22  |  2.6 KB  |  115 lines
  1. Unit GenStack;
  2. {$R-,O+,V-}
  3.  
  4. { Unit GenStack  written by Eric C. Wentz  Last Mod Date 6/28/89 }
  5.  
  6. { FlexStacks are simple FlexArray based stacks using the DataType      }
  7. { defined in Unit GenArray.  Here we START to see some of the benefits }
  8. { of the GenArray Object, but the full benefit will not be seen until  }
  9. { the next "Generation" of descendants are defined, in Unit Stacks.    }
  10.  
  11. INTERFACE
  12.  
  13. Uses Crt,GenArray;
  14.  
  15. Type
  16.   FlexStack = Object(FlexArray)  {Dynamically allocated Stack}
  17.  
  18.     CurTop : Word;  {Index to Top of Stack}
  19.  
  20.     Procedure Create;
  21.  
  22.     Function Full : Boolean;
  23.     Function Depth : Word;
  24.     Function Empty : Boolean;
  25.  
  26.     Procedure Copy (F : FlexStack);
  27.     Procedure ReSize (Num : Word);     {Grow (or Shrink) by Num elements}
  28.  
  29.     {NOTE: It is an Error to ReSize a FlexStack to Zero (or Negative)}
  30.  
  31.     Procedure Push (Var El; Size : Word);  {Size of El MUST match ElementSize}
  32.     Procedure Pop (Var El; Size : Word);
  33.     Procedure Top (Var El; Size : Word);   {TOP does not POP the Stack}
  34.  
  35.     (* Applicable inherited procedures and functions: *)
  36.  
  37.     { Procedure Init (MaxElements,ElementSize); }
  38.     { Procedure Destroy;                        }
  39.     { Function MaxSize : Word;                  }
  40.     { Function ElemSize : Word;                 }
  41.  
  42.   End;
  43.  
  44. IMPLEMENTATION
  45.  
  46. Procedure StackError (Num : Byte);
  47. Begin
  48.   WriteLn;
  49.   Write ('FlexStack ERROR: ');
  50.   Case Num of
  51.             0 : WriteLn ('Attempted PUSH onto Full FlexStack.');
  52.             1 : WriteLn ('Attempted POP or TOP from Empty FlexStack.');
  53.           End;
  54.   WriteLn ('**** PROGRAM TERMINATED ****');
  55.   WriteLn;
  56.   Write ('Press <Return> to Continue.... ');
  57.   ReadLn;
  58.   HALT (0)
  59. End;
  60.  
  61. Procedure FlexStack.Create;
  62. Begin
  63.   CurTop := 0;
  64.   FlexArray.Create
  65. End;
  66.  
  67. Function FlexStack.Full : Boolean;
  68. Begin
  69.   Full := CurTop = MaxSize
  70. End;
  71.  
  72. Function FlexStack.Empty : Boolean;
  73. Begin
  74.   Empty := CurTop = 0
  75. End;
  76.  
  77. Function FlexStack.Depth : Word;
  78. Begin
  79.   Depth := CurTop
  80. End;
  81.  
  82. Procedure FlexStack.Copy (F : FlexStack);
  83. Begin
  84.   FlexArray.Copy (F);
  85.   CurTop := F.CurTop
  86. End;
  87.  
  88. Procedure FlexStack.ReSize (Num : Word);
  89. Begin
  90.   FlexArray.ReSize (MaxSize + Num)
  91. End;
  92.  
  93. Procedure FlexStack.Push (Var El; Size : Word);
  94. Begin
  95.   If Full Then StackError (0);
  96.   Accept (El,CurTop,Size);
  97.   CurTop := CurTop + 1
  98. End;
  99.  
  100. Procedure FlexStack.Pop (Var El; Size : Word);
  101. Begin
  102.   If Empty Then StackError (1);
  103.   CurTop := CurTop - 1;
  104.   Retrieve (El,CurTop,Size)
  105. End;
  106.  
  107. Procedure FlexStack.Top (Var El; Size : Word);
  108. Begin
  109.   If Empty Then StackError (1);
  110.   Retrieve (El,CurTop-1,Size)
  111. End;
  112.  
  113. BEGIN
  114. END.
  115.