Nice! I finally looked up the rules for playing. Missed the part that the arrow shifts all numbers in that direction doubling like numbers and creating a space.
For a cuter size game board that fits laptop:
Oh I luv large font too
For a cuter size game board that fits laptop:
Code: (Select All)
'========
'2048.BAS
'========
'Classic 2048 puzzle for QB64.
'by Dav, OCT/2024
'Use arrow keys to move numbers on board.
'Score is shown in title bar.
'ESC quits
Screen _NewImage(600, 600, 32)
_ScreenMove 350, 60
ReDim Shared board(3, 3), flash(3, 3), score
GetNewNumber
GetNewNumber
Do
DrawBoard
If MovesLeft = 0 Then
Rbox 150, 150, 650, 450, 30, _RGBA(0, 0, 0, 150), 1
Rbox 150, 150, 650, 450, 30, _RGBA(255, 255, 255, 255), 0
Text 200 + 2, 200 + 2, 60, _RGB(0, 0, 0), "NO MORE MOVES!"
Text 200, 200, 60, _RGB(255, 255, 255), "NO MORE MOVES!"
Text 200 + 2, 300 + 2, 60, _RGB(0, 0, 0), "SCORE:" + _Trim$(Str$(score))
Text 200, 300, 60, _RGB(255, 255, 255), "SCORE:" + _Trim$(Str$(score))
_Display: Beep: _Delay 3: Exit Do
End If
Do
key$ = InKey$
_Limit 30
Loop Until key$ <> ""
Select Case key$
Case Chr$(0) + "K": DoLeft 'left arrow
Case Chr$(0) + "M": DoRight 'right arrow
Case Chr$(0) + "H": DoUp 'up arrow
Case Chr$(0) + "P": DoDown 'down arrow
End Select
_KeyClear
GetNewNumber
Loop Until key$ = Chr$(27)
Sleep
End
Sub GetNewNumber
'=== get a list of places to make a number
ReDim temp(15)
c = 0
For x = 0 To 3
For y = 0 To 3
If board(x, y) = 0 Then
temp(c) = x * 4 + y
c = c + 1
End If
Next
Next
'=== choose one place to make a number
If c > 0 Then
i = Int(Rnd * c)
If Rnd < .8 Then
DrawBoard
x1 = Int(temp(i) / 4): y1 = temp(i) Mod 4
For s = 100 To 0 Step -20
Rbox (x1 * 150) + s, (y1 * 150) + s, ((x1 * 150) + 150) - s, ((y1 * 150) + 150) - s, 30, _RGB(239, 229, 218), 1
_Display
_Delay .025
Next
board(x1, y1) = 2
Else
DrawBoard
x1 = Int(temp(i) / 4): y1 = temp(i) Mod 4
For s = 100 To 0 Step -20
Rbox (x1 * 150) + s, (y1 * 150) + s, ((x1 * 150) + 150) - s, ((y1 * 150) + 150) - s, 30, _RGB(239, 229, 218), 1
_Display
_Delay .025
Next
board(x1, y1) = 4
End If
End If
End Sub
Sub DrawBoard
Cls , _RGB(187, 173, 160)
Color _RGB(255, 255, 255)
For x = 0 To 3
For y = 0 To 3
Select Case board(x, y)
Case 2: bg& = _RGB(239, 229, 218)
Case 4: bg& = _RGB(236, 224, 198)
Case 8: bg& = _RGB(241, 177, 121)
Case 16: bg& = _RGB(236, 141, 84)
Case 32: bg& = _RGB(247, 124, 95)
Case 64: bg& = _RGB(233, 89, 55)
Case 128: bg& = _RGB(242, 217, 107)
Case 256: bg& = _RGB(238, 205, 96)
Case 512: bg& = _RGB(238, 205, 96)
Case 1024: bg& = _RGB(238, 205, 96)
Case 2048: bg& = _RGB(238, 205, 96)
Case 4096: bg& = _RGB(121, 184, 226)
Case 8192: bg& = _RGB(121, 184, 226)
Case 16384: bg& = _RGB(121, 184, 226)
Case 32768: bg& = _RGB(60, 64, 64)
Case Else: bg& = _RGB(204, 192, 180)
End Select
If flash(x, y) <> 0 Then
'skip for now
Else
Rbox x * 150 + 5, y * 150 + 5, (x * 150) + 150 - 5, (y * 150) + 150 - 5, 30, bg&, 1
Rbox x * 150 + 5, y * 150 + 5, (x * 150) + 150 - 5, (y * 150) + 150 - 5, 30, _RGB(255, 255, 255), 0
If board(x, y) > 0 Then
num$ = _Trim$(Str$(board(x, y)))
If Val(num$) < 8 Then fg& = _RGB(128, 128, 128) Else fg& = _RGB(255, 255, 255)
size = 150 / 2: ts = size: tx = size / 2 + (size / 4): ty = size / 2
Select Case Len(num$)
Case 2: tx = size / 2: ty = size / 2
Case 3: ts = 150 / 2.5: tx = size / 2.5: ty = size / 1.75
Case 4: ts = 150 / 3: tx = size / 3: ty = size / 1.50
Case 5: ts = 150 / 3.5: tx = size / 3.5: ty = size / 1.36
End Select
Text x * 150 + tx + 2, y * 150 + ty + 2, ts, _RGB(0, 0, 0), num$
Text x * 150 + tx, y * 150 + ty, ts, fg&, num$
End If
End If
Next
Next
'do flash board
For s = 100 To 0 Step -20
For x = 0 To 3
For y = 0 To 3
If flash(x, y) <> 0 Then
Select Case flash(x, y)
Case 2: bg& = _RGB(239, 229, 218)
Case 4: bg& = _RGB(236, 224, 198)
Case 8: bg& = _RGB(241, 177, 121)
Case 16: bg& = _RGB(236, 141, 84)
Case 32: bg& = _RGB(247, 124, 95)
Case 64: bg& = _RGB(233, 89, 55)
Case 128: bg& = _RGB(242, 217, 107)
Case 256: bg& = _RGB(238, 205, 96)
Case 512: bg& = _RGB(238, 205, 96)
Case 1024: bg& = _RGB(238, 205, 96)
Case 2048: bg& = _RGB(238, 205, 96)
Case 4096: bg& = _RGB(121, 184, 226)
Case 8192: bg& = _RGB(121, 184, 226)
Case 16384: bg& = _RGB(121, 184, 226)
Case 32768: bg& = _RGB(60, 64, 64)
Case Else: bg& = _RGB(204, 192, 180)
End Select
Rbox (x * 150) + s, (y * 150) + s, ((x * 150) + 150) - s, ((y * 150) + 150) - s, 30, bg&, 1
End If
Next
Next
_Display
_Delay .025
Next
'do regular board next
For x = 0 To 3
For y = 0 To 3
Select Case board(x, y)
Case 2: bg& = _RGB(239, 229, 218)
Case 4: bg& = _RGB(236, 224, 198)
Case 8: bg& = _RGB(241, 177, 121)
Case 16: bg& = _RGB(236, 141, 84)
Case 32: bg& = _RGB(247, 124, 95)
Case 64: bg& = _RGB(233, 89, 55)
Case 128: bg& = _RGB(242, 217, 107)
Case 256: bg& = _RGB(238, 205, 96)
Case 512: bg& = _RGB(238, 205, 96)
Case 1024: bg& = _RGB(238, 205, 96)
Case 2048: bg& = _RGB(238, 205, 96)
Case 4096: bg& = _RGB(121, 184, 226)
Case 8192: bg& = _RGB(121, 184, 226)
Case 16384: bg& = _RGB(121, 184, 226)
Case 32768: bg& = _RGB(60, 64, 64)
Case Else: bg& = _RGB(204, 192, 180)
End Select
Rbox x * 150 + 5, y * 150 + 5, (x * 150) + 150 - 5, (y * 150) + 150 - 5, 30, bg&, 1
Rbox x * 150 + 5, y * 150 + 5, (x * 150) + 150 - 5, (y * 150) + 150 - 5, 30, _RGB(255, 255, 255), 0
If board(x, y) > 0 Then
num$ = _Trim$(Str$(board(x, y)))
If Val(num$) < 8 Then fg& = _RGB(128, 128, 128) Else fg& = _RGB(255, 255, 255)
size = 150 / 2: ts = size: tx = size / 2 + (size / 4): ty = size / 2
Select Case Len(num$)
Case 2: tx = size / 2: ty = size / 2
Case 3: ts = 150 / 2.5: tx = size / 2.5: ty = size / 1.75
Case 4: ts = 150 / 3: tx = size / 3: ty = size / 1.50
Case 5: ts = 150 / 3.5: tx = size / 3.5: ty = size / 1.36
End Select
Text x * 150 + tx + 2, y * 150 + ty + 2, ts, _RGB(0, 0, 0), num$
Text x * 150 + tx, y * 150 + ty, ts, fg&, num$
End If
Next
Next
ReDim flash(3, 3)
_Title "2048 - " + "Score: " + Str$(score)
_Display
End Sub
Sub DoLeft
ReDim flash(3, 3)
For y = 0 To 3
ReDim row(3)
p = 0
For x = 0 To 3
If board(x, y) <> 0 Then
If row(p) = board(x, y) Then
row(p) = row(p) + board(x, y)
score = score + row(p)
flash(p, y) = row(p) '+ board(x, y)
p = p + 1
ElseIf row(p) = 0 Then
row(p) = board(x, y)
Else
p = p + 1
If p < 4 Then row(p) = board(x, y)
End If
End If
Next
For x = 0 To 3
board(x, y) = row(x)
Next
Next
End Sub
Sub DoRight
ReDim flash(3, 3)
For y = 0 To 3
ReDim row(3)
p = 3
For x = 3 To 0 Step -1
If board(x, y) <> 0 Then
If row(p) = board(x, y) Then
row(p) = row(p) + board(x, y)
score = score + row(p)
flash(p, y) = row(p)
p = p - 1
ElseIf row(p) = 0 Then
row(p) = board(x, y)
Else
p = p - 1
If p >= 0 Then
row(p) = board(x, y)
End If
End If
End If
Next
For x = 0 To 3
board(x, y) = row(x)
Next
Next
End Sub
Sub DoUp
ReDim flash(3, 3)
For x = 0 To 3
ReDim col(3)
p = 0
For y = 0 To 3
If board(x, y) <> 0 Then
If col(p) = board(x, y) Then
col(p) = col(p) + board(x, y)
score = score + col(p)
flash(x, p) = col(p)
p = p + 1
ElseIf col(p) = 0 Then
col(p) = board(x, y)
Else
p = p + 1
If p < 4 Then col(p) = board(x, y)
End If
End If
Next
For y = 0 To 3
board(x, y) = col(y)
Next
Next
End Sub
Sub DoDown
ReDim flash(3, 3)
For x = 0 To 3
ReDim col(3)
p = 3
For y = 3 To 0 Step -1
If board(x, y) <> 0 Then
If col(p) = board(x, y) Then
col(p) = col(p) + board(x, y)
score = score + col(p)
flash(x, p) = col(p)
p = p - 1
ElseIf col(p) = 0 Then
col(p) = board(x, y)
Else
p = p - 1
If p >= 0 Then col(p) = board(x, y)
End If
End If
Next
For y = 3 To 0 Step -1
board(x, y) = col(y)
Next
Next
End Sub
Function MovesLeft
MovesLeft = 0
For x = 0 To 3
For y = 0 To 3
If board(x, y) = 0 Then
MovesLeft = 1
End If
If y < 3 Then
If board(x, y) = board(x, y + 1) Then
MovesLeft = 1
End If
End If
If x < 3 Then
If board(x, y) = board(x + 1, y) Then
MovesLeft = 1
End If
End If
Next
Next
End Function
Sub Text (x, y, textHeight, K As _Unsigned Long, txt$)
'Text SUB by bplus.
Dim fg As _Unsigned Long, cur&, I&, multi, xlen
fg = _DefaultColor
cur& = _Dest
I& = _NewImage(8 * Len(txt$), 16, 32)
_Dest I&
Color K, _RGBA32(0, 0, 0, 0)
_PrintString (0, 0), txt$
multi = textHeight / 16
xlen = Len(txt$) * 8 * multi
_PutImage (x, y)-Step(xlen, textHeight), I&, cur&
Color fg
_FreeImage I&
_Dest cur&
End Sub
Sub Rbox (x1, y1, x2, y2, r, clr~&, fill)
'x1/y1, y2/y2 = placement of box
'r = radius of rounded corner
'clr~& = color of box
'fill = 1 for filled, 0 for just an edge
ReDim filled(_Width + x2, _Height + y2) As Integer
If fill = 1 Then
Line (x1 + r + 1, y1)-(x2 - r - 1, y1 + r), clr~&, BF 'top
Line (x1 + r + 1, y2 - r)-(x2 - r - 1, y2), clr~&, BF 'bottom
Line (x1, y1 + r + 1)-(x1 + r, y2 - r - 1), clr~&, BF 'left
Line (x2 - r, y1 + r + 1)-(x2, y2 - r - 1), clr~&, BF 'right
Line (x1 + r + 1, y1 + r + 1)-(x2 - r - 1, y2 - r - 1), clr~&, BF 'middle
Else
Line (x1 + r, y1)-(x2 - r, y1), clr~& 'top
Line (x1 + r, y2)-(x2 - r, y2), clr~& 'bottom
Line (x1, y1 + r)-(x1, y2 - r), clr~& 'left
Line (x2, y1 + r)-(x2, y2 - r), clr~& 'right
End If
'top left corner
For angle = 180 To 270
If fill = 1 Then
For radius = 0 To r
x3 = (x1 + r) + radius * Cos(_D2R(angle))
y3 = (y1 + r) + radius * Sin(_D2R(angle))
If filled(x3, y3) = 0 Then PSet (x3, y3), clr~&: filled(x3, y3) = 1
Next
Else
x3 = (x1 + r) + r * Cos(_D2R(angle))
y3 = (y1 + r) + r * Sin(_D2R(angle))
If filled(x3, y3) = 0 Then PSet (x3, y3), clr~&: filled(x3, y3) = 1
End If
Next
'top right corner
For angle = 270 To 360
If fill = 1 Then
For radius = 0 To r
x3 = (x2 - r) + radius * Cos(_D2R(angle))
y3 = (y1 + r) + radius * Sin(_D2R(angle))
If filled(x3, y3) = 0 Then PSet (x3, y3), clr~&: filled(x3, y3) = 1
Next
Else
x3 = (x2 - r) + r * Cos(_D2R(angle))
y3 = (y1 + r) + r * Sin(_D2R(angle))
If filled(x3, y3) = 0 Then PSet (x3, y3), clr~&: filled(x3, y3) = 1
End If
Next
'bottom left corner
For angle = 90 To 180
If fill = 1 Then
For radius = 0 To r
x3 = (x1 + r) + radius * Cos(_D2R(angle))
y3 = (y2 - r) + radius * Sin(_D2R(angle))
If filled(x3, y3) = 0 Then PSet (x3, y3), clr~&: filled(x3, y3) = 1
Next
Else
x3 = (x1 + r) + r * Cos(_D2R(angle))
y3 = (y2 - r) + r * Sin(_D2R(angle))
If filled(x3, y3) = 0 Then PSet (x3, y3), clr~&: filled(x3, y3) = 1
End If
Next
'bottom right corner
For angle = 0 To 90
If fill = 1 Then
For radius = 0 To r
x3 = (x2 - r) + radius * Cos(_D2R(angle))
y3 = (y2 - r) + radius * Sin(_D2R(angle))
If filled(x3, y3) = 0 Then PSet (x3, y3), clr~&: filled(x3, y3) = 1
Next
Else
x3 = (x2 - r) + r * Cos(_D2R(angle))
y3 = (y2 - r) + r * Sin(_D2R(angle))
If filled(x3, y3) = 0 Then PSet (x3, y3), clr~&: filled(x3, y3) = 1
End If
Next
End SubOh I luv large font too
b = b + ...