I just found one by @SMcNeill, that one is pretty low on LOC.
I searched Games for it, no show, so with all your permissions (I hope) I will include here:
I knocked out allot of extra empty lines and moved the book he wrote on MoveBox MakeBox to underneath to get an LOC of around 257, not bad, sorta what I was shooting for!
SMcNeill 2048 Game
OH! He called it Double Up no wonder I couldn't find it.
Update 3: Might as well get The Master of cutting BS LOC involved I know he can do better on this one because I think I can
Update: Still can't find it in Games. I don't remember where/when I got it. Less than a year ago, my memory is guessing?
Update 2: @Dav I got yours down to 358 (minus 110 lines) by removing blank lines, but I added Option _Explicit and DIM all not Dim'd yet. Plus I dumped that flash redundant stuff, I don't miss it, I just used last paragraph of screen drawing of Board. I suppose you were going for a visual effect?
I searched Games for it, no show, so with all your permissions (I hope) I will include here:
I knocked out allot of extra empty lines and moved the book he wrote on MoveBox MakeBox to underneath to get an LOC of around 257, not bad, sorta what I was shooting for!
SMcNeill 2048 Game
Code: (Select All)
_Define A-Z As _INTEGER64
Dim Shared Grid(0 To 5, 0 To 5) As Integer
Const Left = 19200
Const Right = 19712
Const Down = 20480
Const Up = 18432
Const ESC = 32
Const LCtrl = 100306
Const RCtrl = 100305
Init
MakeNewGame
Do
_Limit 30
ShowGrid
CheckInput flag
If flag Then GetNextNumber
_Display
Loop
Sub CheckInput (flag)
flag = 0
k = _KeyHit
Select Case k
Case ESC: System
Case 83, 115 'S
If _KeyDown(LCtrl) Or _KeyDown(RCtrl) Then MakeNewGame
Case Left
MoveLeft
flag = -1 'we hit a valid move key. Even if we don't move, get a new number
Case Up
MoveUp
flag = -1
Case Down
MoveDown
flag = -1
Case Right
MoveRight
flag = -1
End Select
End Sub
Sub MoveDown
'first move everything left to cover the blank spaces
Do
moved = 0
For y = 4 To 1 Step -1
For x = 1 To 4
If Grid(x, y) = 0 Then 'every point above this moves down
For j = y To 1 Step -1
Grid(x, j) = Grid(x, j - 1)
If Grid(x, j) <> 0 Then moved = -1
Next
End If
Next
Next
If moved Then y = y + 1 'recheck the same column
Loop Until Not moved
For y = 4 To 1 Step -1
For x = 1 To 4
If Grid(x, y) <> 0 And Grid(x, y) = Grid(x, y - 1) Then 'add them together and every point above this moves
Grid(x, y) = Grid(x, y) * 2
For j = y - 1 To 1
Grid(x, j) = Grid(x, j - 1)
Next
End If
Next
Next
End Sub
Sub MoveLeft
'first move everything to cover the blank spaces
Do
moved = 0
For x = 1 To 4
For y = 1 To 4
If Grid(x, y) = 0 Then 'every point right of this moves left
For j = x To 4
Grid(j, y) = Grid(j + 1, y)
If Grid(j, y) <> 0 Then moved = -1
Next
End If
Next
Next
If moved Then x = x - 1 'recheck the same row
Loop Until Not moved
For x = 1 To 4
For y = 1 To 4
If Grid(x, y) <> 0 And Grid(x, y) = Grid(x + 1, y) Then 'add them together and every point right of this moves left
Grid(x, y) = Grid(x, y) * 2
For j = x + 1 To 4
Grid(j, y) = Grid(j + 1, y)
Next
End If
Next
Next
End Sub
Sub MoveUp
'first move everything to cover the blank spaces
Do
moved = 0
For y = 1 To 4
For x = 1 To 4
If Grid(x, y) = 0 Then 'every point below of this moves up
For j = y To 4
Grid(x, j) = Grid(x, j + 1)
If Grid(x, j) <> 0 Then moved = -1
Next
End If
Next
Next
If moved Then y = y - 1 'recheck the same column
Loop Until Not moved
For y = 1 To 4
For x = 1 To 4
If Grid(x, y) <> 0 And Grid(x, y) = Grid(x, y + 1) Then 'add them together and every point below this moves
Grid(x, y) = Grid(x, y) * 2
For j = y + 1 To 4
Grid(x, j) = Grid(x, j + 1)
Next
Grid(x, 4) = 0
End If
Next
Next
End Sub
Sub MoveRight
'first move everything to cover the blank spaces
Do
moved = 0
For x = 4 To 1 Step -1
For y = 1 To 4
If Grid(x, y) = 0 Then 'every point right of this moves left
For j = x To 1 Step -1
Grid(j, y) = Grid(j - 1, y)
If Grid(j, y) <> 0 Then moved = -1
Next
End If
Next
Next
If moved Then x = x - 1 'recheck the same row
Loop Until Not moved
For x = 4 To 1 Step -1
For y = 1 To 4
If Grid(x, y) <> 0 And Grid(x, y) = Grid(x - 1, y) Then 'add them together and every point right of this moves left
Grid(x, y) = Grid(x, y) * 2
For j = x - 1 To 1 Step -1
Grid(j, y) = Grid(j - 1, y)
Next
End If
Next
Next
End Sub
Sub ShowGrid
'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)
w = 120
h = 120
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) * w, (y - 1) * h, w, h, t$, -1, 0, 0, -1, 0, 0
Next
Next
End Sub
Sub Init
ws = _NewImage(480, 480, 32)
Screen ws
_Delay 1
_Title "Double Up"
_ScreenMove _Middle
Randomize Timer
f& = _LoadFont("C:\Windows\Fonts\courbd.ttf", 32, "MONOSPACE")
_Font f&
End Sub
Sub MakeNewGame
For x = 1 To 4
For y = 1 To 4
Grid(x, y) = 0
Next
Next
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
Next
If valid Then 'If all the grids are full, we can't add any more numbers
'This doesn't mean the game is over, as the player may be able to
Do
x = _Ceil(Rnd * 4)
y = _Ceil(Rnd * 4)
Loop Until Grid(x, y) = 0
Grid(x, y) = 2
End If
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)
Dim BoxBlack As _Unsigned Long
dc& = _DefaultColor: bg& = _BackgroundColor
If Black <> 0 Then
'We have black either as a CONST or a SHARED color
BoxBlack = Black
Else
'We need to define what Black is for our box.
BoxBlack = _RGB32(0, 0, 0)
End If
If _FontWidth <> 0 Then cw = _FontWidth * Len(Caption) Else cw = _PrintWidth(Caption)
ch = _FontHeight
tx1 = x1: tx2 = x2: ty1 = y1: ty2 = y2
Select Case Mode
Case 0
'We use the X2, Y2 coordinates provided as absolute coordinates
Case 1
tx2 = tx1 + cw + 8
ty2 = ty1 + ch + 8
XOffset = 5: YOffset = 5
Case 2
tx2 = tx1 + x2
ty2 = ty1 + y2
Case 3
XOffset = (tx2 - tx1 - cw) \ 2
YOffset = (ty2 - ty1 - ch) \ 2
Case 4
tx2 = tx1 + x2
ty2 = ty1 + y2
XOffset = (tx2 - tx1) \ 2 - cw \ 2
YOffset = (ty2 - ty1 - ch) \ 2
End Select
Line (tx1, ty1)-(tx2, ty2), BoxBlack, BF
Line (tx1 + 1, ty1 + 1)-(tx2 - 1, ty2 - 1), BoxHighLight, B
Line (tx1 + 2, ty1 + 2)-(tx2 - 2, ty2 - 2), BoxHighLight, B
Line (tx1 + 3, ty1 + 3)-(tx2 - 3, ty2 - 3), BoxBlack, B
Line (tx1, ty1)-(tx1 + 3, ty1 + 3), BoxBlack
Line (tx2, ty1)-(tx2 - 3, ty1 + 3), BoxBlack
Line (tx1, ty2)-(tx1 + 3, ty2 - 3), BoxBlack
Line (tx2, ty2)-(tx2 - 3, ty2 - 3), BoxBlack
Line (tx1 + 3, y1 + 3)-(tx2 - 3, ty2 - 3), BoxColor, BF
Color FontColor, FontBackground
_PrintString (tx1 + XOffset, ty1 + YOffset), Caption$
Color dc&, bg&
End Sub
' ========================================= MakeBox Comments
'This is an upgrade version of my original Button routine.
'It's more versitile (but complex) than the original.
'Mode 0 (or any unsupported number) will tell the box to size itself from X1,Y1 to X2,Y2
'Mode 1 will tell the box to autosize itself according to whatever text is placed within it.
'Mode 2 will tell the box to use X2 and Y2 as relative coordinates and not absolute coordinates.
'Mode 3 will tell the box to autocenter text with X2, Y2 being absolute coordinates.
'Mode 4 will tell the box to autocenter text with X2, Y2 being relative coordinates.
'Mode otherwise is unused, but available for expanded functionality.
'X1 carries the X location of where we want to place our box on the screen.
'Y2 carries the Y location of where we want to place our box on the screen.
'X2 is the X boundry of our box on the screen, depending on our mode.
'Y2 is the Y boundry of our box on the screen, depending on our mode.
'Caption is the text that we want our box to contain.
'FontColor is our font color for our caption
'FontBackground is the font background color for our caption
'NOTE: IF FONTCOLOR OR FONTBACKGROUND IS SET TO ZERO, THEY WILL **NOT** AFFECT THE COLOR BEHIND THEM.
'This can be used to mimic the function of _KEEPBACKGROUND, _FILLBACKGROUND, or _ONLYBACKGROUND
'BoxColor is our box color
'BoxHighlight is our box highligh colors
'NOTE: SAME WITH BOXCOLOR AND BOXHIGHLIGHT. IF SET TO ZERO, THEY WILL HAVE **NO** COLOR AT ALL TO THEM, AND WILL NOT AFFECT THE BACKGROUND OF ANYTHING BEHIND THEM.
'XOffset is used to offset our text # pixels from the X1 top.
'YOffset is used to offset our text # pixels from the Y1 top.
'These can be used to place our text wherever we want on our box.
'But remember, if Mode = 3 or 4, the box will autocenter the text and ignore these parameters completely.
OH! He called it Double Up no wonder I couldn't find it.
Update 3: Might as well get The Master of cutting BS LOC involved I know he can do better on this one because I think I can
Update: Still can't find it in Games. I don't remember where/when I got it. Less than a year ago, my memory is guessing?
Update 2: @Dav I got yours down to 358 (minus 110 lines) by removing blank lines, but I added Option _Explicit and DIM all not Dim'd yet. Plus I dumped that flash redundant stuff, I don't miss it, I just used last paragraph of screen drawing of Board. I suppose you were going for a visual effect?
b = b + ...