Smallish Games

[bplus]

2048 Game 55 LOC!

Code: (Select All)

DefLng A-Z: Randomize Timer: ReDim Shared B(15) ' 2048 - 55 LOC
Screen _NewImage(405, 405, 32): _ScreenMove 450, 180
_PrintMode _KeepBackground: _Font _LoadFont("arial.ttf", 28)
Color , &HFFBB0033: AddNewCell: AddNewCell
DoLoop: Cls: _Title "2048 - b+ 55 LOC " + "Score: " + Str$(Score)
For x = 0 To 3: For y = 0 To 3
        If B(x + 4 * y) Then pwr = Log(B(x + 4 * y)) / Log(2) Else pwr = 0
        bg& = _RGB32(255 - 17 * pwr): bg2& = _RGB32(128 - 12 * pwr)
        Line (x * 100 + 4, y * 100 + 4)-Step(100 - 4, 100 - 4), bg&, BF
        Line (x * 100 + 5, y * 100 + 5)-Step(100 - 6, 100 - 6), bg2&, B
        If B(x + 4 * y) > 0 Then
            n$ = _Trim$(Str$(B(x + 4 * y))): u = x * 100: v = y * 100
            ox = (100 - _PrintWidth(n$)) / 2: oy = (100 - _FontHeight) / 2
            Color &HFF000000: _PrintString (u + ox + 2, v + oy + 2), n$
            Color &HFFFFFFFF: _PrintString (u + ox, v + oy), n$
        End If
Next: Next: _Display: _Limit 30
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: Next: Beep: Sleep: End
10 ReDim t(15): jm = 0 ' Update Board by arrow keys
Select Case _KeyHit
    Case 27, 32: System
    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 GoTo DoLoop
For j = 0 To 3
    If jm = 4 Then p = j * jm + ks Else If kstep = 1 Then p = j Else p = 12 + j
    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 k, j
For j = 0 To 15: B(j) = t(j): Next: AddNewCell: GoTo DoLoop
Sub AddNewCell '  == Insert new cell onto board in random unused blank ==
    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.