Lista em Pascal

program ed;
uses crt;
type
apontador = ^celula;
celula = record
item:integer;
prox:apontador;
end;
tipolista = record
primeiro:apontador;
ultimo:apontador;
end;

procedure inicialista(var lista:tipolista);
var
aux:apontador;
begin
new (aux);
lista.primeiro:=aux;
lista.ultimo:=lista.primeiro;
lista.ultimo^.prox :=nil;
end;


function vazia(lista:tipolista):boolean;
begin
vazia:=lista.primeiro = lista.ultimo;
end;

procedure inserirf(x:integer;var lista:tipolista);
var aux:apontador;
begin
new (aux);
lista.ultimo^.prox:=aux;
aux^.prox := nil;
aux^.item :=x;
lista.ultimo := aux;
end;

procedure imprimir(lista:tipolista);
var aux:apontador;
begin
aux := lista.primeiro^.prox;
while ( aux <> nil ) do begin
writeln(aux^.item);
aux:=aux^.prox;
end;
end;

procedure inseriri(x:integer; var lista:tipolista);
var
aux:apontador;
begin
if(vazia(lista)) then
inserirf(x,lista)
else
begin
new(aux);
aux^.item := x;
aux^.prox:=lista.primeiro^.prox;
lista.primeiro^.prox := aux;
end;
end;



procedure retirai(var x:integer; var lista:tipolista);
var
aux:apontador;
begin

aux:=lista.primeiro^.prox;
x:=aux^.item;
lista.primeiro^.prox := aux^.prox;
if (lista.primeiro^.prox = nil ) then lista.ultimo := lista.primeiro;
dispose(aux);

end;




procedure retirarf(var x:integer; var lista:tipolista);
var
aux:apontador;
begin
if ( lista.primeiro^.prox^.prox = nil ) then
retirai(x,lista)
else
begin
aux:=lista.primeiro^.prox;
while ( aux^.prox <> lista.ultimo) do
aux := aux^.prox;
lista.ultimo := aux;
aux:=aux^.prox;
x:=aux^.item;
lista.ultimo^.prox:=nil;
dispose(aux);
end;
end;

procedure retiral( var x:integer; var lista:tipolista; n:integer);
var
aux,aux1:apontador;
i:integer;
begin

aux:=lista.primeiro;
for i:=1 to n-1 do
begin
x:=aux^.prox^.item;

end;
aux1:= aux^.prox;
aux^.prox := aux1^.prox;
dispose(aux1);
end;

procedure media(l:tipolista; var media:real);

var
aux:apontador;
b:integer;
begin

aux:=l.primeiro;

media:=0;
b:=0;

while aux^.prox <> nil do begin

aux:=aux^.prox;
media:=media+aux^.item;
b:=b+1;
end;
media:=media/b;

end;

procedure somapar(l:tipolista; var sp:integer);
var
aux:apontador;
begin
aux:=l.primeiro;
sp:=0;
while (aux^.prox <> nil) do begin
aux:=aux^.prox;
if (aux^.item mod 2) = 0 then
begin
sp:=sp+aux^.item;
end;

end;
end;
procedure retira2(var lista:tipolista; x:integer);
var auxR,aux:apontador;
cont,i:integer;

begin
i:=0;
aux:=lista.primeiro;
while (aux^.item <> x) do begin
aux:= aux^.prox;
i:=i+1;
end;
auxR := lista.primeiro;

for cont:=1 to i-3 do auxR:=auxR^.prox;
aux:=auxR^.prox;
auxR^.prox := aux^.prox;
dispose(aux);

end;


procedure exer3daprova(l:tipolista);
var
mediam:real;
aux:apontador;
i,multi,somap:integer;
begin

i:=0;
multi:=1;
aux:=l.primeiro^.prox;
while ( aux <> nil ) do begin
i:=i+1;
if (aux^.item mod 2 = 1 ) then
multi := multi * aux^.item;
if ( i mod 2 = 0 ) then
somap:=somap + aux^.item;
end;
mediam := multi / i;
writeln(mediam);
writeln(somap);


end;


procedure inserirantes( var l:tipolista; x:integer; elem:integer);
var
aux,aux1:apontador;
begin
aux:=l.primeiro^.prox;
while ( aux^.prox^.item <> elem ) do begin
aux^.prox;
end;
new (aux1);
aux1^.prox := aux^.prox;
aux^.prox := aux1;
aux1^.item := x;




end;


var
l:tipolista;
opc:char;
elem:integer;
n:integer;
soma:integer;
m:real;
{ Programa principal }

begin
inicialista(l);

repeat
writeln(' 1 - Insere in¡cio ');
writeln(' 2 - Insere Fim ');
writeln(' 3 - Retira in¡cio ');
writeln(' 4 - Retira fim ');
writeln(' 5 - Imprimir ');
writeln(' 6 - retirar elemtento em posi‡Æo X ');
writeln(' 7 - Media ');
writeln(' 8 - soma dos elementos pares ');
writeln(' a - Retirar 2§ elemento antes de X ');
writeln(' b - media arit dos elementos impares, e soma dos elem que estÆo nas posi‡äes pares');
writeln(' c - inserir um elemento antes de um determinado elemento');
writeln(' 9 - Sair');


writeln(' 0 - limpar a tela');
opc:=readkey;
{ clrscr; }

case opc of

'1':begin

writeln('Entre com o elemento a ser inserido');
readln(elem);
inseriri(elem,l);

end;
'2' :begin
writeln('Entre com o elemento a ser inserido no final');
readln(elem);
inserirf(elem,l);

end;


'3' :begin

if vazia(l) then writeln('A lista est vazia, impossivel retirar elemento !')
else begin
retirai(elem,l);
writeln('O elemento', elem , 'foi removido do inicio da lista');
end;

end;




'4' :begin
if vazia(l) then writeln('A lista est vazia, impossivel retirar elemento !')
else begin
retirarf(elem,l);
writeln('O elemento', elem , 'foi removido do inicio da lista');
end;

end;


'5':begin
writeln('Elementos do lista');
imprimir(l);
end;
'6' :begin

if not vazia(l) then

writeln('Entre com a posi‡Æo do elemtento a ser removido');
readln(n);
retiral(elem,l,n);

end;

'7' :begin
media(l,m);

writeln('A media ‚ ',m:3:2);
end;
'8' :begin

somapar(l,soma);
writeln('a soma dos elementos pares ‚',soma)
end;

'9':writeln('Saindo do programa');

'0':clrscr;



'a' :begin
writeln('Elemento');
readln(elem);
retira2(l,elem);
end;


'b' :exer3daprova(l);



end;

until(opc='9');
readkey;
end.