Forum Liberty Basic France

Général » Labyrhinte générateur de labyrhinte
Le 24/03/2014 à 17h10

Libertynaute Débutant

Groupe: Membre

Inscrit le: 03/08/2013
Messages: 16
J'ai trouvé sur le net une façon de créer un labyrhinte
Tout d'abord on remplie le tableau avec -1 , ensuite à l'interieur
du cadre c'est a dire de 1 à taille -1 puisque le tableau démarre à 0
calcul du nombre de portes à ouvrir { nb=cote*cote/4 : porte=nb-1 } *(1)

En parcourant le tableau k(x,y) , chaque fois que x et y sont impairs
on note 1 pour le 1er 2 pour le suivant etc....;toutes ces cases numerotées
sont intouchables ,donc nous avons nb cases isolées
il ne nous reste plus qu'a ouvrir une porte entre 2 cases numerotée
jusqu'à ce que toutes soit réunies mais une seule fois d'ou la valeur nb *(1)

j'ai fais pas mal d'essais et de temps en temps il bloque , si quelqu'un a une idée
je serais ravi de comprendre ce qui ce passe merci d'avance

Code VB :
 
 
rem d'apres Roger 2 givry
cote=40:k=(cote+10)*10          'cote toujours un chifre pair
WindowWidth =k
WindowHeight=k
UpperLeftX = 750                'modifier selon l'écran
UpperLeftY = 10
xe=int(rnd(1)*cote-6)+2 or 1    'entrée
xs=cote-xe                      'sortie
on error goto [q]
 
nomainwin
open "" for graphics_nsb as #g
#g, "trapclose [q]"
#g, "down"
#g, "backcolor black  ; boxfilled ";cote*k;" ";cote*k;"; color white; set ";x;" ";y;"; flush"
dim k(cote,cote)'-init Cadre plus entrée /  sortie
for y=0 to cote step 2
    for x=0 to cote
    k(x,y)=-1 : k(y,x)=-1
    next
    k(xs,0)=0:k(xe,cote)=0
next
n=0
for y=1 to cote-1 step 2
    for x=1 to cote-1 step 2
    k(x,y)=n:n=n+1
    next
next
'----------------------------
nb=cote*cote/4
porte=nb-1
REM choix d"une  case -1
[repet]
x=int(rnd(1)*(cote-1))+1:y=int(rnd(1)*(cote-1))+1
if not((x+y) and 1) or k(x,y)>=0 then [repet]
if y and 1 then [sens2]'else improbable !?
if x and 1 then v1=k(x,y-1):v2=k(x,y+1)
if v1=v2 then [repet]
k(x,y-1)=v1:k(x,y+1)=v1:k(x,y)=0:porte=porte-1:goto[scane]'propage !
[sens2]
if y and 1 then v1=k(x-1,y):v2=k(x+1,y)
if v1=v2 then [repet]
k(x-1,y)=v1:k(x+1,y)=v1:k(x,y)=v1:porte=porte-1:goto[scane]
[suivant]
if porte>0 then [repet]
goto [terminus]
[scane] '.............................................indispensable !
for i=1 to cote-1 step 2
for j=1 to cote-1 step 2
if k(i,j)=v2 then k(i,j)=v1
next:next
goto [suivant]
 
[terminus]
 
gosub[renum]
gosub[afficheG]
'gosub[affiche]
#g, "getbmp labyGraph 0 0 ";k;" ";k
bmpsave "labyGraph", "labyGraph.bmp"
[fin]
wait
[q]
close #g
end
'----------------------------------------
[affiche]
gx=3:gy=2
for y=0 to cote
    for x=0 to cote
    locate (x*gx+4),(y*gy+2)
    print  k(x,y)
    next
next
 
return
[afficheG]
rem 1=mur
longx=10 :longy=longx
gap=25 'decallage
#g, "color white; size 3";      'darkgray n'en veut pas ?
for y=0 to cote
    for x=1 to cote
 
    if k(x-1,y)and 1 and k(x,y)and 1 then
     x1=(x-1)*longx:y1=y*longy
    x2=x*longx
    #g,"line ";x1+gap;" "; y1+gap;" "; x2+gap;" "; y1+gap ;
    end if
    next x
next y
 
for x=0 to cote
    for y=1 to cote
    if k(x,y-1)and 1 and k(x,y)and 1 then
    y1=(y-1)*longy:x1=x*longx
    y2=y*longy
    #g,"line ";x1+gap;" "; y1+gap;" "; x1+gap;" ";y2+gap
    end if
    next
next
#g,"flush";
return
 
[renum]
 
for x=0 to cote
  for y=0 to cote
  if k(x,y)>0 then k(x,y)=0
 next
next
return
 
REM une fois renum executé on peu afficher
REM le tableau sous forme 0 et -1
____________________
Les programmes les plus court sont les meilleurs

Web    
Le 24/03/2014 à 17h46

Administrateur

Groupe: Administrateur

Inscrit le: 24/09/2010
Messages: 238
Très belle réalisation (tout comme les tours de Hanoi) même si je n'ai pas encore eu le temps de jeter un oeil sur le code ! :)
____________________

MSN Yahoo Web    
Le 24/03/2014 à 18h51

Administrateur

Groupe: Administrateur

Inscrit le: 25/09/2010
Messages: 361
Pas mal.
Il ne le résous pas par contre ;)
____________________
J'ai toujours raison ! Sauf quand j'ai tort ...

Web    
Le 24/03/2014 à 19h17

Libertynaute Débutant

Groupe: Membre

Inscrit le: 03/08/2013
Messages: 16
qui ne résout pas tout ?
le labyrinthe ou les tours !
____________________
Les programmes les plus court sont les meilleurs

Web    
Le 24/03/2014 à 20h29

Administrateur

Groupe: Administrateur

Inscrit le: 25/09/2010
Messages: 361
Bah il ne trace pas le chemin en rouge entre l'entrée et la sortie ;)
____________________
J'ai toujours raison ! Sauf quand j'ai tort ...

Web    
Le 25/03/2014 à 19h02

Libertynaute Débutant

Groupe: Membre

Inscrit le: 03/08/2013
Messages: 16
Salut Jagang , et puis quoi encore ,c'est un jeu et dans un jeu on ne donne pas la réponse
et la tu as tort :heink
____________________
Les programmes les plus court sont les meilleurs

Web    
Le 25/03/2014 à 23h04

Administrateur

Groupe: Administrateur

Inscrit le: 25/09/2010
Messages: 361
Comment ça j'ai tort :p
Je vais regarder ça pour qu'il me trouve la réponse. Et de surcroît, je vais pas utiliser A* ;)

Jag


PS : Il faut que je trouve un créneau dans mon emploi du temps pour coder par contre ;)
____________________
J'ai toujours raison ! Sauf quand j'ai tort ...

Web    
Général » Labyrhinte générateur de labyrhinte  

 |  |

1 Utilisateur en ligne : 0 Administrateur, 0 Modérateur, 0 Membre et 1 Visiteur
Utilisateur en ligne : Aucun membre connecté
Répondre
Vous n'êtes pas autorisé à écrire dans cette catégorie