unit ArrayQC;
//*******************************************************
// Kolejka w postaci tablicy
//*******************************************************
// 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];
    TArrayQueue = class(TObject)
        private
            Queue       : array of String10; // Tablica przechowująca
                                             // elementy kolejki
            NumAllocated : Longint;     // Liczba przydzielonych elementów
            RemoveHere   : Longint;     // Indeks elementu do pobrania
            AddHere      : Longint;     // Indeks dołączanego elementu
            ResizeWhen   : Longint;     // Graniczny rozmiar dla reorganizacji
            procedure ResizeQueue;

        public
            constructor Create;
            destructor Destroy; override;
            procedure EnterQueue(new_value : String10);
            function LeaveQueue : String10;
            function QueueEmpty : Boolean;
            function TextValue : String;
    end;

implementation

// Initialize NumAllocated so we initialize the queue
// the first time we use it.

// Poniższe ustawienia spowodują reorganizację kolejki, równoznaczną
// z jej zainicjowaniem, podczas dodawania pierwszego elementu
constructor TArrayQueue.Create;
begin
  Queue := NIL;
  NumAllocated := -1;
end;

// Zwolnij tablicę dynamiczną i wywołaj odziedziczony destruktor
destructor TArrayQueue.Destroy;
begin
    Queue := NIL;
    inherited Destroy;
end;

// Dodaj nowy element do kolejki
procedure TArrayQueue.EnterQueue(new_value : String10);
begin
    // Zapewnij wolne miejsce dla nowego elementu
    if (AddHere >= NumAllocated)
    then
      ResizeQueue;
    Queue[AddHere] := new_value;
    AddHere := AddHere + 1;
end;

// Pobranie elementu z kolejki
function TArrayQueue.LeaveQueue : String10;
begin
    if (QueueEmpty) then
        raise EInvalidOperation.Create(
            'Kolejka jest pusta.');

    LeaveQueue := Queue[RemoveHere];
    RemoveHere := RemoveHere + 1;
    if (RemoveHere > ResizeWhen)
    then
      ResizeQueue;
end;

// Sprawdzenie, czy kolejka jest pusta
function TArrayQueue.QueueEmpty : Boolean;
begin
    QueueEmpty := (RemoveHere >= AddHere);
end;

{
Reorganizacja tablicy może odbywać się w dwóch przyczyn:
    1. Osiągnięcia przez kolejkę końca tablicy
    2. Przekroczenia limitu niewykorzystanego miejsca na początku tablicy


W każdym przypadku, po ewentualnym rozszerzeniu tablicy, następuje
przesunięcie kolejki do początku tablicy.

}
procedure TArrayQueue.ResizeQueue;
const
    WANT_FREE_PERCENT = 0.5; // 50% zapas wolnego miejsca
    MIN_FREE = 2;            // nie mniej niż 2 wolne elementy
    CR = #13#10;
var
    want_free, new_size, i : Longint;

begin
    // Bieżący rozmiar kolejki
    new_size := AddHere - RemoveHere;
    // Zapas wolnych elementów
    want_free := Round(WANT_FREE_PERCENT * new_size);
    if (want_free < MIN_FREE)
    then
      want_free := MIN_FREE;

    // Nowy rozmiar tablicy
    new_size := new_size + want_free;
    SetLength(Queue, new_size);


    // Odzyskanie ew. wolnego miejsca na początku tablicy
    if RemoveHere > 0 then
    begin
      for i := RemoveHere to AddHere - 1 do
        Queue[i-RemoveHere] := Queue[i];
    end;

    AddHere := AddHere - RemoveHere;
    RemoveHere := 0;
    NumAllocated := new_size;
    ResizeWhen := want_free;

    // Poniższy komunikat nie jest konieczny - można go wykomentować
    ShowMessage('Resizing.' + CR +
        '    Allocated: ' + IntToStr(new_size) + CR +
        '    Used: ' + IntToStr(AddHere - 1) + CR +
        '    ResizeWhen: ' + IntToStr(ResizeWhen));


end;

// Tekstowa reprezentacja kolejki jako całości
function TArrayQueue.TextValue : String;
const
    CR = #13#10;
var
    i : Longint;
begin
    Result := '';
    for i := RemoveHere to AddHere - 1 do
        Result := Result + Queue[i] + CR;
end;

end.
