Graphics Test #2 - are you certifiable?

[bplus]

Warning! Do not run this if you are prone to Epileptic Seizures.

Code: QB64: [Select]

1. _Title "Rotating Spokes" 'b+ 2021-11-30
2. DefDbl A-Z
3. Const ss = 700: ssd2 = ss / 2: pi = _Pi
4. Screen _NewImage(ss, ss, 32)
5. _ScreenMove 280, 40
6. Do
7.     Cls
8.     For r = 1 To 9
9.         n = 2 ^ r
10.         stepper = pi * (2 / n)
11.         oa = oa * -1
12.         For a = 0 To _Pi(2) - .0000001 Step stepper
13.             x1 = ssd2 + (r - 1) * 35 * Cos(a + oa): y1 = ssd2 + (r - 1) * 35 * Sin(a + oa)
14.             x2 = ssd2 + r * 35 * Cos(a + oa): y2 = ssd2 + r * 35 * Sin(a + oa)
15.             If r Mod 2 Then Line (x1, y1)-(x2, y2), _RGB32(0, 128 + 128 * a / (2 * pi), 0) Else Line (x1, y1)-(x2, y2), _RGB32(0, 0, 128 + 128 * a / (2 * pi))
16.         Next
17.     Next
18.     oa = Abs(oa) + pi / 360
19.     _Display
20.     _Limit 20
21. Loop
22.  

No really, there is no message to send money, send money, send money...

Actually this is pretty close to what I did in OP and also I think I can make it recursive now, stay tuned...

[bplus]

Couldn't get the recursive version working last night but this morning with fresh eyes found a bunch of typos and got slightly different results in middle with 2/3 the code, but looks better I think!

 

Code: QB64: [Select]

1. _Title "Globe - recurs 2 branching" 'b+ 2021-12-01 got it working
2. DefDbl A-Z
3. Const ss = 700, SSD2 = ss / 2, PI = _Pi
4. Screen _NewImage(ss, ss, 32)
5. _ScreenMove 280, 40
6. r2branch 1
7.  
8. Sub r2branch (r)
9.     If r = 9 Then Exit Sub
10.     n = 2 ^ r
11.     stepper = PI * (2 / n)
12.     ao = .5 * stepper
13.     ao2 = .25 * stepper
14.     For a = 0 To 2 * PI - .0000001 Step stepper
15.         x1 = SSD2 + (r - 1) * 40 * Cos(a + ao): y1 = SSD2 + (r - 1) * 40 * Sin(a + ao)
16.         x2 = SSD2 + r * 40 * Cos(a + ao - ao2): y2 = SSD2 + r * 40 * Sin(a + ao - ao2)
17.         Line (x1, y1)-(x2, y2)
18.         x2 = SSD2 + r * 40 * Cos(a + ao + ao2): y2 = SSD2 + r * 40 * Sin(a + ao + ao2)
19.         Line (x1, y1)-(x2, y2)
20.     Next
21.     r2branch r + 1
22. End Sub
23.  

Before recursive effort, I saved the points in an array and used a simple formula for points in array to draw lines from point on one circle to 2 or more points on the next. Then the main problem was getting things to line up pretty.

Really now you can change out the recursive sub for a Main For Loop:

Code: QB64: [Select]

1. _Title "Globe - elim recurs 2 branching" 'b+ 2021-12-01 got it working
2. DefDbl A-Z
3. Const ss = 700, SSD2 = ss / 2, PI = _Pi
4. Screen _NewImage(ss, ss, 32)
5. _ScreenMove 280, 40
6. For r = 1 To 8
7.     n = 2 ^ r
8.     stepper = PI * (2 / n)
9.     ao = .5 * stepper
10.     ao2 = .25 * stepper
11.     For a = 0 To 2 * PI - .0000001 Step stepper
12.         x1 = SSD2 + (r - 1) * 40 * Cos(a + ao): y1 = SSD2 + (r - 1) * 40 * Sin(a + ao)
13.         x2 = SSD2 + r * 40 * Cos(a + ao - ao2): y2 = SSD2 + r * 40 * Sin(a + ao - ao2)
14.         Line (x1, y1)-(x2, y2)
15.         x2 = SSD2 + r * 40 * Cos(a + ao + ao2): y2 = SSD2 + r * 40 * Sin(a + ao + ao2)
16.         Line (x1, y1)-(x2, y2)
17.     Next
18. Next
19.  

[Dimster]

Ran "Rotating Spokes", lucky for me there was no money in my pocket. Pretty cool how it rotates in opposite directions at the same time.
Steve's reminds me of the aftermath of an earthquake. Needs a go fund me site to generate $$$$ from the effort.
Wonder if you guys could live off the proceeds? Maybe consider NFT's??????

[johannhowitzer]

Code: QB64: [Select]

1. $noprefix
2. screen 12
3.  
4. type node_structure
5.    angle  as single
6.    ring   as byte    ' Which ring to draw on
7.    parent as integer ' Parent node
8. end type
9. dim shared node(65535) as node_structure
10. dim shared node_count as integer
11.  
12. input "Number of rings:    ", rings
13. input "Number of branches: ", branches
14.  
15. for ring = 1 to rings
16.    new_branches = branches ^ ring
17.  
18.    for n = 1 to new_branches
19.       node_count = node_count + 1
20.       node(node_count).angle  = (8 * atn(1)) * (n / new_branches)
21.       node(node_count).ring   = ring
22.       node(node_count).parent = first_parent + int((n - 1) / branches)
23.    next n
24.  
25.    first_parent = first_parent + int(new_branches / branches)
26. next ring
27.  
28. cls
29. for n = 1 to node_count
30.    p = node(n).parent
31.    v1 = 240 * (node(n).ring / rings)
32.    v2 = 240 * (node(p).ring / rings)
33.    line(320 + (v1 * cos(node(n).angle)), 240 + (v1 * sin(node(n).angle)))-_
34.        (320 + (v2 * cos(node(p).angle)), 240 + (v2 * sin(node(p).angle))), 15
35. next n
36.  

Without looking at others' code, while I was in some downtime at work I glanced at the OP, and threw this together in about ten minutes.  I see I took a different approach; while others seem to be going straight to the drawing step, I started by building a network of references, and letting the user input the number of rings, as well as the number of branches from each node.

My result is a little different, because the new ring of nodes are grouping up to the previous ring via an int() modifier on the stack index.  But I think this looks even cooler, and since all the nodes are saved, I can do more things to them if I want.  Fun challenge!

 

[bplus]

Oh very nice challenge @johannhowitzer

Here I calculate the number of rings that will have enough space to keep each spoke separate from the others around the edge. Here is 2 to 9 branching, press any when the screen is sleeping ie "ZZZ..."

Code: QB64: [Select]

1. _Title "Globe - N(2 to 9) Branching" 'b+ 2021-12-01
2. DefDbl A-Z
3. Const ss = 730, pi32 = _Pi(3 / 2)
4. Screen _NewImage(ss, ss, 32)
5. _ScreenMove 250, 10
6. Dim As Integer power, radius, n, i, branch, rings
7.  
8. For branch = 2 To 9
9.     Cls
10.  
11.     rings = 1 ' according to number branches decide number of rings that will fit
12.     While ss / 2 * _Pi(2) / branch ^ rings > 3
13.         rings = rings + 1
14.     Wend
15.     rings = Int(rings) - 1
16.     deltaRadius = Int((ss / 2) / rings) ' divide max radius by rings
17.  
18.     'save points of ring in these 2D arrays d1 = ring d2 = point number on ring
19.     ReDim xp(0 To rings, 0 To branch ^ (rings + 1)), yp(0 To rings, 0 To branch ^ (rings + 1))
20.  
21.     For power = 0 To rings ' load points from rings
22.         radius = power * deltaRadius
23.         n = branch ^ power
24.         stepper = _Pi(2 / n)
25.         ao = .5 * stepper
26.         i = 0
27.         For a = 0 To _Pi(2) - .000001 Step stepper
28.             xp(power, i) = ss / 2 + radius * Cos(a + ao + pi32)
29.             yp(power, i) = ss / 2 + radius * Sin(a + ao + pi32)
30.             i = i + 1
31.         Next
32.     Next
33.  
34.     power = 0 ' OK draw the lines
35.     For power = 0 To rings - 1
36.         accum = 0
37.         For i = 0 To branch ^ power - 1
38.             For k = 0 To branch - 1
39.                 Line (xp(power, i), yp(power, i))-(xp(power + 1, accum + k), yp(power + 1, accum + k))
40.             Next
41.             accum = accum + branch
42.         Next
43.     Next
44.     Print "Branches:"; branch; "  ZZZ... "
45.     Sleep
46. Next
47.  
48.  

Alas, it took me more than 10 minutes to whip up ;-))

[bplus]

Recursive 3 branching from tsh73 at JB, translated and adopted to my style of display:

Code: QB64: [Select]

1. _Title "3 branching recurs by tsh73" 'b+ trans from JB 2021-12-02
2. Const ss = 600, cx = ss / 2, cy = cx, pi = _Pi
3. Screen _NewImage(ss, ss, 32)
4. _ScreenMove 300, 60
5. drawBranches cx, cy, 0, 0, 45, 0
6. Sub drawBranches (x, y, a, totLen, legth, level)
7.     If level > 6 Then Exit Sub
8.     x1 = cx + Cos(a) * totLen
9.     y1 = cy + Sin(a) * totLen
10.     Line (x, y)-(x1, y1)
11.     N = 3 ^ (level + 1)
12.     da = 2 * pi / N
13.     drawBranches x1, y1, (a - da), (totLen + legth), legth, level + 1
14.     drawBranches x1, y1, a, (totLen + legth), legth, level + 1
15.     drawBranches x1, y1, (a + da), (totLen + legth), legth, level + 1
16. End Sub
17.  
18.  

[bplus]

Actually this looks more like his original, pretty cool too!:

Code: QB64: [Select]

1. _Title "3 branching recurs by tsh73 more like original" 'b+ trans from JB 2021-12-03
2. Const ss = 600, cx = ss / 2, cy = cx, pi = _Pi
3. Screen _NewImage(ss, ss, 32)
4. _ScreenMove 300, 60
5. Color &HFF000011, &HFFBBBBFF
6. Cls
7. drawBranches cx, cy, 0, 0, 256, 0
8. Sleep
9.  
10. Sub drawBranches (x, y, a, totLen, leg, level)
11.     '                   This had me stuck for awhile!!!
12.     legth = leg ' <<<< change name of variable for recursive sub in QB64 before passing changed value in next call
13.     If legth < 1 Then Exit Sub
14.     x1 = cx + Cos(a) * totLen
15.     y1 = cy + Sin(a) * totLen
16.     Circle (cx, cy), totLen
17.     Line (x, y)-(x1, y1)
18.     N = 3 ^ (level + 1)
19.     da = 2 * pi / N
20.     legth = legth / 2  ' >> changed value requires the name change in QB64 (not in JB that passes by value not reference)
21.     drawBranches x1, y1, (a - da), (totLen + legth), legth, level + 1
22.     drawBranches x1, y1, a, (totLen + legth), legth, level + 1
23.     drawBranches x1, y1, (a + da), (totLen + legth), legth, level + 1
24. End Sub
25.  

 

[_vince]

have a pretty flower, bplus

Code: QB64: [Select]

1. defdbl a-z
2. pi = 4*atn(1)
3. screen _newimage(640, 640, 32)
4. _title "Plumeria"
5. for t=0 to 2*_pi step 0.001
6.         x = 190*cos(t) + 200*cos(t*6)
7.         y = 190*sin(t) + 200*sin(t*6)
8.         d = sqr(x*x + y*y)
9.         if d < 250 then
10.                 c = 255 - d
11.                 if d > od or d > 110 then
12.                         pset (320 + x, 320 + y),_rgb(255,200 - 0.8*c,225 - 0.8*c)
13.                 end if
14.         end if
15.         od = d
16. next
17. sleep
18. system
19.  

[bplus]

Back to you @_vince :)

Code: QB64: [Select]

1. _Title "Plumeria - colorized and motorized by b+"
2. Screen _NewImage(700, 700, 32)
3. _ScreenMove 300, 40
4. Do
5.     For t = 0 To 2 * _Pi Step 0.001
6.         x = 190 * Cos(t + ao) + 200 * Cos(t * 6 + ao)
7.         y = 190 * Sin(t + ao) + 200 * Sin(t * 6 + ao)
8.         PSet (350 + x, 350 + y), _RGB(255 * y / 390, 255 * t / 5, ao * 255)
9.     Next
10.     ao = ao + .001
11.     If ao > 2 * _Pi(1 / 5) Then ao = 0
12. Loop
13.  

[bplus]

More generalized variation with interesting pattern at mult > 6

Code: QB64: [Select]

1. _Title "Press spacebar for new mult"
2. Screen _NewImage(700, 700, 32)
3. _ScreenMove 300, 40
4. For mult = 2 To 16
5.     Cls
6.     Print mult
7.     Do
8.         For t = 0 To 2 * _Pi Step 0.001
9.             x = 200 * Cos(t + ao) + 200 * Cos(t * mult + ao)
10.             y = 200 * Sin(t + ao) + 200 * Sin(t * mult + ao)
11.             PSet (350 + x, 350 + y), _RGB(255 * y / 390, 0, 255 * t / _Pi(2))
12.         Next
13.         ao = ao + .001
14.         If ao > _Pi(2 / (mult - 1)) Then ao = 0
15.         If InKey$ = " " Then Exit Do
16.     Loop
17. Next
18.  
19.  

[_vince]

nice, bplus

How did you generate the cubes or steve's shelves?

[bplus]

nice, bplus

How did you generate the cubes or steve's shelves?

Hi _vince

I was doing experiments in "Real" 3d rendering here:
https://www.qb64.org/forum/index.php?topic=1904.15