Labyrinthes en mode console et screen (nouvelle version)

Vous débutez et vous avez besoin d'aide ? N'hésitez pas à poser vos questions
Avatar de l’utilisateur
Huitbit
Messages : 940
Inscription : jeu. 08/déc./2005 5:19
Localisation : Guadeloupe

Labyrinthes en mode console et screen (nouvelle version)

Message par Huitbit »

Image

Code : Tout sélectionner

;********************************************
;*labyrinthe en mode console simple(pas graphique)   *
;*purebasic version 4                                               *
;********************************************
;déclarations
Global  x_case.l, y_case.l, x_case_max.l, y_case_max.l, compteur_case_sol_visite.l , max_compteur_case_sol_visite.l,a.f,x_new.l,y_new.l
x_case_max=70 ;nombre pair obligatoirement
y_case_max=22 ;nombre pair obligatoirement
max_compteur_case_sol_visite=x_case_max*y_case_max*0.25
compteur_case_sol_visite=0
Enumeration
#case_mur
#case_sol
#case_sol_visite
#case_bordure
#entree
#sortie
EndEnumeration
Structure laby
valeur.b
tuile.s
EndStructure
Global Dim kaz.laby(x_case_max,y_case_max)
Global Dim memo_x_case.l(x_case_max,y_case_max)
Global Dim memo_y_case.l(x_case_max,y_case_max)
Global Dim nombre_possibilites.l(x_case_max,y_case_max)


Procedure.l initialisation()
;remplissage du tableau kaz(x_case,y_case)
For j=0 To y_case_max
    For i= 0 To x_case_max  
       If i % 2 = 1 And j % 2 = 1 
           kaz(i,j)\valeur=#case_sol
       ElseIf i=0 Or i=x_case_max Or j=0 Or j=y_case_max
           kaz(i,j)\valeur=#case_bordure
       Else     
           kaz(i,j)\valeur=#case_mur
       EndIf
    Next i
Next j
;choix d'une case de départ
Repeat
    x_case=1+Random(x_case_max-2)
    y_case=1+Random(y_case_max-2)
Until  x_case%2=1 And y_case%2=1 
 EndProcedure
 
 Procedure.l possibilite(xp.l,yp.l)
 nombre_possibilites(xp,yp)=0
If xp>0 And (yp-2)>0 And  xp<x_case_max And (yp-2)<y_case_max And kaz(xp,yp-2)\valeur=#case_sol
    nombre_possibilites(xp,yp)=nombre_possibilites(xp,yp)+1
EndIf 
If (xp+2)>0 And yp>0 And  (xp+2)<x_case_max And yp<y_case_max And kaz(xp+2,yp)\valeur=#case_sol
    nombre_possibilites(xp,yp)=nombre_possibilites(xp,yp)+1
EndIf 
If xp>0 And (yp+2)>0 And  xp<x_case_max And (yp+2)<y_case_max And kaz(xp,yp+2)\valeur=#case_sol
    nombre_possibilites(xp,yp)=nombre_possibilites(xp,yp)+1
EndIf 
If (xp-2)>0 And yp>0 And  (xp-2)<x_case_max And yp<y_case_max And kaz(xp-2,yp)\valeur=#case_sol
    nombre_possibilites(xp,yp)=nombre_possibilites(xp,yp)+1
EndIf 
 EndProcedure
 
Procedure.l construction(x.l,y.l)
If  memo_x_case(x,y)=0
    memo_x_case(x,y)=x
    memo_y_case(x,y)=y
    kaz(memo_x_case(x,y),memo_y_case(x,y))\valeur=#case_sol_visite
    compteur_case_sol_visite=compteur_case_sol_visite+1
EndIf
 x_new_old=memo_x_case(x,y)
 y_new_old=memo_y_case(x,y)
Repeat
    Repeat
        a=Random(3)*#PI*0.5 ;angle â choix de la direction du foret
        x_new=x_new_old+2*Cos(a)
        y_new=y_new_old+2*Cos(a+#PI/2)
    Until   x_new>0 And y_new>0 And x_new<x_case_max And y_new<y_case_max And kaz(x_new,y_new)\valeur=#case_sol
    kaz(x_new,y_new)\valeur=#case_sol_visite
    memo_x_case(x_new,y_new)=x_new
    memo_y_case(x_new,y_new)=y_new
    x_cloison.l=(x_new_old+x_new)*0.5
    y_cloison.l=(y_new_old+y_new)*0.5
    kaz(x_cloison,y_cloison)\valeur=#case_sol_visite
    compteur_case_sol_visite=compteur_case_sol_visite+1
    possibilite(x_new,y_new)
    x_new_old=x_new
    y_new_old=y_new
Until nombre_possibilites(x_new_old,y_new_old)=0
possibilite(memo_x_case(x,y),memo_y_case(x,y))
If nombre_possibilites(memo_x_case(x,y),memo_y_case(x,y))>0 
    construction(memo_x_case(x,y),memo_y_case(x,y)) 
EndIf
EndProcedure

;programme principal
initialisation()
Repeat
construction(x_case,y_case)
If compteur_case_sol_visite<>max_compteur_case_sol_visite
    Repeat
        x_case=1+Random(x_case_max-2)
        y_case=1+Random(y_case_max-2)
        possibilite(x_case,y_case )
    Until  x_case%2=1 And y_case%2=1    And  kaz(x_case,y_case)\valeur=#case_sol_visite And nombre_possibilites(x_case,y_case )>0
 EndIf
Until  compteur_case_sol_visite=max_compteur_case_sol_visite
;création de l'entrée et de la sortie
kaz(0,1+2*Random(y_case_max*0.5-1))\valeur=#entree
kaz(x_case_max,1+2*Random(y_case_max*0.5-1))\valeur=#sortie

OpenConsole()
Delay(1)
For j=0 To y_case_max
   For i= 0 To x_case_max
       Select kaz(i,j)\valeur
           Case #case_mur
           kaz(i,j)\tuile=Chr(219)  
           Case #case_sol
           kaz(i,j)\tuile=Chr(255) 
           Case #case_sol_visite
           kaz(i,j)\tuile=Chr(250) 
           Case #case_bordure
           kaz(i,j)\tuile=Chr(177) 
           Case #entree
           kaz(i,j)\tuile="E"
           Case #sortie
           kaz(i,j)\tuile="S"
       EndSelect
       Print(kaz(i,j)\tuile)
   Next i
   PrintN("")
Next j
Input()
CloseConsole()
End
Après avoir lu un article de wikipedia, j'ai voulu mettre ça en application!
Un labyrinthe vrai est un labyrinthe où toutes les cellules sont connectées.
Comme le mode console est tendance en ce moment, je l'ai utilisé pour visualiser le résultat :lol: ...
J'ai donc crée un bâtiment avec des pièces isolées(procedure initialisation), puis choisi une pièce de départ.
Ensuite je passe de pièces en pièces tant que c'est possible( procédure construction).
Quand ce n'est plus possible, je reviens à la pièce de départ(récursivité!), si ce n'est toujours pas possible, je me raccorde n'importe où sur un couloir(programme principal) et je continue.

Remarque:
je pense qu'on peut faire sans récursivité mais comme je trouve ça étonnant...
Si quelqu'un a déjà essayé, ça m'intèresse de voir un code "propre" et optimisé!
Pour changer les dimensions, il suffit de changer x_case_max et y_case_max(nombres pairs obligatoirement)

Question: j'utilise la procédure "possibilité" pour tester les pièces voisines, cette dernière me renvoie la variable "nombre_possibilites"
C'est un peu lourd :? Est-ce possible de ce débarrasser de cet intermédiaire?

Idée: quand la matrice est calculée, on peut mettre des tiles originaux pour faire des cartes de voeux! Comme ça si le texte est creux au recto, on s'amuse au verso :lol: !

Hasta la vista!

Encore félicitation à tous ceux qui postent régulièrement et qui assurent la longévité de ce forum! :BIG:
Dernière modification par Huitbit le dim. 11/févr./2007 5:04, modifié 2 fois.
Elevé au MSX !
tonton
Messages : 315
Inscription : mar. 26/avr./2005 15:19

Message par tonton »

pour trouver la sortie il suffit de suivre toujours le meme mur. 8)
Avatar de l’utilisateur
Huitbit
Messages : 940
Inscription : jeu. 08/déc./2005 5:19
Localisation : Guadeloupe

Elementaire mon cher Tonton....

Message par Huitbit »

Par contre, si je crée des îlots(voir wikipédia), ça craint pour Thésée, Ariane et le minotaure :lol: :lol:
Elevé au MSX !
Avatar de l’utilisateur
Huitbit
Messages : 940
Inscription : jeu. 08/déc./2005 5:19
Localisation : Guadeloupe

En attendant...

Message par Huitbit »

J'ai juste modifié l'openconsole, chargé 5 tiles(16*16 faites avec paint à la louche) et puis...run.
Y a pas à dire, quand ça tourne en mode console 8)
Je crois que je vais faire une version où on peut charger les tiles qu'on veut.
Je vais essayer de changer la forme extérieure du labyrinthe (pourquoi pas un coeur pour la St Valentin, vous savez le gros truc commercial qui arrive :lol: )

En 3D ça doit le faire aussi :roll: mais pour l'instant faut pas pousser mémé dans les orties :lol:

Image

Hasta la vista!
Elevé au MSX !
comtois
Messages : 5186
Inscription : mer. 21/janv./2004 17:48
Contact :

Message par comtois »

j'ai ajouté un personnage qui se déplace avec le curseur. En 3D faut prévoir des repères dans le laby (tableau , statues ,objets au sol, ou de quoi exploser les murs :)

Code : Tout sélectionner


;********************************************
;*labyrinthe en mode console simple(pas graphique)   *
;*purebasic version 4                                               *
;********************************************
;déclarations
Global  x_case.l, y_case.l, x_case_max.l, y_case_max.l, compteur_case_sol_visite.l , max_compteur_case_sol_visite.l,a.f,x_new.l,y_new.l
Define Touche$, Quitte.l,Player.POINT
x_case_max=70 ;nombre pair obligatoirement
y_case_max=22 ;nombre pair obligatoirement
max_compteur_case_sol_visite=x_case_max*y_case_max*0.25
compteur_case_sol_visite=0
Enumeration
#case_mur
#case_sol
#case_sol_visite
#case_bordure
#entree
#sortie
EndEnumeration
Enumeration
  #Haut
  #Bas
  #Gauche
  #Droit
EndEnumeration
Macro DeplacementOk(x,y)
  kaz(x,y)\tuile <> Chr(177) And kaz(x,y)\tuile <> Chr(219)
EndMacro

Structure laby
valeur.b
tuile.s
EndStructure
Global Dim kaz.laby(x_case_max,y_case_max)
Global Dim memo_x_case.l(x_case_max,y_case_max)
Global Dim memo_y_case.l(x_case_max,y_case_max)
Global Dim nombre_possibilites.l(x_case_max,y_case_max)


Procedure.l initialisation()
;remplissage du tableau kaz(x_case,y_case)
For j=0 To y_case_max
    For i= 0 To x_case_max
       If i % 2 = 1 And j % 2 = 1
           kaz(i,j)\valeur=#case_sol
       ElseIf i=0 Or i=x_case_max Or j=0 Or j=y_case_max
           kaz(i,j)\valeur=#case_bordure
       Else     
           kaz(i,j)\valeur=#case_mur
       EndIf
    Next i
Next j
;choix d'une case de départ
Repeat
    x_case=1+Random(x_case_max-2)
    y_case=1+Random(y_case_max-2)
Until  x_case%2=1 And y_case%2=1
 EndProcedure
 
 Procedure.l possibilite(xp.l,yp.l)
 nombre_possibilites(xp,yp)=0
If xp>0 And (yp-2)>0 And  xp<x_case_max And (yp-2)<y_case_max And kaz(xp,yp-2)\valeur=#case_sol
    nombre_possibilites(xp,yp)=nombre_possibilites(xp,yp)+1
EndIf
If (xp+2)>0 And yp>0 And  (xp+2)<x_case_max And yp<y_case_max And kaz(xp+2,yp)\valeur=#case_sol
    nombre_possibilites(xp,yp)=nombre_possibilites(xp,yp)+1
EndIf
If xp>0 And (yp+2)>0 And  xp<x_case_max And (yp+2)<y_case_max And kaz(xp,yp+2)\valeur=#case_sol
    nombre_possibilites(xp,yp)=nombre_possibilites(xp,yp)+1
EndIf
If (xp-2)>0 And yp>0 And  (xp-2)<x_case_max And yp<y_case_max And kaz(xp-2,yp)\valeur=#case_sol
    nombre_possibilites(xp,yp)=nombre_possibilites(xp,yp)+1
EndIf
 EndProcedure
 
Procedure.l construction(x.l,y.l)
If  memo_x_case(x,y)=0
    memo_x_case(x,y)=x
    memo_y_case(x,y)=y
    kaz(memo_x_case(x,y),memo_y_case(x,y))\valeur=#case_sol_visite
    compteur_case_sol_visite=compteur_case_sol_visite+1
EndIf
 x_new_old=memo_x_case(x,y)
 y_new_old=memo_y_case(x,y)
Repeat
    Repeat
        a=Random(3)*#PI*0.5 ;angle â choix de la direction du foret
        x_new=x_new_old+2*Cos(a)
        y_new=y_new_old+2*Cos(a+#PI/2)
    Until   x_new>0 And y_new>0 And x_new<x_case_max And y_new<y_case_max And kaz(x_new,y_new)\valeur=#case_sol
    kaz(x_new,y_new)\valeur=#case_sol_visite
    memo_x_case(x_new,y_new)=x_new
    memo_y_case(x_new,y_new)=y_new
    x_cloison.l=(x_new_old+x_new)*0.5
    y_cloison.l=(y_new_old+y_new)*0.5
    kaz(x_cloison,y_cloison)\valeur=#case_sol_visite
    compteur_case_sol_visite=compteur_case_sol_visite+1
    possibilite(x_new,y_new)
    x_new_old=x_new
    y_new_old=y_new
Until nombre_possibilites(x_new_old,y_new_old)=0
possibilite(memo_x_case(x,y),memo_y_case(x,y))
If nombre_possibilites(memo_x_case(x,y),memo_y_case(x,y))>0
    construction(memo_x_case(x,y),memo_y_case(x,y))
EndIf
EndProcedure

;programme principal
initialisation()
Repeat
construction(x_case,y_case)
If compteur_case_sol_visite<>max_compteur_case_sol_visite
    Repeat
        x_case=1+Random(x_case_max-2)
        y_case=1+Random(y_case_max-2)
        possibilite(x_case,y_case )
    Until  x_case%2=1 And y_case%2=1    And  kaz(x_case,y_case)\valeur=#case_sol_visite And nombre_possibilites(x_case,y_case )>0
 EndIf
Until  compteur_case_sol_visite=max_compteur_case_sol_visite
;création de l'entrée et de la sortie
kaz(0,1+2*Random(y_case_max*0.5-1))\valeur=#entree
kaz(x_case_max,1+2*Random(y_case_max*0.5-1))\valeur=#sortie

OpenConsole()
EnableGraphicalConsole(#True)
Delay(1)
For j=0 To y_case_max
   For i= 0 To x_case_max
       Select kaz(i,j)\valeur
           Case #case_mur
           ConsoleColor(1,15)
           kaz(i,j)\tuile=Chr(219)
           Case #case_sol
           ConsoleColor(15,15)
           kaz(i,j)\tuile=Chr(255)
           Case #case_sol_visite
           ConsoleColor(15,15)
           kaz(i,j)\tuile=Chr(250)
           Case #case_bordure
           ConsoleColor(1,15)
           kaz(i,j)\tuile=Chr(177)
           Case #entree
           ConsoleColor(4,15)
           kaz(i,j)\tuile="E"
           Player\x = i
           Player\y = j
           Case #sortie
           ConsoleColor(4,15)
           kaz(i,j)\tuile="S"
       EndSelect
       ConsoleLocate(i,j)
       
       Print(kaz(i,j)\tuile)
   Next i
   ;PrintN("")
Next j


Procedure MovePlayer(Sens,*P.Point)
  memx=*P\x
  memy=*P\y
  Select Sens
    Case #Haut
      If DeplacementOk(*P\x,*P\y-1) : *P\y-1 : EndIf
    Case #Bas
      If DeplacementOk(*P\x,*P\y+1) : *P\y+1 : EndIf
    Case #Gauche
      If (*P\x-1>=0) And DeplacementOk(*P\x-1,*P\y) : *P\x-1 : EndIf
    Case #Droit
      If (*P\x+1<=x_case_max) And DeplacementOk(*P\x+1,*P\y) : *P\x+1 : EndIf
  EndSelect 
  ConsoleLocate(memx,memy)
  Print(kaz(memx,memy)\Tuile)
  ConsoleLocate(*P\x,*P\y)
  Print("O") 
EndProcedure


  ConsoleLocate(Player\x,Player\y)
  ConsoleColor(4,15)
  Print("O") 
Repeat

Touche$ = Inkey()
 
  If RawKey()

    Select RawKey()

   
      Case 38 ; Touche Up
        MovePlayer(#Haut,@Player)

      Case 40 ; Touche Down
        MovePlayer(#Bas,@Player)
     
      Case 37 ; Touche Left
        MovePlayer(#Gauche,@Player)
             
      Case 39 ; Touche Right
        MovePlayer(#Droit,@Player)
             
    EndSelect   

  Else
    Delay(20) ; Evite de monopoliser tout le temps processeur. Utile pour un OS multi-tâches.
  EndIf

Until Touche$ = Chr(27) ; Attends jusqu'à ce que la touche [Echap] soit appuyée 
CloseConsole()
End
http://purebasic.developpez.com/
Je ne réponds à aucune question technique en PV, utilisez le forum, il est fait pour ça, et la réponse peut profiter à tous.
Avatar de l’utilisateur
Huitbit
Messages : 940
Inscription : jeu. 08/déc./2005 5:19
Localisation : Guadeloupe

Le labyrinthe masqué...

Message par Huitbit »

Attention Comtois, ça commence comme ça et ça finit sur un pathfinding :lol:

[EDIT]
Pour faire un labyrinthe masqué, se munir de tiles format png 16*16 et d'un masque en noir et blanc de taille 61*61 format png!
prévoir les images mur,sol,bordure,entree, sortie taille 16*16 et un masque noir et blanc 61*61
61*61 car c'est un laby de 63 cases sur 63
J'ai juste changé la procédure initialisation
J'utilise les fonctions point(x,y) et red() pour lire le masque.
IMPORTANT: c'est plus pratique de charger les images automatiquement, juste au début du code principal, il y a la marche à suivre :wink:
Ce n'est pas encore ce que je veux faire mais ça peut toujours intéresser quelqu'un!
J'espère :roll: dessiner le labyrinthe uniquement dans la partie blanche du masque (je pourrais effacer ce qui correspond à la partie noire du masque mais ce n'est plus un labyrinthe, juste des bouts de murs :cry: , en plus c'est pô bien de tricher :lol: )

Le masque
Image

Le labyrinthe masqué!
Image

Code : Tout sélectionner

;****************************************
;le labyrinthe masqué
; prévoir  images mur,sol,bordure,entree, sortie taille 16*16 et un masque noir et blanc 61*61
;PBv4.02
;****************************************

;déclarations
Global  x_case.l, y_case.l, x_case_max.l, y_case_max.l, compteur_case_sol_visite.l , max_compteur_case_sol_visite.l,a.f,x_new.l,y_new.l
x_case_max=62
y_case_max=62
max_compteur_case_sol_visite=x_case_max*y_case_max*0.25
compteur_case_sol_visite=0
Enumeration
#case_mur
#case_sol
#case_sol_visite
#case_bordure
#case_filtre
#entree
#sortie
#spr_mur
#spr_sol
#spr_bordure
#spr_entree 
#spr_sortie
#spr_final
#img_masque
EndEnumeration
Structure laby
valeur.b
tuile.s
EndStructure
Global Dim kaz.laby(x_case_max,y_case_max)
Global Dim memo_x_case.l(x_case_max,y_case_max)
Global Dim memo_y_case.l(x_case_max,y_case_max)
Global Dim nombre_possibilites.l(x_case_max,y_case_max)


Procedure.l initialisation()
;chargement de l'image qui donnera la forme du labyrinthe
StartDrawing(ImageOutput(#img_masque))
For j=0 To  y_case_max-1
     For i=0 To x_case_max-1
         If Red(Point(i,j))=0
             kaz(i+1,j+1)\valeur=#case_filtre

         EndIf    
     Next i
Next j     
StopDrawing()
;remplissage du tableau kaz(x_case,y_case)
For j=0 To y_case_max
    For i= 0 To x_case_max  
       If i % 2 = 1 And j % 2 = 1  
           kaz(i,j)\valeur=#case_sol
       ElseIf i=0 Or i=x_case_max Or j=0 Or j=y_case_max Or kaz(i,j)\valeur=#case_filtre
           kaz(i,j)\valeur=#case_bordure
       Else     
           kaz(i,j)\valeur=#case_mur
       EndIf
    Next i
Next j
;choix d'une case de départ
Repeat
    x_case=1+Random(x_case_max-2)
    y_case=1+Random(y_case_max-2)
Until  x_case%2=1 And y_case%2=1  And kaz(x_case,y_case)\valeur<>#case_filtre
 EndProcedure
 
 Procedure.l possibilite(xp.l,yp.l)
 nombre_possibilites(xp,yp)=0
If xp>0 And (yp-2)>0 And  xp<x_case_max And (yp-2)<y_case_max And kaz(xp,yp-2)\valeur=#case_sol
    nombre_possibilites(xp,yp)=nombre_possibilites(xp,yp)+1
EndIf 
If (xp+2)>0 And yp>0 And  (xp+2)<x_case_max And yp<y_case_max And kaz(xp+2,yp)\valeur=#case_sol
    nombre_possibilites(xp,yp)=nombre_possibilites(xp,yp)+1
EndIf 
If xp>0 And (yp+2)>0 And  xp<x_case_max And (yp+2)<y_case_max And kaz(xp,yp+2)\valeur=#case_sol
    nombre_possibilites(xp,yp)=nombre_possibilites(xp,yp)+1
EndIf 
If (xp-2)>0 And yp>0 And  (xp-2)<x_case_max And yp<y_case_max And kaz(xp-2,yp)\valeur=#case_sol
    nombre_possibilites(xp,yp)=nombre_possibilites(xp,yp)+1
EndIf 
 EndProcedure
 
Procedure.l construction(x.l,y.l)
If  memo_x_case(x,y)=0
    memo_x_case(x,y)=x
    memo_y_case(x,y)=y
    kaz(memo_x_case(x,y),memo_y_case(x,y))\valeur=#case_sol_visite
    compteur_case_sol_visite=compteur_case_sol_visite+1
EndIf
 x_new_old=memo_x_case(x,y)
 y_new_old=memo_y_case(x,y)
Repeat
    Repeat
        a=Random(3)*#PI*0.5 ;angle â choix de la direction du foret
        x_new=x_new_old+2*Cos(a)
        y_new=y_new_old+2*Cos(a+#PI/2)
    Until   x_new>0 And y_new>0 And x_new<x_case_max And y_new<y_case_max And kaz(x_new,y_new)\valeur=#case_sol
    kaz(x_new,y_new)\valeur=#case_sol_visite
    memo_x_case(x_new,y_new)=x_new
    memo_y_case(x_new,y_new)=y_new
    x_cloison.l=(x_new_old+x_new)*0.5
    y_cloison.l=(y_new_old+y_new)*0.5
    kaz(x_cloison,y_cloison)\valeur=#case_sol_visite
    compteur_case_sol_visite=compteur_case_sol_visite+1
    possibilite(x_new,y_new)
    x_new_old=x_new
    y_new_old=y_new
Until nombre_possibilites(x_new_old,y_new_old)=0
possibilite(memo_x_case(x,y),memo_y_case(x,y))
If nombre_possibilites(memo_x_case(x,y),memo_y_case(x,y))>0 
    construction(memo_x_case(x,y),memo_y_case(x,y)) 
EndIf
EndProcedure
mur$=OpenFileRequester("Choisir une image pour le mur au format png  de taille 16*16","c:\","Fichiers image png |*.png",0) 
sol$=OpenFileRequester("Choisir une imagepour le sol au format png  de taille 16*16","c:\","Fichiers image png |*.png",0) 
bordure$=OpenFileRequester("Choisir une image pour la bordure au  format png  de taille 16*16","c:\","Fichiers image png |*.png",0) 
entree$=OpenFileRequester("Choisir une image pour l'entrée au  format png  de taille 16*16","c:\","Fichiers image png |*.png",0) 
sortie$=OpenFileRequester("Choisir une image pour la sortie au  format png  de taille 16*16","c:\","Fichiers image png |*.png",0) 
masque$=OpenFileRequester("Choisir une image en noir et blanc au  format png de taille 61*61 pour définir la silhouette du labyrinthe  ","c:\","Fichiers image png |*.png",0) 
;programme principal
InitSprite()
InitKeyboard()
OpenScreen(1280,1024,32,"labyrinthe")
UsePNGImageDecoder()
LoadSprite(#spr_mur,mur$)
LoadSprite(#spr_sol,sol$)
LoadSprite(#spr_bordure,bordure$)
LoadSprite(#spr_entree,entree$)
LoadSprite(#spr_sortie,sortie$)
LoadImage(#img_masque,masque$)

; **************************chargement automatique des images******************
;pour utiliser, supprimer les loadsprite précédent et les openfilerequester!
; LoadSprite(#spr_mur,"mur.png")
; LoadSprite(#spr_sol,"sol.png")
; LoadSprite(#spr_bordure,"bordure.png")
; LoadSprite(#spr_entree,"entree.png")
; LoadSprite(#spr_sortie,"sortie.png")
; LoadImage(#img_masque,"masque.png")

initialisation()
Repeat
construction(x_case,y_case)
If compteur_case_sol_visite<>max_compteur_case_sol_visite
    Repeat
        x_case=1+Random(x_case_max-2)
        y_case=1+Random(y_case_max-2)
        possibilite(x_case,y_case )
    Until  x_case%2=1 And y_case%2=1    And  kaz(x_case,y_case)\valeur=#case_sol_visite And nombre_possibilites(x_case,y_case )>0
 EndIf
Until  compteur_case_sol_visite=max_compteur_case_sol_visite
;création de l'entrée et de la sortie
kaz(0,1+2*Random(y_case_max*0.5-1))\valeur=#entree
kaz(x_case_max,1+2*Random(y_case_max*0.5-1))\valeur=#sortie
CreateSprite(#spr_final,1280,1024)
UseBuffer(#spr_final)
ClearScreen(RGB(0,128,128))
For j=0 To y_case_max
   For i= 0 To x_case_max
       Select kaz(i,j)\valeur
           Case #case_mur
           DisplaySprite(#spr_mur,i*16,j*16)
           Case #case_sol
           DisplaySprite(#spr_sol,i*16,j*16)
           Case #case_sol_visite
           DisplaySprite(#spr_sol,i*16,j*16)
           Case #case_bordure
            DisplaySprite(#spr_bordure,i*16,j*16)
           Case #entree
           DisplaySprite(#spr_entree,i*16,j*16)
           Case #sortie
           DisplaySprite(#spr_sortie,i*16,j*16)
       EndSelect
    Next i
  Next j
UseBuffer(-1)

Repeat
     Delay(24)
     DisplaySprite(#spr_final,0,0)
     FlipBuffers()
     ExamineKeyboard()
Until KeyboardPushed(#PB_Key_Escape)
End




Ciao!
Elevé au MSX !
Avatar de l’utilisateur
Huitbit
Messages : 940
Inscription : jeu. 08/déc./2005 5:19
Localisation : Guadeloupe

Mission completed!!!

Message par Huitbit »

Mêmes contraintes que précedemment ( prévoir 5 sprites 16*16 et un masque 61*61 tout ça au format .png) ; voir le post précedent pour plus de détails

IMPORTANT: le programme ne gère pas les surfaces séparées (masque avec plusieurs zones blanches) ; idem si les zones sont reliées par des surfaces trop fines
Modifications:
-le labyrinthe ne se trace que dans la zone blanche du masque
-le nombre de cellules à traiter dépend de la zone blanche du masque (avant elle était fixe et calculée à l'avance)
-la procedure initialisation a été modifiée
-la procedure nettoyage_abords_case(x_net.b,y_net.b) a été rajoutée pour qu'une case sol soit toujours entourée de 4 cases mur
-nouveau choix de l'entrée et de la sortie
Bon ça peut le faire pour la Saint Valentin(à condition de choisir les bons sprites :P )

Un exemple (rien à voir avec la St Valentin!)
Le masque:
Image
8) Mon île 8) (c'est le hasard mais, j'habite à côté de l'entrée (Basse Terre) et ma famille est (presque)originaire de la sortie(Le Moule) 8O )
Image

Code : Tout sélectionner

;*****************************
;purebasic v4.02
;prg qui génère un labyrinthe à l'intérieur d'une forme définie par un sprite n/B:le masque
;*********************************
;déclarations
Global  x_case.l, y_case.l, x_case_max.l, y_case_max.l, compteur_case_sol_visite.l , nombre_max_de_cellules_a_visiter.l,a.f,x_new.l,y_new.l
x_case_max=62
y_case_max=62
compteur_case_sol_visite=0

Enumeration
#case_mur
#case_sol
#case_sol_visite
#case_bordure
#case_entree
#case_sortie
#spr_mur
#spr_sol
#spr_bordure
#spr_entree 
#spr_sortie
#spr_final
#img_masque
EndEnumeration

Structure laby
valeur.b
tuile.s
EndStructure

Global Dim kaz.laby(x_case_max,y_case_max)
Global Dim memo_x_case.l(x_case_max,y_case_max)
Global Dim memo_y_case.l(x_case_max,y_case_max)
Global Dim nombre_possibilites.l(x_case_max,y_case_max)

Procedure.b nettoyage_abords_case(x_net.b,y_net.b)
kaz(x_net,y_net-1)\valeur=#case_mur
kaz(x_net+1,y_net)\valeur=#case_mur
kaz(x_net,y_net+1)\valeur=#case_mur
kaz(x_net-1,y_net)\valeur=#case_mur
EndProcedure

Procedure.l initialisation()
;chargement de l'image qui donnera la forme du labyrinthe
StartDrawing(ImageOutput(#img_masque))
For j=0 To  y_case_max-1
     For i=0 To x_case_max-1
        If Red(Point(i,j))=0
            kaz(i+1,j+1)\valeur=#case_bordure;  un point noir du masque correspond  à une case bordure
        Else
            kaz(i+1,j+1)\valeur=#case_mur; un point blanc du masque correspond à une case mur  
        EndIf    
     Next i
Next j     
StopDrawing()
;remplissage du tableau kaz(x_case,y_case)
nombre_max_de_cellules_a_visiter=0; variable qui permet d'arreter la construction du labyrinthe dans le programme principal
 For j=0 To y_case_max
     For i= 0 To x_case_max  
         If i % 2 = 1 And j % 2 = 1   And  kaz(i,j)\valeur=#case_mur 
              nombre_max_de_cellules_a_visiter=nombre_max_de_cellules_a_visiter+1
             kaz(i,j)\valeur=#case_sol
             If i>1 And  i < x_case_max-1 And j>1 And  j < y_case_max-1 And kaz(i,j)\valeur=#case_sol
                 If  kaz(i,j-1)\valeur=#case_bordure Or kaz(i+1,j)\valeur=#case_bordure Or kaz(i,j+1)\valeur=#case_bordure Or kaz(i-1,j)\valeur=#case_bordure
                     nettoyage_abords_case(i,j)
                 EndIf
             EndIf
         EndIf
     Next i
 Next j
;choix d'une case de départ pour dessiner le labyrinthe
 Repeat
     x_case=1+Random(x_case_max-2)
     y_case=1+Random(y_case_max-2)
     Until  x_case%2=1 And y_case%2=1  And kaz(x_case,y_case)\valeur=#case_sol
 EndProcedure
 
  Procedure.l possibilite(xp.l,yp.l);nombre de directions non explorées à partir du case sol choisie
 nombre_possibilites(xp,yp)=0
If xp>0 And (yp-2)>0 And  xp<x_case_max And (yp-2)<y_case_max And kaz(xp,yp-2)\valeur=#case_sol
    nombre_possibilites(xp,yp)=nombre_possibilites(xp,yp)+1
EndIf 
If (xp+2)>0 And yp>0 And  (xp+2)<x_case_max And yp<y_case_max And kaz(xp+2,yp)\valeur=#case_sol
    nombre_possibilites(xp,yp)=nombre_possibilites(xp,yp)+1
EndIf 
If xp>0 And (yp+2)>0 And  xp<x_case_max And (yp+2)<y_case_max And kaz(xp,yp+2)\valeur=#case_sol
    nombre_possibilites(xp,yp)=nombre_possibilites(xp,yp)+1
EndIf 
If (xp-2)>0 And yp>0 And  (xp-2)<x_case_max And yp<y_case_max And kaz(xp-2,yp)\valeur=#case_sol
    nombre_possibilites(xp,yp)=nombre_possibilites(xp,yp)+1
EndIf 
 EndProcedure
 
 Procedure.l construction(x.l,y.l)
If  memo_x_case(x,y)=0
    memo_x_case(x,y)=x
    memo_y_case(x,y)=y
    kaz(memo_x_case(x,y),memo_y_case(x,y))\valeur=#case_sol_visite
    compteur_case_sol_visite=compteur_case_sol_visite+1
EndIf
 x_new_old=memo_x_case(x,y)
 y_new_old=memo_y_case(x,y)
Repeat
    Repeat
        a=Random(3)*#PI*0.5 ;angle â choix de la direction du foret
        x_new=x_new_old+2*Cos(a)
        y_new=y_new_old+2*Cos(a+#PI/2)
    Until   x_new>0 And y_new>0 And x_new<x_case_max And y_new<y_case_max And kaz(x_new,y_new)\valeur=#case_sol
    kaz(x_new,y_new)\valeur=#case_sol_visite
    memo_x_case(x_new,y_new)=x_new
    memo_y_case(x_new,y_new)=y_new
    x_cloison.l=(x_new_old+x_new)*0.5
    y_cloison.l=(y_new_old+y_new)*0.5
    kaz(x_cloison,y_cloison)\valeur=#case_sol_visite
    compteur_case_sol_visite=compteur_case_sol_visite+1
    possibilite(x_new,y_new)
    x_new_old=x_new
    y_new_old=y_new
Until nombre_possibilites(x_new_old,y_new_old)=0
possibilite(memo_x_case(x,y),memo_y_case(x,y))
If nombre_possibilites(memo_x_case(x,y),memo_y_case(x,y))>0 
    construction(memo_x_case(x,y),memo_y_case(x,y)) 
EndIf
EndProcedure
 
InitSprite()
InitKeyboard()
OpenScreen(1280,1024,32,"labyrinthe")
UsePNGImageDecoder()

 LoadSprite(#spr_mur,"mur.png")
 LoadSprite(#spr_sol,"sol.png")
 LoadSprite(#spr_bordure,"bordure.png")
 LoadSprite(#spr_entree,"entree.png")
 LoadSprite(#spr_sortie,"sortie.png")
 LoadImage(#img_masque,"masque.png")

;programme principal
initialisation()
Repeat
    construction(x_case,y_case)
    If compteur_case_sol_visite<>nombre_max_de_cellules_a_visiter
        Repeat
            x_case=1+Random(x_case_max-2)
            y_case=1+Random(y_case_max-2)
            possibilite(x_case,y_case )
        Until  x_case%2=1 And y_case%2=1   And  kaz(x_case,y_case)\valeur=#case_sol_visite And nombre_possibilites(x_case,y_case )>0
    EndIf
Until  compteur_case_sol_visite=nombre_max_de_cellules_a_visiter
;création de l'entrée et de la sortie
Repeat 
    x_case=1+Random(x_case_max-2)
    y_case=1+Random(y_case_max-2)
Until kaz(x_case,y_case)\valeur=#case_mur And kaz(x_case,y_case-1)\valeur=#case_mur And kaz(x_case,y_case+1)\valeur=#case_mur And kaz(x_case-1,y_case)\valeur=#case_bordure 
kaz(x_case,y_case)\valeur=#case_entree
Repeat 
    x_case=1+Random(x_case_max-2)
    y_case=1+Random(y_case_max-2)
Until kaz(x_case,y_case)\valeur=#case_mur And kaz(x_case,y_case-1)\valeur=#case_mur And kaz(x_case,y_case+1)\valeur=#case_mur And kaz(x_case+1,y_case)\valeur=#case_bordure
kaz(x_case,y_case)\valeur=#case_sortie


CreateSprite(#spr_final,1280,1024)
UseBuffer(#spr_final)
ClearScreen(RGB(0,0,0))
For j=0 To y_case_max
   For i= 0 To x_case_max
       Select kaz(i,j)\valeur
           Case #case_mur
               DisplaySprite(#spr_mur,i*16,j*16)
           Case #case_sol
               DisplaySprite(#spr_sol,i*16,j*16)
           Case #case_sol_visite
               DisplaySprite(#spr_sol,i*16,j*16)
           Case #case_bordure
               DisplaySprite(#spr_bordure,i*16,j*16)
           Case #case_entree
               DisplaySprite(#spr_entree,i*16,j*16)
           Case #case_sortie
               DisplaySprite(#spr_sortie,i*16,j*16)
       EndSelect
    Next i
  Next j
UseBuffer(-1)

Repeat
     Delay(24)
     DisplaySprite(#spr_final,0,0)
     FlipBuffers()
     ExamineKeyboard()
Until KeyboardPushed(#PB_Key_Escape)
End
Elevé au MSX !
comtois
Messages : 5186
Inscription : mer. 21/janv./2004 17:48
Contact :

Message par comtois »

Les routes sont sinueuses en Guadeloupe, et en plus on a vite fait de s'y perdre :)
http://purebasic.developpez.com/
Je ne réponds à aucune question technique en PV, utilisez le forum, il est fait pour ça, et la réponse peut profiter à tous.
Backup
Messages : 14526
Inscription : lun. 26/avr./2004 0:40

Re: Mission completed!!!

Message par Backup »

Huitbit a écrit : (c'est le hasard mais, j'habite à côté de l'entrée (Basse Terre) et ma famille est (presque)originaire de la sortie(Le Moule) 8O )
ouaou ! mais alors t'es aller vivre a l'autre bout du monde :lol:
Avatar de l’utilisateur
Huitbit
Messages : 940
Inscription : jeu. 08/déc./2005 5:19
Localisation : Guadeloupe

Message par Huitbit »

Pas de problèmes pour les "longues" distances et les virages, les voitures sont customisées (véridique 8O )

Image

Hasta la vista!

@Dobro
Ta tortue aurait pas fait ami-ami avec Virenque, Lance Armstrog ou avec Ben Johnson?
Attention aux tests!
Elevé au MSX !
Répondre