Cool stuff ! Here is a DPI aware version (as it doesn't scale well if your desktop isn't 100%). You should use OutputWidth/Height() when using StartDrawing() to get the size of the output.
Code: Select all
; +---------------------------------------------------------+
; ! PureTris ! !
; ! !
; ! Program by Mindphazer !
; ! !
; ! v 1.01 (c) 2023 !
; ! !
; ! --------------------------------------------------------!
; ! Compatibilité OS : !
; ! [x] MacOS !
; ! [x] Windows - [x] DPI aware !
; ! [ ] Linux - peut-être !
; !---------------------------------------------------------!
; ! !
; ! Feel free to improve ! !
; ! ;
; +---------------------------------------------------------+
;
IncludeFile "Tetris.pbf"
Enumeration 1000
#Timer
EndEnumeration
Enumeration MenuBar
#MainMenu
EndEnumeration
Enumeration MenuItems
#MainMenuAbout
#MainMenuExit
EndEnumeration
#LargeurGrille = 10
#HauteurGrille = 22
Global LargeurCase = DesktopScaledX(25)
Global LargeurMiniature = DesktopScaledX(12)
#CouleurFond = $666666
#AppName = "PureTris !"
#AppVersion = "1.01"
#HighScoresFile = "PureTrisHi.dat"
Structure Scores
Nom.s
Score.i
EndStructure
Global Dim HighScores.Scores(10)
Global Dim Grille.b(#LargeurGrille, #HauteurGrille)
Global GameInProgress = #False
Global Piece.b, XPiece.b, YPiece.b, NextPiece.b
Global Dim PieceTetris.b(7,3,3)
Global Dim Couleur(7)
Global Dim Shape(7)
Global YOrigine.b = -1
Global XOrigine.b = 3
Global Score
Global Lignes
Global Level = 1
Global Tempo = 1000 - ((Level - 1) * 100)
; Chaque pièce est définie sur une matrice 2D de 4 x 4
For k = 1 To 7
For i = 0 To 3 ;HauteurPiece(k) - 1
For j = 0 To 3 ;LargeurPiece(k) - 1
Read.b PieceTetris(k, j, i)
Next j
Next i
Next k
DataSection
; I
Data.b 0,0,0,0
Data.b 1,1,1,1
Data.b 0,0,0,0
Data.b 0,0,0,0
; O
Data.b 0,0,0,0
Data.b 0,1,1,0
Data.b 0,1,1,0
Data.b 0,0,0,0
; T
Data.b 0,0,0,0
Data.b 0,1,0,0
Data.b 1,1,1,0
Data.b 0,0,0,0
; L
Data.b 0,0,0,0
Data.b 1,1,1,0
Data.b 1,0,0,0
Data.b 0,0,0,0
; J
Data.b 0,0,0,0
Data.b 1,1,1,0
Data.b 0,0,1,0
Data.b 0,0,0,0
; Z
Data.b 0,0,0,0
Data.b 1,1,0,0
Data.b 0,1,1,0
Data.b 0,0,0,0
; S
Data.b 0,0,0,0
Data.b 0,1,1,0
Data.b 1,1,0,0
Data.b 0,0,0,0
EndDataSection
Procedure EffaceCase(X, Y)
Box(X * LargeurCase, Y * LargeurCase, LargeurCase, LargeurCase, #CouleurFond)
EndProcedure
Procedure DessinPiece(Piece, X, Y)
Protected i.b, j.b
If StartDrawing(CanvasOutput(#Grille))
For i = 0 To 3
For j = 0 To 3
If PieceTetris(Piece, j, i) = 1
DrawImage(ImageID(Shape(Piece)), (X + j) * LargeurCase, (Y + i) * LargeurCase)
EndIf
Next j
Next i
StopDrawing()
EndIf
EndProcedure
Procedure DessinNext(Piece)
Protected i.b, j.b
If StartDrawing(CanvasOutput(#Next))
Box(0, 0, OutputWidth(), OutputHeight(), #Black)
DrawingMode(#PB_2DDrawing_Gradient)
BackColor(#CouleurFond)
FrontColor($999999)
LinearGradient(1, 1, 1, OutputHeight() - 2)
Box(1, 1, OutputWidth() - 2, OutputHeight() - 2)
DrawingMode(#PB_2DDrawing_Default)
X = (OutputWidth() / 2) - ((LargeurMiniature * 4) / 2)
For i = 0 To 3
For j = 0 To 3
If PieceTetris(Piece, j, i) = 1
Box(X + (j * LargeurMiniature), i * LargeurMiniature, LargeurMiniature, LargeurMiniature, #Black)
Box(X + (j * LargeurMiniature) + 1, (i * LargeurMiniature) + 1, LargeurMiniature - 2, LargeurMiniature - 2, Couleur(Piece))
EndIf
Next j
Next i
StopDrawing()
EndIf
EndProcedure
Procedure EffacePiece(Piece, X, Y)
Protected i.b, j.b
If StartDrawing(CanvasOutput(#Grille))
For i = 0 To 3
For j = 0 To 3
If PieceTetris(Piece, j, i) = 1
EffaceCase(X + j, Y + i)
EndIf
Next j
Next i
StopDrawing()
EndIf
EndProcedure
Procedure DessineGrille()
Protected i.b, j.b
If StartDrawing(CanvasOutput(#HighScores))
Box(0, 0, OutputWidth(), OutputHeight(), $333333)
Y = 7
X = 35
For i = 0 To #HauteurGrille - 1
For j = 0 To #LargeurGrille - 1
If Grille(j, i) = 0 : C = $444444 : Else : C = #Red : EndIf
Box((j * 10) + X, (i * 8) + Y, 9, 7, C)
Next j
Next i
StopDrawing()
EndIf
EndProcedure
Procedure.b CanMoveRight(Piece, X, Y)
Protected i.b, j.b
For i = 0 To 3
For j = 0 To 3
If PieceTetris(Piece, j, i) = 1
If X + j + 1 >= #LargeurGrille
ProcedureReturn #False
EndIf
If Y + i >= 0
If Grille(X + j + 1, Y + i) = 1
ProcedureReturn #False
EndIf
EndIf
EndIf
Next
Next
ProcedureReturn #True
EndProcedure
Procedure.b CanMoveLeft(Piece, X, Y)
Protected i.b, j.b
For i = 0 To 3
For j = 0 To 3
If PieceTetris(Piece, j, i) = 1
If X + j - 1 < 0
ProcedureReturn #False
EndIf
If Y + i >= 0
If Grille(X + j - 1, Y + i) = 1
ProcedureReturn #False
EndIf
EndIf
EndIf
Next j
Next i
ProcedureReturn #True
EndProcedure
Procedure.b CanMoveDown(Piece, X, Y)
Protected i.b, j.b
For i = 0 To 3
For j = 0 To 3
If PieceTetris(Piece, j, i) = 1
If (Y + i + 1) >= #HauteurGrille
ProcedureReturn #False
EndIf
If Grille(X + j, Y + i + 1) = 1
ProcedureReturn #False
EndIf
EndIf
Next j
Next i
ProcedureReturn #True
EndProcedure
Procedure.b CanPutPiece(Piece, X, Y)
Protected i.b, j.b
For i = 0 To 3
For j = 0 To 3
If PieceTetris(Piece, j, i) = 1
If Y + i >= 0
If Grille(X + j, Y + i) = 1
ProcedureReturn #False
EndIf
EndIf
EndIf
Next j
Next i
ProcedureReturn #True
EndProcedure
Procedure AfficheScore()
;F = LoadFont(#PB_Any, "Phosphate", 28, #PB_Font_HighQuality)
Protected S.s
CompilerIf #PB_Compiler_OS = #PB_OS_MacOS
F = LoadFont(#PB_Any, "Synchro LET", 28, #PB_Font_HighQuality)
DecalageY = -4
CompilerElse
F = LoadFont(#PB_Any, "Digital-7 Mono", 24, #PB_Font_HighQuality)
DecalageY = 0
CompilerEndIf
S = RSet(Str(Score), 8, "0")
If StartDrawing(CanvasOutput(#Score))
Box(0, 0, OutputWidth(), OutputHeight(), $333333)
DrawingFont(FontID(F))
DrawingMode(#PB_2DDrawing_Transparent)
DrawText((OutputWidth() / 2) - (TextWidth(S) / 2), DecalageY, S, #Red)
StopDrawing()
EndIf
S = RSet(Str(Lignes), 3, "0")
If StartDrawing(CanvasOutput(#Lignes))
Box(0, 0, OutputWidth(), OutputHeight(), $333333)
DrawingFont(FontID(F))
DrawingMode(#PB_2DDrawing_Transparent)
DrawText((OutputWidth() / 2) - (TextWidth(S) / 2), DecalageY, S, #Green)
StopDrawing()
EndIf
S = RSet(Str(Level), 2, "0")
If StartDrawing(CanvasOutput(#Niveau))
Box(0, 0, OutputWidth(), OutputHeight(), $333333)
DrawingFont(FontID(F))
DrawingMode(#PB_2DDrawing_Transparent)
DrawText((OutputWidth() / 2) - (TextWidth(S) / 2), DecalageY, S, #Cyan)
StopDrawing()
EndIf
EndProcedure
Procedure EffacerLigne(Ligne)
Protected i.b, j.b
For i = 0 To 5
If StartDrawing(CanvasOutput(#Grille))
Box(0, Ligne * LargeurCase, 250, LargeurCase, #Red * (i % 2))
Delay(20)
StopDrawing()
EndIf
;Repeat
; Until WindowEvent()
Next i
GrilleJeu = GetGadgetAttribute(#Grille, #PB_Canvas_Image)
Dummy = CreateImage(#PB_Any, 250, 550)
If StartDrawing(ImageOutput(Dummy))
DrawImage(GrilleJeu, 0, LargeurCase, 250, 550)
StopDrawing()
GrabImage(Dummy, 0, 0, 0, 250, (Ligne + 1) * LargeurCase)
EndIf
SetGadgetAttribute(#Grille, #PB_Canvas_Image, ImageID(0))
If StartDrawing(CanvasOutput(#Grille))
Box(0, 0, 250, LargeurCase, #CouleurFond)
StopDrawing()
EndIf
For i = Ligne To 1 Step -1
For j = 0 To #LargeurGrille - 1
Grille(j, i) = Grille(j, i - 1)
Next j
Next i
FreeImage(0)
EndProcedure
Procedure CheckLine()
Protected i.b, j.b
NBLignes = 0
For i = #HauteurGrille - 1 To 0 Step -1
LigneComplete = #True
For j = 0 To #LargeurGrille - 1
If Grille(j, i) = 0
LigneComplete = #False
Break
EndIf
Next j
If LigneComplete = #True
EffacerLigne(i)
i = i + 1
NBLignes = NBLignes + 1
Lignes + 1
If Lignes % 10 = 0 ; Toutes les 10 lignes, on augmente le niveau
Level + 1
Tempo = 1000 - ((Level - 1) * 120)
If Tempo < 1 : Tempo = 1 : EndIf
RemoveWindowTimer(#MainWindow, #Timer)
AddWindowTimer(#MainWindow, #Timer, Tempo)
EndIf
;Debug "Ligne trouvée"
EndIf
Next i
Select NBLignes
Case 1
Score + (40 * Level)
Case 2
Score + (100 * Level)
Case 3
Score + (300 * Level)
Case 4
Score + (1200 * Level)
EndSelect
EndProcedure
Procedure DeposePiece(Piece, X, Y)
Protected i.b, j.b
For i = 0 To 3
For j = 0 To 3
If PieceTetris(Piece, j, i) = 1
; Debug "X= " + Str(X+j-1) + " ; Y= " + Str(Y-i+1)
Grille(X + j, Y + i) = 1
EndIf
Next j
Next i
Checkline()
Score = Score + 1
AfficheScore()
;DessineGrille()
EndProcedure
Procedure.b CanRotate(P, X, Y)
Protected i.b, j.b
Dim Temp.b(3, 3)
For i = 0 To 3
For j = 0 To 3
Temp(i, j) = PieceTetris(P, 3 - j, i)
Next j
Next i
For i = 0 To 3
For j = 0 To 3
If Temp(j, i) = 1
If X + j < 0 Or X + j > #LargeurGrille - 1
ProcedureReturn #False
EndIf
If Y + i < 0 Or Y + i > #HauteurGrille -1
ProcedureReturn #False
EndIf
If Grille(X + j, Y + i) = 1
ProcedureReturn #False
EndIf
EndIf
Next j
Next i
ProcedureReturn #True
EndProcedure
Procedure RotatePiece(P, X, Y)
Protected i.b, j.b
Dim Temp.b(3, 3)
;Dim Temp(LargeurPiece(P), HauteurPiece(P))
For i = 0 To 3; HauteurPiece(P)
For j = 0 To 3; LargeurPiece(P)
Temp(i, j) = PieceTetris(P, i, j)
Next j
Next i
EffacePiece(P, X, Y)
For i = 0 To 3; HauteurPiece(P)
For j = 0 To 3; LargeurPiece(P)
PieceTetris(P, i, j) = Temp(3 - j, i)
Next j
Next i
DessinPiece(P, X, Y)
EndProcedure
Procedure.s Character(Char.s, Number.b)
Protected String.s, i.b
For i = 1 To Number
String = String + Char
Next i
ProcedureReturn String
EndProcedure
Procedure AfficheHiscores()
CompilerIf #PB_Compiler_OS = #PB_OS_MacOS
Taille = 13
CompilerElse
Taille = 10
CompilerEndIf
F = LoadFont(#PB_Any, "Iosevka", Taille, #PB_Font_HighQuality)
If StartDrawing(CanvasOutput(#HighScores))
Box(0, 0, OutputWidth(), OutputHeight(), $333333)
DrawingMode(#PB_2DDrawing_Transparent)
Y = 5
DrawingFont(FontID(F))
For i = 1 To 10
t$ = RSet(Str(i), 2, " ") + " - " + HighScores(i)\Nom + Character(".", 10 - Len(HighScores(i)\Nom)) + RSet(Str(HighScores(i)\Score), 8, "0")
Couleur = RGB(114, 217 - ((i - 1) * 8), 117)
DrawText(5, Y + ((i - 1) * TextHeight(t$)), t$, Couleur); $75D972)
Next i
StopDrawing()
EndIf
EndProcedure
Procedure GameOver()
GameInProgress = #False
GO.s = "Game Over !"
;F = LoadFont(#PB_Any, "Phosphate", 32, #PB_Font_HighQuality)
CompilerIf #PB_Compiler_OS = #PB_OS_MacOS
F = LoadFont(#PB_Any, "Noteworthy", 40, #PB_Font_HighQuality)
CompilerElse
F = LoadFont(#PB_Any, "Showcard Gothic", 20, #PB_Font_HighQuality)
CompilerEndIf
If StartDrawing(CanvasOutput(#Grille))
Box(DesktopScaledX(10), DesktopScaledY(245), DesktopScaledX(230), DesktopScaledY(60), #Black)
DrawingMode(#PB_2DDrawing_Gradient)
FrontColor(#White)
BackColor($37B0FA)
LinearGradient(DesktopScaledX(11), DesktopScaledY(246), DesktopScaledX(240), DesktopScaledY(246))
Box(DesktopScaledX(11), DesktopScaledY(246), DesktopScaledX(228), DesktopScaledY(58)) ;, #Black)
DrawingMode(#PB_2DDrawing_Transparent)
DrawingFont(FontID(F))
DrawText(DesktopScaledX(125) - (TextWidth(GO) / 2), DesktopScaledY(275) - (TextHeight(GO) / 2), GO, #Red)
StopDrawing()
EndIf
For i = 1 To 10
If Score > HighScores(i)\Score
If i = 1
Txt$ = "Vous avez le meilleur score !"
Else
Txt$ = "Vous êtes " + Str(i) + "è !"
EndIf
N$ = InputRequester(Txt$, "Entrez votre nom", "")
For j = 9 To i Step -1
HighScores(j + 1) = HighScores(j)
Next j
HighScores(i)\Nom = Left(N$, 9)
HighScores(i)\Score = Score
Break
EndIf
Next
AfficheHiscores()
EndProcedure
Procedure ClearGrille()
Protected i.b, j.b
XPiece = XOrigine
YPiece = YOrigine
If StartDrawing(CanvasOutput(#Grille))
Box(0, 0, OutputWidth(), OutputHeight(), #CouleurFond)
StopDrawing()
EndIf
For i = 0 To #LargeurGrille
For j = 0 To #HauteurGrille
Grille(i, j) = 0
Next j
Next i
Score = 0
Lignes = 0
Level = 1
Tempo = 1000 - ((Level - 1) * 100)
RemoveWindowTimer(#MainWindow, #Timer)
AddWindowTimer(#MainWindow, #Timer, Tempo)
AfficheScore()
AfficheHiscores()
EndProcedure
Procedure MoveDown()
If GameInProgress = #True
If CanMoveDown(Piece, XPiece, YPiece)
EffacePiece(Piece, XPiece, YPiece)
YPiece = YPiece + 1
DessinPiece(Piece, XPiece, YPiece)
ProcedureReturn #True
Else
DeposePiece(Piece, XPiece, YPiece)
XPiece = XOrigine
YPiece = YOrigine
Piece = NextPiece
NextPiece = Random(7, 1)
DessinNext(NextPiece)
If CanPutPiece(Piece, XPiece, YPiece) = #False
GameOver()
Else
DessinPiece(Piece, XPiece, YPiece)
ProcedureReturn #False
EndIf
EndIf
EndIf
EndProcedure
Procedure NewGame()
SetActiveGadget(#Grille)
ClearGrille()
GameInProgress = #True
Piece = Random(7, 1)
NextPiece = Random(7, 1)
DessinPiece(Piece, XPiece, YPiece)
DessinNext(NextPiece)
EndProcedure
Procedure Initialisations()
Couleur(1) = $3B00FF
Couleur(2) = $EA7361 ; Bleu
Couleur(3) = $4EAFFE ; Orange
Couleur(4) = #Magenta
Couleur(5) = #White
Couleur(6) = #Cyan
Couleur(7) = #Green
SetWindowTitle(#MainWindow, #AppName + " © 2023 - v " + #AppVersion)
For i = 1 To 7
Img = CreateImage(#PB_Any, LargeurCase, LargeurCase)
If StartDrawing(ImageOutput(Img))
Box(0, 0, LargeurCase, LargeurCase, #Black)
DrawingMode(#PB_2DDrawing_Gradient)
FrontColor(#Black)
BackColor(Couleur(i))
CircularGradient(12, 12, 50)
Box(1, 1, LargeurCase - 2, LargeurCase - 2, Couleur(i))
Shape(i) = Img
StopDrawing()
EndIf
Next i
i = 0
FicHiScores = OpenFile(#PB_Any, #HighScoresFile)
If FicHiScores
While Eof(FicHiScores) = 0
i = i + 1
L$ = ReadString(FicHiScores)
HighScores(i)\Nom = StringField(L$, 1, ";")
HighScores(i)\Score = Val(StringField(L$, 2, ";"))
Wend
CloseFile(FicHiScores)
Else
For i = 1 To 10
HighScores(i)\Nom = "XXXXX"
HighScores(i)\Score = (10 - i) * 100
Next i
EndIf
If StartDrawing(CanvasOutput(#Next))
Box(0, 0, OutputWidth(), OutputHeight(), #Black)
DrawingMode(#PB_2DDrawing_Gradient)
BackColor(#CouleurFond)
FrontColor($999999)
LinearGradient(1, 1, 1, OutputHeight() - 2)
Box(1, 1, OutputWidth() - 2, OutputHeight() - 2)
StopDrawing()
EndIf
CompilerIf #PB_Compiler_OS = #PB_OS_MacOS
CreateMenu(#MainMenu, WindowID(#MainWindow))
MenuTitle("&File")
MenuItem(#PB_Menu_About, "")
CompilerEndIf
EndProcedure
OpenMainWindow()
Initialisations()
AddWindowTimer(#MainWindow, #Timer, Tempo)
ClearGrille()
;BindEvent(#PB_Event_Timer, @MoveDown(), #MainWindow)
BindGadgetEvent(#ButtonNewGame, @NewGame())
Repeat
Event = WaitWindowEvent()
Select Event
Case #PB_Event_CloseWindow
Break
Case #PB_Event_Menu
Select EventMenu()
CompilerIf #PB_Compiler_OS = #PB_OS_MacOS
Case #PB_Menu_About
PostEvent(#PB_Event_Menu, #MainWindow, #MainMenuAbout)
Case #PB_Menu_Preferences
Case #PB_Menu_Quit
PostEvent(#PB_Event_CloseWindow, #MainWindow, #Null)
CompilerEndIf
Case #MainMenuAbout
MessageRequester(#AppName, "Written by Mindphazer" + #LF$ + "v " + #AppVersion, #PB_MessageRequester_Info)
Case #MainMenuExit
PostEvent(#PB_Event_CloseWindow, #MainWindow, #Null)
EndSelect
Case #PB_Event_Timer
If EventTimer() = #Timer
MoveDown()
EndIf
Case #PB_Event_Gadget
Select EventGadget()
Case #ButtonQuit
Break
Case #Grille
If EventType() = #PB_EventType_KeyDown And GameInProgress = #True
Select GetGadgetAttribute(#Grille, #PB_Canvas_Key)
Case #PB_Shortcut_Down
MoveDown()
Case #PB_Shortcut_Space
While MoveDown() = #True
;Repeat
;Until WindowEvent()
Wend
Case #PB_Shortcut_Up
If CanRotate(Piece, XPiece, YPiece)
RotatePiece(Piece, XPiece, YPiece)
EndIf
Case #PB_Shortcut_Right
If CanMoveRight(Piece, XPiece, YPiece)
EffacePiece(Piece, XPiece, YPiece)
XPiece = XPiece + 1
DessinPiece(Piece, XPiece, YPiece)
EndIf
Case #PB_Shortcut_Left
If CanMoveLeft(Piece, XPiece, YPiece)
EffacePiece(Piece, XPiece, YPiece)
XPiece = XPiece - 1
DessinPiece(Piece, XPiece, YPiece)
EndIf
Case #PB_Shortcut_Escape
GameInProgress = #False
ClearGrille()
EndSelect
EndIf
EndSelect
EndSelect
ForEver
FicHiScores = CreateFile(#PB_Any, #HighScoresFile)
If FicHiScores
For i = 1 To 10
WriteStringN(FicHiScores, HighScores(i)\Nom + ";" + Str(HighScores(i)\Score))
Next i
CloseFile(FicHiScores)
EndIf