Draw Spinners by bplus

[bplus]

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. OPTION _EXPLICIT
2. _TITLE "draw Spinner" 'B+ started 2019-06-15
3. RANDOMIZE TIMER
4. DIM i, i2, lc, sc&
5. sc& = _SCREENIMAGE
6. _DELAY .1
7.  
8. DIM SHARED xmax AS INTEGER, ymax AS INTEGER
9. xmax = _DESKTOPWIDTH
10. ymax = _DESKTOPHEIGHT
11. CONST nSpinners = 100
12. TYPE SpinnerType
13.     x AS SINGLE
14.     y AS SINGLE
15.     dx AS SINGLE
16.     dy AS SINGLE
17.     sz AS SINGLE
18.     c AS _UNSIGNED LONG
19. END TYPE
20.  
21. DIM SHARED s(1 TO nSpinners) AS SpinnerType
22.  
23.  
24. SCREEN _NEWIMAGE(xmax, ymax, 32)
25. '_SCREENMOVE 300, 20
26. _FULLSCREEN
27.  
28.  
29. COLOR , &HFFAABBCC
30. FOR i = 1 TO nSpinners
31.     newSpinner i
32. NEXT
33. i2 = 1
34. WHILE INKEY$ <> CHR$(27)
35.     _PUTIMAGE , sc&
36.     lc = lc + 1
37.     IF lc MOD 100 = 99 THEN
38.         lc = 0
39.         IF i2 < nSpinners THEN i2 = i2 + 1
40.     END IF
41.     FOR i = 1 TO i2
42.         drawSpinner s(i).x, s(i).y, s(i).sz, _ATAN2(s(i).dy, s(i).dx), s(i).c
43.         s(i).x = s(i).x + s(i).dx: s(i).y = s(i).y + s(i).dy
44.         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
45.     NEXT
46.     _DISPLAY
47.     _LIMIT 15
48. WEND
49.  
50. SUB newSpinner (i AS INTEGER) 'set Spinners dimensions start angles, color?
51.     DIM r
52.     s(i).sz = RND * .25 + .5
53.     IF RND < .5 THEN r = -1 ELSE r = 1
54.     s(i).dx = (s(i).sz * RND * 8) * r * 2: s(i).dy = (s(i).sz * RND * 8) * r * 2
55.     r = INT(RND * 4)
56.     SELECT CASE r
57.         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
58.         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
59.         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
60.         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
61.     END SELECT
62.     r = RND * 120
63.     s(i).c = _RGB32(r, RND * .5 * r, RND * .25 * r)
64. END SUB
65.  
66. SUB drawSpinner (x AS INTEGER, y AS INTEGER, scale AS SINGLE, heading AS SINGLE, c AS _UNSIGNED LONG)
67.     DIM x1, x2, x3, x4, y1, y2, y3, y4, r, a, a1, a2, lg, d, rd, red, blue, green
68.     STATIC switch AS INTEGER
69.     switch = switch + 2
70.     switch = switch MOD 16 + 1
71.     red = _RED32(c): green = _GREEN32(c): blue = _BLUE32(c)
72.     r = 10 * scale
73.     x1 = x + r * COS(heading): y1 = y + r * SIN(heading)
74.     r = 2 * r 'lg lengths
75.     FOR lg = 1 TO 8
76.         IF lg < 5 THEN
77.             a = heading + .9 * lg * _PI(1 / 5) + (lg = switch) * _PI(1 / 10)
78.         ELSE
79.             a = heading - .9 * (lg - 4) * _PI(1 / 5) - (lg = switch) * _PI(1 / 10)
80.         END IF
81.         x2 = x1 + r * COS(a): y2 = y1 + r * SIN(a)
82.         drawLink x1, y1, 3 * scale, x2, y2, 2 * scale, _RGB32(red + 20, green + 10, blue + 5)
83.         IF lg = 1 OR lg = 2 OR lg = 7 OR lg = 8 THEN d = -1 ELSE d = 1
84.         a1 = a + d * _PI(1 / 12)
85.         x3 = x2 + r * 1.5 * COS(a1): y3 = y2 + r * 1.5 * SIN(a1)
86.         drawLink x2, y2, 2 * scale, x3, y3, scale, _RGB32(red + 35, green + 17, blue + 8)
87.         rd = INT(RND * 8) + 1
88.         a2 = a1 + d * _PI(1 / 8) * rd / 8
89.         x4 = x3 + r * 1.5 * COS(a2): y4 = y3 + r * 1.5 * SIN(a2)
90.         drawLink x3, y3, scale, x4, y4, scale, _RGB32(red + 50, green + 25, blue + 12)
91.     NEXT
92.     r = r * .5
93.     fcirc x1, y1, r, _RGB32(red - 20, green - 10, blue - 5)
94.     x2 = x1 + (r + 1) * COS(heading - _PI(1 / 12)): y2 = y1 + (r + 1) * SIN(heading - _PI(1 / 12))
95.     fcirc x2, y2, r * .2, &HFF000000
96.     x2 = x1 + (r + 1) * COS(heading + _PI(1 / 12)): y2 = y1 + (r + 1) * SIN(heading + _PI(1 / 12))
97.     fcirc x2, y2, r * .2, &HFF000000
98.     r = r * 2
99.     x1 = x + r * .9 * COS(heading + _PI): y1 = y + r * .9 * SIN(heading + _PI)
100.     TiltedEllipseFill 0, x1, y1, r, .7 * r, heading + _PI, _RGB32(red, green, blue)
101. END SUB
102.  
103. SUB drawLink (x1, y1, r1, x2, y2, r2, c AS _UNSIGNED LONG)
104.     DIM a, a1, a2, x3, x4, x5, x6, y3, y4, y5, y6
105.     a = _ATAN2(y2 - y1, x2 - x1)
106.     a1 = a + _PI(1 / 2)
107.     a2 = a - _PI(1 / 2)
108.     x3 = x1 + r1 * COS(a1): y3 = y1 + r1 * SIN(a1)
109.     x4 = x1 + r1 * COS(a2): y4 = y1 + r1 * SIN(a2)
110.     x5 = x2 + r2 * COS(a1): y5 = y2 + r2 * SIN(a1)
111.     x6 = x2 + r2 * COS(a2): y6 = y2 + r2 * SIN(a2)
112.     fquad x3, y3, x4, y4, x5, y5, x6, y6, c
113.     fcirc x1, y1, r1, c
114.     fcirc x2, y2, r2, c
115. END SUB
116.  
117. 'need 4 non linear points (not all on 1 line) list them clockwise so x2, y2 is opposite of x4, y4
118. 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)
119.     ftri x1, y1, x2, y2, x4, y4, c
120.     ftri x3, y3, x4, y4, x1, y1, c
121. END SUB
122.  
123. SUB ftri (x1, y1, x2, y2, x3, y3, K AS _UNSIGNED LONG)
124.     DIM a&
125.     a& = _NEWIMAGE(1, 1, 32)
126.     _DEST a&
127.     PSET (0, 0), K
128.     _DEST 0
129.     _MAPTRIANGLE _SEAMLESS(0, 0)-(0, 0)-(0, 0), a& TO(x1, y1)-(x2, y2)-(x3, y3)
130.     _FREEIMAGE a& '<<< this is important!
131. END SUB
132.  
133. SUB fcirc (CX AS INTEGER, CY AS INTEGER, R AS INTEGER, C AS _UNSIGNED LONG)
134.     DIM Radius AS INTEGER, RadiusError AS INTEGER
135.     DIM X AS INTEGER, Y AS INTEGER
136.     Radius = ABS(R): RadiusError = -Radius: X = Radius: Y = 0
137.     IF Radius = 0 THEN PSET (CX, CY), C: EXIT SUB
138.     LINE (CX - X, CY)-(CX + X, CY), C, BF
139.     WHILE X > Y
140.         RadiusError = RadiusError + Y * 2 + 1
141.         IF RadiusError >= 0 THEN
142.             IF X <> Y + 1 THEN
143.                 LINE (CX - Y, CY - X)-(CX + Y, CY - X), C, BF
144.                 LINE (CX - Y, CY + X)-(CX + Y, CY + X), C, BF
145.             END IF
146.             X = X - 1
147.             RadiusError = RadiusError - X * 2
148.         END IF
149.         Y = Y + 1
150.         LINE (CX - X, CY - Y)-(CX + X, CY - Y), C, BF
151.         LINE (CX - X, CY + Y)-(CX + X, CY + Y), C, BF
152.     WEND
153. END SUB
154.  
155. SUB TiltedEllipseFill (destHandle&, x0, y0, a, b, ang, c AS _UNSIGNED LONG)
156.     DIM max AS INTEGER, mx2 AS INTEGER, i AS INTEGER, j AS INTEGER, k AS SINGLE, lasti AS SINGLE, lastj AS SINGLE
157.     DIM prc AS _UNSIGNED LONG, tef AS LONG
158.     prc = _RGB32(255, 255, 255, 255)
159.     IF a > b THEN max = a + 1 ELSE max = b + 1
160.     mx2 = max + max
161.     tef = _NEWIMAGE(mx2, mx2)
162.     _DEST tef
163.     _SOURCE tef 'point wont read without this!
164.     FOR k = 0 TO 6.2832 + .05 STEP .1
165.         i = max + a * COS(k) * COS(ang) + b * SIN(k) * SIN(ang)
166.         j = max + a * COS(k) * SIN(ang) - b * SIN(k) * COS(ang)
167.         IF k <> 0 THEN
168.             LINE (lasti, lastj)-(i, j), prc
169.         ELSE
170.             PSET (i, j), prc
171.         END IF
172.         lasti = i: lastj = j
173.     NEXT
174.     DIM xleft(mx2) AS INTEGER, xright(mx2) AS INTEGER, x AS INTEGER, y AS INTEGER
175.     FOR y = 0 TO mx2
176.         x = 0
177.         WHILE POINT(x, y) <> prc AND x < mx2
178.             x = x + 1
179.         WEND
180.         xleft(y) = x
181.         WHILE POINT(x, y) = prc AND x < mx2
182.             x = x + 1
183.         WEND
184.         WHILE POINT(x, y) <> prc AND x < mx2
185.             x = x + 1
186.         WEND
187.         IF x = mx2 THEN xright(y) = xleft(y) ELSE xright(y) = x
188.     NEXT
189.     _DEST destHandle&
190.     FOR y = 0 TO mx2
191.         IF xleft(y) <> mx2 THEN LINE (xleft(y) + x0 - max, y + y0 - max)-(xright(y) + x0 - max, y + y0 - max), c, BF
192.     NEXT
193.     _FREEIMAGE tef
194. END SUB
195.  
196.