program Pointeurs;
uses crt;

type
	ptr_noeud = ^noeud;
	noeud = record
		valeur : integer;
		suivant : ptr_noeud;
	end;
	
function crNd(elt : integer): ptr_noeud;
var
	nv : ptr_noeud;
begin
	new(nv);
	nv^.valeur := elt;
	nv^.suivant := nil;
	crNd := nv;
end;

function ajoutTete(teteliste : ptr_noeud ; n : integer): ptr_noeud;
var
	tmp : ptr_noeud;
begin
	tmp := crNd(n);
	if teteliste = nil then
		ajoutTete := tmp
	else
	begin
		tmp^.suivant := teteliste;
		ajoutTete := tmp;
	end;
end;

procedure ajoutFinBis(var teteliste : ptr_noeud ; n : integer);
// Pré-c : teteliste =/= nil
var
	tmp : ptr_noeud;
begin
	if teteliste^.suivant = nil then
	begin
		tmp := crNd(n);
		teteliste^.suivant := tmp;
	end
	else
		ajoutFinBis(teteliste^.suivant,n);
end;

function ajoutFin(var teteliste : ptr_noeud ; n : integer): ptr_noeud;
begin
	if teteliste = nil then
		ajoutFin := crNd(n)
	else
	begin
		ajoutFinBis(teteliste,n);
		ajoutFin := teteliste;
	end;
end;

function ajoutApres(var p : ptr_noeud ; n : integer): ptr_noeud;
var
	tmp : ptr_noeud;
begin
	tmp := crNd(n);
	if p = nil then
		ajoutApres := crNd(n)
	else
	begin
		tmp^.suivant := p^.suivant;
		p^.suivant := tmp;
		ajoutApres := p;
	end;
end;

procedure ajoutKiemeBis(var teteliste : ptr_noeud; n,k : integer);
begin
	if teteliste <> nil then
		if k = 2 then
			teteliste := ajoutApres(teteliste,n)
		else
			ajoutKiemeBis(teteliste^.suivant,n,k-1);
end;

function ajoutKieme(var teteliste : ptr_noeud; n,k : integer):ptr_noeud;
begin
	if k = 1 then
		ajoutKieme := ajoutTete(teteliste,n)
	else
	begin
		ajoutKiemeBis(teteliste,n,k);
		ajoutKieme := teteliste;
	end;
end;

function supprTete(var teteliste : ptr_noeud) : ptr_noeud;
var
	tmp : ptr_noeud;
begin
	if teteliste = nil then supprTete := teteliste
	else
	begin
	tmp := teteliste^.suivant;
	dispose(teteliste);
	supprTete := tmp;
	end;
end;

procedure supprFinBis(var teteliste : ptr_noeud);
var
	tmp : ptr_noeud;
begin
	if teteliste^.suivant^.suivant = nil then
	begin
		tmp := teteliste^.suivant;
		teteliste^.suivant := nil;
		dispose(tmp);
	end
	else
		supprFinBis(teteliste^.suivant);
end;

function supprFin(var teteliste : ptr_noeud): ptr_noeud;
begin
	if teteliste = nil then
		supprFin := teteliste
	else if teteliste^.suivant = nil then
		supprFin := supprTete(teteliste)
	else
	begin
		supprFinBis(teteliste);
		supprFin := teteliste;
	end;
end;

function supprApres(var p : ptr_noeud) : ptr_noeud;
var
	tmp : ptr_noeud;
begin
	if p^.suivant <> nil then
	begin
		tmp := p^.suivant;
		p^.suivant := tmp^.suivant;
		dispose(tmp);
		supprApres := p;
	end;
end;

procedure supprKiemeBis(var teteliste : ptr_noeud ; k : integer);
begin
	if teteliste^.suivant <> nil then
		if k = 2 then
			teteliste := supprApres(teteliste)
		else
			supprKiemeBis(teteliste^.suivant,k-1);
end;

function supprKieme(var teteliste : ptr_noeud ; k : integer): ptr_noeud;
begin
	if teteliste = nil then
		supprKieme := teteliste
	else if k = 1 then
		supprKieme := supprTete(teteliste)
	else
	begin
		supprKiemeBis(teteliste,k);
		supprKieme := teteliste;
	end;
end;

//////////////////////// OPERATIONS AVANCEES ////////////////////////////

function appartient(teteliste : ptr_noeud ; n : integer) : ptr_noeud;
begin
	if teteliste = nil then
		appartient := teteliste
	else if teteliste^.valeur = n then
		appartient := teteliste
	else
		appartient := appartient(teteliste^.suivant,n);
end;

procedure suppPremierBis(var teteliste : ptr_noeud ; n : integer);
begin
	if teteliste^.suivant <> nil then
		if teteliste^.suivant^.valeur = n then
			teteliste := supprApres(teteliste)
		else
			suppPremierBis(teteliste^.suivant,n);
end;

function suppPremier(var teteliste : ptr_noeud ; n : integer): ptr_noeud;
begin
	if teteliste = nil then
		suppPremier := teteliste
	else if teteliste^.valeur = n then
		suppPremier := supprTete(teteliste)
	else
	begin
		suppPremierBis(teteliste,n);
		suppPremier := teteliste;
	end;
end;

procedure suppTousBis(var teteliste : ptr_noeud ; n : integer);
begin
	if teteliste <> nil then
	if teteliste^.suivant <> nil then
	begin
		if teteliste^.suivant^.valeur = n then
			teteliste := supprApres(teteliste);
		suppTousBis(teteliste^.suivant,n);
	end;
end;

function suppTous(var teteliste : ptr_noeud ; n : integer): ptr_noeud;
begin
	writeln(teteliste^.valeur);
	if teteliste = nil then
		suppTous := teteliste
	else if teteliste^.valeur = n then
	begin
		teteliste := supprTete(teteliste);
		suppTous := suppTous(teteliste^.suivant,n);
	end
	else
	begin
		suppTousBis(teteliste,n);
		suppTous := teteliste;
	end;
end;

function min(ptr : ptr_noeud; acc : integer) : integer;
begin
	if ptr = nil then
		min := acc
	else
		if ptr^.valeur < acc then
			min := min(ptr^.suivant,ptr^.valeur)
		else
			min := min(ptr^.suivant,acc);
end;

function supprMin(var ptr : ptr_noeud) : ptr_noeud;
begin
	if ptr = nil then
		supprMin := ptr
	else if ptr^.suivant = nil then
		supprMin := nil
	else
		supprMin := suppTous(ptr,min(ptr^.suivant,ptr^.valeur));
end;

function renverser(var teteliste : ptr_noeud): ptr_noeud;
var
	prec, mil, suiv : ptr_noeud;
begin
	prec := teteliste;
	if prec = nil then
		renverser := prec
	else
		mil := prec^.suivant;
	if mil = nil then
		renverser := prec
	else
		suiv := mil^.suivant;
	prec^.suivant := nil;
	while suiv <> nil do
	begin
		mil^.suivant := prec;
		prec := mil;
		mil := suiv;
		suiv := suiv^.suivant;
	end;
	mil^.suivant := prec;
	renverser := mil;
end;

procedure disposeAll(var teteliste : ptr_noeud);
begin
	if teteliste <> nil then
	begin
		teteliste := supprTete(teteliste);
		disposeAll(teteliste);
	end;
end;

procedure concatBis(var ptr1, ptr2 : ptr_noeud);
begin
	if ptr1^.suivant = nil then
		ptr1^.suivant := ptr2
	else concatBis(ptr1^.suivant,ptr2);
end;

function concat(var ptr1, ptr2 : ptr_noeud) : ptr_noeud;
begin
	concatBis(ptr1,ptr2);
	concat := ptr1;
end;

function appList(ptr1, res : ptr_noeud) : boolean;
begin
	if res = nil then
		appList := FALSE
	else
		if appartient(ptr1,res^.valeur) = nil then
			appList := appList(ptr1,res^.suivant)
		else
			appList := TRUE;
end;

procedure noDouble(var ptr1,res : ptr_noeud);
var tmp : ptr_noeud;
begin
	if ptr1 <> nil then
		if appList(ptr1,res) then
			noDouble(ptr1^.suivant,res)
		else
		begin
			new(tmp);
			tmp^.valeur := ptr1^.valeur;
			tmp^.suivant := nil;
			res^.suivant := tmp;
			noDouble(ptr1^.suivant,tmp);
		end;
end;

///////////////UTILITAIRES/////////////////////////

procedure affichListe(teteliste : ptr_noeud);
begin
	if teteliste = nil then
		writeln(' |')
	else
	begin
		write(' | ',teteliste^.valeur);
		affichListe(teteliste^.suivant);
	end;
end;

var
	ptr, ptr2, ptrapp, tmp : ptr_noeud;
	choix : char;
	n, k : integer;
	quit : boolean;
begin
	new(ptr);
	ptr := nil;
	ptr2 := nil;
	quit := FALSE;
	writeln('Bienvenue!');
	repeat
		writeln('Listes actuelles : ');
		if ptr = nil then write(' |');
		affichListe(ptr);
		if ptr2 = nil then write(' |');
		affichListe(ptr2);
		writeln('1. ajoutTete, 2. ajoutFin, 3. ajoutKieme, 4. supprTete, 5. supprFin, 6. supprKieme');
		writeln('7. appartient, 8. suppPremier, 9. suppTous, a. renverser, b. supprMin, c. concat, d. noDouble');
		writeln('0. quitter, x. transfert de liste');
		readln(choix);
		case choix of
		'0' : quit := TRUE;
		'1','2','3' : begin
				writeln('Entrez la valeur à ajouter.');
				readln(n);
				case choix of
				'1' : ptr := ajoutTete(ptr,n);
				'2' : ptr := ajoutFin(ptr,n);
				'3' : begin
					writeln('Entrez la position de la nouvelle valeur');
					readln(k);
					ptr := ajoutKieme(ptr,n,k);
				    end;
				end;
			      end;
		'4' : ptr := supprTete(ptr);
		'5' : ptr := supprFin(ptr);
		'6' : begin
			writeln('Entrez la position de la valeur à supprimer.');
			readln(k);
			ptr := supprKieme(ptr,k);
		    end;
		'7' : begin
			writeln('Entrez la valeur du noeud à chercher.');
			readln(n);
			ptrapp := appartient(ptr,n);
			affichListe(ptrapp);
			readln;
		    end;
		'8' : begin
			writeln('Entrez la valeur du noeud à supprimer.');
			readln(n);
			ptr := suppPremier(ptr,n);
		    end;
		'9' : begin
			writeln('Entrez la valeur des noeuds à supprimer.');
			readln(n);
			ptr := suppTous(ptr,n);
		    end;
		'a','A' : ptr := renverser(ptr);
		'b','B' : ptr := supprMin(ptr);
		'c','C' : begin
				ptr := concat(ptr,ptr2);
				new(tmp);
				tmp := nil;
				ptr2 := tmp;
			  end;
		'd','D' : begin
				new(tmp);
				tmp^.valeur := ptr^.valeur;
				tmp^.suivant := nil;
				noDouble(ptr^.suivant,tmp);
				disposeAll(ptr);
				ptr := tmp;
			  end;
		'x','X' : begin
				disposeAll(ptr2);
				ptr2 := ptr;
				new(tmp);
				tmp := nil;
				ptr := tmp;
			  end;
		end;
		clrscr;
	until quit;
	disposeAll(ptr);
	disposeAll(ptr2);
end.