program kolejkastos;
{$APPTYPE CONSOLE}
uses
SysUtils;
type
stack = ^Tstack;
Tstack = record
data : integer;
next : stack;
end;
T_Kolejka = record
StosA : stack;
StosB : stack;
end;
// ========================================================================== //
// Dokladanie elementu na stos:
procedure PushS(Value : integer; var Top : stack);
var
TempItem : stack;
begin
TempItem := Top;
New(Top);
Top.data := value;
Top.next := TempItem;
end;
// ========================================================================== //
// Usuwanie elementu ze stosu:
function PopS(var Top : stack; var Val : integer) : boolean;
var
TempItem : stack;
begin
if Top <> nil then
begin
Val := Top.data;
TempItem := Top;
Top := Top.next;
Dispose(TempItem);
result := true;
end
else
result := false;
end;
// ========================================================================== //
// Kasowanie stosu:
procedure DestroyS(var Top : stack);
var
TempItem : stack;
begin
while (Top <> nil) do
begin
TempItem := Top.next;
Dispose(Top);
Top := TempItem;
end;
end;
// ========================================================================== //
// Kopiowanie stosu TopS(Source) na stos TopD(Destination):
procedure CopyS(TopS : stack; var TopD : stack);
var
TopR : stack;
begin
TopR := nil;
while (TopS <> nil) do
begin
PushS(TopS.data, TopR);
TopS := TopS.next;
end;
while(TopR <> nil) do
begin
PushS(TopR.data, TopD);
TopR := TopR.next;
end;
DestroyS(TopR);
end;
// ========================================================================== //
// Dokladanie elementu do kolejki:
procedure Push(Value : integer; var K1 : T_Kolejka);
begin
PushS(Value, K1.StosA);
end;
// ========================================================================== //
// Kasowanie elementu z kolejki:
function Pop(var K1 : T_Kolejka; var Value : integer) : boolean;
begin
CopyS(K1.StosA, K1.StosB);
if (PopS(K1.StosB, Value)) then
begin
result := true;
DestroyS(K1.StosA);
CopyS(K1.StosB, K1.StosA);
end
else
result := false;
DestroyS(K1.StosB);
end;
// ================================= TESTER ================================= //
var
Kolejka : T_Kolejka;
Value : integer;
i, j : integer;
begin
Randomize;
WriteLN('=== Testowanie wrzucania 15 elementow do kolejki...');
for i:=1 to 1 do
begin
Value := Random(100);
Push(Value, Kolejka);
WriteLN('Na stos wrzucono liczbe ', Value);
end;
WriteLN('=== OK.');
WriteLN('=== Testowanie wrzucania 5 elementow z kolejki...');
for i:=1 to 5 do
begin
if Pop(Kolejka, Value) = true then
WriteLN('Z kolejki zdjeto liczbe: ', Value)
else
WriteLN('Brak elementow do zdjecia z kolejki.');
end;
WriteLN('=== OK.');
WriteLN('=== Testowanie zakonczono pomyslnie.');
ReadLN;
end.