Well I cleaned up Steve's code a little further, removed Typo in MakeBox and MakeNewGame option/routine altogether, then I had room to throw long comments under the THEN's so now all lines are < 80 chars PLUS I added 4's missing in GetNewNumber routine. So now we make < 100 easy with no horizontal scrolling even on 80 width screen. Plus a tiny little bit of color in the tiles.
Code: (Select All)
Dim Shared Grid(0 To 5, 0 To 5) As Integer
Const Left = 19200, Right = 19712, Down = 20480, Up = 18432, ESC = 32
Screen _NewImage(480, 480, 32): _ScreenMove _Middle
_Title "Double Up by Steve mod b+": Randomize Timer
_Font _LoadFont("C:\Windows\Fonts\courbd.ttf", 32, "MONOSPACE")
GetNextNumber: GetNextNumber
Do
ShowGrid
If CheckInput Then GetNextNumber
_Display: _Limit 30: Cls
Loop
Function CheckInput
Select Case _KeyHit
Case ESC: System
Case Left: MoveLeftRight 1: CheckInput = -1 'we hit a valid move key.
Case Up: MoveUpDown 1: CheckInput = -1 ' Even if we don't move,
Case Down: MoveUpDown -1: CheckInput = -1 ' get a new number.
Case Right: MoveLeftRight -1: CheckInput = -1
End Select
End Function
Sub MoveUpDown (direction As Integer)
start = 1: finish = 4: If direction < 0 Then Swap start, finish
Do
moved = 0
For y = start To finish Step direction: For x = 1 To 4
If Grid(x, y) = 0 Then 'every point above this moves down
For j = y To finish Step direction
Grid(x, j) = Grid(x, j + direction)
If Grid(x, j) <> 0 Then moved = -1
Next
End If
Next x, y
If moved Then y = y + direction 'recheck the same column
Loop Until Not moved
For y = start To finish Step direction: For x = 1 To 4
If Grid(x, y) <> 0 And Grid(x, y) = Grid(x, y + direction) Then
'add them together and every point above this moves
Grid(x, y) = Grid(x, y) * 2
For j = y + direction To finish Step direction
Grid(x, j) = Grid(x, j + direction)
Next
End If
Next x, y
End Sub
Sub MoveLeftRight (direction)
start = 1: finish = 4: If direction < 0 Then Swap start, finish
Do
moved = 0
For x = start To finish Step direction
For y = 1 To 4
If Grid(x, y) = 0 Then 'every point right of this moves left
For j = x To finish Step direction
Grid(j, y) = Grid(j + direction, y)
If Grid(j, y) <> 0 Then moved = -1
Next
End If
Next y, x
If moved Then x = x + direction 'recheck the same row
Loop Until Not moved
For x = start To finish Step direction
For y = 1 To 4
If Grid(x, y) <> 0 And Grid(x, y) = Grid(x + direction, y) Then
'add them together and every point right of this moves left
Grid(x, y) = Grid(x, y) * 2
For j = x + direction To finish Step direction
Grid(j, y) = Grid(j + direction, y)
Next
End If
Next y, x
End Sub
Sub ShowGrid
For x = 1 To 4: For y = 1 To 4
t$ = LTrim$(Str$(Grid(x, y))): If t$ = "0" Then t$ = ""
MakeBox (x - 1) * 120, (y - 1) * 120, 120, 120, t$
Next y, x
End Sub
Sub GetNextNumber
For x = 1 To 4: For y = 1 To 4
If Grid(x, y) = 0 Then valid = -1
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
Sub MakeBox (x1%, y1%, x2%, y2%, Caption$)
Line (x1% + 3, y1% + 3)-(x1% + x2% - 3, y1% + y2% - 3), &HFF008888, B
Line (x1% + 5, y1% + 5)-(x1% + x2% - 5, y1% + y2% - 5), &HFF00FFFF, B
x = x1% + (x2% - _PrintWidth(Caption$)) \ 2
_PrintString (x, y1% + (y2% - _FontHeight) \ 2), Caption$
End Sub
b = b + ...