+- 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: Circular Pattern Using Triangles (/showthread.php?tid=964)
Circular Pattern Using Triangles - SierraKen - 10-12-2022
I've seen this before, probably from B+, but I wanted to see if I could do it from a fresh start. After a few attempts I figured it out! I used radians on the circle and also saved the points in memory so I could then go to a DO/LOOP to use them how I wish.
After many triangles it starts over again with a random color again.Code: (Select All)
'Circular Pattern Using Triangles by SierraKen
'October 11, 2022
'
'Thanks to B+ and others for the inspiration to make my own.
Dim x(1000), y(1000)
Screen _NewImage(800, 600, 32)
_Title "Circular Pattern Using Triangles by SierraKen - Esc to quit"
For t = 0 To 1000 Step 1 / 3
x(t) = (Sin(t) * 180) + 400
y(t) = (Cos(t) * 180) + 300
Circle (x(t), y(t)), 2, _RGB32(0, 255, 0)
Next t
Randomize Timer
c1 = (Rnd * 155) + 100: c2 = (Rnd * 155) + 100: c3 = (Rnd * 155) + 100
Do
_Limit 20
'This uses radians in the circle. I used a radian chart online to get each formula with _PI
Line (x(7 * (_Pi / 6) + a), y(7 * (_Pi / 6) + a))-(x(11 * (_Pi / 6) + a), y((11 * _Pi / 6) + a)), _RGB32(c1, c2, c3)
Line (x(11 * (_Pi / 6) + a), y(11 * (_Pi / 6) + a))-(x((_Pi / 2) + a), y((_Pi / 2) + a)), _RGB32(c1, c2, c3)
Line (x((_Pi / 2) + a), y((_Pi / 2) + a))-(x(7 * (_Pi / 6) + a), y(7 * (_Pi / 6) + a)), _RGB32(c1, c2, c3)
a = a + 1 / 3
If a > 300 Then
a = 0
Cls
For tt = 0 To 2000 Step 1 / 3
xx = (Sin(tt) * 180) + 400
yy = (Cos(tt) * 180) + 300
Circle (xx, yy), 2, _RGB32(0, 255, 0)
Next tt
c1 = (Rnd * 155) + 100: c2 = (Rnd * 155) + 100: c3 = (Rnd * 155) + 100
End If
Loop Until InKey$ = Chr$(27)RE: Circular Pattern Using Triangles - bplus - 10-12-2022
Did you know I could make Sierpinski Triangles from Circles:
Code: (Select All)
_Title "Sierpinski Circled by bplus"
'2018-07-23 update some code tweaks learned when translating this to other BASIC flavors
'for new ORG avatar?
Const xmax = 740
Const ymax = 740
Randomize Timer
Screen _NewImage(xmax, ymax, 32)
_ScreenMove 360, 5
Dim Shared cx, cy, cr, ra, inc
cx = xmax / 2: cy = ymax / 2: cr = ymax / 6: inc = _Pi(1 / 360)
Color _RGBA(100, 255, 100, 40), _RGB32(0, 0, 0)
For n = 3 To 8
a = 0
ra = _Pi(2) / n
While a < ra
Cls
levels = 12 - n
RecurringCircles cx, cy, cr, n, a, levels
a = a + inc
_Display
_Limit 10
Wend
Cls
RecurringCircles cx, cy, cr, n, 0, levels
_Display
_Limit 5
Next
Sub RecurringCircles (x, y, r, n, rao, level)
fcirc x, y, r
If level > 0 Then
For i = 0 To n - 1
x1 = x + 1.5 * r * Cos(i * ra + rao + _Pi(-.5))
y1 = y + 1.5 * r * Sin(i * ra + rao + _Pi(-.5))
RecurringCircles x1, y1, r * .5, n, 2 * rao, level - 1
Next
End If
End Sub
'Steve McNeil's copied from his forum note: Radius is too common a name
Sub fcirc (CX As Long, CY As Long, R As Long)
Dim subRadius As Long, RadiusError As Long
Dim X As Long, Y As Long
subRadius = Abs(R)
RadiusError = -subRadius
X = subRadius
Y = 0
If subRadius = 0 Then PSet (CX, CY): Exit Sub
' Draw the middle span here so we don't draw it twice in the main loop,
' which would be a problem with blending turned on.
Line (CX - X, CY)-(CX + X, CY), , BF
While X > Y
RadiusError = RadiusError + Y * 2 + 1
If RadiusError >= 0 Then
If X <> Y + 1 Then
Line (CX - Y, CY - X)-(CX + Y, CY - X), , BF
Line (CX - Y, CY + X)-(CX + Y, CY + X), , BF
End If
X = X - 1
RadiusError = RadiusError - X * 2
End If
Y = Y + 1
Line (CX - X, CY - Y)-(CX + X, CY - Y), , BF
Line (CX - X, CY + Y)-(CX + X, CY + Y), , BF
Wend
End SubRE: Circular Pattern Using Triangles - SierraKen - 10-12-2022
That's beautiful B+! Very good for Christmas!