Morph Curve

[bplus]

That Paul Dunn does some cool stuff!

Code: QB64: [Select]

1. _TITLE "Morph Curve" 'for QB64 B+ 2019-01-27
2. ' Morph Curve.bas  SmallBASIC 0.12.8 [B+=MGA] 2017-04-11
3. 'from SpecBAS version Paul Dunn Dec 2, 2015
4. '[youtube]https://www.youtube.com/watch?v=j2rmBRLEVms[/youtube]
5.  
6. 'prep
7. CONST xmax = 700
8. CONST ymax = 700
9. SCREEN _NEWIMAGE(xmax, ymax, 32)
10. _SCREENMOVE 100, 20
11. pts = 12000: interps = 20
12. REDIM p(pts + 1, 1), q(pts + 1, 1), s(pts + 1, 1), i(interps)
13. l = 0: cx = xmax / 2: cy = ymax / 2: sc = cy * .5: st = 2 * _PI / pts
14. FOR n = 1 TO interps
15.     i(n) = SIN(n / interps * (_PI / 2))
16. NEXT
17.  
18. 'main
19. n = 0: m = 0: rmode = 0
20. WHILE 1
21.     c = 0
22.     IF INKEY$ = " " THEN rmode = 1
23.     IF rmode = 0 THEN
24.         n = n + 1
25.         IF n > 12 THEN n = 0: m = m + 1
26.         IF m > 12 THEN rmode = 1
27.     END IF
28.     IF rmode THEN n = rand(1, 75): m = rand(-250, 250)
29.     FOR t = 0 TO 2 * _PI STEP st
30.  
31.         q(c, 0) = cx + sc * (COS(t) + COS(n * t) / 2 + SIN(m * t) / 3)
32.         q(c, 1) = cy + sc * (SIN(t) + SIN(n * t) / 2 + COS(m * t) / 3)
33.         c = c + 1
34.     NEXT
35.     q(c, 0) = q(0, 0): q(c, 1) = q(0, 1)
36.     CLS
37.     PRINT "m = "; m; "  n = "; n; "  spacebar skips to random mode."
38.     IF l = 0 THEN
39.         drawpoly q()
40.         l = l + 1
41.         _DISPLAY
42.         _DELAY 10 / 1000
43.     ELSE
44.         FOR t = 1 TO interps
45.             CLS
46.             PRINT "m = "; m; "  n = "; n;
47.             IF rmode <> 1 THEN PRINT "  spacebar skips to random mode." ELSE PRINT
48.             FOR nn = 0 TO pts
49.                 s(nn, 0) = q(nn, 0) * i(t) + p(nn, 0) * (1 - i(t))
50.                 s(nn, 1) = q(nn, 1) * i(t) + p(nn, 1) * (1 - i(t))
51.             NEXT
52.             s(nn, 0) = s(0, 0)
53.             s(nn, 1) = s(0, 1)
54.             drawpoly s()
55.             _DISPLAY
56.             _DELAY 10 / 1000
57.         NEXT
58.     END IF
59.     _DISPLAY
60.     _DELAY 100 / 1000
61.     'p() = q()
62.     REDIM p(LBOUND(q) TO UBOUND(q), 1)
63.     FOR i = LBOUND(q) TO UBOUND(q)
64.         p(i, 0) = q(i, 0): p(i, 1) = q(i, 1)
65.     NEXT
66. WEND
67.  
68. FUNCTION rand (lo, hi)
69.     rand = (RND * (hi - lo + 1)) \ 1 + lo
70. END FUNCTION
71.  
72. SUB drawpoly (a())
73.     FOR i = LBOUND(a) TO UBOUND(a) - 1
74.         LINE (a(i, 0), a(i, 1))-(a(i + 1, 0), a(i + 1, 1))
75.     NEXT
76.     LINE (a(UBOUND(a), 0), a(UBOUND(a), 1))-(a(LBOUND(a), 0), a(LBOUND(a), 1))
77. END SUB
78.  

[Petr]

Hell, that's really good!

[johnno56]

Cool... Reminds me of a bowl of spaghetti... Mmm... Pasta.

[bplus]

Thicker pasta and colorized pasta sauce (Hi Johnno!):

Code: QB64: [Select]

1. _TITLE "Morph Curve Colorized" 'for QB64 B+ 2019-01-28
2. ' Morph Curve.bas  SmallBASIC 0.12.8 [B+=MGA] 2017-04-11
3. 'from SpecBAS version Paul Dunn Dec 2, 2015
4. '[youtube]https://www.youtube.com/watch?v=j2rmBRLEVms[/youtube]
5.  
6. 'prep
7. CONST xmax = 700
8. CONST ymax = 700
9. SCREEN _NEWIMAGE(xmax, ymax, 32)
10. _SCREENMOVE 100, 20
11. DIM SHARED plasmaN, plasmaR, plasmaG, plasmaB
12. pts = 12000: interps = 20
13. REDIM p(pts + 1, 1), q(pts + 1, 1), s(pts + 1, 1), i(interps)
14. l = 0: cx = xmax / 2: cy = ymax / 2: sc = cy * .5: st = 2 * _PI / pts
15. FOR n = 1 TO interps
16.     i(n) = SIN(n / interps * (_PI / 2))
17. NEXT
18.  
19. 'main
20. n = 0: m = 0: rmode = 0
21. WHILE 1
22.     resetPlasma
23.     c = 0
24.     IF INKEY$ = " " THEN rmode = 1
25.     IF rmode = 0 THEN
26.         n = n + 1
27.         IF n > 12 THEN n = 0: m = m + 1
28.         IF m > 12 THEN rmode = 1
29.     END IF
30.     IF rmode THEN n = rand(1, 75): m = rand(-250, 250)
31.     FOR t = 0 TO 2 * _PI STEP st
32.         q(c, 0) = cx + sc * (COS(t) + COS(n * t) / 2 + SIN(m * t) / 3)
33.         q(c, 1) = cy + sc * (SIN(t) + SIN(n * t) / 2 + COS(m * t) / 3)
34.         c = c + 1
35.     NEXT
36.     q(c, 0) = q(0, 0): q(c, 1) = q(0, 1)
37.     CLS
38.     PRINT "m = "; m; "  n = "; n; "  spacebar skips to random mode."
39.     IF l = 0 THEN
40.         drawpoly q()
41.         l = l + 1
42.         _DISPLAY
43.         _DELAY 10 / 1000
44.     ELSE
45.         FOR t = 1 TO interps
46.             CLS
47.             PRINT "m = "; m; "  n = "; n;
48.             IF rmode <> 1 THEN PRINT "  spacebar skips to random mode." ELSE PRINT
49.             FOR nn = 0 TO pts
50.                 s(nn, 0) = q(nn, 0) * i(t) + p(nn, 0) * (1 - i(t))
51.                 s(nn, 1) = q(nn, 1) * i(t) + p(nn, 1) * (1 - i(t))
52.             NEXT
53.             s(nn, 0) = s(0, 0)
54.             s(nn, 1) = s(0, 1)
55.             drawpoly s()
56.             _DISPLAY
57.             _DELAY 10 / 1000
58.         NEXT
59.     END IF
60.     _DISPLAY
61.     _DELAY 100 / 1000
62.     'p() = q()
63.     REDIM p(LBOUND(q) TO UBOUND(q), 1)
64.     FOR i = LBOUND(q) TO UBOUND(q)
65.         p(i, 0) = q(i, 0): p(i, 1) = q(i, 1)
66.     NEXT
67. WEND
68.  
69. FUNCTION rand (lo, hi)
70.     rand = (RND * (hi - lo + 1)) \ 1 + lo
71. END FUNCTION
72.  
73. SUB drawpoly (a())
74.     FOR i = LBOUND(a) TO UBOUND(a) - 1
75.         kl~& = setPlasma~&
76.         thic a(i, 0), a(i, 1), a(i + 1, 0), a(i + 1, 1), 4, kl~&
77.     NEXT
78.     kl~& = setPlasma~&
79.     thic a(UBOUND(a), 0), a(UBOUND(a), 1), a(LBOUND(a), 0), a(LBOUND(a), 1), 4, kl~&
80. END SUB
81.  
82. SUB thic (x1, y1, x2, y2, thick, K AS _UNSIGNED LONG)
83.     'add filled circles at each end
84.     t2 = thick / 2
85.     IF t2 < 1 THEN t2 = 1
86.     fcirc x1, y1, t2, K
87.     fcirc x2, y2, t2, K
88.     a = _ATAN2(y2 - y1, x2 - x1)
89.     x3 = x1 + t2 * COS(a + _PI(.5))
90.     y3 = y1 + t2 * SIN(a + _PI(.5))
91.     x4 = x1 + t2 * COS(a - _PI(.5))
92.     y4 = y1 + t2 * SIN(a - _PI(.5))
93.     x5 = x2 + t2 * COS(a + _PI(.5))
94.     y5 = y2 + t2 * SIN(a + _PI(.5))
95.     x6 = x2 + t2 * COS(a - _PI(.5))
96.     y6 = y2 + t2 * SIN(a - _PI(.5))
97.     filltri x6, y6, x4, y4, x3, y3, K
98.     filltri x3, y3, x5, y5, x6, y6, K
99. END SUB
100.  
101. ' found at [abandoned, outdated and now likely malicious qb64 dot net website - don’t go there]:    http://www.[abandoned, outdated and now likely malicious qb64 dot net website - don’t go there]/forum/index.php?topic=14425.0
102. SUB filltri (x1, y1, x2, y2, x3, y3, K AS _UNSIGNED LONG)
103.     a& = _NEWIMAGE(1, 1, 32)
104.     _DEST a&
105.     PSET (0, 0), K
106.     _DEST 0
107.     _MAPTRIANGLE _SEAMLESS(0, 0)-(0, 0)-(0, 0), a& TO(x1, y1)-(x2, y2)-(x3, y3)
108.     _FREEIMAGE a& '<<< this is important!
109. END SUB
110.  
111. SUB resetPlasma () 'all globals
112.     plasmaR = RND ^ 2: plasmaG = RND ^ 2: plasmaB = RND ^ 2: plasmaN = 0
113. END SUB
114.  
115. FUNCTION setPlasma~& () 'all globals
116.     plasmaN = plasmaN + .01
117.     setPlasma~& = _RGB32(120 + 84 * SIN(plasmaR * plasmaN), 120 + 84 * SIN(plasmaG * plasmaN), 120 + 84 * SIN(plasmaB * plasmaN))
118. END FUNCTION
119.  
120. 'Steve McNeil's  copied from his forum   note: Radius is too common a name
121. SUB fcirc (CX AS LONG, CY AS LONG, R AS LONG, K AS _UNSIGNED LONG)
122.     DIM subRadius AS LONG, RadiusError AS LONG
123.     DIM X AS LONG, Y AS LONG
124.  
125.     subRadius = ABS(R)
126.     RadiusError = -subRadius
127.     X = subRadius
128.     Y = 0
129.  
130.     IF subRadius = 0 THEN PSET (CX, CY), K: EXIT SUB
131.  
132.     ' Draw the middle span here so we don't draw it twice in the main loop,
133.     ' which would be a problem with blending turned on.
134.     LINE (CX - X, CY)-(CX + X, CY), K, BF
135.  
136.     WHILE X > Y
137.         RadiusError = RadiusError + Y * 2 + 1
138.         IF RadiusError >= 0 THEN
139.             IF X <> Y + 1 THEN
140.                 LINE (CX - Y, CY - X)-(CX + Y, CY - X), K, BF
141.                 LINE (CX - Y, CY + X)-(CX + Y, CY + X), K, BF
142.             END IF
143.             X = X - 1
144.             RadiusError = RadiusError - X * 2
145.         END IF
146.         Y = Y + 1
147.         LINE (CX - X, CY - Y)-(CX + X, CY - Y), K, BF
148.         LINE (CX - X, CY + Y)-(CX + X, CY + Y), K, BF
149.     WEND
150. END SUB
151.  
152.  

EDIT: adjust thic call to 4 (from 3), as some lines were beady, need even thickness.

[johnno56]

Much better! Linguini !!

[Pete]

Now Mark just needs to add balls... Meat balls!

Pete :D

[bplus]

Now Mark just needs to add balls... Meat balls!

Pete :D

Dang! why didn't I think of that? hmm...

Thanks Pete :D

[Pete]

Don't worry about the pasta. I'll keep "stirring the pot" while you bang out your meatballs.

Pete :D

[bplus]

OK I have added meatballs to the plate. They are red unless you look at them. ;-))

Code: QB64: [Select]

1. _TITLE "Morph Curve Colorized and Balled" 'for QB64 B+ 2019-01-29
2. ' Morph Curve.bas  SmallBASIC 0.12.8 [B+=MGA] 2017-04-11
3. 'from SpecBAS version Paul Dunn Dec 2, 2015
4. '[youtube]https://www.youtube.com/watch?v=j2rmBRLEVms[/youtube]
5.  
6. '2019-01-29 add magic red meat balls to the plate
7.  
8. 'prep
9. CONST xmax = 700
10. CONST ymax = 700
11. SCREEN _NEWIMAGE(xmax, ymax, 32)
12. _SCREENMOVE 300, 20
13. DIM SHARED plasmaN, plasmaR, plasmaG, plasmaB
14. pts = 12000: interps = 20
15. REDIM p(pts + 1, 1), q(pts + 1, 1), s(pts + 1, 1), i(interps)
16. l = 0: cx = xmax / 2: cy = ymax / 2: sc = cy * .5: st = 2 * _PI / pts
17. FOR n = 1 TO interps
18.     i(n) = SIN(n / interps * (_PI / 2))
19. NEXT
20.  
21. 'main
22. n = 0: m = 0: rmode = 0
23. WHILE 1
24.     resetPlasma
25.     c = 0
26.     IF INKEY$ = " " THEN rmode = 1
27.     IF rmode = 0 THEN
28.         n = n + 1
29.         IF n > 12 THEN n = 0: m = m + 1
30.         IF m > 12 THEN rmode = 1
31.     END IF
32.     IF rmode THEN n = rand(1, 75): m = rand(-250, 250)
33.     FOR t = 0 TO 2 * _PI STEP st
34.         q(c, 0) = cx + sc * (COS(t) + COS(n * t) / 2 + SIN(m * t) / 3)
35.         q(c, 1) = cy + sc * (SIN(t) + SIN(n * t) / 2 + COS(m * t) / 3)
36.         c = c + 1
37.     NEXT
38.     q(c, 0) = q(0, 0): q(c, 1) = q(0, 1)
39.     magicRedBalls
40.     IF rmode <> 1 THEN
41.         _TITLE "Morph Curve: m =" + STR$(m) + ",  n =" + STR$(n) + ",  spacebar skips to random mode."
42.     ELSE
43.         _TITLE "Morph Curve: m =" + STR$(m) + ",  n =" + STR$(n)
44.     END IF
45.     IF l = 0 THEN
46.         drawpoly q()
47.         l = l + 1
48.         _DISPLAY
49.         _DELAY 10 / 1000
50.     ELSE
51.         FOR t = 1 TO interps
52.             magicRedBalls
53.             FOR nn = 0 TO pts
54.                 s(nn, 0) = q(nn, 0) * i(t) + p(nn, 0) * (1 - i(t))
55.                 s(nn, 1) = q(nn, 1) * i(t) + p(nn, 1) * (1 - i(t))
56.             NEXT
57.             s(nn, 0) = s(0, 0)
58.             s(nn, 1) = s(0, 1)
59.             drawpoly s()
60.             _DISPLAY
61.             _DELAY 10 / 1000
62.         NEXT
63.     END IF
64.     _DISPLAY
65.     _DELAY 200 / 1000
66.     'p() = q()
67.     REDIM p(LBOUND(q) TO UBOUND(q), 1)
68.     FOR i = LBOUND(q) TO UBOUND(q)
69.         p(i, 0) = q(i, 0): p(i, 1) = q(i, 1)
70.     NEXT
71. WEND
72.  
73. FUNCTION rand (lo, hi)
74.     rand = (RND * (hi - lo + 1)) \ 1 + lo
75. END FUNCTION
76.  
77. SUB drawpoly (a())
78.     FOR i = LBOUND(a) TO UBOUND(a) - 1
79.         kl~& = setPlasma~&
80.         thic a(i, 0), a(i, 1), a(i + 1, 0), a(i + 1, 1), 4, kl~&
81.     NEXT
82.     kl~& = setPlasma~&
83.     thic a(UBOUND(a), 0), a(UBOUND(a), 1), a(LBOUND(a), 0), a(LBOUND(a), 1), 4, kl~&
84. END SUB
85.  
86. SUB thic (x1, y1, x2, y2, thick, K AS _UNSIGNED LONG)
87.     'add filled circles at each end
88.     t2 = thick / 2
89.     IF t2 < 1 THEN t2 = 1
90.     fcirc x1, y1, t2, K
91.     fcirc x2, y2, t2, K
92.     a = _ATAN2(y2 - y1, x2 - x1)
93.     x3 = x1 + t2 * COS(a + _PI(.5))
94.     y3 = y1 + t2 * SIN(a + _PI(.5))
95.     x4 = x1 + t2 * COS(a - _PI(.5))
96.     y4 = y1 + t2 * SIN(a - _PI(.5))
97.     x5 = x2 + t2 * COS(a + _PI(.5))
98.     y5 = y2 + t2 * SIN(a + _PI(.5))
99.     x6 = x2 + t2 * COS(a - _PI(.5))
100.     y6 = y2 + t2 * SIN(a - _PI(.5))
101.     filltri x6, y6, x4, y4, x3, y3, K
102.     filltri x3, y3, x5, y5, x6, y6, K
103. END SUB
104.  
105. ' found at [abandoned, outdated and now likely malicious qb64 dot net website - don’t go there]:    http://www.[abandoned, outdated and now likely malicious qb64 dot net website - don’t go there]/forum/index.php?topic=14425.0
106. SUB filltri (x1, y1, x2, y2, x3, y3, K AS _UNSIGNED LONG)
107.     a& = _NEWIMAGE(1, 1, 32)
108.     _DEST a&
109.     PSET (0, 0), K
110.     _DEST 0
111.     _MAPTRIANGLE _SEAMLESS(0, 0)-(0, 0)-(0, 0), a& TO(x1, y1)-(x2, y2)-(x3, y3)
112.     _FREEIMAGE a& '<<< this is important!
113. END SUB
114.  
115. SUB resetPlasma () 'all globals
116.     plasmaR = RND ^ 2: plasmaG = RND ^ 2: plasmaB = RND ^ 2: plasmaN = 0
117. END SUB
118.  
119. FUNCTION setPlasma~& () 'all globals
120.     plasmaN = plasmaN + .01
121.     setPlasma~& = _RGB32(120 + 84 * SIN(plasmaR * plasmaN), 120 + 84 * SIN(plasmaG * plasmaN), 120 + 84 * SIN(plasmaB * plasmaN))
122. END FUNCTION
123.  
124. 'Steve McNeil's  copied from his forum   note: Radius is too common a name
125. SUB fcirc (CX AS LONG, CY AS LONG, R AS LONG, K AS _UNSIGNED LONG)
126.     DIM subRadius AS LONG, RadiusError AS LONG
127.     DIM X AS LONG, Y AS LONG
128.  
129.     subRadius = ABS(R)
130.     RadiusError = -subRadius
131.     X = subRadius
132.     Y = 0
133.  
134.     IF subRadius = 0 THEN PSET (CX, CY), K: EXIT SUB
135.  
136.     ' Draw the middle span here so we don't draw it twice in the main loop,
137.     ' which would be a problem with blending turned on.
138.     LINE (CX - X, CY)-(CX + X, CY), K, BF
139.  
140.     WHILE X > Y
141.         RadiusError = RadiusError + Y * 2 + 1
142.         IF RadiusError >= 0 THEN
143.             IF X <> Y + 1 THEN
144.                 LINE (CX - Y, CY - X)-(CX + Y, CY - X), K, BF
145.                 LINE (CX - Y, CY + X)-(CX + Y, CY + X), K, BF
146.             END IF
147.             X = X - 1
148.             RadiusError = RadiusError - X * 2
149.         END IF
150.         Y = Y + 1
151.         LINE (CX - X, CY - Y)-(CX + X, CY - Y), K, BF
152.         LINE (CX - X, CY + Y)-(CX + X, CY + Y), K, BF
153.     WEND
154. END SUB
155.  
156. SUB magicRedBalls
157.     COLOR _RGBA32(128, 128, 128, 100), _RGB32(120, 0, 0)
158.     CLS
159.     FOR i = 25 TO xmax STEP 50
160.         LINE (i, 0)-(i + 10, ymax), , BF
161.         LINE (0, i)-(xmax, i + 10), , BF
162.     NEXT
163.     COLOR
164.     FOR y = 30 TO ymax STEP 50
165.         FOR x = 30 TO xmax STEP 50
166.             fcirc x, y, 10, _RGB32(128, 128, 128)
167.         NEXT
168.     NEXT
169.     CIRCLE (xmax / 2, ymax / 2), 330, _RGB32(199, 199, 199)
170.     CIRCLE (xmax / 2, ymax / 2), 410, _RGB32(199, 199, 199)
171.     PAINT (xmax / 2, 5), _RGB32(180, 200, 180), _RGB32(199, 199, 199)
172.     PAINT (10, 10), _RGB32(0, 68, 0), _RGB32(199, 199, 199)
173.     PAINT (xmax - 10, 10), _RGB32(0, 68, 0), _RGB32(199, 199, 199)
174.     PAINT (10, ymax - 10), _RGB32(0, 68, 0), _RGB32(199, 199, 199)
175.     PAINT (xmax - 10, ymax - 10), _RGB32(0, 68, 0), _RGB32(199, 199, 199)
176.     FOR r = 0 TO 20
177.         CIRCLE (xmax / 2, ymax / 2), 330 + r, _RGB32(100 + 5 * r, 100 + 5 * r, 100 + 5 * r)
178.     NEXT
179.     CIRCLE (xmax / 2, ymax / 2), 408, _RGB32(204, 205, 205)
180. END SUB
181.  

[Pete]

No offense, but that looks more like a cherry pie, and the lattice crust is starting to mold. Oh well, meatballs, pie, what's the difference? I suppose one way you'd be thought of as a master cooker and the other way, well...

Definitely a short-order cook / baker, regardless!

Pete :D 

[bplus]

OK, not meatballs just a plate decoration. Here is the table set:

[johnno56]

What?!? No cheese!?

Can you do a roast chicken? oh, or even better, Lasagne... Mmmm...

[Pete]

Yeah Mark. Get in the kitchen and code me a sweater!

Pete :D