unit AStackC;
//*******************************************************
// Array-based stack class.
//*******************************************************
// Copyright (C) 1998 John Wiley & Sons, Inc.
// All rights reserved. See additional copyright
// information in Readme.txt.
//
// Revised (C) 1999 Andrzej Grażyński, HELION Publ. 
//*******************************************************

interface

uses
    Dialogs, SysUtils, Classes;

type
    String10     = String[10];
    TStringArray = array [1..1000000] of String10;
    PStringArray = ^TStringArray;

    TArrayStack = class(TObject)
        private
            Stack: array of String10;
            NumItems     : Longint;      // Liczba elementów
            NumAllocated : Longint;      // Pojemność stosu
            ShrinkWhen   : Longint;      // Graniczna liczba elementów dla kompresji
            procedure ResizeStack;
            destructor Destroy; override;

        public
            procedure Push(value : String10);
            function Pop : String10;
            function StackEmpty : Boolean;
            function TextValue : String;
    end;

implementation


destructor TArrayStack.Destroy;
begin
  Stack := NIL; // zwolnij pamięć przydzieloną dla tablicy
  inherited Destroy;
end;

// Połóż element na stosie
procedure TArrayStack.Push(value : String10);
begin
    // Zapewnij miejsce na nowy element
    if (NumItems >= NumAllocated)
    then
      ResizeStack;
    NumItems := NumItems + 1;
    Stack[NumItems-1] := value;
end;

// Zdejmij ze stosu szczytowy element
function TArrayStack.Pop : String10;
begin
    if (NumItems < 1) then
        raise EInvalidOperation.Create(
            'Stos jest pusty.');

    Result := Stack[NumItems-1];
    NumItems := NumItems - 1;
    if (NumItems < ShrinkWhen)
    then
      ResizeStack;
end;

// Sprawdź, czy stos jest pusty
function TArrayStack.StackEmpty : Boolean;
begin
    Result := (NumItems < 1);
end;

// Resize the stack to have WANT_FREE_PERCENT unused
// entries. Set m_ShrinkWhen so we know to resize the
// array when the number of used entries is too small.
// Set this value to resize the array when there is more
// than twice the desired amount of memory free.
//

// Zapewnij "WANT_FREE_PERCENT" % wolnego miejsca


// Normally WANT_FREE_PERCENT and MIN_FREE would have
// values like .1 and 10. They are set to .5 and 1 to make
// it easy to see how the algorithm works. MIN_FREE must
// be at least 1.
procedure TArrayStack.ResizeStack;
const
    WANT_FREE_PERCENT = 0.5; // Try for 50% free space.
    MIN_FREE = 1;            // Min unused space when resizing.
    CR = #13#10;
    CRCR = #13#10#13#10;
var
    want_free, new_size : Longint;
begin
    // Oblicz nowy rozmiar tablicy.
    want_free := Round(WANT_FREE_PERCENT * NumItems);
    if (want_free < MIN_FREE)
    then
      want_free := MIN_FREE;
    new_size := NumItems + want_free;

    // Zmień wielkość przydzielonej pamięci
    SetLength(Stack,new_size);

    NumAllocated := new_size;

    // Oblicz graniczną liczbę elementów, poniżej której należy
    // zmniejszyć wielkosć pamięci dla tablicy
    ShrinkWhen := NumItems - want_free;

    // Wykomentuj poniższą sekwencją po przetestowaniu
    ShowMessage('Zmiana rozmiaru.' + CRCR +
        'Przydzielone: ' + IntToStr(NumAllocated) + CR +
        'Używane: ' + IntToStr(NumItems) + CR +
        'Wolne: ' + IntToStr(want_free) + CR +
        'Granica kompresji: ' + IntToStr(ShrinkWhen));
end;

// utwórz reprezentację łańcuchową zawartośći stosu
function TArrayStack.TextValue : String;
const
    CR = #13#10;
var
    i : Integer;
begin
    Result := '';
    for i := NumItems downto 1 do
        Result := Result + Stack[i-1] + CR;
end;

end.
