PureBasic Forums - English

Posted: **Tue Jun 03, 2025 5:56 pm**

Hi all,
following SPH's Magic 4x4, here's my Pure2048
The rules are the same, and the code is -hopefully- cross-platform (developped on MacOS, tested on Win11 and Ubuntu 22.04)

To SPH : i'm not challenging you

My version is more similar to the original 2048 game !

Share your scores (24520 for me)

Code: Select all

; _______           _______  _______  _______  _______     ___    _____  
;(  ____ )|\     /|(  ____ )(  ____ \/ ___   )(  __   )   /   )  / ___ \ 
;| (    )|| )   ( || (    )|| (    \/\/   )  || (  )  |  / /) | ( (___) )
;| (____)|| |   | || (____)|| (__        /   )| | /   | / (_) (_ \     / 
;|  _____)| |   | ||     __)|  __)     _/   / | (/ /) |(____   _)/ ___ \ 
;| (      | |   | || (\ (   | (       /   _/  |   / | |     ) ( ( (   ) )
;| )      | (___) || ) \ \__| (____/\(   (__/\|  (__) |     | | ( (___) )
;|/       (_______)|/   \__/(_______/\_______/(_______)     (_)  \_____/ 
;                                                                        
; Code by Mindphazer 2025
; Version 1.3.4

Enumeration Gadgets
  #MainWindow
  #PlayingScreen
  #Arial
  #ArialSmall
  #ArialScore
  #TimerAnimation
  #TimerFlash
  #KeyUp
  #KeyDown
  #KeyLeft
  #KeyRight
  #KeyESC
  #KeyUndo
  #KeyNouveau
  #KeyQuitter
  #MainMenu
  #MenuNouveau
  #MenuUndo
  #MenuQuitter
  #MenuAbout
EndEnumeration

#GridSize = 4
#TileSize = 120
#Padding = 10
#IndexMenu = 51
#Version = "1.3.4"
#MergeAnimDuration = 150 ; Duration of merge animation in ms

CompilerIf #PB_Compiler_OS = #PB_OS_MacOS
  LoadFont(#ArialSmall, "Arial", 14 * DesktopResolutionX(), #PB_Font_Bold)
  LoadFont(#ArialScore, "Arial", 28 * DesktopResolutionX(), #PB_Font_Bold)
  LoadFont(#Arial, "Arial", (#TileSize / 2.5) * DesktopResolutionX(), #PB_Font_Bold)
  #MenuPadding = 0
CompilerElse
  LoadFont(#ArialSmall, "Arial", 12, #PB_Font_Bold)
  LoadFont(#ArialScore, "Arial", 22, #PB_Font_Bold)
  LoadFont(#Arial, "Arial", #TileSize / 4, #PB_Font_Bold)
  #MenuPadding = 20
CompilerEndIf

#HeaderHeight = 70
#WindowWidth = #GridSize * (#TileSize + #Padding) + #Padding 
#WindowHeight = #HeaderHeight + #GridSize * (#TileSize + #Padding) + #Padding + #MenuPadding
#NewTileAnimDuration = 200 ; en ms

Global Dim Grid.i(#GridSize - 1, #GridSize - 1)
Global Dim _SaveGrid.i(#GridSize - 1, #GridSize - 1)
Global Score
Global GameOver.b
Global HighScore
Global NewHiscore.b
Global NBThemes
Global CanUndo.b, PreviousScore

Structure NewTile
  x.i
  y.i
  value.i
EndStructure

Structure MergeTile
  x.i
  y.i
  value.i
  startTime.i
EndStructure

Structure TileColor
  BackColor.i
  TextColor.i
EndStructure

Structure Theme
  Map Colors.TileColor()
EndStructure

Global NewTileAnim.NewTile
Global NewTileAnimActive.b = #False
Global NewTileAnimStartTime.i
Global NewList MergeTiles.MergeTile()
Global MergeAnimActive.b = #False
Global NewMap Themes.Theme()
Global NewMap Language.s()
Global ThemeApplique.s = "Pastel 2"

Procedure.s GetLanguage()
  ;
  ; Cette fonction permet de récupérer la langue native du système, selon le type d'OS
  ;
  Protected Result.s
  CompilerIf #PB_Compiler_OS = #PB_OS_MacOS               ; Thanks to Danilo
    Protected NSUserDefaults_defs, NSString_locale
    NSUserDefaults_defs = CocoaMessage(0, 0, "NSUserDefaults standardUserDefaults")
    If NSUserDefaults_defs
      NSString_locale = CocoaMessage(0, NSUserDefaults_defs, "objectForKey:$", @"AppleLocale")
      If NSString_locale
        Result = Left(PeekS(CocoaMessage(0, NSString_locale, "UTF8String"), -1, #PB_UTF8), 2)
      EndIf
    EndIf
    ProcedureReturn Result
  CompilerElseIf #PB_Compiler_OS = #PB_OS_Windows         ; Thanks to Rescator
    Define dll.i, text$, len.i, *GetLocaleInfo
	  dll = OpenLibrary(#PB_Any,"kernel32.dll")
	  If dll
	  	CompilerIf #PB_Compiler_Unicode
		  	*GetLocaleInfo = GetFunction(dll, "GetLocaleInfoW")
		  CompilerElse
			*GetLocaleInfo = GetFunction(dll, "GetLocaleInfoA")
	  	CompilerEndIf
	  	If *GetLocaleInfo
	  		len = CallFunctionFast(*GetLocaleInfo, #LOCALE_USER_DEFAULT, $0059, #Null, #Null)
	  		If len
	  			text$ = Space(len - 1)
	  			If CallFunctionFast(*GetLocaleInfo, #LOCALE_USER_DEFAULT, $0059, @text$, len)
	  				Result = text$
	  			EndIf
	  		EndIf
  		EndIf
  		CloseLibrary(dll)
  	EndIf
  	ProcedureReturn Result
	CompilerElseIf #PB_Compiler_OS = #PB_OS_Linux           ; Thanks to AZJIO
		If ExamineEnvironmentVariables()
		  While NextEnvironmentVariable()
		    If Left(EnvironmentVariableName(), 4) = "LANG"
					Result = Left(EnvironmentVariableValue(), 2)
				  Break
				EndIf
		  Wend
		EndIf
		ProcedureReturn Result
  CompilerEndIf
EndProcedure

Procedure DrawAntiAliasedRoundBox(x, y, width, height, radius, color, alpha = 255)
  If radius > width / 2 : radius = width / 2 : EndIf
  If radius > height / 2 : radius = height / 2 : EndIf
  VectorSourceColor(RGBA(Red(color), Green(color), Blue(color), alpha))
  MovePathCursor(x + radius, y)
  AddPathLine(x + width - radius, y)
  AddPathCurve(x + width, y, x + width, y, x + width, y + radius)
  AddPathLine(x + width, y + height - radius)
  AddPathCurve(x + width, y + height, x + width, y + height, x + width - radius, y + height)
  AddPathLine(x + radius, y + height)
  AddPathCurve(x, y + height, x, y + height, x, y + height - radius)
  AddPathLine(x, y + radius)
  AddPathCurve(x, y, x, y, x + radius, y)
  ClosePath()
  FillPath()
EndProcedure

Procedure AnimateNewTile(x, y, value)
  NewTileAnimActive = #True
  NewTileAnimStartTime = ElapsedMilliseconds()
  AddWindowTimer(#MainWindow, #TimerAnimation, 16) ; timer de 16 ms (~60 FPS)
EndProcedure

Procedure AddRandomTile()
  Protected EmptyTiles.i = 0, x, y, i, r, count = 0
  Protected Dim empties(15, 1) ; max 16 cases
  For x = 0 To 3
    For y = 0 To 3
      If Grid(x, y) = 0
        empties(count, 0) = x
        empties(count, 1) = y
        count + 1
      EndIf
    Next
  Next
  If count = 0 : ProcedureReturn : EndIf

  r = Random(count - 1)
  x = empties(r, 0)
  y = empties(r, 1)

  ; 90% chance pour 2, 10% pour 4
  If Random(99) < 90
    NewTileAnim\value = 2
  Else
    NewTileAnim\value = 4
  EndIf
  NewTileAnim\x = x
  NewTileAnim\y = y

  Grid(x, y) = NewTileAnim\value

  ; Démarre l'animation d'apparition
  AnimateNewTile(x, y, NewTileAnim\value)
EndProcedure

Procedure CenterText(X, Y, W, Texte.s, Font, Color, Alpha = 255)
  Protected XT
  VectorFont(FontID(Font))
  XT = X + (W / 2) - (VectorTextWidth(Texte) / 2)
  VectorSourceColor(RGBA(Red(color), Green(color), Blue(color), Alpha))
  MovePathCursor(XT, Y)
  DrawVectorText(texte)
EndProcedure

Procedure DrawGrid()
  Protected x, y, val$, color, tx, ty
  Protected now = ElapsedMilliseconds()
  Protected animScale.f = 1.0, mergeScale.f
  If Score > HighScore
    NewHiscore = #True
    HighScore = Score
  EndIf
  If StartVectorDrawing(CanvasVectorOutput(#PlayingScreen))
    DrawAntiAliasedRoundBox(0, 0, VectorOutputWidth(), VectorOutputHeight(), 0, RGB(250, 248, 239))
    VectorFont(FontID(#ArialSmall))
    VectorSourceColor(RGBA(119, 110, 101, 255))
    LScore = DesktopScaledY((#TileSize + #Padding))
    XScore = (VectorOutputWidth() / 4) - (LScore / 2)
    Xhigh = (VectorOutputWidth() / 2) + (VectorOutputWidth() / 4) - (LScore / 2)
    DrawAntiAliasedRoundBox(XScore, DesktopScaledY(10), LScore, DesktopScaledY(50), 40, RGB(238, 228, 218))
    DrawAntiAliasedRoundBox(Xhigh, DesktopScaledY(10), LScore, DesktopScaledY(50), 40, RGB(238, 228, 218))
    CenterText(XScore, DesktopScaledY(13), LScore, language("Score"), #ArialSmall, RGB(119, 110, 101))
    CenterText(XScore, DesktopScaledY(27), LScore, Str(Score), #ArialScore, RGB(119, 110, 101))
    CenterText(Xhigh, DesktopScaledY(13), LScore, Language("HighScore"), #ArialSmall, RGB(119, 110, 101))
    CenterText(Xhigh, DesktopScaledY(27), LScore, Str(HighScore), #ArialScore, RGB(119, 110, 101))
    VectorFont(FontID(#Arial))
    For x = 0 To #GridSize - 1
      For y = 0 To #GridSize - 1
        color = RGB(205, 193, 180)
        If Grid(x, y) > 0
          color = Themes(ThemeApplique)\Colors(Str(grid(x, y)))\BackColor
        EndIf
        ; Animation d'apparition
        If NewTileAnimActive And x = NewTileAnim\x And y = NewTileAnim\y
          elapsed = now - NewTileAnimStartTime
          If elapsed < #NewTileAnimDuration
            animScale = 0.5 + 0.5 * (elapsed / #NewTileAnimDuration)
          Else
            animScale = 1.0
            NewTileAnimActive = #False
          EndIf
        Else
          animScale = 1.0
        EndIf
        ; Animation de fusion
        mergeScale = 1.0
        ForEach MergeTiles()
          If MergeTiles()\x = x And MergeTiles()\y = y
            elapsed = now - MergeTiles()\startTime
            If elapsed < #MergeAnimDuration
              ; Pulsation : grossit jusqu'à 1.2 puis revient à 1.0
              mergeScale = 1.0 + 0.2 * Sin((elapsed / #MergeAnimDuration) * #PI)
            Else
              DeleteElement(MergeTiles())
            EndIf
          EndIf
        Next
        ; Appliquer l'échelle maximale (apparition ou fusion)
        animScale = animScale * mergeScale

        tileX = DesktopScaledX(#Padding + x * (#TileSize + #Padding))
        tileY = DesktopScaledY(#HeaderHeight + #Padding + y * (#TileSize + #Padding))
        tileW = DesktopScaledX(#TileSize)
        tileH = DesktopScaledY(#TileSize)

        If animScale <> 1.0 And Grid(x, y) > 0
          cx = tileX + tileW / 2
          cy = tileY + tileH / 2
          w2 = tileW * animScale / 2
          h2 = tileH * animScale / 2
          DrawAntiAliasedRoundBox(cx - w2, cy - h2, tileW * animScale, tileH * animScale, 40, color)
          val$ = Str(Grid(x, y))
          tx = cx - VectorTextWidth(val$) / 2
          ty = cy - VectorTextHeight(val$) / 2
          BColor = Themes(ThemeApplique)\Colors(val$)\BackColor
          Tcolor = Themes(ThemeApplique)\Colors(val$)\TextColor
          VectorSourceColor(RGBA(Red(Tcolor), Green(Tcolor), Blue(Tcolor), 255))
          MovePathCursor(tx, ty)
          DrawVectorText(val$)
        Else
          DrawAntiAliasedRoundBox(tileX, tileY, tileW, tileH, 40, color)
          If Grid(x, y) > 0
            val$ = Str(Grid(x, y))
            VectorFont(FontID(#Arial))
            tx = tileX + (tileW - VectorTextWidth(val$)) / 2
            ty = tileY + (tileH - VectorTextHeight(val$)) / 2
            BColor = Themes(ThemeApplique)\Colors(val$)\BackColor
            Tcolor = Themes(ThemeApplique)\Colors(val$)\TextColor
            VectorSourceColor(RGBA(Red(Tcolor), Green(Tcolor), Blue(Tcolor), 255))
            MovePathCursor(tx, ty)
            DrawVectorText(val$)
          EndIf
        EndIf
      Next
    Next

    If GameOver
      AddWindowTimer(#MainWindow, #TimerFlash, 16)
      If NewHiscore = #True
        HighScoreFile = OpenFile(#PB_Any, GetTemporaryDirectory() + "2048High.fic")
        If HighScoreFile
          WriteStringN(HighScoreFile, Str(Score))
          CloseFile(HighScoreFile)
        EndIf
      EndIf
    EndIf
    StopVectorDrawing()
  EndIf
  ; Si aucune animation n'est active, arrêter le timer
  If Not NewTileAnimActive And ListSize(MergeTiles()) = 0
    RemoveWindowTimer(#MainWindow, #TimerAnimation)
  EndIf
EndProcedure

Procedure CollapseLine(Array _Line(1), reverse, x.i = -1, y.i = -1, direction.i = -1)
  Protected i, j, changed = #False, merged = #False
  Protected Dim temp(3)
  Protected mergeIndex = -1
  Protected mergePos = -1

  If reverse
    For i = 3 To 0 Step -1
      If _Line(i) > 0
        temp(j) = _Line(i)
        j + 1
      EndIf
    Next
  Else
    For i = 0 To 3
      If _Line(i) > 0
        temp(j) = _Line(i)
        j + 1
      EndIf
    Next
  EndIf

  For i = 0 To 2
    If temp(i) > 0 And temp(i) = temp(i + 1)
      temp(i) * 2
      Score + temp(i)
      temp(i + 1) = 0
      merged = #True
      mergeIndex = i
    EndIf
  Next

  j = 0
  Dim result(3)
  For i = 0 To 3
    If temp(i) > 0
      result(j) = temp(i)
      If i = mergeIndex
        AddElement(MergeTiles())
        MergeTiles()\value = result(j)
        MergeTiles()\startTime = ElapsedMilliseconds()
        ; Définir les coordonnées en fonction de la direction
        If direction = #KeyUp Or direction = #KeyDown
          MergeTiles()\x = x
          MergeTiles()\y = j
          If reverse And direction = #KeyDown
            MergeTiles()\y = 3 - j
          EndIf
        ElseIf direction = #KeyLeft Or direction = #KeyRight
          MergeTiles()\x = j
          MergeTiles()\y = y
          If reverse And direction = #KeyRight
            MergeTiles()\x = 3 - j
          EndIf
        EndIf
        MergeAnimActive = #True
        AddWindowTimer(#MainWindow, #TimerAnimation, 16)
      EndIf
      j + 1
    EndIf
  Next

  For i = 0 To 3
    If _Line(i) <> result(i)
      changed = #True
    EndIf
    _Line(i) = result(i)
  Next
  ProcedureReturn changed
EndProcedure

Procedure.i CanMove()
  Protected x, y
  For x = 0 To 3
    For y = 0 To 3
      If Grid(x, y) = 0
        ProcedureReturn #True
      EndIf
      If x < 3 And Grid(x, y) = Grid(x + 1, y)
        ProcedureReturn #True
      EndIf
      If y < 3 And Grid(x, y) = Grid(x, y + 1)
        ProcedureReturn #True
      EndIf
    Next
  Next
  ProcedureReturn #False
EndProcedure

Procedure About()
  MessageRequester("Pure2048", "Version " + #Version + #CRLF$ + "Written with Purebasic " + #PB_Compiler_Version + #CRLF$ + "(c) 2025 - Mindphazer")
EndProcedure

Procedure InitGame()
  Protected x, y
  Score = 0
  GameOver = #False
  NewHiscore = #False
  CanUndo = #False
  RemoveWindowTimer(#MainWindow, #TimerFlash)
  ClearList(MergeTiles())
  For x = 0 To #GridSize - 1
    For y = 0 To #GridSize - 1
      Grid(x, y) = 0
    Next
  Next
  AddRandomTile()
  AddRandomTile()
EndProcedure

Procedure TimerHandle()
  If EventTimer() = #TimerAnimation
    DrawGrid()
  ElseIf EventTimer() = #TimerFlash
    Protected T.s = "Game Over"
    Protected Tx, Ty
    StartVectorDrawing(CanvasVectorOutput(#PlayingScreen))
    VectorFont(FontID(#Arial))
    Tx = (VectorOutputWidth() - VectorTextWidth(T)) / 2
    Ty = (VectorOutputHeight() - VectorTextHeight(T)) / 2
    DrawAntiAliasedRoundBox(Tx - 20, Ty - 20, VectorTextWidth(T) + 40, VectorTextHeight(T) + 40, 40, RGB(100, 100, 100), 50)
    VectorSourceColor(RGBA(100, 60, 40, 255))
    MovePathCursor(Tx + 1, Ty + 1)
    DrawVectorText(T)
    VectorSourceColor(RGBA(255, 16, 100, 128 + Sin(ElapsedMilliseconds() * 0.005) * 127 ))
    MovePathCursor(Tx, Ty)
    DrawVectorText(T)
    StopVectorDrawing()    
  EndIf
EndProcedure

Procedure SaveGrid()
  CopyArray(Grid(), _SaveGrid())
  PreviousScore = Score
  CanUndo = #True
EndProcedure

Procedure MenuHandler()
  Protected x, y, changed = #False, i
  Protected Dim _Line(3)
  Select EventMenu()
    Case #KeyDown
      If Not GameOver
        SaveGrid()
        For x = 0 To #GridSize - 1
          For y = 0 To #GridSize - 1 : _Line(y) = Grid(x, y) : Next
          If CollapseLine(_Line(), #True, x, -1, #KeyDown)
            changed = #True
          EndIf
          For y = 0 To #GridSize - 1 : Grid(x, y) = _Line(3 - y) : Next
        Next
      EndIf
    Case #KeyUp
      If Not GameOver
        SaveGrid()
        For x = 0 To #GridSize - 1
          For y = 0 To #GridSize - 1 : _Line(y) = Grid(x, y) : Next
          If CollapseLine(_Line(), #False, x, -1, #KeyUp)
            changed = #True
          EndIf
          For y = 0 To #GridSize - 1 : Grid(x, y) = _Line(y) : Next
        Next
      EndIf
    Case #KeyLeft
      If Not GameOver
        SaveGrid()
        For y = 0 To #GridSize - 1
          For x = 0 To #GridSize - 1 : _Line(x) = Grid(x, y) : Next
          If CollapseLine(_Line(), #False, -1, y, #KeyLeft)
            changed = #True
          EndIf
          For x = 0 To #GridSize - 1 : Grid(x, y) = _Line(x) : Next
        Next
      EndIf
    Case #KeyRight
      If Not GameOver
        SaveGrid()
        For y = 0 To #GridSize - 1
          For x = 0 To #GridSize - 1 : _Line(x) = Grid(x, y) : Next
          If CollapseLine(_Line(), #True, -1, y, #KeyRight)
            changed = #True
          EndIf
          For x = 0 To #GridSize - 1 : Grid(x, y) = _Line(3 - x) : Next
        Next
      EndIf
    Case #KeyESC
      If Not GameOver
        GameOver = #True
        DrawGrid()
      EndIf
    Case #MenuAbout
      About()
    Case #MenuQuitter, #KeyQuitter
      If Not GameOver
        If MessageRequester(Language("Attention"), language("Abandon"), #PB_MessageRequester_YesNo) = #PB_MessageRequester_Yes
          PostEvent(#PB_Event_CloseWindow)
        EndIf
      Else
        PostEvent(#PB_Event_CloseWindow)
      EndIf
    Case #MenuUndo, #KeyUndo
      If CanUndo
        CopyArray(_SaveGrid(), Grid())
        If HighScore = Score
          HighScore = PreviousScore
        EndIf
        Score = PreviousScore
        DrawGrid()
        CanUndo = #False
      EndIf
    Case #MenuNouveau, #KeyNouveau
      If Not GameOver
        If MessageRequester(Language("Attention"), language("Abandon"), #PB_MessageRequester_YesNo) = #PB_MessageRequester_Yes
          InitGame()
        EndIf
      Else
        InitGame()
      EndIf
    Case #IndexMenu To #IndexMenu + NBThemes
      ThemeApplique = GetMenuItemText(#MainMenu, EventMenu())
      For i = #IndexMenu To #IndexMenu + NBThemes
        If GetMenuItemText(#MainMenu, i) = ThemeApplique
          SetMenuItemState(#MainMenu, i, 1)  
        Else
          SetMenuItemState(#MainMenu, i, 0)
        EndIf
      Next i
      DrawGrid()
    CompilerIf #PB_Compiler_OS = #PB_OS_MacOS
      Case #PB_Menu_Quit
        PostEvent(#PB_Event_CloseWindow)
      Case #PB_Menu_About
        About()
    CompilerEndIf
  EndSelect
  If changed
    AddRandomTile()
    If Not CanMove()
      GameOver = #True
    EndIf
  EndIf
EndProcedure

Procedure InitWindow()
  Protected ThemesName$, index, b, t
  OpenWindow(#MainWindow, 100, 100, #WindowWidth, #WindowHeight, "Pure2048", #PB_Window_SystemMenu | #PB_Window_ScreenCentered | #PB_Window_MinimizeGadget)
  HighScoreFile = ReadFile(#PB_Any, GetTemporaryDirectory() + "2048High.fic")
  If HighScoreFile
    HighScore = Val(ReadString(HighScoreFile))
    CloseFile(HighScoreFile)
  EndIf
  CanvasGadget(#PlayingScreen, 0, 0, #WindowWidth, #WindowHeight, #PB_Canvas_Keyboard)
  SetActiveGadget(#PlayingScreen)
  AddKeyboardShortcut(#MainWindow, #PB_Shortcut_Up, #KeyUp)
  AddKeyboardShortcut(#MainWindow, #PB_Shortcut_Down, #KeyDown)
  AddKeyboardShortcut(#MainWindow, #PB_Shortcut_Left, #KeyLeft)
  AddKeyboardShortcut(#MainWindow, #PB_Shortcut_Right, #KeyRight)
  AddKeyboardShortcut(#MainWindow, #PB_Shortcut_Escape, #KeyESC)
  
  CreateMenu(#MainMenu, WindowID(#MainWindow))
  MenuTitle(Language("MenuJeu"))
  CompilerIf #PB_Compiler_OS = #PB_OS_MacOS
    MenuItem(#PB_Menu_About, "")
    MenuItem(#PB_Menu_Preferences, "")
    MenuItem(#PB_Menu_Quit, "")
    MenuItem(#MenuNouveau, Language("MenuItemNouveau") + Chr(9) + "Cmd+N")
    MenuItem(#MenuUndo, Language("MenuItemUndo") + Chr(9) + "Cmd+Z")
    AddKeyboardShortcut(#MainWindow, #PB_Shortcut_Command | #PB_Shortcut_N, #KeyNouveau)
    AddKeyboardShortcut(#MainWindow, #PB_Shortcut_Command | #PB_Shortcut_Z, #KeyUndo)
  CompilerElse
    MenuItem(#MenuNouveau, Language("MenuItemNouveau") + Chr(9) + "Ctrl+N")
    MenuItem(#MenuUndo, Language("MenuItemUndo") + Chr(9) + "Ctrl+Z")
    MenuItem(#MenuQuitter, language("MenuItemQuit") + Chr(9) + "Ctrl+Q")
    AddKeyboardShortcut(#MainWindow, #PB_Shortcut_Control | #PB_Shortcut_N, #KeyNouveau)
    AddKeyboardShortcut(#MainWindow, #PB_Shortcut_Control | #PB_Shortcut_Z, #KeyUndo)
    AddKeyboardShortcut(#MainWindow, #PB_Shortcut_Control | #PB_Shortcut_Q, #KeyQuitter)
  CompilerEndIf
  Restore Couleurs
  MenuTitle(Language("MenuTheme"))
  Repeat
    Read.s ThemesName$
    If ThemesName$ <> "***"
      MenuItem(#IndexMenu + NBThemes, ThemesName$)
      If ThemesName$ = ThemeApplique
        SetMenuItemState(#MainMenu, #IndexMenu + NBThemes, 1)
      EndIf
      Repeat
        Read.i index
        Read.i b
        Read.i t
        Themes(ThemesName$)\Colors(Str(index))\BackColor = b
        Themes(ThemesName$)\Colors(Str(index))\TextColor = t
      Until index = 32768
      NBThemes + 1
    EndIf
  Until ThemesName$ = "***"
  CompilerIf #PB_Compiler_OS <> #PB_OS_MacOS
    MenuTitle("?")
    MenuItem(#MenuAbout, Language("MenuItemAbout"))
  CompilerEndIf
  
  BindEvent(#PB_Event_Timer, @TimerHandle())
  BindEvent(#PB_Event_Menu, @MenuHandler(), #MainWindow)
EndProcedure

Procedure InitLanguage()
  Select GetLanguage()
    Case "fr"
      Restore LanguageFR
    Case "de"
      Restore LanguageDE
    Case "it"
      Restore LanguageIT
    Case "us", "en"
      Restore LanguageUS
    Case "ru"
      Restore LanguageRU
    Default
      Restore LanguageUS
  EndSelect
  Repeat
    Read.s Title.s 
    Read.s Libelle.s
    If Title <> "*"
      Language(Title) = Libelle
      EndIf
  Until Title = "*" 
EndProcedure

InitLanguage()
InitWindow()
InitGame()
DrawGrid()

Repeat
  Event = WaitWindowEvent()
Until Event = #PB_Event_CloseWindow

DataSection
  LanguageFR:
  Data.s "MenuJeu", "Jeu"
  Data.s "MenuItemNouveau", "Nouveau"
  Data.s "MenuItemUndo", "Annuler dernier mouvement"
  Data.s "MenuItemQuit", "Quitter"
  Data.s "MenuTheme", "Thèmes"
  Data.s "MenuItemAbout", "A propos..."
  Data.s "Score", "SCORE"
  Data.s "HighScore", "MEILLEUR"
  Data.s "Attention", "Attention"
  Data.s "Abandon", "Voulez-vous abandonner la partie ?" + #CRLF$ + "Si vous avez un meilleur score, il ne sera pas sauvegardé."
  Data.s "*", "*"
  LanguageUS:
  Data.s "MenuJeu", "Game"
  Data.s "MenuItemNouveau", "New"
  Data.s "MenuItemUndo", "Undo Last Move"
  Data.s "MenuItemQuit", "Quit"
  Data.s "MenuTheme", "Themes"
  Data.s "MenuItemAbout", "About"
  Data.s "Score", "SCORE"
  Data.s "HighScore", "BEST"
  Data.s "Attention", "Attention"
  Data.s "Abandon", "Do you really want to leave the game ?" + #CRLF$ + "If you have a high score, it won't be saved."
  Data.s "*", "*"
  LanguageDE:    ; Thanks to NicTheQuick
  Data.s "MenuJeu", "Spiel"
  Data.s "MenuItemNouveau", "Neu"
  Data.s "MenuItemUndo", "Letzten Zug rückgängig machen"
  Data.s "MenuItemQuit", "Beenden"
  Data.s "MenuTheme", "Themen"
  Data.s "MenuItemAbout", "Über"
  Data.s "Score", "PUNKTE"
  Data.s "HighScore", "BESTE"
  Data.s "Attention", "Achtung"
  Data.s "Abandon", "Möchten Sie das Spiel abbrechen?" + #CRLF$ + "Wenn Sie eine höhere Punktzahl haben, wird diese nicht gespeichert."
  Data.s "*", "*"
  LanguageIT:
  Data.s "MenuJeu", "Gioco"
  Data.s "MenuItemNouveau", "Nuovo"
  Data.s "MenuItemUndo", "Annullamento dell'ultimo movimento"
  Data.s "MenuItemQuit", "Lasciare"
  Data.s "MenuTheme", "Tema"
  Data.s "MenuItemAbout", "Chi siamo"
  Data.s "Score", "PUNTEGGIO"
  Data.s "HighScore", "MIGLIOR"
  Data.s "Attention", "Attenzione"
  Data.s "Volete abbandonare la partita ?" + #CRLF$ + "Se avete un punteggio più alto, non verrà salvato."
  Data.s "*", "*"
  LanguageRU:
  Data.s "MenuJeu", "Игра"
  Data.s "MenuItemNouveau", "Новая"
  Data.s "MenuItemUndo", "Отменить последний ход"
  Data.s "MenuItemQuit", "Выйти"
  Data.s "MenuTheme", "Темы"
  Data.s "MenuItemAbout", "Об игре"
  Data.s "Score", "СЧЕТ"
  Data.s "HighScore", "ЛУЧШИЙ"
  Data.s "Attention", "Внимание"
  Data.s "Abandon", "Вы действительно хотите выйти из игры?" + #CRLF$ + "Если у вас будет высокий балл, он не будет сохранен."
  Data.s "*", "*"
  Couleurs:
  ; Thème bleu
  Data.s "Blue 1"
  Data.i     2, $EEE4DA, $776E65
  Data.i     4, $EDE0C8, $776E65
  Data.i     8, $F2B179, $F9F6F2
  Data.i    16, $F59563, $F9F6F2
  Data.i    32, $F67C5F, $F9F6F2
  Data.i    64, $F65E3B, $F9F6F2
  Data.i   128, $EDCF72, $F9F6F2
  Data.i   256, $EDCC61, $F9F6F2
  Data.i   512, $EDC850, $F9F6F2
  Data.i  1024, $EDC53F, $F9F6F2
  Data.i  2048, $EDC22E, $F9F6F2
  Data.i  4096, $323A3C, $F9F6F2
  Data.i  8192, $776E65, $F9F6F2
  Data.i 16384, $5A524A, $F9F6F2
  Data.i 32768, $3E3933, $F9F6F2
  
  ; Thème original
  Data.s "2048 Original"
  Data.i     2, $DAE4EE, $656E77
  Data.i     4, $C8E0ED, $656E77
  Data.i     8, $79B1F2, $F2F6F9
  Data.i    16, $6395F5, $F2F6F9
  Data.i    32, $5F7CF6, $F2F6F9
  Data.i    64, $3B5EF6, $F2F6F9
  Data.i   128, $72CFED, $F2F6F9
  Data.i   256, $61CCED, $F2F6F9
  Data.i   512, $50C8ED, $F2F6F9
  Data.i  1024, $3FC5ED, $F2F6F9
  Data.i  2048, $2EC2ED, $F2F6F9
  Data.i  4096, $323A3C, $F2F6F9
  Data.i  8192, $656E77, $F2F6F9
  Data.i 16384, $4A525A, $F2F6F9
  Data.i 32768, $33393E, $F2F6F9
  
  ; bleu
  Data.s "Blue 2"
  Data.i     2, $FAF7E0, $404D00
  Data.i     4, $F2EBB2, $404D00
  Data.i     8, $EADE80, $404D00
  Data.i    16, $E1D04D, $FFFFFF
  Data.i    32, $DAC626, $FFFFFF
  Data.i    64, $D4BC00, $FFFFFF
  Data.i   128, $C1AC00, $FFFFFF
  Data.i   256, $A79700, $FFFFFF
  Data.i   512, $8F8300, $FFFFFF
  Data.i  1024, $646000, $FFFFFF
  Data.i  2048, $404D00, $FFFFFF
  Data.i  4096, $B6E91D, $404D00
  Data.i  8192, $B8B8E3, $FFFFFF
  Data.i 16384, $D7A4D7, $FFFFFF
  Data.i 32768, $DDB7C6, $FFFFFF
  
  ; Variante thème original
  Data.s "2048"
  Data.i     2, $DAE4EE, $656E77
  Data.i     4, $C8E0ED, $656E77
  Data.i     8, $79B1F2, $F2F6F9
  Data.i    16, $6395F5, $F2F6F9
  Data.i    32, $5F7CF6, $F2F6F9
  Data.i    64, $3B5EF6, $F2F6F9
  Data.i   128, $72CFED, $F2F6F9
  Data.i   256, $61CCED, $F2F6F9
  Data.i   512, $50C8ED, $F2F6F9
  Data.i  1024, $48E0A3, $F2F6F9
  Data.i  2048, $55CC33, $F2F6F9
  Data.i  4096, $CCC400, $F2F6F9
  Data.i  8192, $CCA900, $F2F6F9
  Data.i 16384, $B37700, $F2F6F9
  Data.i 32768, $B33F7B, $F2F6F9
  
  ; Pastel 
  Data.s "Pastel"
  Data.i     2, $FAE6E6, $545D66
  Data.i     4, $D8BFD8, $545D66
  Data.i     8, $DDA0DD, $545D66
  Data.i    16, $B469FF, $545D66
  Data.i    32, $0045FF, $F2F6F9
  Data.i    64, $4763FF, $545D66
  Data.i   128, $00D7FF, $545D66
  Data.i   256, $2FFFAD, $545D66
  Data.i   512, $7FFF00, $545D66
  Data.i  1024, $D1CE00, $545D66
  Data.i  2048, $FF901E, $F2F6F9
  Data.i  4096, $CD5A6A, $F2F6F9
  Data.i  8192, $82004B, $F2F6F9
  Data.i 16384, $D30094, $F2F6F9
  Data.i 32768, $8B008B, $F2F6F9
  
  ; Néon
  Data.s "Neon"
  Data.i     2, $EFFF0A, $000000
  Data.i     4, $FFF90D, $000000
  Data.i     8, $FFE122, $000000
  Data.i    16, $FF883F, $000000
  Data.i    32, $FF5E80, $FFFFFF
  Data.i    64, $ED4DC7, $FFFFFF
  Data.i   128, $AA3CFF, $000000
  Data.i   256, $3C71FF, $000000
  Data.i   512, $3CD9FF, $000000
  Data.i  1024, $3CFFE8, $000000
  Data.i  2048, $3CFF98, $000000
  Data.i  4096, $14FF39, $000000
  Data.i  8192, $9314FF, $000000
  Data.i 16384, $FF00FF, $000000
  Data.i 32768, $E22B8A, $FFFFFF
  
  Data.s "Pastel 2"
  Data.i     2, $E8E8FF, $656E77
  Data.i     4, $EEDDFF, $656E77
  Data.i     8, $D6E1FF, $555555
  Data.i    16, $E6D7FF, $555555
  Data.i    32, $FFD5E8, $555555
  Data.i    64, $FFE0D2, $555555
  Data.i   128, $F0F0D0, $555555
  Data.i   256, $DCF5D2, $555555
  Data.i   512, $D2F5F1, $555555
  Data.i  1024, $B2E0F9, $555555
  Data.i  2048, $A5D6FA, $555555
  Data.i  4096, $A5C9EE, $555555
  Data.i  8192, $B8B8E3, $555555
  Data.i 16384, $D7A4D7, $555555
  Data.i 32768, $DDB7C6, $555555
  
  Data.s "***"
EndDataSection

Posted: **Tue Jun 03, 2025 6:14 pm**

Gratula! I like both version. ( I won't compete with my puny scores though

)

Posted: **Tue Jun 03, 2025 6:21 pm**

Looks nice and moves smoothly. I like the themes.
Your version also allows it to move in a direction where no movement is possible and then a new tile appears. I though the original 2048 did not hat that possibility. But anyways, in some case it helps a lot to just move in a direction to just get a fresh tile.

I am playing right now and reached a score of 10272 so far.

Maybe add different languages or switch automatically to the language of the environment it is running in.

Edit: I made only a score of 26136 because I once made a huge mistake by tapping the wrong cursor key.

Posted: **Tue Jun 03, 2025 7:09 pm**

Mindphazer wrote: Tue Jun 03, 2025 5:56 pm To SPH : i'm not challenging you
My version is more similar to the original 2048 game !

No problem. I have a preference...

Posted: **Tue Jun 03, 2025 7:22 pm**

NicTheQuick wrote: Tue Jun 03, 2025 6:21 pm Looks nice and moves smoothly. I like the themes.
Your version also allows it to move in a direction where no movement is possible and then a new tile appears. I though the original 2048 did not hat that possibility. But anyways, in some case it helps a lot to just move in a direction to just get a fresh tile.

I am playing right now and reached a score of 10272 so far.

Maybe add different languages or switch automatically to the language of the environment it is running in.

Edit: I made only a score of 26136 because I once made a huge mistake by tapping the wrong cursor key.

Thank you for your feedback
Yeah, multilanguage is on my todo list, and maybe the ability to cancel the last move, if the player tapped the wrong key

Posted: **Tue Jun 03, 2025 7:22 pm**

SPH wrote: Tue Jun 03, 2025 7:09 pm No problem. I have a preference...

My version of course

Posted: **Tue Jun 03, 2025 8:28 pm**

Please note that my game allows you to save a game in progress and also to go back up to 5 moves. It saves the best scores for each grid (3x3, 4x4, 5x5, etc.)

Posted: **Tue Jun 03, 2025 9:16 pm**

that was gentle on my bleary eyes before finishing my morning coffee.
works well win11 thanks 4696

Posted: **Tue Jun 03, 2025 9:29 pm**

@Mindphazer

I like it a lot.

Very smooth and easy on the eye.

Moulder.

Posted: **Wed Jun 04, 2025 8:08 am**

SPH wrote: Tue Jun 03, 2025 8:28 pm Please note that my game allows you to save a game in progress and also to go back up to 5 moves. It saves the best scores for each grid (3x3, 4x4, 5x5, etc.)

Haha
I know your game offers more options than mine
That's exactly why i specified that i was not challenging you

Posted: **Wed Jun 04, 2025 8:09 am**

moulder61 wrote: Tue Jun 03, 2025 9:29 pm @Mindphazer

I like it a lot.

Very smooth and easy on the eye.

Moulder.

Thanks Moulder for your kind words

Posted: **Wed Jun 04, 2025 9:00 pm**

Works nice..i see with my big surprise ...i have not loose the hand

Aaaaah !!! this 2048

I lost several years, and thousands hours in toilets or waiting room to play with it

And a day...i don't know how...i have win and have the maximum score possible

Since this day...I feel alone in the toilets like on a desert island

Thanks a lot for sharing this nice code, who remember me this greats moments of my life

Posted: **Thu Jun 05, 2025 8:55 am**

Thank you KCC

Maybe i should write a spiderbasic version of Pure2048, then you could still play in the toilets with you phone

Posted: **Thu Jun 05, 2025 9:13 am**

Small update,you can now undo the last move (and the last move ONLY), with Ctrl-Z
I added multilanguage, hopefully it works as expected. Four languages so far (french, english, german and italian)
Don't hesitate to correct if I made some translation errors

First post updated

Posted: **Thu Jun 05, 2025 10:26 am**

Here are some small corrections for the German language:

Code: Select all

  LanguageDE:
  Data.s "MenuJeu", "Spiel"
  Data.s "MenuItemNouveau", "Neu"
  Data.s "MenuItemUndo", "Letzten Zug rückgängig machen"
  Data.s "MenuItemQuit", "Beenden"
  Data.s "MenuTheme", "Themen"
  Data.s "MenuItemAbout", "Über"
  Data.s "Score", "PUNKTE"
  Data.s "HighScore", "BESTE"
  Data.s "Attention", "Achtung"
  Data.s "Abandon", "Möchten Sie das Spiel abbrechen?" + #CRLF$ + "Wenn Sie eine höhere Punktzahl haben, wird diese nicht gespeichert."
  Data.s "*", "*"

Btw: Why do you only show the About menu on Windows?

PureBasic Forums - English

Pure2048

Pure2048

Re: Pure2048

Re: Pure2048

Re: Pure2048

Re: Pure2048

Re: Pure2048

Re: Pure2048

Re: Pure2048

Re: Pure2048

Re: Pure2048

Re: Pure2048

Re: Pure2048

Re: Pure2048

Re: Pure2048

Re: Pure2048