Page 1 of 5

PureTris !

Posted: Thu Apr 20, 2023 9:01 am
by Mindphazer
Hello to all,
after having seen the movie "Tetris" on AppleTV (if you have the opportunity to see it, I recommend it to you!), and as I had some time, I developed a small Tetris.
It's unpretentious, certainly perfectible, but it works...
For those who, like me, spent hours (and a lot of money) playing it, I tried to remake the original Tetris (nostalgia!!)
It is played with the keyboard only:
Left arrow : move the piece to the left
Right arrow : move the piece to the right
Down arrow : move the piece down one line
Up arrow : rotate (counterclockwise) the piece
A : rotate (clockwise) the piece
Space : makes the piece fall
Escape: Pauses and hides the game (panic key !! :mrgreen: )
P : Pauses the game
N : New game
C : Hold the piece
Q : Quits the game in progress


The game was originally developed on MacOS, and is functional on Windows. No API, so there's no reason why it can't work on Linux, but I didn't test it
I use fonts that are not necessarily installed on all computers, so there might be some adaptations to do at this level

PS : some words in the game are in french as i'm french !!

Update : A few enhancements (thanks to Fred & Infratec !) and the possibility to pause the game (key P)

Update June, 30th :
A new version of PureTris has been released
The program includes a number of internal improvements and visual modifications.
Sounds have been added, and can be activated by checking "Sounds". In this case, the sound library must first be loaded.
If the sounds are not loaded, PureTris will still work!
- All texts are now included in DataSection, to facilitate multilingual management.
Simply set the "Lang" variable with the country code ("FRA", "ENG", "ITA", "ESP", Etc...), and create a DataSection "TextsLANG:" replacing "LANG" with the country code. Then add a Case with your Lang in the Select/Endselect section (line 1150)
By default, everything is in French
- The piece can now be rotated clockwise (key A)
- No more .pbf files to include. The form is now included in the main source
- The Q key is used to quit a game in progress.
- The calculation of speed has been modified - the game was unplayable at high levels! Timer decreases by 10% with each level change
- The random distribution of coins has been revised so that statistics are uniform for each coin (it's impossible to have the same coin 3 times in a row).

Update July, 22th :
- No more statistics
- You can hold the piece (C key)
- The shadow is an option
- Playing time is now stored in the hiscores

Update July, 24th :
New procedure to get the default language (thanks AJZIO). 4 languages so far (Fra, Eng, Ger, and Rus)

The source is too big to be published here, so you can download it here : https://workupload.com/file/4qvGLwsZ5Wf

Have fun !

Re: PureTris !

Posted: Thu Apr 20, 2023 9:22 am
by Caronte3D
Well done, I like it :wink:

Re: PureTris !

Posted: Thu Apr 20, 2023 9:28 am
by Mindphazer
Thanks a lot !!

Re: PureTris !

Posted: Fri Apr 21, 2023 1:15 am
by idle
well done thanks

Re: PureTris !

Posted: Fri Apr 21, 2023 7:53 am
by Mindphazer
Thank you idle
Glad you like it !

Re: PureTris !

Posted: Fri Apr 21, 2023 8:22 am
by dige
@Mindphazer: great Tetris implementation with so few lines of code!
Do you like to change the event handling to BindEvent, then this would also be something for the SpiderBasic Showcase :D

Greetz dige

Re: PureTris !

Posted: Fri Apr 21, 2023 8:56 am
by jacdelad
Very cool and compact. 8)

Re: PureTris !

Posted: Fri Apr 21, 2023 10:53 am
by Mindphazer
dige wrote: Fri Apr 21, 2023 8:22 am @Mindphazer: great Tetris implementation with so few lines of code!
Do you like to change the event handling to BindEvent, then this would also be something for the SpiderBasic Showcase :D

Greetz dige
Thanks !

Yeah, sure, why not ! :D
I'll have a look

Re: PureTris !

Posted: Fri Apr 21, 2023 10:53 am
by Mindphazer
jacdelad wrote: Fri Apr 21, 2023 8:56 am Very cool and compact. 8)
Thanks !

Re: PureTris !

Posted: Fri Apr 21, 2023 11:12 am
by luis
Very nice :D

Re: PureTris !

Posted: Fri Apr 21, 2023 11:18 am
by Mindphazer
luis wrote: Fri Apr 21, 2023 11:12 amVery nice :D
Thank you Luis ! :D

Re: PureTris !

Posted: Fri Apr 21, 2023 1:51 pm
by Fred
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

Re: PureTris !

Posted: Fri Apr 21, 2023 2:27 pm
by NicTheQuick
Works on Linux too. 8)

Re: PureTris !

Posted: Fri Apr 21, 2023 2:51 pm
by Mindphazer
Fred wrote: Fri Apr 21, 2023 1:51 pm 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.
Thanks Fred !
And thanks for the tip about OutputWidth/Height(), i'll have a look

Re: PureTris !

Posted: Fri Apr 21, 2023 2:51 pm
by Mindphazer
NicTheQuick wrote: Fri Apr 21, 2023 2:27 pm Works on Linux too. 8)
Glad it does, thanks for testing :)