2048 Puzzle

[SMcNeill]

There -- I stripped off the 30 lines that I mentioned earlier.

Code: (Select All)

Dim Shared Grid(0 To 5, 0 To 5) As Integer

Screen _NewImage(480, 480, 32): _ScreenMove _Middle

_Title "Double Up by Steve": Randomize Timer: Color , 0

_Font _LoadFont("courbd.ttf", 32, "MONOSPACE")

GetNextNumber: GetNextNumber

Do

    For x = 1 To 4: For y = 1 To 4

            t$ = LTrim$(Str$(Grid(x, y))): If t$ = "0" Then t$ = ""

            x1% = (x - 1) * 120: y1% = (y - 1) * 120

            Line (x1% + 3, y1% + 3)-Step(117, 117), &HFF008888, BF

            Line (x1% + 5, y1% + 5)-Step(115, 115), &HFF00FFFF, B

            _PrintString (x1% + 60 - _PrintWidth(t$) \ 2, y1% + 44), t$

    Next y, x

    Select Case _KeyHit

        Case 32: System

        Case 19200: MoveLeftRight 1: GetNextNumber 'we hit a valid move key.

        Case 18432: MoveUpDown 1: GetNextNumber ' Even if we don't move,

        Case 20480: MoveUpDown -1: GetNextNumber '         get a new number.

        Case 19712: MoveLeftRight -1: GetNextNumber

    End Select

    _Display: _Limit 30

Loop

Sub MoveUpDown (d As Integer)

    s = 1: f = 4: If d < 0 Then Swap s, f

    Do

        moved = 0

        For y = s To f Step d: For x = 1 To 4

                If Grid(x, y) = 0 Then 'every point above this moves down

                    For j = y To f Step d

                        Grid(x, j) = Grid(x, j + d): moved = (Grid(x, j) <> 0)

                    Next

                End If

        Next x, y

        If moved Then y = y + d 'recheck the same column

    Loop Until Not moved

    For y = s To f Step d: For x = 1 To 4

            If Grid(x, y) <> 0 And Grid(x, y) = Grid(x, y + d) Then

                Grid(x, y) = Grid(x, y) * 2

                For j = y + d To f Step d: Grid(x, j) = Grid(x, j + d): Next

            End If

    Next x, y

End Sub

Sub MoveLeftRight (d)

    s = 1: f = 4: If d < 0 Then Swap s, f

    Do

        moved = 0

        For x = s To f Step d: For y = 1 To 4

                If Grid(x, y) = 0 Then 'every point right of this moves left

                    For j = x To f Step d

                        Grid(j, y) = Grid(j + d, y): moved = (Grid(j, y) <> 0)

                    Next

                End If

        Next y, x

        If moved Then x = x + d 'recheck the same row

    Loop Until Not moved

    For x = s To f Step d: For y = 1 To 4

            If Grid(x, y) <> 0 And Grid(x, y) = Grid(x + d, y) Then

                Grid(x, y) = Grid(x, y) * 2

                For j = x + d To f Step d: Grid(j, y) = Grid(j + d, y): Next

            End If

    Next y, x

End Sub

Sub GetNextNumber

    For x = 1 To 4: For y = 1 To 4: valid = (Grid(x, y) = 0): Next y, x

    If valid Then

        Do: x = _Ceil(Rnd * 4): y = _Ceil(Rnd * 4): Loop Until Grid(x, y) = 0

        If Rnd < .8 Then Grid(x, y) = 2 Else Grid(x, y) = 4 ' < missed 4

    End If

End Sub

And, every line is still less than 80 characters in width.