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

interface

uses
    Dialogs, SysUtils, Classes,
    ExtCtrls, Windows, Graphics;

type
    String10         = String[10];
    TCircleQueueArray = array[0..100000000] of String10;
    PCircleQueueArray = ^TCircleQueueArray;
    TCircleQueue = class(TObject)
        private
            Queue        : PCircleQueueArray; // 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.
            NumItems     : Longint;           // # items in the queue.
            ShrinkWhen   : Longint;           // Shrink when NumItems < ShrinkWhen.
            procedure ResizeQueue;

        public
            destructor Destroy; override;
            procedure EnterQueue(new_value : String10);
            function LeaveQueue : String10;
            function QueueEmpty : Boolean;
            function TextValue : String;
            procedure DrawQueue(img : TImage);
    end;

implementation

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

// Add an item to the queue.
procedure TCircleQueue.EnterQueue(new_value : String10);
begin
    if (NumItems >= NumAllocated) then ResizeQueue;

    Queue^[AddHere] := new_value;
    AddHere := (AddHere + 1) mod NumAllocated;
    NumItems := NumItems + 1;
end;

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

    LeaveQueue := Queue^[RemoveHere];
    RemoveHere := (RemoveHere + 1) mod NumAllocated;
    NumItems := NumItems - 1;
    if (NumItems < ShrinkWhen) then ResizeQueue;
end;

// Return true if the queue is empty.
function TCircleQueue.QueueEmpty : Boolean;
begin
    QueueEmpty := (NumItems <= 0);
end;

// Resize the queue.
procedure TCircleQueue.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 : Integer;
    new_array              : PCircleQueueArray;
begin
    // Create the new array.
    want_free := Round(WANT_FREE_PERCENT * NumItems);
    if (want_free < MIN_FREE) then want_free := MIN_FREE;
    new_size := NumItems + want_free;
    GetMem(new_array, new_size * SizeOf(String10));

    // Copy the items into positions new_array[0]
    // through new_array[NumItems - 1].
    for i := 0 to NumItems - 1 do
        new_array^[i] :=
            Queue^[(i + RemoveHere) mod NumAllocated];

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

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

    RemoveHere := 0;
    AddHere := NumItems;

    // We will resize when NumItems < ShrinkWhen.
    ShrinkWhen := NumAllocated - 2 * want_free;
    if (ShrinkWhen < 3) then ShrinkWhen := 0;

    // Comment the following when not testing.
    ShowMessage('Resizing.' + CR +
        '    Allocated: ' + IntToStr(NumAllocated) + CR +
        '    Used: ' + IntToStr(NumItems - 1) + CR +
        '    ShrinkWhen: ' + IntToStr(ShrinkWhen));
end;

// Return a textual representation of the queue.
function TCircleQueue.TextValue : String;
const
    CR = #13#10;
var
    i : Longint;
begin
    Result := '';
    for i := 0 to NumItems - 1 do
        Result := Result +
            Queue^[(RemoveHere + i) mod NumAllocated] +
            CR;
end;

// Display a graphical representation of the queue.
procedure TCircleQueue.DrawQueue(img : TImage);
const
    FRACT1 = 0.55;
    FRACT2 = 0.75;
var
    rect                      : TRect;
    text_size                 : TSize;
    i, wid, mid               : Integer;
    x1, y1, x2, y2            : Integer;
    theta, Dtheta, r1, r2, r3 : Single;
    txt                       : String;
begin
    with img.Canvas do
    begin
        // Erase the image.
        wid := img.ClientWidth;
        rect.Left   := 0;
        rect.Top    := 0;
        rect.Right  := wid;
        rect.Bottom := wid;
        Brush.Color := clLtGray;
        FillRect(rect);

        // Draw the circles.
        mid := wid div 2;
        r1 := wid * FRACT1 / 2;
        r2 := wid * FRACT2 / 2;
        Ellipse(Round(mid - r2), Round(mid - r2),
                Round(mid + r2), Round(mid + r2));
        Ellipse(Round(mid - r1), Round(mid - r1),
                Round(mid + r1), Round(mid + r1));

        // Divide the array entries.
        theta := 0;
        dtheta := 2 * pi / NumAllocated;
        for i := 0 to NumAllocated - 1 do
        begin
            // Draw a line separating this entry from the next.
            x1 := Round(mid + r1 * Cos(theta));
            y1 := Round(mid + r1 * Sin(theta));
            x2 := Round(mid + r2 * Cos(theta));
            y2 := Round(mid + r2 * Sin(theta));
            MoveTo(x1, y1);
            LineTo(x2, y2);
            theta := theta + Dtheta;
        end;

        // Display the entries.
        r3 := (r1 + r2) / 2;
        theta := (RemoveHere + 0.5) * Dtheta;
        for i := 0 to NumItems - 1 do
        begin
            x1 := Round(mid + r3 * Cos(theta));
            y1 := Round(mid + r3 * Sin(theta));
            txt := Queue^[(i + RemoveHere) mod NumAllocated];
            text_size := TextExtent(txt);
            TextOut(x1 - text_size.cx div 2,
                    y1 - text_size.cy div 2,
                    txt);
            theta := theta + Dtheta;
        end;

        // Mark the front and back positions.
        theta := (RemoveHere + 0.5) * Dtheta;
        text_size := TextExtent('Rem');
        r2 := r1 - text_size.cx;
        TextOut(
            Round(mid + r2 * Cos(theta) - text_size.cx / 2),
            Round(mid + r2 * Sin(theta) - text_size.cy / 2),
            'Rem');
        theta := (AddHere + 0.5) * Dtheta;
        text_size := TextExtent('Add');
        r3 := r2 - 1.7 * text_size.cx;
        TextOut(
            Round(mid + r3 * Cos(theta) - text_size.cx / 2),
            Round(mid + r3 * Sin(theta) - text_size.cy / 2),
            'Add');
    end; // End With img.Canvas
end;

end.
