Challenges

[bplus]

sorry for the confusion @Petr, Steve is correct I got lazy and just posted the edit window from one forum to this one. I posted this challenge at 3 places to share the joy

Wouldn't have been so bad had I checked my post, so I am embarassed.

Here is a new version hot off the press with a Plasma coloring scheme for the petals:

Code: (Select All)

_Title "Flower of Life 4" ' b+ 2024-03-27
' the challenge here is to do this without overlapping circles
' to do this we need all the points and drawPetal
' try a random coloring from a plasma palette

Screen _NewImage(700, 700, 32)
_ScreenMove 300, 40
Randomize Timer
cx = _Width / 2: cy = _Height / 2: r = 100: c~& = &HFF8888FF

' create plasma palette
Dim Shared CN, PR, PG, PB
ReDim Shared Pal(1 To 144) As _Unsigned Long

Dim px(42), py(42)
For i = 0 To 5 ' just collect the points
    p = p + 1
    x = cx + 2 * r * Cos(i * _Pi(1 / 3) - _Pi(.5))
    y = cy + 2 * r * Sin(i * _Pi(1 / 3) - _Pi(.5))
    px(p) = x: py(p) = y
    For j = 0 To 5
        p = p + 1
        px(p) = x + r * Cos(j * _Pi(1 / 3) - _Pi(.5))
        py(p) = y + r * Sin(j * _Pi(1 / 3) - _Pi(.5))
    Next
Next
px(0) = cx: py(0) = cy
Dim qx(36), qy(36)
Print "Here are all the points we need to connect with petals if distance between them = r."
For i = 0 To 42 'remove repeated points
    If i <> 14 And i <> 16 And i <> 24 And i <> 32 And i <> 38 And i <> 40 Then
        qx(q) = px(i): qy(q) = py(i)
        Circle (qx(q), qy(q)), 1
        q = q + 1
    End If
Next
_PrintString (100, 680), "press any, to see the petals drawn to fill out Flower of Life..."
Sleep
Line (0, 0)-(_Width, 18), &HFF000000, BF ' black out text
Line (0, 679)-(_Width, _Height), &HFF000000, BF
Do
    createPal
    For i = 0 To 35
        For j = i + 1 To 36
            If _Hypot(qx(i) - qx(j), qy(i) - qy(j)) - r < .1 Then
                drawPetal qx(i), qy(i), qx(j), qy(j), Pal(Int(Rnd * 144) + 1)
                ' _Limit 3
            End If
        Next
    Next
    For i = 0 To 35 ' draw border
        x = cx + 310 * Cos(i * _Pi(2 / 36))
        y = cy + 310 * Sin(i * _Pi(2 / 36))
        If i = 0 Then savex = x: savey = y Else drawPetal lastx, lasty, x, y, &HFFFFFF00
        lastx = x: lasty = y
    Next
    drawPetal lastx, lasty, savex, savey, &HFFFFFF00
    Sleep
Loop Until _KeyDown(27)

Sub drawPetal (x1, y1, x2, y2, c~&)
    dist = _Hypot(x1 - x2, y1 - y2)
    a = _Atan2(y1 - y2, x1 - x2)
    x0 = x2 + dist * Cos(a + _Pi(1 / 3))
    y0 = y2 + dist * Sin(a + _Pi(1 / 3))
    mx = (x1 + x2) / 2
    my = (y1 + y2) / 2
    a1 = _Atan2(my - y0, mx - x0)
    a2 = a1 + _Pi(1 / 6)
    a3 = a1 - _Pi(1 / 6)
    If a2 < a3 Then starta = a2: stopa = a3 Else starta = a3: stopa = a2
    arc x0, y0, dist, starta, stopa, c~&
    arc x0, y0, dist + 1, starta, stopa, c~&
    x0 = x2 + dist * Cos(a - _Pi(1 / 3))
    y0 = y2 + dist * Sin(a - _Pi(1 / 3))
    a1 = _Atan2(my - y0, mx - x0)
    a2 = a1 + _Pi(1 / 6)
    a3 = a1 - _Pi(1 / 6)
    If a2 < a3 Then starta = a2: stopa = a3 Else starta = a3: stopa = a2
    arc x0, y0, dist, starta, stopa, c~&
    arc x0, y0, dist + 1, starta, stopa, c~&
End Sub

'use radians
Sub arc (x, y, r, raStart, raStop, c As _Unsigned Long) ' this does not check raStart and raStop like arcC does
    'x, y origin, r = radius, c = color
    'raStart is first angle clockwise from due East = 0 degrees
    ' arc will start drawing there and clockwise until raStop angle reached
    Dim al, a
    If raStop < raStart Then
        arc x, y, r, raStart, _Pi(2), c
        arc x, y, r, 0, raStop, c
    Else
        ' modified to easier way suggested by Steve
        'Why was the line method not good? I forgot.
        al = _Pi * r * r * (raStop - raStart) / _Pi(2)
        For a = raStart To raStop Step 1 / al
            PSet (x + r * Cos(a), y + r * Sin(a)), c
        Next
    End If
End Sub

Function Plasma~& ()
    CN = CN + .3 'dim shared cN as _Integer64, pR as long, pG as long, pB as long
    Plasma~& = _RGB32(127 + 127 * Sin(PR * CN), 127 + 127 * Sin(PG * CN), 127 + 127 * Sin(PB * CN))
End Function

Sub resetPlasma ()
    PR = Rnd ^ 2: PG = Rnd ^ 2: PB = Rnd ^ 2
End Sub

Sub createPal
    resetPlasma
    CN = 0
    For i = 1 To 144
        Pal(i) = Plasma~&
    Next
End Sub

amp free i hope ;-))

nutz not my day for posting, edit because I copied the wrong version, should have been Flower of Life 4