+- QB64 Phoenix Edition (https://staging.qb64phoenix.com)
+-- Forum: QB64 Rising (https://staging.qb64phoenix.com/forumdisplay.php?fid=1)
+--- Forum: Code and Stuff (https://staging.qb64phoenix.com/forumdisplay.php?fid=3)
+---- Forum: Programs (https://staging.qb64phoenix.com/forumdisplay.php?fid=7)
+---- Thread: Checkered Checkers (/showthread.php?tid=1482)
Checkered Checkers - bplus - 02-18-2023
For some time now I've been trying do something like this recursively:
Code: (Select All)
_Title "Checkered Checkers, press any for another screen..." ' b+ 2023-02-17
Screen _NewImage(641, 641, 12)
_ScreenMove 300, 60
d = 8: sq = 640 / d: sq8 = sq / d: dm1 = d - 1
Dim arr(d, d)
While _KeyDown(27) = 0
For j = 0 To dm1
For i = 0 To dm1
If Rnd < .5 Then arr(i, j) = 1 Else arr(i, j) = 0
Next
Next
For y = 0 To dm1
For x = 0 To dm1
If arr(x, y) Then
For yy = 0 To dm1
For xx = 0 To dm1
If arr(xx, yy) Then
Line (x * sq + xx * sq8, y * sq + yy * sq8)-(x * sq + xx * sq8 + sq8 - 1, y * sq + yy * sq8 + sq8 - 1), , BF
Else
Line (x * sq + xx * sq8, y * sq + yy * sq8)-(x * sq + xx * sq8 + sq8 - 1, y * sq + yy * sq8 + sq8 - 1), , B
End If
Next
Next
End If
Line (x * sq, y * sq - 1)-(x * sq + sq, y * sq + sq - 1), , B
Next
Next
Sleep
Cls
WendSo it wouldn't take more code lines to do deeper levels. With recursion you could just keep going deeper as long as the side length of a checker was >=1 pixel.
RE: Checkered Checkers - bplus - 02-18-2023
Today I've got it figured out and added the option to divide the sides of a screen from 2 to 10 cells:
Code: (Select All)
_Title "Checkered Checkers Recursive, press any for another screen..." ' b+ 2023-02-17
Screen _NewImage(740, 740, 12)
Randomize Timer
_ScreenMove 300, 0
Dim Shared As Long Divisor, DivisorMinusOne
While _KeyDown(27) = 0
Divisor = Int(Rnd * 9) + 2
DivisorMinusOne = Divisor - 1
ReDim Shared arr(DivisorMinusOne, DivisorMinusOne) ' holds pattern
For j = 0 To DivisorMinusOne
For i = 0 To DivisorMinusOne
If Rnd < .5 Then arr(i, j) = 1
Next
Next
CheckRecur 0, 0, (_Width - 1) / Divisor
Sleep
Cls
Wend
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 SubNote: It is possible to get an all white screen or all black screen except for white grid.
RE: Checkered Checkers - mnrvovrfc - 02-18-2023
This would be awesome on one of those giant screens... much larger than that of my laptop.
RE: Checkered Checkers - bplus - 02-18-2023
Thankyou mnr...
I was surprised to see some of the screens look like Sierpinski work or TempodiBasic's "Chess Pattern" when the divisor was 2 or 3 even 4 and the checks make a pattern.
RE: Checkered Checkers - bplus - 02-19-2023
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 SubRE: Checkered Checkers - mnrvovrfc - 02-20-2023
Another greenback into your pocket! With so few lines of code.
Although for my computer I had to adjust it so the program window were a bit less tall. Otherwise I have to hide the bottom panel of the desktop.
RE: Checkered Checkers - bplus - 02-20-2023
Thankyou again mnr...
Yes to adjust for your screen make Ymax your maximum display height and then match it with Xmax. Most screens are wider than high and all that is needed is a square screen to divide up.