program code;

	const
		NbMax = 20;

	type
		Mot = string[20];
		PtSimple = ^BoiteSimple;
		BoiteSimple = record
				num: integer;     	{num contient l'etiquette du sommet, ici son numero}
				etiquette: char;
				suivant: PtSimple;
			end;
		Graphe = array[0..NbMax] of Ptsimple;

		PtCouple = ^BoiteCouple;
		BoiteCouple = record
				num1: integer;
				num2: integer;
				etiquette: char;
				suivant: PtCouple;
			end;
		Couple = array[0..NbMax, 0..NbMax] of PtCouple;
		TypeCouleur = (blanc, gris, noir);
		ElementPile = record
				x, y: integer;
				c: char;
			end;
	var
		g: Graphe;
		m: Couple;
		nb: integer;                  {le nombre de sommet du graphe g autre que le sommet central}
{--------------------------------------------------------------------------------}
	procedure CreerFlecheSimple (i, j: integer; c: char; var g: Graphe);
{creation d'une fleche dans le graphe "g" allant de "i" vers "j" et d'etiquette c}
		var
			tmp: PtSimple;

	begin
		tmp := g[i];
		new(g[i]);						{l'insertion d'un nouveau successeur est en tete de liste}
		g[i]^.num := j;
		g[i]^.etiquette := c;
		g[i]^.suivant := tmp;
	end;
{--------------------------------------------------------------------------------}
	procedure saisie (var g: Graphe);
		var
			s: Mot;
			i: integer;
	begin
		ShowText;
		writeln('Entrer un mot par ligne');
		writeln('Terminer par une ligne contenant le symbole ''.''');
		repeat
			begin
				readln(s);
				if s <> '.' then
					begin
						if length(s) = 1 then
							CreerFlecheSimple(0, 0, s[1], g)
						else
							begin
								nb := nb + 1;
								CreerFlecheSimple(0, nb, s[1], g);
								for i := 2 to (length(s) - 1) do
									begin
										nb := nb + 1;
										CreerFlecheSimple(nb - 1, nb, s[i], g);
									end;
								CreerFlecheSimple(nb, 0, s[length(s)], g);
							end
					end;
			end
		until s = '.';
	end;

{-----------------------creation de l'automate des couples m--------------------------------}

	procedure CreerFlecheCouple (i, j, k, l: integer; c: char; var m: Couple);
{creation d'une fleche dans le graphe couple "m" allant de "(i,j)" vers "(k,l)" et d'etiquette c}
		var
			tmp: PtCouple;

	begin
		tmp := m[i, j];
		new(m[i, j]);						{l'insertion d'un nouveau successeur est en tete de liste}
		m[i, j]^.num1 := k;
		m[i, j]^.num2 := l;
		m[i, j]^.etiquette := c;
		m[i, j]^.suivant := tmp;
	end;


	procedure CreationCouple (g: graphe; var m: Couple);
		var
			i, j: integer;
			pi, pj: PtSimple;
	begin
		for i := 0 to nb do
			for j := 0 to nb do
				begin
					pi := g[i];
					while (pi <> nil) do
						begin
							pj := g[j];
							while (pj <> nil) do
								begin
									if pi^.etiquette = pj^.etiquette then
										CreerFlecheCouple(i, j, pi^.num, pj^.num, pi^.etiquette, m);
									pj := pj^.suivant;
								end;
							pi := pi^.suivant;
						end;
				end;
	end;
{-------------------affichage des graphes dans la fenetre texte-----------------------------}
{Impression dans la fenetre texte}
	procedure imprimersuccesseurs (p: PtSimple);
	begin
		if p <> nil then
			begin
				write('[', p^.etiquette, ']', p^.num : 2, ',');
				imprimersuccesseurs(p^.suivant);
			end;
	end;

	procedure ImprimerGraphe (var g: Graphe);
{imprime le graphe en petales g dans la fenetre texte}
		var
			i: integer;
	begin
		showtext;
		writeln('automate en petales');
		for i := 0 to nb do
			begin
				write(i : 1, ' ->');
				imprimersuccesseurs(g[i]);
				writeln;
			end;
	end;

	procedure imprimersuccCouple (p: PtCouple);
	begin
		if p <> nil then
			begin
				write('[', p^.etiquette, ']', '(', p^.num1 : 1, ',', p^.num2 : 1, ')', ';');
				imprimersuccCouple(p^.suivant);
			end;
	end;

	procedure ImprimerCouple (var m: Couple);
{imprime le graphe des couples m dans la fenetre texte}
		var
			i, j: integer;
	begin
		showtext;
		writeln('Automate des couples');
		for i := 0 to nb do
			for j := 0 to nb do
				begin
					write('(', i : 1, ',', j : 1, ')', ' - > ');
					imprimersuccCouple(m[i, j]);
					writeln;
				end;
		writeln;
	end;
{--------------------------------initialisation du graphe---------------------------}
	procedure initialiser (var g: Graphe; var m: Couple);
		var
			i, j: integer;
	begin
		for i := 0 to nb do
			begin
				g[i] := nil;
			end;
		for i := 0 to nb do
			for j := 0 to nb do
				begin
					m[i, j] := nil;
				end;
		nb := 0;
	end;

{----------------------------exploration----------------------------------------------}

{---------------------------------------------------------------------------------}
	procedure Parcours (var m: Couple);
		var
			i, j: integer;
			estcode: boolean;
			couleur: array[0..NbMax, 0..NbMax] of TypeCouleur;
			pile: array[1..100] of ElementPile;      {pile pour memoriser le chemin}
			sommet: integer;

		procedure afficherpile;
			var
				i: integer;
		begin
			write('(', 0 : 1, ',', 0 : 1, ')');
			for i := 1 to sommet do
				begin
					write('--', pile[i].c : 1, '->', '(', pile[i].x : 1, ',', pile[i].y : 1, ')');
				end;
			writeln;
		end;

		procedure Tremaux (i, j: integer; var m: Couple);
{exploration de (i,j)}
			var
				t: PtCouple;
				elem: ElementPile;
		begin
			couleur[i, j] := gris;
			t := m[i, j];
			while (t <> nil) do
				begin
					if (couleur[t^.num1, t^.num2] = blanc) then
						begin
							sommet := sommet + 1;
							elem.x := t^.num1;
							elem.y := t^.num2;
							elem.c := t^.etiquette;
							pile[sommet] := elem;
							Tremaux(t^.num1, t^.num2, m);
							sommet := sommet - 1;
						end
					else if (t^.num1 = 0) and (t^.num2 = 0) then
						begin
							if estcode then
								estcode := (i = j);
							if (i <> j) then
								begin
									sommet := sommet + 1;
									elem.x := t^.num1;
									elem.y := t^.num2;
									elem.c := t^.etiquette;
									pile[sommet] := elem;
									afficherpile;
									sommet := sommet - 1;
								end;
						end;
					t := t^.suivant;
				end;
			couleur[i, j] := noir;
		end;

	begin
		sommet := 0;
		for i := 0 to nb do
			for j := 0 to nb do
				begin
					couleur[i, j] := blanc;
				end;
		writeln('debut de l''exploration');
		estcode := true;
		Tremaux(0, 0, m);
		if estcode then
			writeln('C''est un code')
		else
			writeln('Ce n''est pas un code ');
	end;

{-------------------------------programme principal----------------------------------}
begin
{on n'utilise pas QuickDraw dans ce programme}
					{Initialisation}
	initialiser(g, m);
					{Saisie du graphe g}
	saisie(g);
	ImprimerGraphe(g);
	CreationCouple(g, m);
	ImprimerCouple(m); {On pourra masquer cette ligne si le graphe est trop gros}
	Parcours(m);
end.