Thread Rating:
  • 0 Vote(s) - 0 Average
  • 1
  • 2
  • 3
  • 4
  • 5
2048 Puzzle
#22
That is so ugly! I know it's supposed to be a joke but Good God! I hate horizontal scrolling.

I got to say it again, I hate horizontal scrolling! Maybe as much as Steve hated MS yesterday, see that's your punishment for posting that shit. LOL!

The above example just proves it. Try to read that first line all the way across, you have to use the vertical scoll bar to get to the bottom to use the horizontal scroll then scroll up again to read the next section on same line if you don't lose your place... and repeat! You got me swearing...

but Steve wouild say that was the intentional message, no he wont now that I said it for him Wink

Anyway I am posting again so you all can compare uglyness versus beauty on the same page without having to jump back and forth in pages:

Up above ugly, down below beauty, disregarding LOC for a sec:
Code: (Select All)
_Title "2048 - 64 LOC" ' bplus 2024-10-21                 == instructions and code updates below ==
DefLng A-Z: Randomize Timer '                     == Basic Setup: Default Type and Random starts ==
ReDim Shared B(15), 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
    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) '  == set shade grey, the higher the value the darker ==
            Line (x * 100 + 3, y * 100 + 3)-Step(100 - 3, 100 - 3), bg&, BF '       == draw tile ==
            Line (x * 100 + 3, y * 100 + 3)-Step(100 - 3, 0 - 3), &HFFFFFFFF, B ' == accent tile ==
            If B(x + 4 * y) > 0 Then '                          == label cells that aren't blank ==
                n$ = _Trim$(Str$(B(x + 4 * 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$ '  shade ==
                Color &HFFFFFFFF: _PrintString (x * 100 + ox, y * 100 + oy), n$ ' =& print value ==
            End If
    Next: Next
    _Title "2048 - " + "Score: " + Str$(Score): _Display '                    ==  know the score ==
    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 ' = OH NO! Game Over message box break the ==
    s$ = "No More Moves!": _PrintString (75 + (250 - _PrintWidth(s$)) / 2, 166), s$ '     == bad ==
    s$ = "Score:" + Str$(Score): _PrintString (75 + (250 - _PrintWidth(s$)) / 2, 266), s$ ' news ==
    _Display: Beep: Exit Do '                == Sleep after Do loop holds screen in final state. ==
    10 Do: k$ = InKey$: _Limit 30: Loop Until k$ <> "" '                         == wait for key ==
    ReDim t(15): jm = 0 '  == start temp board array t() and make sure only arrow keys processed ==
    If k$ = Chr$(0) + "K" Then jm = 4: ks = 0: ke = 3: kstep = 1: km = 1 '         == Left arrow ==
    If k$ = Chr$(0) + "M" Then jm = 4: ks = 3: ke = 0: kstep = -1: km = 1 '       == Right arrow ==
    If k$ = Chr$(0) + "H" Then jm = 1: ks = 0: ke = 3: kstep = 1: km = 4 '          == Up arrow  ==
    If k$ = Chr$(0) + "P" Then jm = 1: ks = 3: ke = 0: kstep = -1: km = 4 '        == Down arrow ==
    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 '                             == inner loop, main processing ==
            If B(j * jm + k * km) <> 0 Then ' only handle cells with a value
                If t(p) = B(j * jm + k * km) Then ' == ah a matching tile! combine & update score =
                    t(p) = t(p) + B(j * jm + k * km): Score = Score + t(p): p = p + kstep * km
                ElseIf t(p) = 0 Then '                   == move board value into next open slot ==
                    t(p) = B(j * jm + k * km)
                Else '                                   == move board value into next open slot ==
                    p = p + kstep * km: t(p) = B(j * jm + k * km) '    == and update next p slot ==
                End If
            End If
        Next
    Next
    For j = 0 To 15: B(j) = t(j): Next: AddNewCell '       == Copy t() into B() array & Add cell ==
Loop Until _KeyDown(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 ==
    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

Now regarding LOC, it seems to me, intuitively, there is a usefulness in this practice of reducing code to essentials. Maybe I am wrong. Steve is very good at it one of the reasons I respect his skills, I was hoping to see him join in with a real effort but he is busy this time of year as reported yesterday.

What is the lesson, what can I get from this little session? I am tempted to go back to my editor and forbid any line over 100 characters. I could save myself all that trouble attempting to allow an exception to 100 characters with a horizontal scroll. But it would surely be missed, even by me. But like the colon, it should be used judiciously. I even started a set of guidelines for us of colon. Opps! I called it rules, that does not work here in Basic, rules are for oneself and those who are into monologues. Wink
b = b + ...
Reply


Messages In This Thread
2048 Puzzle - by Dav - 10-17-2024, 02:19 AM
RE: 2048 Puzzle - by FellippeHeitor - 10-17-2024, 02:42 AM
RE: 2048 Puzzle - by Dav - 10-17-2024, 02:48 AM
RE: 2048 Puzzle - by FellippeHeitor - 10-17-2024, 03:17 AM
RE: 2048 Puzzle - by bplus - 10-17-2024, 09:16 AM
RE: 2048 Puzzle - by Dav - 10-17-2024, 01:01 PM
RE: 2048 Puzzle - by bplus - 10-17-2024, 03:36 PM
RE: 2048 Puzzle - by Dav - 10-17-2024, 04:19 PM
RE: 2048 Puzzle - by bplus - 10-17-2024, 04:26 PM
RE: 2048 Puzzle - by SMcNeill - 10-17-2024, 05:05 PM
RE: 2048 Puzzle - by bplus - 10-17-2024, 05:15 PM
RE: 2048 Puzzle - by SMcNeill - 10-17-2024, 05:28 PM
RE: 2048 Puzzle - by Dav - 10-17-2024, 10:46 PM
RE: 2048 Puzzle - by bplus - 10-18-2024, 12:48 AM
RE: 2048 Puzzle - by Dav - 10-18-2024, 11:49 AM
RE: 2048 Puzzle - by bplus - 10-18-2024, 01:51 PM
RE: 2048 Puzzle - by bplus - 10-18-2024, 09:59 PM
RE: 2048 Puzzle - by Dav - 10-20-2024, 10:44 PM
RE: 2048 Puzzle - by bplus - 10-20-2024, 11:32 PM
RE: 2048 Puzzle - by bplus - 10-21-2024, 09:18 AM
RE: 2048 Puzzle - by SMcNeill - 10-21-2024, 10:19 AM
RE: 2048 Puzzle - by bplus - 10-22-2024, 11:37 AM
RE: 2048 Puzzle - by SMcNeill - 10-22-2024, 02:27 PM
RE: 2048 Puzzle - by SMcNeill - 10-22-2024, 02:39 PM
RE: 2048 Puzzle - by bplus - 10-22-2024, 03:26 PM
RE: 2048 Puzzle - by SMcNeill - 10-22-2024, 03:49 PM
RE: 2048 Puzzle - by SMcNeill - 10-22-2024, 03:36 PM
RE: 2048 Puzzle - by bplus - 10-22-2024, 03:38 PM
RE: 2048 Puzzle - by bplus - 10-22-2024, 04:37 PM
RE: 2048 Puzzle - by SMcNeill - 10-22-2024, 08:18 PM
RE: 2048 Puzzle - by bplus - 10-22-2024, 04:47 PM
RE: 2048 Puzzle - by SMcNeill - 10-23-2024, 03:44 AM
RE: 2048 Puzzle - by bplus - 10-23-2024, 10:32 AM
RE: 2048 Puzzle - by bplus - 10-23-2024, 12:40 PM
RE: 2048 Puzzle - by SMcNeill - 10-23-2024, 01:51 PM
RE: 2048 Puzzle - by bplus - 10-23-2024, 05:00 PM
RE: 2048 Puzzle - by bplus - 10-24-2024, 06:42 PM
RE: 2048 Puzzle - by Dav - 10-25-2024, 07:32 PM
RE: 2048 Puzzle - by bplus - 10-26-2024, 12:34 PM
RE: 2048 Puzzle - by Dav - 10-26-2024, 01:21 PM
RE: 2048 Puzzle - by bplus - 10-26-2024, 01:33 PM
RE: 2048 Puzzle - by bplus - 10-27-2024, 01:39 AM
RE: 2048 Puzzle - by bplus - 10-27-2024, 10:08 AM



Users browsing this thread: 1 Guest(s)