This might be final version of my 2048 game. I changed some more lines and commented everything!
@Dav when I was doing comments where you were using row and row() I want to use col and col() and vice versa.
Please check comments for the code that handles the Arrow keypresses and see if it makes sense the way I have used row and col.
EDIT: ' 2024-10-19 94 LOC DrawBoard NOT needed in AddCell
@Dav when I was doing comments where you were using row and row() I want to use col and col() and vice versa.
Please check comments for the code that handles the Arrow keypresses and see if it makes sense the way I have used row and col.
Code: (Select All)
_Title "2048 - bplus mod Dav 2nd 2024-10-17" ' bplus 2024-10-17 instructions and code updates below
DefLng A-Z: Randomize Timer ' == Basic Setup: Default Type and Random starts ==
ReDim Shared Board(3, 3), Score, F ' == Globals Game Board, Score, Font ==
Screen _NewImage(400, 400, 32): _ScreenMove 450, 180 ' == Screen Stuff ==
_PrintMode _KeepBackground: F = _LoadFont("arial.ttf", 28): _Font F ' == Print stuff ==
AddNewCell: AddNewCell ' = Add 2 random cells to Board for starters ==
Do
DrawBoard
If RemaingMove = 0 Then ' == Game is over if Board is filled AND 0 combines possible. ==
Line (75, 100)-(325, 300), _RGBA(0, 0, 0, 40), BF ' == Game Over message box with accent ==
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: Exit Do ' == Sleep after Do loop holds screen in final state. ==
End If
Do: key$ = InKey$: _Limit 30: Loop Until key$ <> "" ' == wait for arrow keypress then handle it
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
AddNewCell
Loop Until key$ = Chr$(27) ' == Escape quits before running out of moves ==
Sleep ' == Hold screen at final state until user presses a key ==
Sub AddNewCell ' == Insert new cell onto board in random unused blank ==
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, convert index to row =y1, col =x1 ==
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 ' way more 2's, 80% than 4's, 20%
End If
End Sub
Sub DrawBoard ' == Update the Board State on screen ==
Cls , _RGB(100, 100, 250): Color _RGB(255, 255, 255)
For x = 0 To 3: For y = 0 To 3 ' == draw board, find power of 2 that each Board(x,y) is ==
If Board(x, y) Then power = Log(Board(x, y)) / Log(2) Else power = 0
bg& = _RGB32(255 - 17 * power) ' =set to shade of grey, the higher the value the darker
Line (x * 100 + 3, y * 100 + 3)-Step(100 - 3, 100 - 3), bg&, BF
Line (x * 100 + 3, y * 100 + 3)-Step(100 - 3, 0 - 3), &HFFFFFFFF, B
If Board(x, y) > 0 Then ' == label cells that aren't blank ==
n$ = _Trim$(Str$(Board(x, y))) ' == find offsets for centering in cell ==
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&) ' == Update Board according to Left or Right arrow press ==
If direction& = 1 Then pstart = 0: pstepper = 1: xs = 0: xe = 3 ' == Left Arrow ==
If direction& = 2 Then pstart = 3: pstepper = -1: xs = 3: xe = 0 ' == Right Arrow ==
For y = 0 To 3 ' == outer loop down Board array ==
ReDim col(3): p = pstart ' == setup ==
For x = xs To xe Step pstepper ' == inner loop across ==
If Board(x, y) <> 0 Then ' == if value then update column x ==
If col(p) = Board(x, y) Then ' == have matching values score! and combine ==
col(p) = col(p) + Board(x, y): Score = Score + col(p): p = p + pstepper
ElseIf col(p) = 0 Then ' == move col value if blanks between ==
col(p) = Board(x, y)
Else ' == col(p) had a value skip to next slot and update ==
p = p + pstepper: If p >= 0 And p < 4 Then col(p) = Board(x, y)
End If
End If
Next
For x = xs To xe Step pstepper: Board(x, y) = col(x): Next ' = update with combined or moved
Next
End Sub
Sub UDArrow (direction&) ' == Update Board according to Up or Down arrow press ==
If direction& = 1 Then pstart = 0: pstepper = 1: ys = 0: ye = 3 ' == Up Arrow ==
If direction& = 2 Then pstart = 3: pstepper = -1: ys = 3: ye = 0 ' == Down Arrow ==
For x = 0 To 3 ' == outer loop across Board array ==
ReDim row(3): p = pstart ' == setup ==
For y = ys To ye Step pstepper ' == inner loop up/down Board array ==
If Board(x, y) <> 0 Then ' == if value then update row y ==
If row(p) = Board(x, y) Then ' == have matching values score! and combine ==
row(p) = row(p) + Board(x, y): Score = Score + row(p): p = p + pstepper
ElseIf row(p) = 0 Then ' == move row value if blanks between ==
row(p) = Board(x, y)
Else ' == rowl(p) had a value skip to next slot and update ==
p = p + pstepper: If p >= 0 And p < 4 Then row(p) = Board(x, y)
End If
End If
Next
For y = ys To ye Step pstepper: Board(x, y) = row(y): Next
Next
End Sub
Function RemaingMove ' == Can player still make a move? ==
For x = 0 To 3: For y = 0 To 3 ' == Look for empty space or combine move ==
If Board(x, y) = 0 Then RemaingMove = 1 ' == yes a move is left ==
If y < 3 Then If Board(x, y) = Board(x, y + 1) Then RemaingMove = 1 ' yes move left ==
If x < 3 Then If Board(x, y) = Board(x + 1, y) Then RemaingMove = 1 ' yes move left ==
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
' From Dav's 2048.BAS v1.01 Puzzle, OCT/2024 New for v1.01: Screen autoscales
' 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, I call Double Parking:
' + Premise: Avoid _code line extensions if at all possible, all lines < 100 chars nice too.
' + For sure, multiple assignments can go on one line specially if all are related.
' - When it comes to documenting varaibles DO NOT Double Park, following Terry's descriptive method.
' + For sure, multiple short Sub calls specially if all are related.
' + Doubling up on For loops specially 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 ie to shorten
' names so everything fits in 100 chars across line. It should be a last step in reducing LOC.
' OK 97 LOC < 100 10/18/2024 am post
' OK 95 cut 2 but had to add one because line was too long for mult-assignments
' When adding comments I had to change Dav' temp Row() and Col() words. He or I had/have them
' reversed.
' 2024-10-19 94 LOC DrawBoard NOT needed in AddCellEDIT: ' 2024-10-19 94 LOC DrawBoard NOT needed in AddCell
b = b + ...