Pilha em Pascal

program pilha;

uses crt;

type
apontador = ^celula;
celula = record
item:integer;
prox:apontador;
end;
tipopilha=record
fundo:apontador;
topo:apontador;
end;

procedure iniciapilha(var pilha:tipopilha);
var
aux:apontador;
begin
new (aux);
pilha.fundo:=aux;
pilha.topo:=pilha.fundo;
pilha.topo^.prox :=nil;
end;


function vazia(pilha:tipopilha):boolean;
begin
vazia:=pilha.fundo = pilha.topo;
end;

procedure inserir(x:integer;var pilha:tipopilha);
var aux:apontador;
begin
new (aux);
pilha.topo^.prox:=aux;
aux^.prox := nil;
aux^.item :=x;
pilha.topo := aux;
end;

procedure imprimir(pilha:tipopilha);
var aux:apontador;
begin
aux := pilha.fundo^.prox;
while ( aux <> nil ) do begin
writeln(aux^.item);
aux:=aux^.prox;
end;
end;


procedure retirai(var x:integer; var pilha:tipopilha);

var
aux:apontador;
begin
aux:= pilha.fundo^.prox;
x:=aux^.item;
pilha.fundo^.prox := aux^.prox;
if(pilha.fundo^.prox = nil ) then pilha.topo := pilha.fundo;
dispose(aux);

end;


procedure retirar(var x:integer; var pilha:tipopilha);
var
aux:apontador;
begin
if ( pilha.fundo^.prox^.prox = nil ) then
retirai(x,pilha)

else begin
aux:=pilha.fundo^.prox;
while (aux^.prox <>pilha.topo) do
aux :=aux^.prox;
pilha.topo :=aux;
aux:=aux^.prox;
x:=aux^.item;
pilha.topo^.prox:=nil;
dispose(aux);


end;
end;









procedure media(l:tipopilha; var media:real);
var
aux:apontador;
b:integer;
begin
aux:=l.fundo;
media:=0;
b:=0;
while aux^.prox <> nil do begin
aux:=aux^.prox;
media:=media*aux^.item;
b:=b+1;
end;
writeln('A Media ‚',exp(1/b*ln(media)));
end;

procedure quantidade(l:tipopilha; var qtde:integer);
var
aux:apontador;
b:integer;
begin
aux:=l.fundo;

while aux^.prox <> nil do begin
aux:=aux^.prox;
qtde:=qtde+1;

end;

end;


var
elem:integer;
f:tipopilha;
qtde:integer;
opc:integer;
n:integer;
soma:integer;
m:real;


begin
iniciapilha(f);

repeat
writeln(' 1 - Inserir ');

writeln(' 2 - Retirar ');

writeln(' 3 - Imprimir ');

writeln(' 4 - Media Geometrica ');

writeln(' 5 - Quantidade de elementos ');

writeln(' 6 - Sair');


writeln(' 0 - limpar a tela');

readln(opc);

case opc of

1 :begin

writeln('Entre com o elemento a ser inserido');
readln(elem);
inserir(elem,f);

end;

2 :begin

if vazia(f) then writeln('A pilha est vazia, impossivel retirar elemento !')
else begin
retirar(elem,f);
writeln('O elemento', elem , 'foi removido da pilha');
end;

end;

3:begin
writeln('Elementos do pilha');
imprimir(f);
end;


4 :begin
media(f,m);
writeln('A media ‚ ',m:3:2);

end;

5 :begin
quantidade(f,qtde);
writeln('A quantidade de elementos ‚:', qtde );
end;

6: writeln('Saindo do programa');

0:clrscr;
end;
until opc=6;

end.