unit ArrayQC;
//*******************************************************
// Array-based queue class.
//*******************************************************
// Copyright (C) 1998 John Wiley & Sons, Inc.
// All rights reserved. See additional copyright
// information in Readme.txt.
//*******************************************************

interface

uses
    Dialogs, SysUtils, Classes;

type
    String10         = String[10];
    TArrayQueueArray = array[0..100000000] of String10;
    PQueueArray = ^TArrayQueueArray;
    TArrayQueue = class(TObject)
        private
            Queue        : PQueueArray; // The array we will resize.
            NumAllocated : Longint;     // The number of entries allocated.
            RemoveHere   : Longint;     // The next item to be removed.
            AddHere      : Longint;     // Where the next new item goes.
            ResizeWhen   : Longint;     // Resize if RemoveHere > ResizeWhen.
            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.
constructor TArrayQueue.Create;
begin
    NumAllocated := -1;
end;

// Free any allocated memory.
destructor TArrayQueue.Destroy;
begin
    if (NumAllocated > 0) then FreeMem(Queue);
    inherited Destroy;
end;

// Add an item to the queue.
procedure TArrayQueue.EnterQueue(new_value : String10);
begin
    // Make sure there's room for the new item.
    if (AddHere >= NumAllocated) then ResizeQueue;
    Queue^[AddHere] := new_value;
    AddHere := AddHere + 1;
end;

// Remove the last item from the list.
function TArrayQueue.LeaveQueue : String10;
begin
    if (QueueEmpty) then
        raise EInvalidOperation.Create(
            'No items to remove.');

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

// Return the number of items in the list.
function TArrayQueue.QueueEmpty : Boolean;
begin
    QueueEmpty := (RemoveHere >= AddHere);
end;

{
There are two reasons to resize the queue:
    1. We have reached the end and need more room
    2. We have too much empty space at the beginning

In either case we create a new array of the correct size.
We then move all of the items in the queue to the front
of the new array.

ResizeWhen is set so we resize when Front > ResizeWhen.
}
procedure TArrayQueue.ResizeQueue;
const
    WANT_FREE_PERCENT = 0.5; // Try for 50% free space.
    MIN_FREE = 2;            // Min unused space when resizing.
    CR = #13#10;
var
    want_free, new_size, i : Longint;
    new_array              : PQueueArray;
begin
    // See how big the array should be.
    new_size := AddHere - RemoveHere;
    want_free := Round(WANT_FREE_PERCENT * new_size);
    if (want_free < MIN_FREE) then want_free := MIN_FREE;
    new_size := new_size + want_free;

    // Create a new array.
    GetMem(new_array, new_size * SizeOf(String10));

    // Copy the existing items into the new array.
    for i := RemoveHere to AddHere - 1 do
        new_array^[i - RemoveHere] := Queue^[i];
    AddHere := AddHere - RemoveHere;
    RemoveHere := 0;

    // Free the previously allocated memory.
    if (NumAllocated > 0) then FreeMem(Queue);
    NumAllocated := new_size;

    // Make Queue point to the new memory.
    Queue := new_array;

    // We resize when RemoveHere > ResizeWhen.
    ResizeWhen := want_free;

    // Comment the following when not testing.
    ShowMessage('Resizing.' + CR +
        '    Allocated: ' + IntToStr(new_size) + CR +
        '    Used: ' + IntToStr(AddHere - 1) + CR +
        '    ResizeWhen: ' + IntToStr(ResizeWhen));
end;

// Return a textual representation of the queue.
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.
