unit CircleQC;
//*******************************************************
// Circular queue 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,
    ExtCtrls, Windows, Graphics;

type
    String10         = String[10];
    TCircleQueue = class(TObject)
        private
            Queue        : Array of String10;
            NumAllocated : Longint;           // Rozmiar tablicy - max. liczba elementów
            RemoveHere   : Longint;           // Indeks elementu czołowego
            AddHere      : Longint;           // Indeks wolnej pozycji dla wstawienia elementu
            NumItems     : Longint;           // Liczba elementów w kolejce
            ShrinkWhen   : Longint;           // Limit dla redukcji rozmiaru tablicy
            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

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

// Wprowadź element do kolejki.
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;

// Pobierz czołowy element z kolejki.
function TCircleQueue.LeaveQueue : String10;
begin
  if (QueueEmpty)
  then
    raise EInvalidOperation.Create(
            'Kolejka jest pusta.');

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

// Sprawdź, czy kolejka jest pusta
function TCircleQueue.QueueEmpty : Boolean;
begin
    QueueEmpty := (NumItems <= 0);
end;

// Zmień rozmiar tablicy
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;
    k: integer;
begin

  // 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;


  if (NumItems > 0)and (AddHere <= RemoveHere) then // Czy kolejka jest "zawinięta"?
  begin // tak
    if new_size > NumAllocated then
    begin
      SetLength(Queue, new_size);
      k := new_size - 1;
      for i := NumAllocated-1 downto RemoveHere do
      begin
        Queue[k] := Queue[i];
        Dec(k);
      end;
      Inc(RemoveHere, new_size-NumAllocated);
      NumAllocated := new_Size;
    end
    else if new_size < NumAllocated then
    begin
      k := RemoveHere - (NumAllocated-new_size);
      for i := RemoveHere to NumAllocated do
      begin
        Queue[k] := Queue[i];
        Inc(k);
      end;
      Dec(RemoveHere, NumAllocated - new_size);
      SetLength(Queue, new_size);
      NumAllocated := new_Size;
    end;
  end
  else
  begin //nie zawinięta
    Setlength(Queue, new_size);
    NumAllocated := new_Size;
  end;


  ShrinkWhen := NumAllocated - 2 * want_free;
  if (ShrinkWhen < 3)
  then
    ShrinkWhen := 0;



  //Poniższy komunikat nie jest konieczny, można go wykomentować
  ShowMessage('Resizing.' + CR +
        '    Allocated: ' + IntToStr(NumAllocated) + CR +
        '    Used: ' + IntToStr(NumItems) + CR +
        '    ShrinkWhen: ' + IntToStr(ShrinkWhen));



end;


// Tekstowa reprezentacja kolejki jako całości
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;

// Wyświetlenie graficznej reprezentacji kolejki
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
        // Wyczyść obrazek
        wid := img.ClientWidth;
        rect.Left   := 0;
        rect.Top    := 0;
        rect.Right  := wid;
        rect.Bottom := wid;
        Brush.Color := clLtGray;
        FillRect(rect);

        // narysuj okręgi
        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));


        theta := 0;
        dtheta := 2 * pi / NumAllocated;
        for i := 0 to NumAllocated - 1 do
        begin
            // wykreśl linię oddzielającą elementy
            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;

        // Wyświetl elementy kolejki
        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;

        // Zaznacz czoło i tył kolejki
        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;

end.
