Posts: 597
Threads: 110
Joined: Apr 2022
Reputation:
34
(03-26-2024, 11:37 PM)bplus Wrote: draw this:
Of course, I could not help myself and tweaked something silly:
https://basicanywheremachine-news.blogsp...e-ish.html
Posts: 3,925
Threads: 175
Joined: Apr 2022
Reputation:
211
03-30-2024, 02:53 PM
(This post was last modified: 03-30-2024, 02:53 PM by bplus.)
Outstanding! nice work Charlie. I like your control of the colors for the petals. It's got me challlenged!
b = b + ...
Posts: 597
Threads: 110
Joined: Apr 2022
Reputation:
34
03-30-2024, 03:39 PM
(This post was last modified: 03-30-2024, 03:39 PM by CharlieJV.)
(03-30-2024, 02:53 PM)bplus Wrote: 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#
Posts: 3,925
Threads: 175
Joined: Apr 2022
Reputation:
211
03-31-2024, 01:33 PM
(This post was last modified: 03-31-2024, 03:29 PM by 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
b = b + ...
Posts: 236
Threads: 41
Joined: May 2022
Reputation:
28
03-31-2024, 02:00 PM
(This post was last modified: 03-31-2024, 02:17 PM by 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)
Posts: 2,686
Threads: 326
Joined: Apr 2022
Reputation:
215
(03-31-2024, 02:00 PM)Petr Wrote: 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: &
Posts: 236
Threads: 41
Joined: May 2022
Reputation:
28
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.
Posts: 3,925
Threads: 175
Joined: Apr 2022
Reputation:
211
03-31-2024, 03:28 PM
(This post was last modified: 03-31-2024, 03:36 PM by 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
b = b + ...
Posts: 3,925
Threads: 175
Joined: Apr 2022
Reputation:
211
06-18-2024, 10:42 PM
(This post was last modified: 06-18-2024, 11:28 PM by bplus.)
What numbers between 1 and 1000 can NOT be expressed as the sum of consecutive integers?
ie 15 = 7 + 8
18 = 5 + 6 + 7
so neither one of these are in the set of numbers that can NOT be expressed as a sum of consecutive integers.
BONUS: one number can be expressed 15 different ways as a sum of consecutive numbers what is it and list the ways.
b = b + ...
Posts: 2,686
Threads: 326
Joined: Apr 2022
Reputation:
215
06-19-2024, 04:32 AM
(This post was last modified: 06-19-2024, 04:34 AM by SMcNeill.)
(06-18-2024, 10:42 PM)bplus Wrote: What numbers between 1 and 1000 can NOT be expressed as the sum of consecutive integers?
ie 15 = 7 + 8
18 = 5 + 6 + 7
so neither one of these are in the set of numbers that can NOT be expressed as a sum of consecutive integers.
BONUS: one number can be expressed 15 different ways as a sum of consecutive numbers what is it and list the ways.
Here's my method that I've started testing with:
Code: (Select All)
SCREEN _NEWIMAGE(800, 600, 32)
DIM ConInt(100) AS STRING
FOR i = 1 TO 100
FOR j = 1 TO 100
match = CheckMatch(j, i)
IF match THEN ConInt(i) = ConInt(i) + STR$(j)
NEXT
NEXT
FOR i = 1 TO 34
PRINT i; ")"; ConInt(i)
NEXT
FOR i = 35 TO 67
LOCATE i - 34, 30: PRINT i; ")"; ConInt(i)
NEXT
FOR i = 68 TO 100
LOCATE i - 67, 60: PRINT i; ")"; ConInt(i)
NEXT
FUNCTION CheckMatch (start, limit)
sum = start: inc = start
DO
inc = inc + 1
sum = sum + inc
LOOP UNTIL sum >= limit
IF sum = limit THEN CheckMatch = -1
END FUNCTION
Short. Simple. Gives me the starting point to the numbers that you can consecutively add to, to make that number.
For example, at 15 it returns: "1 4 7"
1 + 2 + 3 + 4 + 5 = 15
4 + 5 + 6 = 15
7 + 8 = 15
I'm not finding any numbers that can be found 15 different ways though. The most I can come up with is 5 different matches to make the same consecutive number.
Or are you talking about a number that can be made from a string of 15 values? I don't think that's possible either, as 1 + 2 + 3 + 4 + 5 + 6 + 7 + 8 + 9 + 10 + 11 + 12 + 13 = 91. Add more to it, and it becomes out of bounds ( > 100)
Oooohhhh.... Nevermind. I can't read. The limit was 1000, not 100. LOL!! My bad!
Still, the solution I have above holds up for us. The limits just need to be increased, and you need a larger screen to print them all on, if you want to view them all at once!
|