WITH Ada.Text_Io;
USE Ada.Text_Io;
WITH Ada.Integer_Text_Io;
USE Ada.Integer_Text_Io;
WITH Odporne_Wejscie;
USE Odporne_Wejscie;
PROCEDURE Dynamic_Stack IS
-------------------------------------------------------------------------------------
TYPE Stack_Element;
TYPE Stack_Ptr IS ACCESS Stack_Element;
TYPE Stack_Element IS
RECORD
Data : Positive;
Next : Stack_Ptr;
END RECORD;
TYPE Stack IS
RECORD
Top : Stack_Ptr := NULL;
END RECORD;
-------------------------------------------------------------------------------------
-- procedura sluzaca do dodawania elementow do stosu
-------------------------------------------------------------------------------------
PROCEDURE Push (
S : IN OUT Stack;
W : Integer) IS
P : Stack_Ptr;
BEGIN
P := NEW Stack_Element;
P.Data := W;
P.Next := S.Top;
S.Top := P;
END Push;
-------------------------------------------------------------------------------------
-- procedura sluzaca do wypisywania elementow stosu
-------------------------------------------------------------------------------------
PROCEDURE Write_Stack (
S : IN Stack) IS
P : Stack_Ptr;
BEGIN
P := S.Top;
IF P=NULL THEN
Put("BRAK ELEMENTOW DO WYSWIETLENIA");
New_Line;
RETURN;
END IF;
Put("Top -> ");
WHILE P /= NULL LOOP
Put(P.Data ,2);
Put(" -> ");
P := P.Next;
END LOOP;
Put("Bottom");
END Write_Stack;
------------------------------------------------------------------------------------
-- procedura sluzaca do usuwania elementow ze stosu
------------------------------------------------------------------------------------
PROCEDURE Pop (
S : IN OUT Stack) IS
P : Stack_Ptr;
BEGIN
P := S.Top;
IF P=NULL THEN
Put("NIE MOZNA USUNAC ELEMENTU, STOS JEST PUSTY");
RETURN;
END IF;
S.Top := P.Next;
Put("Usuniety element: ");
Put(P.Data,2);
END Pop;
----------------------------------------------------------------------------------
-- procedura sluzaca do tworzenia pustego stosu
----------------------------------------------------------------------------------
PROCEDURE Make_Null_Stack (
S : IN OUT Stack) IS
P : Stack_Ptr;
BEGIN
P := S.Top;
IF P=NULL THEN
Put("STOS JEST PUSTY");
RETURN;
END IF;
WHILE P /= NULL LOOP
P := S.Top;
IF P=NULL THEN
Put("UTWORZONO PUSTY STOS");
RETURN;
END IF;
S.Top := P.Next;
END LOOP;
END Make_Null_Stack;
----------------------------------------------------------------------------------
-- procedura wyswietlajaca element znajdujacy sie na szczycie stosu
----------------------------------------------------------------------------------
PROCEDURE Top_Element (
S : Stack) IS
P : Stack_Ptr;
BEGIN
P := S.Top;
Put("Element na szczycie stosu: ");
Put(P.Data,2);
END Top_Element;
----------------------------------------------------------------------------------
-- funkcja sluzaca do sprawdzania czy stos jest pusty
----------------------------------------------------------------------------------
FUNCTION Stack_Empty (
S : Stack)
RETURN Boolean IS
BEGIN
IF S.Top=NULL THEN
RETURN True;
ELSE
RETURN False;
END IF;
END Stack_Empty;
---------------------------------------------------------------------------------
-- start programu
---------------------------------------------------------------------------------
M : Integer;
Wybor : Integer;
BEGIN
DECLARE
S : Stack;
BEGIN
S.Top := NULL;
LOOP
Put_Line("-------------------");
Put_Line("WYBIERZ POLECENIE :");
Put_Line("-------------------");
Put_Line("1 : Dodaj element do stosu");
Put_Line("2 : Usun element stosu");
Put_Line("3 : Wyswietl element ze szczytu stosu");
Put_Line("4 : Wyswietl elementy stosu");
Put_Line("5 : Sprawdz, czy stos jest pusty");
Put_Line("6 : Stworz pusty stos");
Put_Line("7 : Zakoncz program");
New_Line;
Odporne_Wejscie.Get(Wybor,1,7);
Put("Wybrano : ");
Put(Wybor,2);
New_Line(2);
CASE Wybor IS
WHEN 1 =>
Put("Nowy element. ");
Odporne_Wejscie.Get(M,1,Integer'Last);
Push(S,M);
New_Line(2);
WHEN 2 =>
Pop(S);
New_Line (2);
WHEN 3 =>
IF S.Top=NULL THEN
Put("NIE MOZNA WYSWIETLIC ELEMENTU, STOS JEST PUSTY");
ELSE
Top_Element(S);
END IF;
New_Line(2);
WHEN 4 =>
Write_Stack(S);
New_Line(2);
WHEN 5 =>
IF Stack_Empty(S) THEN
Put("STOS JEST PUSTY");
ELSE
Put("STOS ZAWIERA ELEMENTY");
END IF;
New_Line(2);
WHEN 6 =>
Make_Null_Stack(S);
New_Line(2);
WHEN 7 =>
EXIT;
WHEN OTHERS =>
Put_Line("Podaj liczbe naturalna z zakresu 1..7 !");
New_Line(2);
END CASE;
END LOOP;
END;
END Dynamic_Stack;