### Author Topic: Draw Spinners by bplus  (Read 3681 times)

0 Members and 1 Guest are viewing this topic.

#### bplus

• Global Moderator
• Forum Resident
• Posts: 8053
• b = b + ...
##### Draw Spinners by bplus
« on: March 01, 2020, 04:40:43 pm »
Author: bplus
Source: qb64.org Forum
URL: https://www.qb64.org/forum/index.php?topic=1431
Version: QB64
Tags:  [graphics] [screen saver]

Description:
Give it a second for things to develop, to quit just press escape. SMcNeill and Petr offered mods see URL.

Code: QB64: [Select]
1. _TITLE "draw Spinner" 'B+ started 2019-06-15
2. DIM i, i2, lc, sc&
3.
4. CONST nSpinners = 100
5. TYPE SpinnerType
6.     dx AS SINGLE
7.     dy AS SINGLE
8.     sz AS SINGLE
9.
10. DIM SHARED s(1 TO nSpinners) AS SpinnerType
11.
12.
13. SCREEN _NEWIMAGE(xmax, ymax, 32)
14. '_SCREENMOVE 300, 20
15.
16.
17. COLOR , &HFFAABBCC
18. FOR i = 1 TO nSpinners
19.     newSpinner i
20. i2 = 1
21.     _PUTIMAGE , sc&
22.     lc = lc + 1
23.     IF lc MOD 100 = 99 THEN
24.         lc = 0
25.         IF i2 < nSpinners THEN i2 = i2 + 1
26.     FOR i = 1 TO i2
27.         drawSpinner s(i).x, s(i).y, s(i).sz, _ATAN2(s(i).dy, s(i).dx), s(i).c
28.         s(i).x = s(i).x + s(i).dx: s(i).y = s(i).y + s(i).dy
29.         IF s(i).x < -100 OR s(i).x > xmax + 100 OR s(i).y < -100 OR s(i).y > ymax + 100 THEN newSpinner i
30.     _LIMIT 15
31.
32. SUB newSpinner (i AS INTEGER) 'set Spinners dimensions start angles, color?
33.     DIM r
34.     s(i).sz = RND * .25 + .5
35.     IF RND < .5 THEN r = -1 ELSE r = 1
36.     s(i).dx = (s(i).sz * RND * 8) * r * 2: s(i).dy = (s(i).sz * RND * 8) * r * 2
37.     r = INT(RND * 4)
38.         CASE 0: s(i).x = RND * (xmax - 120) + 60: s(i).y = 0: IF s(i).dy < 0 THEN s(i).dy = -s(i).dy
39.         CASE 1: s(i).x = RND * (xmax - 120) + 60: s(i).y = ymax: IF s(i).dy > 0 THEN s(i).dy = -s(i).dy
40.         CASE 2: s(i).x = 0: s(i).y = RND * (ymax - 120) + 60: IF s(i).dx < 0 THEN s(i).dx = -s(i).dx
41.         CASE 3: s(i).x = xmax: s(i).y = RND * (ymax - 120) + 60: IF s(i).dx > 0 THEN s(i).dx = -s(i).dx
42.     r = RND * 120
43.     s(i).c = _RGB32(r, RND * .5 * r, RND * .25 * r)
44.
45. SUB drawSpinner (x AS INTEGER, y AS INTEGER, scale AS SINGLE, heading AS SINGLE, c AS _UNSIGNED LONG)
46.     DIM x1, x2, x3, x4, y1, y2, y3, y4, r, a, a1, a2, lg, d, rd, red, blue, green
47.     STATIC switch AS INTEGER
48.     switch = switch + 2
49.     switch = switch MOD 16 + 1
50.     red = _RED32(c): green = _GREEN32(c): blue = _BLUE32(c)
51.     r = 10 * scale
52.     x1 = x + r * COS(heading): y1 = y + r * SIN(heading)
53.     r = 2 * r 'lg lengths
54.     FOR lg = 1 TO 8
55.         IF lg < 5 THEN
56.             a = heading + .9 * lg * _PI(1 / 5) + (lg = switch) * _PI(1 / 10)
57.             a = heading - .9 * (lg - 4) * _PI(1 / 5) - (lg = switch) * _PI(1 / 10)
58.         x2 = x1 + r * COS(a): y2 = y1 + r * SIN(a)
59.         drawLink x1, y1, 3 * scale, x2, y2, 2 * scale, _RGB32(red + 20, green + 10, blue + 5)
60.         IF lg = 1 OR lg = 2 OR lg = 7 OR lg = 8 THEN d = -1 ELSE d = 1
61.         a1 = a + d * _PI(1 / 12)
62.         x3 = x2 + r * 1.5 * COS(a1): y3 = y2 + r * 1.5 * SIN(a1)
63.         drawLink x2, y2, 2 * scale, x3, y3, scale, _RGB32(red + 35, green + 17, blue + 8)
64.         rd = INT(RND * 8) + 1
65.         a2 = a1 + d * _PI(1 / 8) * rd / 8
66.         x4 = x3 + r * 1.5 * COS(a2): y4 = y3 + r * 1.5 * SIN(a2)
67.         drawLink x3, y3, scale, x4, y4, scale, _RGB32(red + 50, green + 25, blue + 12)
68.     r = r * .5
69.     fcirc x1, y1, r, _RGB32(red - 20, green - 10, blue - 5)
70.     x2 = x1 + (r + 1) * COS(heading - _PI(1 / 12)): y2 = y1 + (r + 1) * SIN(heading - _PI(1 / 12))
71.     fcirc x2, y2, r * .2, &HFF000000
72.     x2 = x1 + (r + 1) * COS(heading + _PI(1 / 12)): y2 = y1 + (r + 1) * SIN(heading + _PI(1 / 12))
73.     fcirc x2, y2, r * .2, &HFF000000
74.     r = r * 2
75.     x1 = x + r * .9 * COS(heading + _PI): y1 = y + r * .9 * SIN(heading + _PI)
76.     TiltedEllipseFill 0, x1, y1, r, .7 * r, heading + _PI, _RGB32(red, green, blue)
77.
78. SUB drawLink (x1, y1, r1, x2, y2, r2, c AS _UNSIGNED LONG)
79.     DIM a, a1, a2, x3, x4, x5, x6, y3, y4, y5, y6
80.     a = _ATAN2(y2 - y1, x2 - x1)
81.     a1 = a + _PI(1 / 2)
82.     a2 = a - _PI(1 / 2)
83.     x3 = x1 + r1 * COS(a1): y3 = y1 + r1 * SIN(a1)
84.     x4 = x1 + r1 * COS(a2): y4 = y1 + r1 * SIN(a2)
85.     x5 = x2 + r2 * COS(a1): y5 = y2 + r2 * SIN(a1)
86.     x6 = x2 + r2 * COS(a2): y6 = y2 + r2 * SIN(a2)
87.     fquad x3, y3, x4, y4, x5, y5, x6, y6, c
88.     fcirc x1, y1, r1, c
89.     fcirc x2, y2, r2, c
90.
91. 'need 4 non linear points (not all on 1 line) list them clockwise so x2, y2 is opposite of x4, y4
92. SUB fquad (x1 AS INTEGER, y1 AS INTEGER, x2 AS INTEGER, y2 AS INTEGER, x3 AS INTEGER, y3 AS INTEGER, x4 AS INTEGER, y4 AS INTEGER, c AS _UNSIGNED LONG)
93.     ftri x1, y1, x2, y2, x4, y4, c
94.     ftri x3, y3, x4, y4, x1, y1, c
95.
96. SUB ftri (x1, y1, x2, y2, x3, y3, K AS _UNSIGNED LONG)
97.     DIM a&
98.     a& = _NEWIMAGE(1, 1, 32)
99.     _DEST a&
100.     PSET (0, 0), K
101.     _MAPTRIANGLE _SEAMLESS(0, 0)-(0, 0)-(0, 0), a& TO(x1, y1)-(x2, y2)-(x3, y3)
102.     _FREEIMAGE a& '<<< this is important!
103.
104. SUB fcirc (CX AS INTEGER, CY AS INTEGER, R AS INTEGER, C AS _UNSIGNED LONG)
107.     IF Radius = 0 THEN PSET (CX, CY), C: EXIT SUB
108.     LINE (CX - X, CY)-(CX + X, CY), C, BF
109.     WHILE X > Y
111.         IF RadiusError >= 0 THEN
112.             IF X <> Y + 1 THEN
113.                 LINE (CX - Y, CY - X)-(CX + Y, CY - X), C, BF
114.                 LINE (CX - Y, CY + X)-(CX + Y, CY + X), C, BF
115.             X = X - 1
117.         Y = Y + 1
118.         LINE (CX - X, CY - Y)-(CX + X, CY - Y), C, BF
119.         LINE (CX - X, CY + Y)-(CX + X, CY + Y), C, BF
120.
121. SUB TiltedEllipseFill (destHandle&, x0, y0, a, b, ang, c AS _UNSIGNED LONG)
122.     DIM max AS INTEGER, mx2 AS INTEGER, i AS INTEGER, j AS INTEGER, k AS SINGLE, lasti AS SINGLE, lastj AS SINGLE
123.     DIM prc AS _UNSIGNED LONG, tef AS LONG
124.     prc = _RGB32(255, 255, 255, 255)
125.     IF a > b THEN max = a + 1 ELSE max = b + 1
126.     mx2 = max + max
127.     tef = _NEWIMAGE(mx2, mx2)
128.     _DEST tef
129.     _SOURCE tef 'point wont read without this!
130.     FOR k = 0 TO 6.2832 + .05 STEP .1
131.         i = max + a * COS(k) * COS(ang) + b * SIN(k) * SIN(ang)
132.         j = max + a * COS(k) * SIN(ang) - b * SIN(k) * COS(ang)
133.         IF k <> 0 THEN
134.             LINE (lasti, lastj)-(i, j), prc
135.             PSET (i, j), prc
136.         lasti = i: lastj = j
137.     DIM xleft(mx2) AS INTEGER, xright(mx2) AS INTEGER, x AS INTEGER, y AS INTEGER
138.     FOR y = 0 TO mx2
139.         x = 0
140.         WHILE POINT(x, y) <> prc AND x < mx2
141.             x = x + 1
142.         xleft(y) = x
143.         WHILE POINT(x, y) = prc AND x < mx2
144.             x = x + 1
145.         WHILE POINT(x, y) <> prc AND x < mx2
146.             x = x + 1
147.         IF x = mx2 THEN xright(y) = xleft(y) ELSE xright(y) = x
148.     _DEST destHandle&
149.     FOR y = 0 TO mx2
150.         IF xleft(y) <> mx2 THEN LINE (xleft(y) + x0 - max, y + y0 - max)-(xright(y) + x0 - max, y + y0 - max), c, BF
151.     _FREEIMAGE tef
152.
153.
« Last Edit: March 03, 2020, 12:18:19 pm by Qwerkey »