2048 Puzzle

[bplus]

Here's something interesting, ...maybe

Code: (Select All)

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 '                == save index of empty cells for random pick ==
            If B(y * 4 + x) = 0 Then temp(c) = y * 4 + x: c = c + 1
    Next: Next
    If c > 0 Then '      == choose one place to make a number, convert index to row =y1, col =x1 ==
        i = Int(Rnd * c): y1 = Int(temp(i) / 4): x1 = temp(i) Mod 4 '  == pick and convert index ==
        If Rnd < .8 Then B(4 * y1 + x1) = 2 Else B(4 * y1 + x1) = 4 ' = more 2's, 80% than 4's, 20%
    End If
End Sub

I tried this with straight index to B()

Code: (Select All)

Sub AddNewCell '  == Insert new cell onto board in random unused blank ==
    Dim temp(15), x, y, c, i, x1, y1
    For i = 0 To 15 '  == save index of empty cells for random pick ==
        If B(i) = 0 Then temp(c) = i: c = c + 1
    Next
    If c > 0 Then '      == choose one place to make a number, convert index to row =y1, col =x1 ==
        i = Int(Rnd * c) '  == pick and convert index ==
        If Rnd < .8 Then B(i) = 2 Else B(i) = 4 ' = more 2's, 80% than 4's, 20%
    End If
End Sub

That didn't work, it was crazy / interesting trying to figure out why!