Finally < 100 at 97 LOC added rules for Parking 
New High Score with new look at Blue and Grey Theme:
Code: (Select All)
_Title "2048 - bplus mod Dav 2nd 2024-10-17" ' bplus 2024-10-17
'from Dav's 2048.BAS v1.01 Puzzle, OCT/2024 New for v1.01: Screen autoscales
DefLng A-Z: Randomize Timer
ReDim Shared Board(3, 3), Score, F
Screen _NewImage(400, 400, 32): _ScreenMove 450, 180
_PrintMode _KeepBackground: F = _LoadFont("arial.ttf", 28): _Font F
GetNewNumber: GetNewNumber
Do
DrawBoard
If RemaingMove = 0 Then
Line (75, 100)-(325, 300), _RGBA(0, 0, 0, 40), BF
Line (75, 100)-(325, 300), _RGBA(255, 255, 255, 150), B
s$ = "No More Moves!": _PrintString (75 + (250 - _PrintWidth(s$)) / 2, 166), s$
s$ = "Score:" + Str$(Score): _PrintString (75 + (250 - _PrintWidth(s$)) / 2, 266), s$
_Display: Beep: _Delay 3: Exit Do
End If
Do: key$ = InKey$: _Limit 30: Loop Until key$ <> ""
If key$ = Chr$(0) + "K" Then LRArrow 1 'left arrow
If key$ = Chr$(0) + "M" Then LRArrow 2 'right arrow
If key$ = Chr$(0) + "H" Then UDArrow 1 'up arrow
If key$ = Chr$(0) + "P" Then UDArrow 2 'down arrow
GetNewNumber
Loop Until key$ = Chr$(27)
Sleep
Sub GetNewNumber
ReDim temp(15) '=== get a list of places to make a number
For y = 0 To 3: For x = 0 To 3
If Board(x, y) = 0 Then temp(c) = x + y * 4: c = c + 1
Next: Next
If c > 0 Then '=== choose one place to make a number
i = Int(Rnd * c): y1 = Int(temp(i) / 4): x1 = temp(i) Mod 4
If Rnd < .8 Then Board(x1, y1) = 2 Else Board(x1, y1) = 4
DrawBoard
End If
End Sub
Sub DrawBoard
Cls , _RGB(100, 100, 250): Color _RGB(255, 255, 255)
For x = 0 To 3: For y = 0 To 3 'do regular board next
If Board(x, y) Then power = Log(Board(x, y)) / Log(2) Else power = 0
bg& = _RGB32(255 - 17 * power)
Line (x * 100 + 3, y * 100 + 3)-((x * 100) + 100 - 3, (y * 100) + 100 - 3), bg&, BF
Line (x * 100 + 3, y * 100 + 3)-((x * 100) + 100 - 3, (y * 100) + 100 - 3), &HFFFFFFFF, B
If Board(x, y) > 0 Then
n$ = _Trim$(Str$(Board(x, y))): ox = (100 - _PrintWidth(n$)) / 2: oy = (100 - _FontHeight(F)) / 2
Color &HFF000000: _PrintString (x * 100 + ox + 2, y * 100 + oy + 2), n$
Color &HFFFFFFFF: _PrintString (x * 100 + ox, y * 100 + oy), n$
End If
Next: Next
_Title "2048 - " + "Score: " + Str$(Score): _Display
End Sub
Sub LRArrow (direction&)
If direction& = 1 Then pstart = 0: pstepper = 1: xs = 0: xe = 3 ' left
If direction& = 2 Then pstart = 3: pstepper = -1: xs = 3: xe = 0 ' right
For y = 0 To 3
ReDim row(3)
p = pstart
For x = xs To xe Step pstepper
If Board(x, y) <> 0 Then
If row(p) = Board(x, y) Then
row(p) = row(p) + Board(x, y): Score = Score + row(p): p = p + pstepper
ElseIf row(p) = 0 Then
row(p) = Board(x, y)
Else
p = p + pstepper: If p >= 0 And p < 4 Then row(p) = Board(x, y)
End If
End If
Next
For x = xs To xe Step pstepper: Board(x, y) = row(x): Next
Next
End Sub
Sub UDArrow (direction&)
If direction& = 1 Then pstart = 0: pstepper = 1: ys = 0: ye = 3 ' up
If direction& = 2 Then pstart = 3: pstepper = -1: ys = 3: ye = 0 ' down
For x = 0 To 3
ReDim col(3)
p = pstart
For y = ys To ye Step pstepper
If Board(x, y) <> 0 Then
If col(p) = Board(x, y) Then
col(p) = col(p) + Board(x, y): Score = Score + col(p): p = p + pstepper
ElseIf col(p) = 0 Then
col(p) = Board(x, y)
Else
p = p + pstepper: If p >= 0 And p < 4 Then col(p) = Board(x, y)
End If
End If
Next
For y = ys To ye Step pstepper: Board(x, y) = col(y): Next
Next
End Sub
Function RemaingMove
For x = 0 To 3: For y = 0 To 3
If Board(x, y) = 0 Then RemaingMove = 1
If y < 3 Then If Board(x, y) = Board(x, y + 1) Then RemaingMove = 1
If x < 3 Then If Board(x, y) = Board(x + 1, y) Then RemaingMove = 1
Next: Next
End Function
' =============================================================================================
' Instructions briefly:
' Use arrow keys to move all numbers on board to a side, like numbers will combine and double
' Score is shown in title bar. ESC quits. Objective is to get a tile at 2048 but can go further.
'==============================================================================================
' Tracking bplus mods
' 2024-10-17 Dav's original 468 tons of blank lines for easy reading removed plus all that redundant
' Flash code and stuff, reduced to last paragraph of screening the Board. Added Option _Explicit and
' Dim lines for all variables not Dim'd for Option _Explicit. Now 356 LOC!
' Next dump rounded box and TEXT subs and replace with font and Line BF
' removed ss for screen shrinkage factor just used a 400 x 400 screen
' RBox replaced with standard Line
' OK now 257 lines about even with Steves
' OK 237 with combined DoRight DoLeft
' OK 215 line combined DoUp and DoDown
' OK 192 lines with reduction in picking a new place for next number
' OK 186 lines with reduction of RemainingMove
' OK 182 more edits of comments
' OK 174 no blank lines!
' Man I am looking at all those lines for color in DrawBoard.
' OK 158 lines.
' OK 154 4 lines off RemainingMove does it still work?
' OK 148 some more lines in UDArrow and LRArrow
' OK 142 double parking where it makes sense
' OK 138 subst IF Then for Select Case
' OK 131 sub DEFLNG A-Z for Option _Explicit remov DIM's
' OK the Double Parking is getting more serious
' OK 110 enough! 10/17/2024
' OK last night right after I posted 110, I immediately saw 2 obvious lines to take out
' WTH! in for a penny in for a 100, more judicious double/triple parking
' Rules for double/triple/more statements on one line by way of colon:
' For sure multiple assignments can go on one line specially if all are related.
' Doubling up on For loops for 2D array For y = 0 to ny : For x = 0 to nx ... Next: Next
' Line 3 saved on Option _Explicit and combined with Random, I don't recommend starting
' without Option _Explicit because it comes in handy when name changes come. It should be
' a last step in reducing LOC.
' Avoid _code line extensions if at all possible, all lines < 100 chars nice too.
' OK 97 LOC < 100 10/18/2024New High Score with new look at Blue and Grey Theme:
b = b + ...