[lazarus] jeux/labyrinthe : generation et résolution
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
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)
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
- [lazarus] jeux/labyrinthe : generation et résolution
- Score jeux flash ✓ - Forum Flash
- Générateur de labyrinthe - Forum C
- Jeux flash multijoueur ✓ - Forum C / C++ / C++.NET
- Jeux de devinette - Forum PHP
- Jeux de grattage gratuit - Forum Flash
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.