10-21-2024, 10:19 AM
And now, we have 2048 - 32 LOC!!
The program now fits completely on a single QB64PE code screen for me. YAYS!! I win!
Code: (Select All)
_Title "2048 - 32 LOC": DefLng A-Z: Randomize Timer: ReDim Shared B(15), Score, F: Screen _NewImage(400, 400, 32): _ScreenMove 450, 180: _PrintMode _KeepBackground: F = _LoadFont("arial.ttf", 28): _Font F: AddNewCell: AddNewCell ' = Add 2 random cells to Board for starters ==
Do
5 Cls , _RGB(100, 100, 250): Color _RGB(255, 255, 255) ' == DrawBoard ==
For x = 0 To 3: For y = 0 To 3 ' == find power of 2 that each Board(x,y) is for bg& in tiles ==
If B(x + 4 * y) Then power = Log(B(x + 4 * y)) / Log(2) Else power = 0
bg& = _RGB32(255 - 17 * power): 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 ' == accent tile ==
If B(x + 4 * y) > 0 Then n$ = _Trim$(Str$(B(x + 4 * 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$
Next: Next: _Title "2048 - " + "Score: " + Str$(Score): _Display
For y = 0 To 3: For x = 0 To 3 ' == Look for empty space or combine move ==
If B(y * 4 + x) = 0 Then 10 ' == yes a move is left, skip to 10 ==
If y < 3 Then If B(y * 4 + x) = B((y + 1) * 4 + x) Then 10 ' == a move left goto 10 ==
If x < 3 Then If B(y * 4 + x) = B(y * 4 + (x + 1)) Then 10 ' == a move left goto 10 ==
Next: Next
Line (75, 100)-(325, 300), _RGBA(0, 0, 0, 40), BF: 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
10 Do: k$ = InKey$: _Limit 30: Loop Until k$ <> "": ReDim t(15): jm = 0 ' == start temp board array t() and make sure only arrow keys processed ==
Select Case k$: Case Chr$(0) + "K": jm = 4: ks = 0: ke = 3: kstep = 1: km = 1: Case Chr$(0) + "M": jm = 4: ks = 3: ke = 0: kstep = -1: km = 1: Case Chr$(0) + "H": jm = 1: ks = 0: ke = 3: kstep = 1: km = 4: Case Chr$(0) + "P": jm = 1: ks = 3: ke = 0: kstep = -1: km = 4: End Select
If jm = 0 Then 5 ' == back to the drawing board ! ==
For j = 0 To 3 ' == outer loop is always same numbers but could be for x or y ==
If jm = 4 Then p = j * jm + ks Else If kstep = 1 Then p = j Else p = 12 + j
For k = ks To ke Step kstep: If B(j * jm + k * km) <> 0 Then Select Case t(p): Case B(j * jm + k * km): t(p) = t(p) + B(j * jm + k * km): Score = Score + t(p): p = p + kstep * km: Case 0: t(p) = B(j * jm + k * km): Case Else: p = p + kstep * km: t(p) = B(j * jm + k * km): End Select
Next k, j: For j = 0 To 15: B(j) = t(j): Next: AddNewCell: Loop Until _KeyDown(27): Sleep ' == Hold screen at final state until user presses a key ==
Sub AddNewCell ' == Insert new cell onto board in random unused blank ==
Dim temp(15), x, y, c, i, x1, y1
For y = 0 To 3: For x = 0 To 3 ' == save index of empty cells for random pick ==
If B(y * 4 + x) = 0 Then temp(c) = y * 4 + x: 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 ' == pick and convert index ==
If Rnd < .8 Then B(4 * y1 + x1) = 2 Else B(4 * y1 + x1) = 4 ' = more 2's, 80% than 4's, 20%
End If
End Sub
' =============================================================================================
' 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 AddCell and main both I chose in main only.
' ============================================================================
' 2024-10-20 2048 - 1D Board combine all arrow handling subs into one, save LOC!
' OK 75 LOC
' 2024-10-21 2048 - 64 LOC
' subs and a function reinserted back into Main
The program now fits completely on a single QB64PE code screen for me. YAYS!! I win!