2048 Puzzle

[bplus]

Oh sweet! _Font _LoadFont("theFile.ttf...) ' skip the font handle middleman variable

Ninja magic here, the two routines MoveUpDown and MoveLeftRight combined, not 30 lines but not nothing either:

Here is relaxed version with most comments removed except crucial ones and spaces thrown in for breathing room PLUS all lines are under 80 characters:

Code: (Select All)

_Title "2048 - Relaxed a little " ' bplus 2024-10-22 fit 80 chars

DefLng A-Z: Randomize Timer

ReDim Shared B(15) ' Game Board 4x4 indexes go left to right and then down

Screen _NewImage(400, 400, 32): _ScreenMove 450, 180

_PrintMode _KeepBackground: F = _LoadFont("arial.ttf", 28): _Font F

OY = (100 - _FontHeight(F)) / 2 ' Y offset in tile

W~& = &HFFFFFFFF ' White Color

AddNewCell: AddNewCell

Do

    5 Cls , _RGB(100, 100, 250): Color _RGB(255, 255, 255)

    For y = 0 To 3: For x = 0 To 3

            If B(x + 4 * y) Then p2 = Log(B(x + 4 * y)) / Log(2) Else p2 = 0

            bg& = _RGB32(255 - 17 * p2)

            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), W~&, B

            If B(x + 4 * y) > 0 Then

                n$ = _Trim$(Str$(B(x + 4 * y)))

                OX = (100 - _PrintWidth(n$)) / 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 x, y

    _Title "2048 - " + "Score: " + Str$(Score): _Display



    ' Remaining Move ?

    For y = 0 To 3: For x = 0 To 3

            If B(y * 4 + x) = 0 Then 10

            If y < 3 Then If B(y * 4 + x) = B((y + 1) * 4 + x) Then 10

            If x < 3 Then If B(y * 4 + x) = B(y * 4 + (x + 1)) Then 10

    Next x, y



    ' No, Game Over

    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 ReDim t(15): jm = 0 ' Update Board by arrow keys

    Select Case _KeyHit

        Case 19200: jm = 4: ks = 0: ke = 3: kstep = 1: km = 1

        Case 19712: jm = 4: ks = 3: ke = 0: kstep = -1: km = 1

        Case 18432: jm = 1: ks = 0: ke = 3: kstep = 1: km = 4

        Case 20480: jm = 1: ks = 3: ke = 0: kstep = -1: km = 4

    End Select

    If jm = 0 Then 5

    For j = 0 To 3

        If jm = 4 Then '      outer loop y's = row ends

            p = j * jm + ks '   start pointer at arrow side left or right

        Else '                outer loop x's

            If kstep = 1 Then p = j Else p = 12 + j ' pointer at column ends

        End If

        For k = ks To ke Step kstep

            If B(j * jm + k * km) <> 0 Then

                If t(p) = B(j * jm + k * km) Then

                    t(p) = t(p) + B(j * jm + k * km): Score = Score + t(p)

                    p = p + kstep * km

                ElseIf t(p) = 0 Then

                    t(p) = B(j * jm + k * km)

                Else

                    p = p + kstep * km: t(p) = B(j * jm + k * km)

                End If

            End If

        Next

    Next

    For j = 0 To 15: B(j) = t(j): Next: AddNewCell: _Limit 30

Loop Until _KeyDown(27)

Sub AddNewCell

    Dim temp(15), x, y, c, i, x1, y1

    For y = 0 To 3: For x = 0 To 3

            If B(y * 4 + x) = 0 Then temp(c) = y * 4 + x: c = c + 1

    Next x, y

    If c > 0 Then

        i = Int(Rnd * c): y1 = Int(temp(i) / 4): x1 = temp(i) Mod 4

        If Rnd < .8 Then B(4 * y1 + x1) = 2 Else B(4 * y1 + x1) = 4

    End If

End Sub



' =============================================================================



' Instructions briefly:

' Use arrow keys to move all numbers on board toward that side, like numbers

' will combine and double. Score is shown in title bar. ESC quits.

' Objective is to get a tile to 2048 but can go further.



'==============================================================================



' Guide for multiple statements on one line by way of colon = Double Parking:



' + Premise: Avoid horizontal scrolling if at all possible!

'   Use code _line extensions if you must. I think it worth the effort to avoid

'   those as well.  ( Now all lines < 80 chars !)



' + For sure, multiple assignments can go on one line best if all are related.



' + For sure, multiple short Sub calls specially if all are related.



' + Remember Next x, y and for keypress either _Keyhit or Input$(1)



' + Option _Explicit used until code is where I want then removed.

EDIT: WTH? this didn't work when I checked it. Fixed now.