Challenges

[CharlieJV]

draw this:

Of course, I could not help myself and tweaked something silly:

https://basicanywheremachine-news.blogsp...e-ish.html

   

[bplus]

Outstanding! nice work Charlie. I like your control of the colors for the petals. It's got me challlenged!

[CharlieJV]

Outstanding! nice work Charlie. I like your control of the colors for the petals. It's got me challlenged!

The fun thing (and my obsessive fascination with it lately) with DRAW involves doing some creative things.

Like using the shape of a petal (a "Vesica Pescis") to draw images at whatever plot points along the petal.

For example:

Code: (Select All)

FOR A# = 120 TO 240 STEP 10
' draw bottom part
DRAW "B M 200,205"
DRAW "B U 100"
DRAW "B TA" + A# + "U 100"
DRAW "C14 U 10 R 10 D 10 L10"
' DRAW top part
DRAW "B M 200,105"
DRAW "B D 100"
DRAW "B TA" + A# + "D 100"
DRAW "C12 U 10 R 10 D 10 L10"
SLEEP 0.001
NEXT A#

   

[bplus]

Happy Easter to all who celebrate it on this day!

Here is the first solution i came up with for Flower of Life:

Code: (Select All)

_Title "Flower of life 2" ' b+ 2024-03-26
' fix first version of flower of life around edges

Screen _NewImage(700, 700, 32)
_ScreenMove 300, 40

'drawPetal 300, 350, 400, 350, &HFF8888FF
'End
cx = _Width / 2: cy = _Height / 2: r = 100: c~& = &HFF8888FF
drawflower6 cx, cy, r, c~&
'End
For i = 0 To 5
    px = cx + 2 * r * Cos(i * _Pi(1 / 3) - _Pi(.5))
    py = cy + 2 * r * Sin(i * _Pi(1 / 3) - _Pi(.5))
    If i <> 0 Then
        drawflower6 (px + lastpx) / 2, (py + lastpy) / 2, r, c~&
    Else
        savex = px: savey = py
    End If
    drawflower6 px, py, r, c~&
    lastpx = px: lastpy = py
Next
drawflower6 (savex + lastpx) / 2, (savey + lastpy) / 2, r, c~&

For i = 0 To 35
    x = cx + 300 * Cos(i * _Pi(2 / 36))
    y = cy + 300 * 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

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

Sub drawflower6 (x, y, r, c~&)
    Dim px(5), py(5)
    For i = 0 To 5
        px(i) = x + r * Cos(i * _Pi(1 / 3) - _Pi(.5))
        py(i) = y + r * Sin(i * _Pi(1 / 3) - _Pi(.5))
    Next
    For i = 0 To 5
        drawPetal x, y, px(i), py(i), c~&
        drawPetal px(i), py(i), px((i + 1) Mod 6), py((i + 1) Mod 6), c~&
    Next
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
    Dim al, a
    '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

    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

i solved by first drawing a petal then drawing a flower then overlapping the flower drawings. To get the edges right, I had to calc the midpoints between the current flower to draw and the last one drawn, this part:

Code: (Select All)

If i <> 0 Then
        drawflower6 (px + lastpx) / 2, (py + lastpy) / 2, r, c~&
    Else
        savex = px: savey = py
    End If

It is curious the only 2 solves I've seen to this challenge were not in QB64, and very different approaches than mine.

---

vince challenged me at discord to do it without overlap. i decided i had to skip the flower drawing part and do all petals individually BUT to avoid duplicate petal drawing i had to get all the points the flower petals connect. i did that in an unusual way by collecting all the points I used in flower drawing and then removing the duplicates, 36 + 1 points THEN if i drew the petal from point 23 to point 24 i did Not want to duplicate drawing from point 24 to point 23.

index i runs through all the points but the last and index j runs through all the points after i to the last, if the distance between point i and point j is just r then draw the petal. This gets all the petals drawn without duplication.

Code: (Select All)

_Title "Flower of Life" ' b+ 2024-03-27
' the challenge here is to do this without overlapping circles
' to do this we need all the points and drawPetal
Screen _NewImage(700, 700, 32)
_ScreenMove 300, 40

cx = _Width / 2: cy = _Height / 2: r = 100: c~& = &HFF8888FF

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
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), &HFF8888FF
            _Limit 3
        End If
    Next
Next
For i = 0 To 35 ' draw border
    x = cx + 300 * Cos(i * _Pi(2 / 36))
    y = cy + 300 * 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

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

an alternate coloring scheme that i was challenged to do after seeing Charlies submission:
   

edit: replace code with original copies, remove amp

[Petr]

What is this syntax, Bplus? IDE refuses to read the source code. What are those semicolons at the end of lines? Is it even QB64?


Ah, so it's not your fault, BPlus, it's probably the forum's fault. That source code - I don't know if you have the same output as me, but it destroys the source code by adding nonsense to it.

For example, line 7 shows up for me here as
cx = _Width / 2: cy = _Height / 2: r = 100: c~& = &HFF8888FF

When I manually fixed it everywhere (by deleting amp; ) I got it running.

Better is using source box without text formating (QB)

[SMcNeill]

What is this syntax, Bplus? IDE refuses to read the source code. What are those semicolons at the end of lines? Is it even QB64?


Ah, so it's not your fault, BPlus, it's probably the forum's fault. That source code - I don't know if you have the same output as me, but it destroys the source code by adding nonsense to it.

For example, line 7 shows up for me here as
cx = _Width / 2: cy = _Height / 2: r = 100: c~& = &HFF8888FF

When I manually fixed it everywhere (by deleting amp I got it running.

Better is using source box without text formating (QB)

& is html code for the & symbol. Apparently wherever bplus copied from first, or posted to, or something, it substituted the & for the & symbol in his code.

Just do a find and replace all:

Find: &
Replace: &

[Petr]

BPlus, you have an excellent rating for programming, but since you obviously don't use an IDE, you have an insufficient rating there

Nice work, math geek.

[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