Untitled

program stos;
{$APPTYPE CONSOLE}
uses
  SysUtils;

type
    stack = ^Tstack;
   	Tstack = record
  	  	data : integer;
  	  	next : stack;
  	end;

// ========================================================================== //
// Dokladanie elementu na stos:
procedure Push(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 Pop(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 Destroy(var Top : stack);
var
 TempItem : stack;
begin
 while (Top <> nil) do
 begin
  TempItem := Top.next;
  Dispose(Top);
  Top := TempItem;
 end;
end;

// ========================================================================== //
// Wypisanie zawartosci stosu (od szczytu w dol):
procedure List(Top : stack);
begin
 WriteLN('* Elementy stosu: ');
 while (Top <> nil) do
 begin
  WriteLN(Top.data);
  Top := Top.next;
 end;
 WriteLN('* Koniec listy.');
end;

// ========================================================================== //
// Wypisanie zawartosci stosu (od dolu do szczytu):
procedure ListR(Top : stack);
var
 TopR : stack;
begin
 TopR := nil;

 while (Top <> nil) do
 begin
  Push(Top.data, TopR);
  Top := Top.next;
 end;

 List(TopR);
 Destroy(TopR);
end;

// ========================================================================== //
// Kopiowanie stosu TopS(Source) na stos TopD(Destination):
procedure Copy(TopS : stack; var TopD : stack);
var
 TopR : stack;
begin
 TopR := nil;

 while (TopS <> nil) do
 begin
  Push(TopS.data, TopR);
  TopS := TopS.next;
 end;

 while(TopR <> nil) do
 begin
  Push(TopR.data, TopD);
  TopR := TopR.next;
 end;

 Destroy(TopR);
end;


// ================================= TESTER ================================= //
var
 Top : stack;
 TopCopy : stack;
 Value : integer;
 i, j : integer;

begin
 Randomize;

 WriteLN('=== Testowanie wrzucania 15 elementow na stos...');
 for i:=1 to 15 do
 begin
  Value := Random(100);
  Push(Value, Top);
  WriteLN('Na stos wrzucono liczbe ', Value);
 end;
 WriteLN('=== OK.');

 WriteLN('=== Testowanie kasowania 5 elementow ze stosu...');
 for j:=1 to 5 do
 begin
  if Pop(Top, Value) = true then
   WriteLN('Ze stosu zdjeto liczbe: ', Value)
  else
   WriteLN('Brak elementow do zdjecia ze stosu.');
 end;
 WriteLN('=== OK.');

 WriteLN('=== Wypisywanie elementow ze stosu od gory...');
 List(Top);
 WriteLN('=== OK.');

 WriteLN('=== Wypisywanie elementow ze stosu od dolu...');
 ListR(Top);
 WriteLN('=== OK.');

 WriteLN('=== Kopiowanie stosu i wypisywnaie elementow z kopii...');
 Copy(Top, TopCopy);
 List(TopCopy);
 WriteLN('=== OK.');

 WriteLN('=== Testowanie zakonczono pomyslnie.');
 ReadLN; ReadLN;
end.