Page 1 sur 1

Comment remplire une surface fermée.

Publié : jeu. 28/nov./2024 20:35
par plabouro472
Comment remplir une surface fermée.

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


Re: Comment remplire une surface fermée.

Publié : jeu. 28/nov./2024 21:54
par cage
Bonsoir,

J'ai tué ma souris! :D

cage

Re: Comment remplire une surface fermée.

Publié : ven. 29/nov./2024 21:01
par Kwai chang caine
Moi aussi :lol:
Merci pour le partage 8)

Re: Comment remplire une surface fermée.

Publié : sam. 30/nov./2024 0:35
par plabouro472
Peut être qu'avec la touche enter ce serait plus rapide.
Essayons pour voir 😜

Re: Comment remplire une surface fermée.

Publié : lun. 02/déc./2024 21:45
par Kwai chang caine
Effectivement :oops:
Je vais pouvoir remplacer mon clavier maintenant :wink: :lol:
Encore merci 8)

Re: Comment remplire une surface fermée.

Publié : mar. 03/déc./2024 18:05
par plabouro472
Un appui prolonger sur la touche ENTER.... 😉

Re: Comment remplire une surface fermée.

Publié : mer. 04/déc./2024 21:15
par Kwai chang caine
C'est ce que j'avais fait, je rigolais :wink:

Re: Comment remplire une surface fermée.

Publié : mer. 04/déc./2024 21:56
par Shadow
Beau travail merci.