10-23-2024, 03:44 AM
Cleaned up the code from #9 that you'd posted earlier. ( https://qb64phoenix.com/forum/showthread...&pid=29236 )
Have it down to about 100 lines of code and most all are single lines of code. It's not down to 64 LOC, but without going out of my way to compress it further, I think this is about as small as I can make it, unless someone has some nice ninja magic to drop 30 lines out of it.
Have it down to about 100 lines of code and most all are single lines of code. It's not down to 64 LOC, but without going out of my way to compress it further, I think this is about as small as I can make it, unless someone has some nice ninja magic to drop 30 lines out of it.
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, LCtrl = 100306, RCtrl = 100305
Screen _NewImage(480, 480, 32): _ScreenMove _Middle
_Title "Double Up": Randomize Timer
_Font _LoadFont("C:\Windows\Fonts\courbd.ttf", 32, "MONOSPACE")
MakeNewGame
Do
Cls
_Limit 30
ShowGrid
If CheckInput Then GetNextNumber
_Display
Loop
Function CheckInput
Select Case _KeyHit
Case ESC: System
Case 83, 115: If _KeyDown(LCtrl) Or _KeyDown(RCtrl) Then MakeNewGame
Case Left: MoveLeftRight 1: CheckInput = -1 'we hit a valid move key. Even if we don't move, get a new number
Case Up: MoveUpDown 1: CheckInput = -1
Case Down: MoveUpDown -1: CheckInput = -1
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 4, (x - 1) * 120, (y - 1) * 120, 120, 120, t$, -1, 0, 0, -1, 0, 0
Next y, x
End Sub
Sub MakeNewGame
For x = 1 To 4: For y = 1 To 4: Grid(x, y) = 0: Next y, x
GetNextNumber: GetNextNumber
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: Grid(x, y) = 2
End Sub
Sub MakeBox (Mode As Integer, x1 As Integer, y1 As Integer, x2 As Integer, y2 As Integer, Caption As String, FontColor As _Unsigned Long, FontBackground As _Unsigned Long, BoxColor As _Unsigned Long, BoxHighLight As _Unsigned Long, XOffset As Integer, YOffset As Integer)
Line (x1 + 1, y1 + 1)-(x1 + x2 - 1, y1 + y2 - 1), BoxHighLight, B
Line (x1 + 2, t1 + 2)-(x1 + x2 - 2, y1 + y2 - 2), BoxHighLight, B
_PrintString (x1 + (x2 - _PrintWidth(Caption)) \ 2, y1 + (y2 - _FontHeight) \ 2), Caption$
End Sub