Source:PureTetris.pb

Adaptation pour PureBasic d'un code Darkbasic

• Un tetris simple

;PB 4.0 
; Adaptation en 20 minutes du code d'Atreid 

If InitSprite() = 0 Or InitKeyboard() = 0
 MessageRequester( "Erreur" , "Impossible d'initialiser DirectX 7 Ou plus" , 0 )
 End
ElseIf OpenScreen( 800 , 600 , 32 , "Tetris" ) = 0
 MessageRequester( "Erreur" , "Impossible d'ouvrir l'écran " , 0 )
 End
EndIf

Declare fctAjoutePiece()
Declare fctBougeAGauche()
Declare fctBougeADroite()
Declare fctTourneAGauche()
Declare fctTourneADroite()
Declare goDown()
Declare dessineGrille(posx.l, posy.l, largeur.l, hauteur.l)
Declare dessinePiece(posx.l, posy.l, largeur.l, hauteur.l)
Declare ToucheLesBords()
Declare collision()

 
;déclaration des variables
;grille(x,y) contiendra un
;1 ou un 0, si la Case de la
;grille est remplie ou non
Global Dim grille(10, 26) 
;construction d'un sol
For t=1 To 10
	grille(t,26)=1
Next t
 
;ce tableau contiendra les pièces.
;pour le moment, on n'a que le T,
;il faudrait faire les autres
Global Dim piece(3,3)
 
;mettre toutes les variables globales
;dans un type rend le code plus propre
Structure t_glob
	pieceX.l
	pieceY.l
	ajoutPiece.l
	deplacePiece.l
EndStructure
Global glob.t_glob
;ajoutPiece : cette variable est incrémentée
;non-stop. Lorsqu'elle est égale à 0, on ajoute
;une pièce.
;lorsqu'on veut ajouter une nouvelle pièce, il
;suffit de lui donner une valeure inférieure à
;zéro. Avec -50, on a environ une seconde
;d'attente avant l'ajout de la pièce
glob\ajoutPiece = -50
;même principe qu'ajoutPiece, mais pour le
;déplacement de la pièce
glob\deplacePiece = -100
 
;gestion du clavier : ces variables stockent
;l'état précédent d'une touche. Comme ça, on
;peut faire des conditions du type de "si
;la touche est pressée mais ne l'était pas
;lors de la dernière boucle"
Define.l lastLeft, lastRight, lastUp ,lastDown 
 
;boucle principale
Repeat
	;comme je l'ai dit plus haut, on incrémente
	;ces variables
	glob\ajoutPiece + 1
	glob\deplacePiece + 1
 	;ajout d'une pièce
	If glob\ajoutPiece = 0
		fctAjoutePiece()
	EndIf
	
	;i glob.ajoutPiece est supérieur à 0, cela
	;signifie qu'il y a une pièce à déplacer, donc
	;on peut s'occupper de cette pièce
	ExamineKeyboard()
	If glob\ajoutPiece > 0
		;déplacement de la pièce
		If lastLeft=0 And KeyboardPushed(#PB_Key_Left)
			fctBougeAGauche()
		EndIf
		lastLeft = KeyboardPushed(#PB_Key_Left)
		If lastRight=0 And KeyboardPushed(#PB_Key_Right)
			fctBougeADroite()
		EndIf
		lastRight = KeyboardPushed(#PB_Key_Right)
		
		;rotation de la pièce
		If lastUp=0 And KeyboardPushed(#PB_Key_Up)
			fctTourneAGauche()
		EndIf
		lastUp = KeyboardPushed(#PB_Key_Up)
		If lastDOwn=0 And KeyboardPushed(#PB_Key_Down)
			fctTourneADroite()
		EndIf
		lastDown = KeyboardPushed(#PB_Key_Down)
	
		;si on presse espace, on descend la pièce
		;rapidement
		If KeyboardPushed(#PB_Key_Space) : glob\deplacePiece = 0 : EndIf
		;quand glob.deplacepiece est égal à 0, on
		;la déplace vers le bas et on met la variable
		;à -50
		If glob\deplacePiece = 0
			glob\deplacePiece = -50
			goDown()
		EndIf
	EndIf
	;affichage
	ClearScreen(0)
	StartDrawing(ScreenOutput())
	dessineGrille(10, 10, 232, 580)
	dessinePiece(10, 10, 232, 580)
	StopDrawing()
	FlipBuffers()
Until KeyboardPushed(#PB_Key_Escape)
 
Procedure dessineGrille(posx.l, posy.l, largeur.l, hauteur.l)
	Define.f w,	h
	;calcul de la largeur et de la hauteur d'une case
	w = (largeur / 10.0)
	h = (hauteur / 25.0)
	;couleur d'affichage de la grille et des boîtes placées
	
	For x=0 To 10
		For y=0 To 25
			;lignes verticales
			LineXY(posx + (w*x), posy, posx+(w*x), posy+hauteur,RGB(96,96,96))
			;lignes horizontales
			LineXY(posx, posy+(y*h), posx+largeur, posy+(y*h),RGB(96,96,96))
			If grille(x,y)=1
				Box(posx+(w*(x-1)), posy+(w*(y-1)), w, h, RGB(96,96,96))
			EndIf
		Next y
	Next x

EndProcedure
 
Procedure delLines()
	;cette commande supprime une ligne, si elle est complète.
	For y=25 To 1 Step -1
		;on compte le nombre de cases remplies
		nbr = 0
		For x=1 To 10
			 nbr + grille(x,y)
		Next x
		;s'il y en a 10...
		If nbr=10
			;... on descend toutes les cases se trouvant
			;en-dessus de la ligne :
			;grille(x,y) = grille(x,y-1)
			For y2=y To 1 Step -1
				For x=1 To 10
					grille(x,y2) = grille(x,y2-1)
				Next x
			Next y2
			y + 1
		EndIf
	Next y
EndProcedure
 
Procedure fctAjoutePiece()
	;cette fonction crée une nouvelle pièce en
	;haut de l'écran.
	
	;sélection aléatoire de la forme de la pièce
	num = Random(5)
	Select num
		Case 0
			Restore _piece_T
		Case 1
			Restore _piece_L
		Case 2
			Restore _piece_L2
		Case 3
			Restore _piece_Z
		Case 4
			Restore _piece_Z2
		Case 5
			Restore _piece_I
	EndSelect
	For x=1 To 3
		For y=1 To 3
			Read piece(x,y)
		Next y
	Next x
	;positionnement de la pièce : en haut et aléatoirement
	;le long de X (c'est plus marrant)
	glob\pieceX = 1+Random(6)
	glob\pieceY = 0
EndProcedure
 
Procedure fctTourneADroite()
	;cette commande effectue une rotation à la pièce. En gros,
	;je transforme
	;ABC    GDA
	;DEF en HEB
	;GHI    IFC
	Dim temporaire(3,3)
	For t=1 To 3
		temporaire(t, 1) = piece(1, (4-t))
		temporaire(3, t) = piece(t, 1)
		temporaire(t, 3) = piece(3, (4-t))
		temporaire(1, t) = piece(t, 3)
	Next t
	temporaire(2,2) = piece(2,2)
	For x=1 To 3
		For y=1 To 3
			piece(x,y) = temporaire(x,y)
		Next y
	Next x
	;je regarde si, à cause de la rotation, il faut décaler
	;la pièce
	ToucheLesBords()
EndProcedure
 
Procedure fctTourneAGauche()
	;idem à fctTourneADroite mais dans l'autre sens
	Dim temporaire(3,3)
	For t=1 To 3
		temporaire(1, t) = piece((4-t), 1)
		temporaire(t, 1) = piece(3, t)
		temporaire(3, (4-t)) = piece(t, 3)
		temporaire(t, 3) = piece(1, t)
	Next t
	temporaire(2,2) = piece(2,2)
	For x=1 To 3
		For y=1 To 3
			piece(x,y) = temporaire(x,y)
		Next y
	Next x
	ToucheLesBords()
EndProcedure
 
Procedure fctBougeAGauche()
	;déplace la pièce vers la gauche
	glob\pieceX - 1
	;elle dépasse le bord de l'écran ?
	If glob\pieceX < -1 : glob\pieceX = -1 : EndIf
	If glob\pieceX = -1
		;Regardons cette même pièce, dans deux orientations
		;différentes :
		;   010      000
		;1: 010   2: 111
		;   010      000
		;c'est une barre. Si elle est verticale, on peut la
		;mettre à la position X=-1, la barre sera alignée le
		;long du bord. Par contre, si elle est horizontale,
		;on ne peut pas la mettre plus à gauche que X=0.
		For t=1 To 3
			If piece(1, t)=1 : glob\pieceX = 0 : EndIf
		Next t
	EndIf
	;si la pièce est en collision avec une autre, on la remet
	;à la position X précédente.
	If collision()=1 : glob\pieceX + 1 : EndIf
EndProcedure
 
Procedure fctBougeADroite()
	;mêmes explications que fctBougeAGauche
	glob\pieceX + 1
	If glob\pieceX > 8 : glob\pieceX = 8 : EndIf
	If glob\pieceX = 8
		For t=1 To 3
			If piece(3, t)=1 : glob\pieceX = 7 : EndIf
		Next t
	EndIf
	If collision()=1 : glob\pieceX - 1 : EndIf
EndProcedure
 
Procedure ToucheLesBords()
	;en gros, cette fonction ne faut que
	;replacer la pièce si elle dépasse l'un
	;des bords
	If glob\pieceX > 8 : glob\pieceX = 8 : EndIf
	If glob\pieceX = 8
		For t=1 To 3
			If piece(3, t)=1 : glob\pieceX = 7 : EndIf
		Next t
	EndIf
	If glob\pieceX < -1 : glob\pieceX = -1 : EndIf
	If glob\pieceX = -1
		For t=1 To 3
			If piece(1, t)=1 : glob\pieceX = 0 : EndIf
		Next t
	EndIf
EndProcedure
 
Procedure dessinePiece(posx.l, posy.l, largeur.l, hauteur.l)
	;cette fonction affiche la pièce sur la grille. Ses paramètres doivent
	;être identiques à ceux de dessineGrille
	Define.f w,	h
	If glob\ajoutPiece > 0
		w = (largeur / 10.0)
		h = (hauteur / 25.0)

		For x=1 To 3
			For y=1 To 3
				If piece(x,y)=1
					Box(posx+(w*((x+glob\pieceX)-1)), posy+(w*((y+glob\pieceY)-1)), w, h, #White)
				EndIf
			Next y
		Next x

	EndIf
EndProcedure
 
Procedure auSol()
	;cette fonction regarde si la pièce est "posée" sur des cases remplies
	For x=1 To 3
		For y=3 To 1 Step -1
			If piece(x,y)=1
				;si une Case de la grille juste sous une Case de
				;la pièce est remplie, la fonction renvoie la
				;valeur 1
				If grille(x+glob\pieceX, y+glob\pieceY+1)=1 : ProcedureReturn #True : EndIf
			EndIf
		Next y
	Next x
	;si aucune Case de la grille n'était remplie, la fonction
	;renvoie la valeur 0
	ProcedureReturn #False
EndProcedure 
 
Procedure collision()
	;regarde si l'une des cases de la pièce est sur l'une
	;des cases remplies de la grille. Si c'est le cas, renvoie
	;1, sinon renvoie 0.
	For x=1 To 3
		For y=1 To 3
			If piece(x,y)=1
				If grille(x+glob\pieceX, y+glob\pieceY)=1 : ProcedureReturn #True : 	EndIf  
			EndIf
		Next y
	Next x
	ProcedureReturn 0
EndProcedure
 
Procedure goDown()
	;si la pièce est posée, on ne descend pas mais...
	If auSol()=1
		;... on "met la pièce dans la grille"
		For x=1 To 3
			For y=1 To 3
				If piece(x,y)=1
					grille(x+glob\pieceX, y+glob\pieceY)=1
				EndIf
			Next y
		Next x
		;on prépare l'ajout d'une nouvelle pièce
		glob\ajoutPiece = -50
		glob\deplacePiece = -100
		;on supprime éventuellement les lignes, s'il le faut
		delLines()
	Else
		;descente de la pièce, si elle n'était pas au sol
		glob\pieceY + 1
	EndIf
EndProcedure
 
;ces données servent à la construction des pièces. 0 indique
;une Case vide, 1 une Case pleine. Le tableau des pièces 
;est de dimension 3x3.
DataSection
_piece_T:
Data.l 0,1,0
Data.l 1,1,1
Data.l 0,0,0
 
_piece_L:
Data.l 1,1,1
Data.l 0,0,1
Data.l 0,0,0
 
_piece_L2:
Data.L 1,1,1
Data.L 1,0,0
Data.l 0,0,0
 
_piece_Z:
Data.l 1,1,0
Data.l 0,1,1
Data.l 0,0,0
 
_piece_Z2:
Data.l 0,1,1
Data.l 1,1,0
Data.l 0,0,0
 
_piece_I:
Data.l 0,1,0
Data.l 0,1,0
Data.l 0,1,0
EndDataSection