Ce n'est pas une question, c'est une réponse.
Ce code va afficher une grille avec une surface fermée.
Elle va se remplir automatiquement en cyan à l’intérieure et en jaune à l’extérieure.
Les prochains emplacement a être traité sont marqué en vert.
Un dialogue s'affiche à chaques cycle pour temporiser et affiche l'état de la pile.
Un appui prolonger sur la touche enter accélérera le mouvement.
L'outil peut être utilisé dans un éditeur de niveau de jeux.
On dessine les murs puis on rempli la zone avec le sol par exemple.
Le principe :
A partir de la coordonnée de départ,
- on la place sur la pile
- Boucle Tant qu'il y a un élément sur la pile
- On récupère la dernière position empilé
- On recherche la position libre le plus a gauche, le point de depart
- On recherche la position libre le plus a droite, le point d'arrivé
- on trace une ligne entre les deux
Puis le long de cette ligne,
- On recherche les passages possible en dessous et on place leurs coordonnées sur la pile
- On recherche les passages possible au dessus et on place leurs coordonnées sur la pile
- Fin de boucle si la pile est vide
Voici le code de la démo.
Module de gestion de pile et Programme teste
Code : Tout sélectionner
; Remplissage automatique ( FILL )
; PureBasic 6.12
; Version 20241128
; *********************************
; *** Module de gestion de pile ***
; * Empile des valeurs numériques *
; * *
; Entièrement autonome, il peut être utilisé dans toutes autres application.
DeclareModule Stack_Int
; ******** Constantes et variables Publiques ***************
; Rien de public à déclarer
; ******** Declaration des procedures Publiques ***************
Declare .i GetIndex ( ) ; Retourne le nombr d'éléments dans la pile.
Declare Push ( Valeur.i ) ; Empile une valeur numérique.
Declare .i Pop ( ) ; Retourne l'élément précédemment empilé.
Declare .b IsEmpty ( ) ; Teste si la pile est vide retourne vrai / faux.
Declare .b IsFull ( ) ; Teste si la pile est pleine retourne vrai / faux.
Declare .i Last ( ) ; Retourne le dernier élément de la pile sans le dépiler ( ce n'est pas un "Pop()" ).
Declare Clr ( ) ; Vide la pile complétement.
EndDeclareModule
Module Stack_Int
; ******** Constantes et variables privées ***************
Global NewList TableVal .i ( )
; ******** Procedures Privées ***************
; Il n'y en a pas.
; ******** Procedures Publiques ************
; Celles qui ont été déclarer plus haut
Procedure .i GetIndex( )
ProcedureReturn ListIndex( TableVal() )
EndProcedure
Procedure Push ( Valeur.i )
AddElement( TableVal() )
TableVal() = Valeur
EndProcedure
Procedure .i Pop ( )
Protected ValTmp.i
If LastElement(TableVal()) <> 0
ValTmp = TableVal()
DeleteElement( TableVal() )
ProcedureReturn ValTmp
Else
ProcedureReturn -1
EndIf
EndProcedure
Procedure .b IsEmpty ( )
ProcedureReturn Bool( LastElement( TableVal( ) ) = 0 )
EndProcedure
Procedure .b IsFull ( )
ProcedureReturn Bool( LastElement( TableVal( ) ) <> 0 )
EndProcedure
Procedure .i Last ( )
If LastElement( TableVal() ) <> 0
ProcedureReturn TableVal()
Else
ProcedureReturn -1
EndIf
EndProcedure
Procedure Clr ( )
ClearList(TableVal())
EndProcedure
; ******* Initialisation *******
; Rien à initialiiser
EndModule
; * *
; *** Fin du module Stack_Int ***
; *********************************
; *********************************
; *** Programme teste ***
; * *
Global .i Ecran
Global .i Image
Global .u LargeurGrille = 50
Global .u HauteurGrille = 25
Global .u LargeurImage = 10 * LargeurGrille + 1
Global .u HauteurImage = 10 * HauteurGrille + 1
Global .i Dim TbImage( LargeurGrille , HauteurImage )
Global .i CompteurPile = 0 ; Utilisé pour information
Procedure PlanteUnDrapeau ( _x , _y , Col )
; Met en évidence la position du trou placée sur la pile
StartDrawing ( ImageOutput(Image) ) ; Debut du traçage dans l'image
Box( _x*10+1 ,_y*10+1, 9, 9 , Col ) ; Dessine un rectangle plein
StopDrawing() ; Fin du traçage
SetGadgetState( Ecran , ImageID(Image) ) ; Place l'image à l'écran
EndProcedure
Procedure ChercheTrousDessus ( _xDebut , _xFin , _y , _c ) ; Cherche un Passage au dessus et emplile les coordonnées
Protected .w _xTmp = _xDebut
If _y > 0 ; Si on peut regarder au dessus
While _xTmp <= _xFin ; Entre _xDebut et _Xfin
If TbImage( _xTmp , _y - 1 ) = _c ; s'il y a un Passage au dessus, on empile la coordonnée
Stack_Int::Push( _xTmp )
Stack_Int::Push( _y - 1 )
CompteurPile + 1
PlanteUnDrapeau (_xTmp , _y - 1 , #Green ) ; et on place un drapeau à l'écran
While _xTmp <= _xFin And TbImage( _xTmp , _y - 1 ) = _c ; On continue le deplacement à droite Tant-qu'il y a un Passage
_xTmp+1
Wend
Else ; s'il y a un Mur au dessus,
While _xTmp <= _xFin And TbImage( _xTmp , _y - 1 ) <> _c ; On continue le deplacement à droite Tant-que c'est un Mur
_xTmp+1
Wend
EndIf
Wend ; On reboucle jusqu'a _xFin
EndIf
EndProcedure
Procedure ChercheTrousDessous ( _xDebut , _xFin , _y , _c ) ; Cherche un Passage en dessous et emplile la coordonnée
Protected .w _xTmp = _xDebut
If _y < HauteurGrille ; Si on peut regarder en dessous
While _xTmp <= _xFin ; Entre _xDebut et _Xfin
If TbImage( _xTmp , _y + 1 ) = _c ; s'il y a un Passage en dessous, on empile la coordonnée
Stack_Int::Push( _xTmp )
Stack_Int::Push( _y + 1 )
CompteurPile + 1
PlanteUnDrapeau (_xTmp , _y + 1 , #Green ) ; et on place un drapeau à l'écran
While _xTmp <= _xFin And TbImage( _xTmp , _y + 1) = _c ; On continue le deplacement à droite Tant-qu'il y a un Passage en dessous
_xTmp+1
Wend
Else ; s'il y a un Mur au dessous,
While _xTmp <= _xFin And TbImage( _xTmp , _y + 1 ) <> _c ; On continue le deplacement à droite Tant-qu'en dessous c'est un Mur
_xTmp+1
Wend
EndIf
Wend ; On reboucle jusqu'a _xFin
EndIf
EndProcedure
Procedure TraceLigne ( _xDebut , _y , _xFin , Col )
Protected .a _x
; Trace une ligne de _xDebut à _xFin
StartDrawing ( ImageOutput(Image) ) ; Debut du traçage dans l'image
For _x = _xDebut To _xFin
Box( _x*10+1 ,_y*10+1, 9, 9 , Col ) ; Dessine un rectangle plein
TbImage( _x , _y ) = Col ; Mise à jour de la table TbImage
Next
StopDrawing() ; Fin du traçage
SetGadgetState( Ecran , ImageID(Image) ) ; Place l'image à l'écran
EndProcedure
Procedure .u xGauche ( _x , _y , _c ) ;Cherche la limite à gauche
Protected .w _xTmp = _x
While _xTmp >= 0 And TbImage( _xTmp , _y ) = _c
_xTmp-1
Wend
ProcedureReturn _xTmp + 1
EndProcedure
Procedure .u xDroite ( _x , _y , _c ) ;Cherche la limite à droite
Protected .w _xTmp = _x
While _xTmp <= LargeurGrille And TbImage( _xTmp , _y ) = _c
_xTmp+1
Wend
ProcedureReturn _xTmp - 1
EndProcedure
Procedure Remplissage ( xx , yy , Couleur )
Protected .a x = 0
Protected .a y = 0
Protected .a xDebut = 0
Protected .a xFin = 0
Stack_Int::Push( xx )
Stack_Int::Push( yy )
CompteurPile + 1
CouleurFond = TbImage( xx , yy )
While Stack_Int::IsFull( ) ; Tant-que la pile est pleine
y = Stack_Int::Pop( ) ; Reccupère les coordonnées
x = Stack_Int::Pop( )
CompteurPile - 1
If TbImage( x , y ) = CouleurFond ; si c'est un trou, on Trace
xDebut = xGauche( x , y , CouleurFond )
xFin = xDroite( x , y , CouleurFond )
TraceLigne( xDebut , y , xFin , Couleur )
ChercheTrousDessous( xDebut , xFin , y , CouleurFond )
ChercheTrousDessus ( xDebut , xFin , y , CouleurFond )
EndIf
If Not MessageRequester( "Pile = " + Str( CompteurPile ) , "Suivant ?" , #PB_MessageRequester_YesNo ) = #PB_MessageRequester_Yes:End :EndIf
Wend
EndProcedure
If OpenWindow(0, 100, 100, 128, 128, "Remplissage automatique ( FILL )", #PB_Window_SystemMenu )
Image = CreateImage( #PB_Any , LargeurImage , HauteurImage , 24 , #White )
Ecran = ImageGadget ( #PB_Any , 0 , 0 , LargeurImage , HauteurImage , ImageID(Image) ) ; Affichage
ResizeWindow ( 0 , #PB_Ignore , #PB_Ignore , LargeurImage , HauteurImage )
; Tracé du cadrillage Pixel de 10x10
StartDrawing ( ImageOutput(Image) )
For y = 0 To HauteurGrille - 1
For x = 0 To LargeurGrille - 1
Plot( (x+0)*10 , (y+0)*10 , #Black )
Plot( (x+1)*10 , (y+0)*10 , #Black )
Plot( (x+0)*10 , (y+1)*10 , #Black )
Plot( (x+1)*10 , (y+1)*10 , #Black )
Next
Next
StopDrawing()
; Trace la grille ( ici 50x25 )
Restore DataImage
For y = 0 To HauteurGrille -1
Read .s a$
For x = 0 To Len( a$ )-1
Pixel = Val( Mid( a$ , x+1 , 1 ) )
StartDrawing ( ImageOutput(Image) )
If Pixel = 1
Box( x*10+1 ,y*10+1, 9, 9 , #Black )
Else
Box( x*10+1 ,y*10+1, 9, 9 , #White )
EndIf
; Charge la table avec la couleur des pixel
TbImage( x , y ) = Pixel
StopDrawing()
Next
Next
SetGadgetState( Ecran , ImageID(Image) )
; Remplir à partir du point x=3 , y=3 , couleur=Cyan
Remplissage ( 3 , 3 , #Cyan )
; Remplir à partir du point x=0 , y=0 , couleur=Jaune
Remplissage ( 0 , 0 , #Yellow )
Debug "Fini"
Repeat : Until WaitWindowEvent() = #PB_Event_CloseWindow
EndIf
DataSection
DataImage:
Data .s "00000000000000000000000000000000000000000000000000"
Data .s "01111100000000111111111100000000000000001111110000"
Data .s "01000110000111000000000011000000000001110000001000"
Data .s "01000011000100000000000000100000000110000000000100"
Data .s "01000001100100011111100100011111111000001101000100"
Data .s "01000000110100010000110100000000000000001101000100"
Data .s "01000000010010010000010101111111111111000001000100"
Data .s "01001111011001001000010101000000000001001111110100"
Data .s "01001000001000101000110101011111111101001000000010"
Data .s "01001011001100011000100101010000000101001110100010"
Data .s "01101001000110001000100101010111110101001000100010"
Data .s "00101111000010000001100101010100010101001011100100"
Data .s "00100000000011000001000101010111010101001000100100"
Data .s "00110011110001110111000101010000010101001110101100"
Data .s "00010010010000011100000101011111110101001000101000"
Data .s "00010010010000000000000101000000000101001010101000"
Data .s "00010000110000001111110101111111111101001001010000"
Data .s "00010001100000000010010100000000000001001001010000"
Data .s "00011011001110000010010111111111111111001110100000"
Data .s "00001010011011000011110000000000000000000000100000"
Data .s "00001000010001100000000000000000000000000000111000"
Data .s "00001100010000011000000000000000111111111100000100"
Data .s "00000111110000001110000000111111100000000010001000"
Data .s "00000000000000000011100011100000000000000001110000"
Data .s "00000000000000000000111110000000000000000000000000"
EndDataSection
