[lazarus] jeux/labyrinthe : generation et résolution

Soyez le premier à donner votre avis sur cette source.

Vue 7 501 fois - Téléchargée 763 fois

Description

Bonjour à tous. Dans le cadre de ma deuxième année à l' INSA de Lyon, j'ai été amené à créé un programme avec lazarus. Je vous propose la suite de ce programme que j'avais écris en Pascal en console : http://www.delphifr.com/codes/GENERATION-RECHERCHE-SORTIE-LABYRINTHE_51844.aspx

Je l'ai doté d'une GUI avec l'utilisation de Lazarus. Il a été compilé avec succès sous Windows, certaines fonctionnalités sont désactivées sous Linux (Dont le mode multi-joueur)

Au niveau des algorithmes, ça n'a pas changé, j'utilise la méthode exhaustive pour la génération du labyrinthe et A* pour la recherche de sortie.

J'utilise une bibliothèque externe synaps pour le mode multi-joueur.
Plus d'informations sont disponibles sur le fichier .pdf disponible ici : http://lazarus.malossane.fr/amazeing.pdf

Plus d'informations (anglais) :

/$$ /$$ /$$$$$$ /$$$$$$$$ /$$$$$$$$ /$$
| $$$ /$$$ /$$__ $$|_____ $$ | $$_____/|__/
/$$$$$$ | $$$$ /$$$$| $$ \ $$ /$$/ | $$ /$$ /$$$$$$$ /$$$$$$
|____ $$| $$ $$/$$ $$| $$$$$$$$ /$$/ | $$$$$ | $$| $$__ $$ /$$__ $$
/$$$$$$$| $$ $$$| $$| $$__ $$ /$$/ | $$__/ | $$| $$ \ $$| $$ \ $$
/$$__ $$| $$\ $ | $$| $$ | $$ /$$/ | $$ | $$| $$ | $$| $$ | $$
| $$$$$$$| $$ \/ | $$| $$ | $$ /$$$$$$$$| $$$$$$$$| $$| $$ | $$| $$$$$$$
\_______/|__/ |__/|__/ |__/|________/|________/|__/|__/ |__/ \____ $$
/$$ \ $$
| $$$$$$/
\______/
This program has been written by:
Timothée Malossane

For INSA LYON Project. Licence : GPL/LGPL
Written with Lazarus O.9.28.2 and compiled with FPC 2.2.4

The project can be compiled on Windows XP/Vista/Seven and Linux.
It has not been tested for Mac and some optimizations will be necessary
to be fully functionnal on Linux.

You can see Screenshots of our project on the Web page
http://lazarus.malossane.fr
You can download our project (Files and Installer for Windows) on
http://lazarus.malossane.fr

Some functionnalities of our projet can't be loaded on Linux, that is why the
online mode doesn't function on linux.

One Externe Library has been used : Synapse that you can download at
http://www.ararat.cz/synapse/doku.php/start

Source / Exemple :


unit ulabyrinthe;
{$mode objfpc}{$H+}
interface
uses
   LCLIntf, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, Buttons,
  ExtCtrls, LResources, Menus,UPersonnage; // Perso

Const dim_X_max = 200; // Dimension X Max de la matrice
      dim_Y_max = 200; // Dimension Y Max de la matrice
      dim_gen_max = 100; // Dimension pour la generation Max de la matrice
      dim_C_max = 500; // Dimension pour la recherche de chemin
      LF=chr(10);
      IMAGE_CAROTTE = 'data/carotte.bmp';
      IMAGE_ETOILE = 'data/etoile.bmp';
Type t_gen = array[0..dim_gen_max,0..dim_gen_max] of integer; // Type utilisé pour le générateur
     t_gen_final = array[0..(1+2*dim_gen_max),0..(1+2*dim_gen_max)] of char; // Idem

     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 CLabyrinthe = Class
  protected
    //Variables Labyrinthes
    table : array[1..dim_X_max,1..dim_Y_max] of char ;
    position_X,position_Y : integer;
    position_X_loup,position_Y_loup : integer;
    dimension_X,dimension_Y : integer ;
    pos_entree_X,pos_entree_Y,pos_sortie_X,pos_sortie_Y : integer ;
    //Variables Visuelles
    joueur : CPersonnage;
    imagecanvas, imagecanvas_joueur,imagecanvas_loup : tImage;
     //Variables Recherche de sortie
    chemin : array[0..dim_C_max,1..2] of integer ;
    noeuds : array[1..dim_C_max,1..3] of integer ;
    etape,nb_noeuds : integer;

    //Procedures et fonctions pour la recherche de sortie
    Procedure NettoieCellules(var alab:t_gen; ax2, ay2, adim_x, adim_y, av1, av2:integer);
    Procedure Draw(i,j:integer);
    Function  Analyse(i,j:integer):integer;
    function minimum(var x,y:Integer):Integer;
    function heuristique(point1,point2:array of integer):t_point;
    function get_nb_chemins(f_x,f_y:integer):t_array;
    function get_last_noeud():t_point;
    procedure get_chemin(pos_deb_x,pos_deb_y,pos_fin_x,pos_fin_Y:integer);
    Procedure IA_DrawLoup(i,j:integer);

    //Procedures et fonctions concernant le labrinthe
     Procedure GenererLab(aoutpout:string;adimx,adimy:integer);
     Procedure OuvrirLab(aoutpout:string);
     Procedure Generate();virtual;
     Procedure insert_bonus(number_carotte:integer = 6;number_loup:integer = 3);
  public
     Constructor Create(aImage:TImage;aOutPout:string = '';adim:integer = 0;adimy:integer = 0);
     Destructor Destroy ();override;
     Procedure assign_player(aImg:TImage;aJoueur:CPersonnage);

     function Move(aAction:string):integer;
     Procedure IA_LancerLoup(aImg:TImage);
     Function IA_MoveLoup():integer;
     Function IA_Move():integer;
     Procedure EraseCase();
End;

implementation
{Constructeur/Destructeur}
Constructor CLabyrinthe.Create(aImage:TImage;aOutPout:string = '';adim:integer = 0;adimy:integer = 0);
Begin
     If (aOutPout = '') Then aOutPout:= 'aleatoire';
     If ((adim <> 0) AND (adimy = 0)) Then adimy := adim; //Si dimY pas rensigné, Matrice carrée
     If   ((not FileExists(aOutPout)) or (adim <>  0)) Then   Begin //Si admin est renseigné, on Reecrit le Maze
          GenererLab(aOutPout,adim,adimy);
     end;

     OuvrirLab(aOutPout);

     imagecanvas := aImage;
     imagecanvas.show;

     imagecanvas_joueur := NIL;
     imagecanvas_loup := NIL;
     Generate;

End;
Destructor CLabyrinthe.Destroy ();

Begin
   joueur.Destroy;
   imagecanvas.Hide;
   Inherited;
end;

{Procedures d'Affichage/Démarrage du labyrinthe}
Procedure CLabyrinthe.assign_player(aImg:TImage;aJoueur:CPersonnage);
var bmp : TBitMap;
Begin
     joueur := aJoueur;
     imagecanvas_joueur := aImg;
     imagecanvas_joueur.show;
     bmp := TBitMap.Create;
     bmp.LoadFromFile(joueur.image);
     imagecanvas_joueur.Canvas.Draw(0,0, bmp);
     draw(pos_entree_X,pos_entree_Y);
     bmp.free;
end;
Procedure CLabyrinthe.insert_bonus(number_carotte:integer = 6;number_loup:integer = 3);
var bmp : TBitMap;
var i,x,y:integer;
Begin
     randomize;
     bmp := TBitMap.Create;
     bmp.LoadFromFile(IMAGE_CAROTTE);
     for i := 1 to (number_carotte) do  begin
          x := 0; y := 0;
          While (table[x,y] <> ' ') do begin
               x := random(dimension_X);
               y := random(dimension_Y);
          end;
          imagecanvas.Canvas.Draw((x-1)*15,(y-1)*15, bmp);
          table[x,y] := 'L'
     End;

     bmp.free;
     bmp := TBitMap.Create;
     bmp.LoadFromFile(IMAGE_ETOILE);
     for i := 1 to number_loup do  begin
          x := 0; y := 0;
          While (table[x,y] <> ' ') do begin
               x := random(dimension_X);
               y := random(dimension_Y);
          end;
          imagecanvas.Canvas.Draw((x-1)*15,(y-1)*15, bmp);
          table[x,y] := 'B'
     End;
     bmp.free;
end;
Procedure CLabyrinthe.OuvrirLab(aoutpout:string);
var sauv_j,i,j:integer;
	car:char;
	fichier:text;
begin
		assign(fichier,aoutpout);
		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
					table[j,i] := car;
					j:=j+1;
					Case car  Of
					  'D','E':  begin pos_entree_X :=j-1;pos_entree_Y :=i; end;
					  'S':  begin pos_sortie_X:=j-1;pos_sortie_Y :=i; end;
					End;
				End;
			end;
		dimension_X:=sauv_j;
		dimension_Y:=i;
                position_X := pos_entree_X;
                position_Y := pos_entree_Y;
                Close(fichier);
end;
Procedure CLabyrinthe.Generate();
var aBmp,aBmp1,aBmp2 : TBitMap; i,j:integer;
Begin
   // aImage.Canvas.Draw(1,1);

    imagecanvas.Canvas.Brush.Color := ClWhite;
   imagecanvas.Canvas.FillRect(0,0,imagecanvas.Width, imagecanvas.Height);

      abmp := TBitMap.Create;
     abmp.LoadFromFile('data/mur.bmp');

    abmp1 := TBitMap.Create;
     abmp1.LoadFromFile('data/depart.bmp');

     abmp2 := TBitMap.Create;
     abmp2.LoadFromFile('data/objectif.bmp');

   for j:=1 to dimension_Y do
		begin
			for i:=1 to dimension_X do begin
				Case table[i,j] of
				'E','D' : imagecanvas.Canvas.Draw((i-1)*15, (j-1)*15, abmp1);
				'S' : imagecanvas.Canvas.Draw((i-1)*15, (j-1)*15, abmp2);
				'M' : imagecanvas.Canvas.Draw((i-1)*15, (j-1)*15, abmp);
				//Else write(board.table[i,j]);
				End;
                                //imagecanvas.Refresh;
                         end;
	end;
      abmp.Free; // Release allocated resource
      abmp1.Free; // Release allocated resource
      abmp2.Free; // Release allocated resource
End;

{Procedures d'Analyses de l'etat de la partie}
Procedure CLabyrinthe.EraseCase();
Begin
   table[position_X,position_Y] := ' ';
   imagecanvas.Canvas.FillRect((position_X-1)*15,(position_Y-1)*15,(position_X)*15,(position_Y)*15);
end;

Function  CLabyrinthe.Move(aAction:string) : integer;
Begin
     result := 0;
     If (aAction = 'up') AND (analyse(position_X,position_Y-1) = 0) Then Begin
         position_y := position_y -1;   end
    Else If  (aAction = 'down') AND (analyse(position_X,position_Y+1) = 0)Then begin
         position_y := position_y +1;   end
    Else If  (aAction = 'left')AND (analyse(position_X-1,position_Y) = 0)AND (position_X > 1) Then  begin
         position_X := position_X -1;  end
    Else If  (aAction = 'right') AND (analyse(position_X+1,position_Y) = 0) AND (position_X < dimension_X)Then begin
         position_X := position_X +1;   end;

    draw(position_X,position_Y);
     Case table[position_x,position_y] of
     'S': result := 1;
     'L': result := 2;
     'B': result := 3;
     end;
end;
Procedure CLabyrinthe.Draw(i,j:integer);
var u : integer;
Begin
     imagecanvas_joueur.Left := imagecanvas.Left+(i-1)*15;
     imagecanvas_joueur.Top := imagecanvas.Top+(j-1)*15;

End;
function  CLabyrinthe.Analyse(i,j:integer):integer;

Begin
    If (table[i,j] = 'M') Then
       result := 1
    Else
        result:=0;
End;

{Procedures d'IA}
Procedure CLabyrinthe.IA_LancerLoup(aImg:TImage);
var bmp : TBitMap;
Begin
     imagecanvas_loup := aImg;
     imagecanvas_loup.Show;
     bmp := TBitMap.Create;
     bmp.LoadFromFile('data/loup.bmp');
     imagecanvas_loup.Canvas.Draw(0,0, bmp);
     IA_DrawLoup(pos_entree_X,pos_entree_Y);
     bmp.free;
     position_X_loup:= pos_entree_X;
     position_Y_loup:= pos_entree_Y;
end;
Procedure CLabyrinthe.IA_DrawLoup(i,j:integer);
Begin
    imagecanvas_loup.Left := imagecanvas.Left+(i-1)*15;
    imagecanvas_loup.Top := imagecanvas.Top+(j-1)*15;
End;
Function CLabyrinthe.IA_MoveLoup():integer;
Begin
    get_chemin(position_X_loup,position_Y_loup,position_X,position_Y);
    position_X_loup:= chemin[1,1];
    position_Y_loup:= chemin[1,2];
    IA_DrawLoup(chemin[1,1],chemin[1,2]);
    result := 0;
    If (position_X = position_X_loup) AND (position_Y = position_Y_loup) Then Begin
       result := 1;  //Le loup a rattrapé le lapin
    end;
End;
Function CLabyrinthe.IA_Move():integer;
Begin
    get_chemin(position_X,position_Y,pos_sortie_X,pos_sortie_Y);
    position_X:= chemin[1,1];
    position_Y:= chemin[1,2];
    Draw(chemin[1,1],chemin[1,2]);
    result := 0;
    Case table[position_x,position_y] of
     'S': result := 1;
     'L': result := 2;
     'B': result := 3;
     end;
End;
{Procedures de recherche de sortie}
function CLabyrinthe.minimum(var x,y:Integer):Integer;
	begin
	  if x<y then minimum:=x
	  else minimum:=y;
end;
function CLabyrinthe.heuristique(point1,point2:array of integer):t_point;
	var p1, p2 : integer;
	begin
	p1 := ((point1[0]-pos_sortie_X)*(point1[0]-pos_sortie_X))+((point1[1]-pos_sortie_Y)*(point1[1]-pos_sortie_Y));
	p2 := ((point2[0]-pos_sortie_X)*(point2[0]-pos_sortie_X))+((point2[1]-pos_sortie_Y)*(point2[1]-pos_sortie_Y));
	If minimum(p1,p2) = p2 Then
		heuristique := point2
	Else
		heuristique := point1;
end;
function CLabyrinthe.get_nb_chemins(f_x,f_y:integer):t_array;
	var nb:integer;
	begin
	nb := 0;
	If (f_y> 1) and ((table[f_x, f_y-1] = ' ') OR (table[f_x, f_y-1] = 'S')OR (table[f_x, f_y-1] = 'L') OR (table[f_x, f_y-1] = 'B')) 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< dimension_Y) AND ((table[f_x, f_y+1] = ' ')OR (table[f_x, f_y+1] = 'S')OR (table[f_x, f_y+1] = 'L')OR (table[f_x, f_y+1] = 'B')) 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 ((table[f_x-1, f_y] = ' ')OR(table[f_x-1, f_y] = 'S')OR(table[f_x-1, f_y] = 'L') OR(table[f_x-1, f_y] = 'B')) 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< dimension_X) AND ((table[f_x+1, f_y] = ' ')OR(table[f_x+1, f_y] = 'S')OR(table[f_x+1, f_y] = 'L') OR(table[f_x+1, f_y] = 'B')) 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;
function CLabyrinthe.get_last_noeud():t_point;
	var i : integer;
	var res : t_point;
	begin
	i := 0;
		Repeat
			i := i + 1;
		until (noeuds[i][1] = 0);
		res[1] := noeuds[i-1,1];
		res[2] := noeuds[i-1,2];
		get_last_noeud := res;
end;
procedure CLabyrinthe.get_chemin(pos_deb_x,pos_deb_y,pos_fin_x,pos_fin_y:integer);
	var i,x,y:integer;
	var nb:t_array;point:t_point;
        var table_buffer : array[1..dim_X_max,1..dim_Y_max] of char ;// On va travailler sur une copie de la table
	begin
                For i := 1 to dim_C_max do
		Begin
		noeuds[i][1] := 0;
		noeuds[i][2] := 0;
		noeuds[i][3] := 0;
		chemin[i][1] := 0;
		chemin[i][2] := 0;
               	End;
                table_buffer := table; // On sauvegarde la table
                x := pos_deb_X;
		y := pos_deb_Y;
		etape := 0;
		nb_noeuds := 0;
		chemin[0,1] := x;
		chemin[0,2] := y;
                If (pos_fin_X = pos_deb_X) AND (pos_fin_Y = pos_deb_Y) Then Begin
                    chemin[1,1] := x;
	            chemin[1,2] := y;
                    etape := 1;
                end;

		While  ((x <> pos_fin_X)OR (y <> pos_fin_Y)) AND (nb_noeuds >= 0) do
		begin
			nb := get_nb_chemins(x,y);
			etape := etape + 1 ;
                        noeuds[nb_noeuds,3] := noeuds[nb_noeuds,3] + 1;

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

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

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

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

				//	Writeln('Loutre est à un noeud à x:',x,' y:',y);
					table[x,y] := '-';
					chemin[etape,1] := point[1];
					chemin[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.
					etape := etape-noeuds[nb_noeuds,3];
					noeuds[nb_noeuds,3] := 0;
					nb_noeuds := nb_noeuds - 1;
					noeuds[nb_noeuds,3] := noeuds[nb_noeuds,3]-1;
				end;

				1: begin
					If (x=noeuds[nb_noeuds+1,1]) AND (y=noeuds[nb_noeuds+1,2])Then
						Begin
						nb_noeuds := nb_noeuds + 1;
						noeuds[nb_noeuds,3] := noeuds[nb_noeuds,3]+1;
						End;
					//Writeln('1 Choix x:',nb[2,1],' y:',nb[2,2]);
					//Writeln('Loutre venant de x:',chemin[etape-1,1],' y:',chemin[etape-1,2]);
					chemin[etape,1] := nb[2,1];
					chemin[etape,2] := nb[2,2];
					table[x,y] := '-';
					x :=nb[2,1];
					y :=nb[2,2];
					//Writeln('Loutre allant à x:',x,' y:',y);
				end;
				2: begin
					nb_noeuds := nb_noeuds + 1;
					noeuds[nb_noeuds,1]:=x;
					noeuds[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]]);
					//	Writeln('Pos choisie x:',point[1],' y:',point[2]);
					chemin[etape,1] := point[1];
					chemin[etape,2] := point[2];
					noeuds[nb_noeuds,3] := noeuds[nb_noeuds,3] + 1;
					table[x,y] := '-';
					x :=point[1];
					y :=point[2];
				end;
				3: begin
					nb_noeuds := nb_noeuds + 1;
					noeuds[nb_noeuds,1]:=x;
					noeuds[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]]);
					point := heuristique([point[1],point[2]],[nb[4,1],nb[4,2]]);
					chemin[etape,1] := point[1];
					chemin[etape,2] := point[2];
					noeuds[nb_noeuds,3] := noeuds[nb_noeuds,3] + 1;
					table[x,y] := '-';
					x :=point[1];
					y :=point[2];
				end;
                                4: begin
					nb_noeuds := nb_noeuds + 1;
					noeuds[nb_noeuds,1]:=x;
					noeuds[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]]);
					point := heuristique([point[1],point[2]],[nb[4,1],nb[4,2]]);
                                        point := heuristique([point[1],point[2]],[nb[5,1],nb[5,2]]);
					chemin[etape,1] := point[1];
					chemin[etape,2] := point[2];
					noeuds[nb_noeuds,3] := noeuds[nb_noeuds,3] + 1;
					table[x,y] := '-';
					x :=point[1];
					y :=point[2];
				end;
			 End;
			//Writeln(etape,'|',nb_noeuds,'|',noeuds[nb_noeuds,3]);
			//Readln();
		 End;
                 table := table_buffer; // On remet la table en place
end;

{Procedures de Generation du Labyrinthe Aleatoire}
Procedure CLabyrinthe.NettoieCellules(var alab:t_gen; ax2, ay2, adim_x, adim_y, av1, av2:integer);
Begin
	alab[ax2,ay2] := av1;
	If (ax2 > 0) And (alab[ax2 - 1,ay2] = av2) Then
		NettoieCellules(alab, ax2 - 1, ay2, adim_x, adim_y, av1, av2);
	If (ax2 < adim_x-1) And (alab[ax2 + 1,ay2] = av2) Then
		NettoieCellules(alab, ax2 + 1, ay2, adim_x, adim_y, av1, av2);
	If (ay2 > 0) And (alab[ax2,ay2 - 1] = av2) Then
		NettoieCellules(alab, ax2, ay2 - 1, adim_X, adim_y, av1, av2);
	If (ay2 < adim_y-1) And (alab[ax2,ay2 + 1] = av2) Then
		NettoieCellules(alab, ax2, ay2 + 1, adim_x, adim_y, av1, av2);
End;
procedure CLabyrinthe.GenererLab(aoutpout:string;adimx,adimy:integer);
var lab : t_gen;
	dim_x,dim_y,dim_Finale_x,dim_Finale_y:integer;
	continue,rand,x1,x2,y1,y2,x,y:integer;
	v1,v2,NbMurs:integer;
	MH : t_gen;
	MV : t_gen;
	rendu : t_gen_final;
	fichier:text;
begin
        dim_x := adimx;
	dim_y := adimy;
	dim_Finale_X := 2*dim_x+1;
        dim_Finale_Y := 2*dim_y+1;
	randomize;
	NbMurs := 0;
	//Initialisation des tableaux de murs
         For x := 0 To dim_x-1 do
		For y := 0 To dim_y-1 do
			lab[x,y] := x * dim_y + y;

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

	For x := 0 To dim_x-2 do
		For y := 0 To dim_y-1 do
		    MV[x,y] := 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;

        {s := '';
        For i := 0 to dim_y-2 do
            s := s+FloatToStr(MH[dim_x-1][i])+'//';
        Showmessage(s);  }
	//Maintenant, on a 2 tableaux avec des murs horizontaux et verticaux, tres facile a utiliser.

        //On met des trous de partout
	For x := 0 To dim_Finale_X -1 do
		For y := 0 To dim_Finale_Y -1 do
			rendu[x,y]:=' ';
	//On met des M sur la premiere et derniere ligne
	For x := 0 to dim_Finale_X - 1 do begin
		rendu[x,0]:= 'M';
		rendu[x,dim_Finale_Y-1]:= 'M';
        End;
	//On met des M sur la premiere colonne et derniere colonne.
	For y := 0 to dim_Finale_Y-1 do
		begin
		rendu[0,y]:= 'M';
		rendu[dim_Finale_X-1,y]:= '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 x := 0 To dim_x-2 do
		Begin
		For y := 0 To dim_y-1 do
			If (MV[x,y] = 1) Then
				Begin
				rendu[2*(x+1),y*2+0]:= 'M';
				rendu[2*(x+1),y*2+1]:= 'M';
				rendu[2*(x+1),y*2+2]:= 'M';
                                //ShowMessage(FloatToStr(i)+'//'+FloatToStr(j)+'//'+rendu[2*(i+1)+1,j*2+1]+'//'+rendu[2*(i+1)+1,j*2+2]+'//'+rendu[2*(i+1)+1,j*2+3]+'//')
				End;
		End;
	For x := 0 To dim_x-1 do
		Begin
		For y := 0 To dim_y-2 do
			If (MH[x,y] = 1) Then
				Begin
			        rendu[x*2  ,(y+1)*2]:= 'M';
				rendu[x*2+1,(y+1)*2]:= 'M';
				rendu[x*2+2,(y+1)*2]:= 'M';
                                //ShowMessage(FloatToStr(i*2+1)+'//'+FloatToStr((j+1)*2+1)+'//'+FloatToStr(i)+'//')
				End;
		End;
	//On met l'entrée et la sortie sur les cotés du labyrinthe
	rendu[0,(random(dim_Finale_Y div 2)+1)*2-1]:='E';
	rendu[dim_Finale_X-1,(random(dim_Finale_Y div 2)+1)*2-1]:='S';
	//On ecrit le fichier
	assign (fichier,aoutpout);
	rewrite(fichier);

	For y := 0 To dim_Finale_Y-1 do
		Begin
		For x := 0 To dim_Finale_X-1 do
			Write(fichier,rendu[x,y]);
		Writeln(fichier,'');
		End;
	close(fichier);
End;
end.

Conclusion :


J'espère que ca pourra aider certaines personne devant faire un jeu avec Lazarus, notamment au niveau du scintillement des controles. (Pas d'anti-aliasing facile d'accès avec lazarus)

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

Pour obtenir l’exécutable, je vous conseille de télécharger l'installateur windows (Installe et désinstalle proprement, et contient les données audios et visuelles:
http://lazarus.malossane.fr/amazeing.exe
Messages postés
132
Date d'inscription
dimanche 29 octobre 2006
Statut
Membre
Dernière intervention
24 août 2020
2
Le programme a l'air très bien mais n'ayant pas Lazarus, je ne peux pas en juger. J'ai essayé de traduire en Delphi mais c'est impossible.

Ce serait sympa de mette l'exe dans le .zip. Attention, il faut le rebaptiser ( en .ex au lieu de .exe) sans quoi, le zip ne parviendra pas à destination.
Messages postés
19
Date d'inscription
jeudi 4 septembre 2008
Statut
Membre
Dernière intervention
28 juin 2013

Bonjour,

Je ne suis que dédutant, mais je viens d'acheter le livre de Matthieu Giroux et
je m'empresse d'exploiter votre réalisation.
Il y a souvent trop de critiques non constructives sur ce site , et je tiens à dire que la chose importante et constructive est l'endraide.

Encore merci pour le temps passé.

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.