Generation et recherche de sortie d'un labyrinthe

Soyez le premier à donner votre avis sur cette source.

Vue 5 880 fois - Téléchargée 546 fois

Description

Bonjour a tous.
Je viens vous présenter un programme pascal que j'ai créé dans le cadre d'un TP en première année de l'INSA Lyon. Je ne sais pas si il aidera grand monde c'est a vous de juger.
Il a été compilé avec succès avec FreePascal sous Windows, apparemment l'affichage des charactères spéciaux pose problème sous linux, et il est également conseiller d'utiliser la fonction d'affichage '_ancienne' car l'actuelle n'est pas certaine de fonctionner sous linux dans tous les cas.

Par contre la génération de labyrinthe marche toujours (Utilisation de l'algorithme trouvé ici : http://ilay.org/yann/articles/maze/), ainsi que la recherche de sortie (Dérivée de l'algorithme A* et Djikstra)

Ne soyez pas trop violents dans vos réactions
(Nb, toutes les références à la loutre viennent de l'énoncé de notre TP, il fallait faire sortir la loutre :p )

Fichier complet comprenant les labyrinthes déjà crées et notre compte rendu : http://malossane.fr/usb-file-474.html

Cordialement,
Tim

Source / Exemple :


Program labyrinthe ;
///////////////////////////////////////
//Programme Sauvons la loutre!!!
//Auteurs : V Bavasso, T Malossane, V Marcan-Dumesnil, C L'héritier
//Description : Trouve la sortie du labyrinthe.
////////////////////////////////////////

uses crt;

///////////////////////////////////////
//Declaration des Cstes
////////////////////////////////////////

Const dim_X_max = 200; // Dimension X Max de la matrice
      dim_Y_max = 200; // Dimension Y Max de la matrice
	  dim_C_max = 500; // Dimension Max du NB de noeuds
	  E = Chr(16);
	  S = Chr(17);
	  M = Chr(219); //(177 et 219 pas mal du tout également)
	  L = Chr(1);

///////////////////////////////////////
//Déclaration des Types
////////////////////////////////////////

Type t_lab = Record // Type contenant le labyrinthe
		table : array[1..dim_X_max,1..dim_Y_max] of char ;
		dim_X,dim_Y : integer ;
		pos_X_entree,pos_Y_entree : integer ;
		pos_X_sortie,pos_Y_sortie : integer ;
	End;
	t_loutre = Record // Type contenant le chemin
		chemin : array[0..dim_C_max,1..2] of integer ;
		noeuds : array[1..dim_C_max,1..3] of integer ;
		etape,nb_noeuds : integer;
	End;
	t_array = array[1..5,1..2] of integer;  // Type contenant les informations de chaque noeud trouvé (0,0 contient le nombre de chemins possibles, les autres sont les coordonnées des chemins à emprunter
	t_point = array[1..2] of integer;  // Type contenant l'abscisse et l'ordonnée d'un point

Type t_gen = array[0..100,0..100] of integer; // Type utilisé pour le générateur
	t_gen_final = array[1..201,1..201] of char; // Idem

{========================= Debut de déclaration des fonctions ==============================}

///////////////////////////////////////////////////////////////////////////////////
//Fonction heuristique: Cherche quelle case est la plus probable
//Fonction qui calcule le minimum entre 2 valeurs.
//Used by : Fonction Heuristique
///////////////////////////////////////////////////////////////////////////////////

function minimum(var x,y:Integer):Integer;
	begin
	  if x<y then minimum:=x
	  else minimum:=y;
end;

///////////////////////////////////////////////////////////////////////////////////
//Fonction heuristique: Cherche quelle case est la plus probable
//FONCTION QUI Donne la case à choisir. Cette recherche est
//heuristique, on calcule la distance (Pythagore) entre 2 points puis on
//cherche le minimum, on choisira le plus proche, car la probabilité pour
//que la solution soit plus courte est plus importante
///////////////////////////////////////////////////////////////////////////////////

function heuristique(point1,point2:array of integer;f_board:t_lab):t_point;
	var p1, p2 : integer;
	begin
	p1 := ((point1[0]-f_board.pos_X_sortie)*(point1[0]-f_board.pos_X_sortie))+((point1[1]-f_board.pos_Y_sortie)*(point1[1]-f_board.pos_Y_sortie));
	p2 := ((point2[0]-f_board.pos_X_sortie)*(point2[0]-f_board.pos_X_sortie))+((point2[1]-f_board.pos_Y_sortie)*(point2[1]-f_board.pos_Y_sortie));
	If minimum(p1,p2) = p2 Then
		heuristique := point2
	Else
		heuristique := point1;
end;

///////////////////////////////////////////////////////////////////////////////////
//Fonction get_nb_chemins: Donne le nombre total de possibilités (Droite gauche haut bas) pour la case
//en fonction de x et y et retourne t_array contenant les informations
//Return t_array:
//[1,1] : Nb de Chemins possibles
//[i,1] (2<i<5) : Coordonnées X des chemins possibles (4 maximum)
//[i,2] (2<2<5) : Coordonnées X des chemins possibles (4 maximum)
///////////////////////////////////////////////////////////////////////////////////

function get_nb_chemins(f_board:t_lab;f_x,f_y:integer):t_array;
	var nb:integer;
	begin
	nb := 0;
	If (f_y> 1) and ((f_board.table[f_x, f_y-1] = ' ') OR (f_board.table[f_x, f_y-1] = 'S')) Then // haut
		begin
		nb := nb + 1;
		get_nb_chemins[nb+1,1] := f_x;
		get_nb_chemins[nb+1,2] := f_y-1;
		//Writeln('haut');
		end;
	If (f_y< f_board.dim_y) AND ((f_board.table[f_x, f_y+1] = ' ')OR (f_board.table[f_x, f_y+1] = 'S')) Then //bas
	   begin
		nb := nb + 1;
		get_nb_chemins[nb+1,1] := f_x;
		get_nb_chemins[nb+1,2] := f_y+1;
		//Writeln('bas');
		end;
	If (f_x> 1) AND ((f_board.table[f_x-1, f_y] = ' ')OR(f_board.table[f_x-1, f_y] = 'S')) Then //gauche
	   begin
		nb := nb + 1;
		get_nb_chemins[nb+1,1] := f_x-1;
		get_nb_chemins[nb+1,2] := f_y;
		//Writeln('gauche');
		end;
	If (f_x< f_board.dim_X) AND ((f_board.table[f_x+1, f_y] = ' ')OR(f_board.table[f_x+1, f_y] = 'S')) Then //droite
	   begin
		nb := nb + 1;
		get_nb_chemins[nb+1,1] := f_x+1;
		get_nb_chemins[nb+1,2] := f_y;
		//Writeln('droite');
		end;
	get_nb_chemins[1,1] := nb;
end;

///////////////////////////////////////////////////////////////////////////////////
//Fonction get_last_noeud: Donne le dernier noeud qui n'a pas totalement été visité
//en fonction du chemin déjà parcouru par la loutre
//Return t_point:
//[1] : X du dernier noeud
//[2] : Y du dernier noeud
///////////////////////////////////////////////////////////////////////////////////

function get_last_noeud(f_loutre:t_loutre):t_point;
	var i : integer;
	var res : t_point;
	begin
	i := 0;
		Repeat
			i := i + 1;
		until (f_loutre.noeuds[i][1] = 0);
		res[1] := f_loutre.noeuds[i-1,1];
		res[2] := f_loutre.noeuds[i-1,2];
		get_last_noeud := res;
end;

{========================= Debut de déclaration des procedure ==============================}

///////////////////////////////////////////////////////////////////////////////////
//Procedure get_chemin: Procedure principale qui retourne un chemin le plus court possible
//en fonction du chemin déjà parcouru par la loutre
//Elle travaille directement sur les variables board (labyrinthe) et loutre (chemin de la loutre)
///////////////////////////////////////////////////////////////////////////////////

procedure get_chemin(var board : t_lab;var loutre:t_loutre);
	var i,x,y:integer;
	var nb:t_array;point:t_point;
	begin
		x := board.pos_X_entree;
		y := board.pos_Y_entree;
		loutre.etape := 0;
		loutre.nb_noeuds := 0;
		loutre.chemin[0,1] := x;
		loutre.chemin[0,2] := y;
		While  ((x <> board.pos_X_sortie)OR (y <> board.pos_Y_sortie)) AND (loutre.nb_noeuds >= 0) do
		begin
			nb := get_nb_chemins(board,x,y);
			loutre.etape := loutre.etape + 1 ;
			loutre.noeuds[loutre.nb_noeuds,3] := loutre.noeuds[loutre.nb_noeuds,3] + 1;

			//Writeln('Etape n°',loutre.etape);
			 Case nb[1,1] of
				0:begin
					point := get_last_noeud(loutre);

					If (point[1] = x) And (point[2]=y) Then
						Begin
							//Writeln('La loutre est coincée, Elle retourne au dernier embranchement!');

							loutre.noeuds[loutre.nb_noeuds+1,1] := 0;
							loutre.noeuds[loutre.nb_noeuds+1,2] := 0;

							//loutre.nb_noeuds := loutre.nb_noeuds-1;
							point := get_last_noeud(loutre);
						End;

				//	Writeln('Loutre est à un noeud à x:',x,' y:',y);
					board.table[x,y] := '-';
					loutre.chemin[loutre.etape,1] := point[1];
					loutre.chemin[loutre.etape,2] := point[2];

					x :=point[1];
					y :=point[2];
					//Writeln('Loutre allant à x:',x,' y:',y);

					// Maintenant, on efface les endroits ou la loutre est allée et qui ne vont pas.
					loutre.etape := loutre.etape-loutre.noeuds[loutre.nb_noeuds,3];
					loutre.noeuds[loutre.nb_noeuds,3] := 0;
					loutre.nb_noeuds := loutre.nb_noeuds - 1;
					loutre.noeuds[loutre.nb_noeuds,3] := loutre.noeuds[loutre.nb_noeuds,3]-1;
				end;

				1: begin
					If (x=loutre.noeuds[loutre.nb_noeuds+1,1]) AND (y=loutre.noeuds[loutre.nb_noeuds+1,2])Then
						Begin
						loutre.nb_noeuds := loutre.nb_noeuds + 1;
						loutre.noeuds[loutre.nb_noeuds,3] := loutre.noeuds[loutre.nb_noeuds,3]+1;
						End;
					//Writeln('1 Choix x:',nb[2,1],' y:',nb[2,2]);
					//Writeln('Loutre venant de x:',loutre.chemin[loutre.etape-1,1],' y:',loutre.chemin[loutre.etape-1,2]);
					loutre.chemin[loutre.etape,1] := nb[2,1];
					loutre.chemin[loutre.etape,2] := nb[2,2];
					board.table[x,y] := '-';
					x :=nb[2,1];
					y :=nb[2,2];
					//Writeln('Loutre allant à x:',x,' y:',y);
				end;
				2: begin
					loutre.nb_noeuds := loutre.nb_noeuds + 1;
					loutre.noeuds[loutre.nb_noeuds,1]:=x;
					loutre.noeuds[loutre.nb_noeuds,2]:=y;
					//Writeln('1er Choix x:',nb[2,1],' y:',nb[2,2]);
					//Writeln('2eme Choix x:',nb[3,1],' y:',nb[3,2]);
					point := heuristique([nb[2,1],nb[2,2]],[nb[3,1],nb[3,2]],board);
					//	Writeln('Pos choisie x:',point[1],' y:',point[2]);
					loutre.chemin[loutre.etape,1] := point[1];
					loutre.chemin[loutre.etape,2] := point[2];
					loutre.noeuds[loutre.nb_noeuds,3] := loutre.noeuds[loutre.nb_noeuds,3] + 1;
					board.table[x,y] := '-';
					x :=point[1];
					y :=point[2];
				end;
				3: begin
					loutre.nb_noeuds := loutre.nb_noeuds + 1;
					loutre.noeuds[loutre.nb_noeuds,1]:=x;
					loutre.noeuds[loutre.nb_noeuds,2]:=y;
					//Writeln('1er Choix x:',nb[2,1],' y:',nb[2,2]);
					//Writeln('2eme Choix x:',nb[3,1],' y:',nb[3,2]);
					point := heuristique([nb[2,1],nb[2,2]],[nb[3,1],nb[3,2]],board);
					point := heuristique([point[1],point[2]],[nb[4,1],nb[4,2]],board);
					loutre.chemin[loutre.etape,1] := point[1];
					loutre.chemin[loutre.etape,2] := point[2];
					loutre.noeuds[loutre.nb_noeuds,3] := loutre.noeuds[loutre.nb_noeuds,3] + 1;
					board.table[x,y] := '-';
					x :=point[1];
					y :=point[2];
				end;
			 End;
			//Writeln(loutre.etape,'|',loutre.nb_noeuds,'|',loutre.noeuds[loutre.nb_noeuds,3]);
			//Readln();
		 End;
end;

///////////////////////////////////////////////////////////////////////////////////
//Procedure get_data: Procedure principale qui s'occupe de la récupération des données dans les fichiers
//afin de les traiter pour les insérer dans les matrices induites au labyrinthe.
//Elle travaille directement sur la variable board (labyrinthe) définie par son type en début de programme.
//En entree, elle veut le chemin du labyrinthe.txt satisfaisant aux conditions.
///////////////////////////////////////////////////////////////////////////////////

procedure get_data(u:string;var board:t_lab);
	const LF=chr(10);
	var sauv_j,i,j:integer;
		car:char;
		fichier:text;
	begin
		assign(fichier,u);
		reset(fichier);
		i:=1;
		j:=1;
		sauv_j := 1;
		while not eof(fichier) do
			begin
				read(fichier,car);
				if car= LF then
					Begin
					i:=i+1;
					If j > 1 Then
						sauv_j := j-1;
					j:=1;
					End
				Else
				begin
					board.table[j,i]:= car;
					j:=j+1;
					Case car  Of
					  'D','E':  begin
							  board.pos_X_entree := j-1;
							  board.pos_Y_entree := i;
							end;
					  'S':  begin
							  board.pos_X_sortie := j-1;
							  board.pos_Y_sortie := i;
							end;
					End;
				End;
			end;
		board.dim_X:=sauv_j;
		board.dim_Y:=i;
	end;

///////////////////////////////////////////////////////////////////////////////////
//Procedure affichage: Procedure qui sert à afficher le labyrinthe à vide.
//Elle travaille sur une copie de la variable board (labyrinthe).
///////////////////////////////////////////////////////////////////////////////////

procedure affichage(board:t_lab);
var i,j:integer;
begin
	textcolor(15);
	for j:=1 to board.dim_Y do
		begin
			for i:=1 to board.dim_X do
				Case board.table[i,j] of
				'E','D' : write(E);
				'S' : write(S);
				'M' : write(M);
				Else write(board.table[i,j]);
				End;
		writeln( );
	end;
	//writeln( );
end;

///////////////////////////////////////////////////////////////////////////////////
//Procedure initialise : Procedure qui initialise les tableaux utilisés.
//Notamment les tableaux de loutre.
///////////////////////////////////////////////////////////////////////////////////

procedure initialise(var f_loutre:t_loutre);
var i : integer;
begin
	For i := 1 to dim_C_max do
		Begin
		f_loutre.noeuds[i][1] := 0;
		f_loutre.noeuds[i][2] := 0;
		f_loutre.noeuds[i][3] := 0;
		f_loutre.chemin[i][1] := 0;
		f_loutre.chemin[i][2] := 0;
	End;

end;

///////////////////////////////////////////////////////////////////////////////////
//Procedure afficher_sortie : Procedure affiche la loutre et son voyage a travers le labyrinthe.
//Notamment les tableaux de loutre.
///////////////////////////////////////////////////////////////////////////////////

procedure afficher_sortie(board:t_lab;loutre:t_loutre);
var i,j,jesersarien:integer;
begin

	clrscr;
	affichage(board);

		for i:=1 to loutre.etape do
			Begin
			//GotoXY(1,1);
			//InsLine ;
			GotoXY ( loutre.chemin[i,1] , loutre.chemin[i,2]) ;
			Write (L);
			GotoXY ( loutre.chemin[i-1,1] , loutre.chemin[i-1,2]) ;
			If (loutre.chemin[i-1,1]<>board.pos_X_entree) OR (loutre.chemin[i-1,2]<>board.pos_Y_entree) Then
				Write (' ')
			Else
				Write (E);

			GotoXY (1,board.dim_Y) ;
			//Readln(); Au lieu d'appuyer sur entrer, on fait bouger la loutre
			For j := 1 to 40000000 do
				jesersarien:=0;
			//read();
			End;
	readln();
End;

// Ancienne procedure afficher_sortie
//Marche toujours, mais est trop longue pour les labyrinthes depassant 10x10
//La nouvelle est plus rapide, mais si ca vous tente, vous pouvez utiliser l'ancienne, il suffit
// de la decommenter et de commenter celle qui est ci-dessus.
{procedure afficher_sortie(board:t_lab;loutre:t_loutre);
var i,j,count:integer;

begin
	count:= -1;
	Repeat
		count := count + 1;
		clrscr;
		for j:=1 to board.dim_Y do
			begin
			for i:=1 to board.dim_X do
				begin
				If (loutre.chemin[count,1] = i) AND (loutre.chemin[count,2] = j) Then
					write(L)
				Else write(board.table[i,j]);
			end;
			writeln( );
		end;
		readln();
	Until (loutre.chemin[count,1] = board.pos_X_sortie) AND (loutre.chemin[count,2] = board.pos_Y_sortie);
End;}

{========================= Debut de declarations des Procedures concernants le GENERATEUR ==============================}

// Fonction necessaire à l'algorithme de generation ; Cf http://ilay.org/yann/articles/maze/ Pour l'algorithme utilisé
Procedure NettoieCellules(var lab:t_gen; x2, y2, dim_x, dim_y, v1, v2:integer);
Begin
	lab[x2,y2] := v1;
	If (x2 > 0) And (lab[x2 - 1,y2] = v2) Then
		NettoieCellules(lab, x2 - 1, y2, dim_x, dim_y, v1, v2);
	If (x2 < dim_x-1) And (lab[x2 + 1,y2] = v2) Then
		NettoieCellules(lab, x2 + 1, y2, dim_x, dim_y, v1, v2);
	If (y2 > 0) And (lab[x2,y2 - 1] = v2) Then
		NettoieCellules(lab, x2, y2 - 1, dim_X, dim_y, v1, v2);
	If (y2 < dim_y-1) And (lab[x2,y2 + 1] = v2) Then
		NettoieCellules(lab, x2, y2 + 1, dim_x, dim_y, v1, v2);
End;

//Genere le fichier .txt à l'oupout rentré, de dimension voulue.
procedure generer_lab(outpout:string;dim:integer);
var lab : t_gen;
	dim_x,dim_y,dim_Finale:integer;
	continue,rand,x1,x2,y1,y2,i,j:integer;
	v1,v2,NbMurs:integer;
	MH : t_gen;
	MV : t_gen;
	rendu : t_gen_final;
	fichier:text;
begin
	dim_x := dim;
	dim_y := dim;
	dim_Finale := 2*dim+1;
	randomize;
	NbMurs := 0;
	//Initialisation des tableaux de murs
    For i := 0 To dim_x-1 do
		For j := 0 To dim_y-1 do
			lab[i,j] := i * dim_y + j;

	For i := 0 To dim_x-1 do
		For j := 0 To dim_y-2 do
			MH[i,j] := 1;

	For i := 0 To dim_x-2 do
		For j := 0 To dim_y-1 do
			MV[i,j] := 1;
	//On va maintenant enlever nos murs 1 par 1
	While NbMurs <> ((dim_x*dim_y)-1) do
	Begin
		continue := 0;
		rand := random(2)+1;
		Case rand of
			1:begin//Murs Horizontaux
				x1 := random(dim_x);
				y1 := random(dim_y-1);
				If (MH[x1,y1] = 1) Then
					begin
					continue := 1;
					x2 := x1;
					y2 := y1 + 1	;
				end;
			end;
			2:begin//Murs Verticaux
				x1 := random(dim_x-1);
				y1 := random(dim_y);
				If MV[x1,y1] = 1 Then
					begin
					continue := 1;
					x2 := x1+1;
					y2 := y1;
				end;
			end;
		End;
		If continue = 1 Then // (= Si un mur a été trouvé)
		Begin
			v1:=lab[x1,y1];
			v2:=lab[x2,y2];
			If v1 <> v2 Then
			Begin
				// On enlève le mur
				Case rand of
					1:
						MH[x1][y1] := 0;
			        2:
						MV[x1][y1] := 0;
				End;
				// On met la même valeur dans les cases de la chaîne

				NettoieCellules(lab, x2, y2, dim_x, dim_y, v1, v2);

				NbMurs := NbMurs+1;
			End;

		End;
	End;

	//Maintenant, on a 2 tableaux avec des murs horizontaux et verticaux, tres facile a utiliser.
	//On doit cependant les traiter pour pouvoir creer notre tableaux de la forme souhaitée dans le TP.
	//Et ce ne fut pas une partie de plaisir.

	//On met des trous de partout
	For i := 1 To dim_Finale do
		For j := 1 To dim_Finale do
			rendu[i,j]:=' ';
	//On met des M sur la premiere et derniere ligne
	For i := 1 to dim_Finale do
		rendu[1,i]:= 'M';
	For i := 1 to dim_Finale do
		rendu[dim_Finale,i]:= 'M';
	//On met des M sur la premiere colonne et derniere colonne.
	For i := 1 to dim_Finale do
		begin
		rendu[i,1]:= 'M';
		rendu[i,dim_Finale]:= 'M';
		end;
	// On met les murs la ou ils doivent etre en sachant que la dimension finale va etre multipliée par 2 puis additionée à 1.
	For i := 0 To dim_x-2 do
		Begin
		For j := 0 To dim_y-1 do
			If (MV[i,j] = 1) Then
				Begin
				rendu[2*(i+1)+1,j*2+1]:= 'M';
				rendu[2*(i+1)+1,j*2+2]:= 'M';
				rendu[2*(i+1)+1,j*2+3]:= 'M';
				End;
		End;
	For i := 0 To dim_x-1 do
		Begin
		For j := 0 To dim_y-2 do
			If (MH[i,j] = 1) Then
				Begin
				rendu[i*2+1,(j+1)*2+1]:= 'M';
				rendu[i*2+2,(j+1)*2+1]:= 'M';
				rendu[i*2+3,(j+1)*2+1]:= 'M';
				End;
		End;
	//On met l'entrée et la sortie sur les cotés du labyrinthe ou on est sur qu'il n'y a aucun mur devant.
	rendu[(random(dim_Finale div 2)+1)*2,1]:='E';
	rendu[(random(dim_Finale div 2)+1)*2,dim_Finale]:='S';

	//On ecrit le fichier
	assign (fichier,outpout);
	rewrite(fichier);

	For i := 1 To dim_Finale do
		Begin
		For j := 1 To dim_Finale do
			Write(fichier,rendu[i,j]);
		Writeln(fichier,'');
		End;
	close(fichier);
End;

{========================= Debut de declarations des menus ==============================}

procedure presentation;
begin
  textcolor(10);gotoxy(17,2);write('TP :');
  textcolor(11);gotoxy(26,2);writeln('Recherche de la sortie d''un labyrinthe ');
  textcolor(15);
  writeln;
  writeln('          ÉÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ»');
  writeln('          º                                                  º');
  writeln('          º             Sauvons la loutre !                  º');
  writeln('          º                                                  º');
  writeln('          º                                                  º');
  writeln('          º                                                  º');
  writeln('          º                                                  º');
  writeln('          º                                                  º');
  writeln('          º                R&#8218;alis&#8218; par:                      º');
  writeln('          º              V.Bavasso                           º');
  writeln('          º              C.L''heritier                        º');
  writeln('          º              T.Malossane                         º');
  writeln('          º              V.Marcan-Dumesnil                   º');
  writeln('          º                                                  º');
  writeln('          º                                                  º');
  writeln('          º                                                  º');
  writeln('          º                                                  º');
  writeln('          º          1ere Ann&#8218;e Insa Lyon PCC                º');
  writeln('          º                                                  º');
  writeln('          ÈÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ&#188;');
  writeln;
  textcolor(14);writeln('                          APPUYEZ SUR ENTRER...');
  readln;
end;

procedure ecran_0;
begin
  clrscr; // On efface l'ecran
  textcolor(15);
  writeln;
  writeln('          ÉÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ»');
  writeln('          º                                                  º');
  writeln('          º     Ci-dessous se trouve le labyrinthe           º');
  writeln('          º           diabolique : Aidons la loutre!         º');
  writeln('          º                                                  º');
  writeln('          º  Appuyez sur entrer pour faire sortir la loutre  º');
  writeln('          ÈÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ&#188;');
  writeln;
end;

procedure ecran_1;
begin
  clrscr; // On efface l'ecran
  textcolor(15);
  writeln;
  writeln('          ÉÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ»');
  writeln('          º                                                  º');
  writeln('          º     Felicitations, vous avez sauv&#8218;               º');
  writeln('          º           notre chere loutre, alors...           º');
  writeln('          º                                                  º');
  writeln('          º  ...a bientot pour de nouvelles aventures !      º');
  writeln('          ÈÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ&#188;');
  writeln;
  Readln();
end;

procedure ecran_2;
begin
  clrscr; // On efface l'ecran
  textcolor(15);
  writeln;
  writeln('          ÉÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ»');
  writeln('          º                                                  º');
  writeln('          º     Helas, il n''y avait aucune solution  ...     º');
  writeln('          º           notre loutre est perdue a tout jamais  º');
  writeln('          º                                                  º');
  writeln('          º  Soyez gentil avec elle : Creez une sortie!      º');
  writeln('          ÈÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ&#188;');
  writeln;
  Readln();
end;

procedure menu_principal;
begin
  clrscr;
  textcolor(15);
  writeln;
  writeln;
  writeln;
  textcolor(11);gotoxy(28,3);writeln('Choix du labyrinthe');
  textcolor(15);
  writeln('          ÉÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ»');
  writeln('          º    1. Utiliser un labyrinthe d&#8218;ja cr&#8218;&#8218;           º');
  writeln('          º    2. Utiliser votre propre labyrinthe           º');
  writeln('          º    3. Generer un labyrinthe al&#8218;atoire de  9x9    º');
  writeln('          º    4. Generer un labyrinthe al&#8218;atoire de 15x15   º');
  writeln('          º    5. Generer un labyrinthe al&#8218;atoire de 25x25   º');
  writeln('          º    6. Generer un labyrinthe al&#8218;atoire de 57x57   º');
  writeln('          º    7. Quitter.                                   º');
  writeln('          ÈÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ&#188;');
  writeln;
  textcolor(10);
  write('                Faites votre choix :');
end;

procedure menu_1;
begin
  clrscr;
  writeln;
  writeln;
  writeln;
  textcolor(11);gotoxy(25,3);writeln('Veuillez choisir votre labyrinthe');
  textcolor(15);
  writeln('     ---------------------------------------------------------------');
  writeln('    |  Ce logiciel contient 10 labyrinthes enregistr&#8218;s              |');
  writeln('    |  Vous pouvez en choisir un au choix                           |');
  writeln('    |                                                               |');
  writeln('    |  Veuillez entrer un num&#8218;ro compris entre 1 et 10              |');
  writeln('     ---------------------------------------------------------------');
  writeln;
  textcolor(10);
  write('                Entrez votre num&#8218;ro :');
end;

procedure menu_2;
begin
  clrscr;
  writeln;
  writeln;
  writeln;
  textcolor(11);gotoxy(25,3);writeln('Veuillez choisir votre labyrinthe');
  textcolor(15);
  writeln('     ---------------------------------------------------------------');
  writeln('    |  Vous devez entrer le nom de votre labyrinthe.                |');
  writeln('    |  Il doit etre dans le meme dossier que ce programme.          |');
  writeln('    |  Rentrez sous la forme : ''labyrinthe_test.txt''                |');
  writeln('    |                                                               |');
  writeln('    |  Veuillez entrer votre nom de fichier ci-dessous              |');
  writeln('     ---------------------------------------------------------------');
  writeln;
  textcolor(10);
  write('                Entrez votre num&#8218;ro :');
end;

{========================= Debut du programme Principal ==============================}

Var main,main_sauv: t_lab ;// Declaration variable contenant les infos labyrinthe, main_sauv est la version qui ne sera pas modifiée par get_chemin()
    loutre:t_loutre; // Variable qui contiendra le chemin de la loutre
	fichier : string;
	choix:integer;
	num:char;
	str:string;

BEGIN
	initialise(loutre); // On vide toutes les arrays de la loutre
	presentation();
	menu_principal();
	readln(choix);
	Case choix of
	1 : Begin
		menu_1();
		Readln(num);
		fichier := Concat('labyrinthe',num,'.txt'); // On concatene les strings avec le numéro rentré par la personne
		End;
	2:
		Begin
		menu_2();
		Readln(str);
		fichier := str; // On concatene les strings avec le numéro rentré par la personne
		End;
	3:
		Begin
			fichier := 'labyrinthe_alea.txt';
			generer_lab(fichier,4);
		End;
	4:
		Begin
			fichier := 'labyrinthe_alea.txt';
			generer_lab(fichier,7);
		End;
	5:
		Begin
			fichier := 'labyrinthe_alea.txt';
			generer_lab(fichier,12);
		End;
	6:
		Begin
			fichier := 'labyrinthe_alea.txt';
			generer_lab(fichier,28);
		End;
	End;
	If choix <> 7 Then
		Begin
		get_data(fichier,main); // On recupere le labyrinthe
		main_sauv:= main;
		ecran_0();
		affichage(main_sauv); // On affiche le labyrinthe
		Readln();
		get_chemin(main,loutre); // On trouve la sortie
		If loutre.nb_noeuds >= 0 Then // Sortie trouvée
			Begin
			afficher_sortie(main_sauv,loutre); // On affiche la sortie
			ecran_1();
			End
		Else
			ecran_2();
	End;
END.

Conclusion :


Alors...
Avez vous sauvé la loutre?

Codes Sources

A voir également

Ajouter un commentaire Commentaires
Messages postés
7
Date d'inscription
mercredi 28 septembre 2005
Statut
Membre
Dernière intervention
7 août 2011

Pas mal du tout ;)
Mais pour l'instant je reste sous Autoit qui reste beaucoup plus simple tout en offrant des possibilités infinies (Labyrinthe en Autoit ici si vous voulez voir à quoi ca ressemble http://www.siteduzero.com/concours-657-595-laby-etages.html)
La fonction de generation du labyrinthe a été adaptée directement à partir de ce programme.
Messages postés
63
Date d'inscription
lundi 31 mars 2008
Statut
Membre
Dernière intervention
3 mai 2010

ce programme ne se compile pas sur Delphi 7 AMIGA68!!
c'est un programme fait en pascal avec FreePascal.
Pour pouvoir le compiler sous Delphi, il faudra eventuellement le transformer: d'oú ma proposition ci-dessus.

T'inquiète, je travaille dessus pour montrer à Timmalos à quoi ca pourrait ressembler!
Messages postés
7
Date d'inscription
mercredi 28 septembre 2005
Statut
Membre
Dernière intervention
7 août 2011

Je n'en ai aucune idée désolé

Si tu es sous Windows et que tu cherches juste a te faire une idée tu peux utiliser le lien que j'ai mis dans la presentation (http://malossane.fr/usb-file-474.html)
Il contient un exécutable certifié sans virus de mon coté, et le site de dépôt m'appartient donc pas de soucis ;), qui peut te permettre de voir à quoi ressemble le programme.
Messages postés
54
Date d'inscription
dimanche 23 février 2003
Statut
Membre
Dernière intervention
21 décembre 2009

hum...
Chuis bête ou flemmard ?

Comment compiler tout ça sous Delphi 7 perso ?
Messages postés
7
Date d'inscription
mercredi 28 septembre 2005
Statut
Membre
Dernière intervention
7 août 2011

Merci a tous pour vos commentaires ;)

J'essaierai de continuer ce programme après mes partiels, puisque vous y tenez tant !
Afficher les 13 commentaires

Vous n'êtes pas encore membre ?

inscrivez-vous, c'est gratuit et ça prend moins d'une minute !

Les membres obtiennent plus de réponses que les utilisateurs anonymes.

Le fait d'être membre vous permet d'avoir un suivi détaillé de vos demandes et codes sources.

Le fait d'être membre vous permet d'avoir des options supplémentaires.