Checkered Checkers

[bplus]

Now you can control where the checkers go, make your own patterns:

Code: (Select All)

_Title "Checkered Recursive, Left Click toggles Square, Right Draws | 2nd Click Restarts" ' b+ 2023-02-19
Screen _NewImage(740, 740, 12)
Randomize Timer
_ScreenMove 300, 0
Dim Shared As Long Divisor, DivisorMinusOne
Dim pSide
restart:
Cls
Locate 22, 20
Input "(0 quits) Enter 2 to 10, for screen Divisor "; Divisor
If Divisor = 0 Then End
If Divisor < 2 Or Divisor > 11 Then GoTo restart
DivisorMinusOne = Divisor - 1
pSide = (_Height - 1) / Divisor
ReDim Shared arr(DivisorMinusOne, DivisorMinusOne) ' holds pattern
Cls
For y = 0 To DivisorMinusOne
    For x = 0 To DivisorMinusOne
        Line (x * pSide, y * pSide)-Step(pSide, pSide), , B
    Next
Next
Do
    While _MouseInput: Wend
    LBM = _MouseButton(1): RBM = _MouseButton(2): mx = _MouseX: my = _MouseY
    If LBM Then
        _Delay .2
        x = Int(mx / pSide): y = Int(my / pSide)
        If arr(x, y) Then arr(x, y) = 0 Else arr(x, y) = 1
        If arr(x, y) Then
            Line (x * pSide, y * pSide)-Step(pSide, pSide), 15, BF
        Else
            Line (x * pSide, y * pSide)-Step(pSide, pSide), 0, BF
            Line (x * pSide, y * pSide)-Step(pSide, pSide), 15, B
        End If
    End If
    _Limit 100
Loop Until RBM
Cls
CheckRecur 0, 0, (_Width - 1) / Divisor
_Delay 2
Do
    While _MouseInput: Wend
    LBM = _MouseButton(1): RBM = _MouseButton(2)
    _Limit 60
Loop Until RBM Or LBM
GoTo restart

Sub CheckRecur (FirstX, FirstY, Side)
    If Side <= 4 Then Exit Sub ' done
    For y = 0 To DivisorMinusOne
        For x = 0 To DivisorMinusOne
            Line (FirstX + x * Side, FirstY + y * Side)-Step(Side, Side), , B
            If Side / Divisor <= 4 Then
                If arr(x, y) Then
                    Line (FirstX + x * Side + 1, FirstY + y * Side + 1)-Step(Side - 3, Side - 3), 15, BF
                Else
                    Line (FirstX + x * Side + 1, FirstY + y * Side + 1)-Step(Side - 3, Side - 3), 0, BF
                End If
            Else
                If arr(x, y) Then
                    CheckRecur FirstX + x * Side, FirstY + y * Side, Side / Divisor
                End If
            End If
        Next
    Next
End Sub