Pentacle Flux Capacitor #2: Dancing Man

[bplus]

Playing with lightning:

Code: QB64: [Select]

1. 'Pentacle Flux Capacitor 2.bas for QB64 fork 2017-08-23
2. 'translated from: Pentacle Flux Capacitor 2.txt for JB (B+=MGA) 2017-08-23
3. ' updated 2019-09-05 with cleaner more random blackouts, er..., ah, drama!
4.  
5. RANDOMIZE TIMER
6. CONST xmax = 800
7. CONST ymax = 600
8. SCREEN _NEWIMAGE(xmax, ymax, 32)
9. _TITLE "Pentacle Flux Capacitor #2: Dancing Man"
10.  
11. COMMON SHARED xc, yc, dist, tp(), tp2()
12. xc = xmax / 2
13. yc = ymax / 2 + 20
14. DIM tp(4, 1), tp2(4, 1)
15. blackout& = _NEWIMAGE(xmax, ymax, 32)
16. _DEST blackout&
17. LINE (0, 0)-(xmax, ymax), &H99000000, BF
18. PFC& = _NEWIMAGE(xmax, ymax, 32)
19. _DEST PFC&
20. drawPFC
21. _DEST 0
22. WHILE 1
23.     _PUTIMAGE , PFC&, 0
24.     _DISPLAY
25.     _PUTIMAGE , blackout&, 0
26.     _DISPLAY
27.     _DELAY RND * 80 / 1000
28.     Lightning xc, yc - 90, xc, yc + 10, 135
29.     FOR i = 0 TO 4
30.         xe = tp2(i, 0)
31.         ye = tp2(i, 1)
32.         d = rand(.1 * dist, .7 * dist)
33.         SELECT CASE i
34.             CASE 0
35.                 Lightning xc, yc - 90, xe, ye, d
36.                 Lightning xc, yc - 90, xe, ye, d
37.             CASE 1, 4
38.                 Lightning xc, yc - 70, xe, ye, d
39.             CASE 2, 3
40.                 Lightning xc, yc + 10, xe, ye, d
41.         END SELECT
42.     NEXT
43.     _DISPLAY
44.     _DELAY RND * 40 / 1000 + 20 / 1000
45. WEND
46.  
47.  
48. SUB drawPFC
49.     '3 main points for array tp()
50.     pRadius = 40: cRadius = 1.5 * pRadius
51.     a3 = _PI(2 / 5): r = ymax / 2 - cRadius
52.     ao = _PI(-1 / 2): a = ao
53.     FOR rr = r TO 0 STEP -10
54.         midInk 255, 255, 255, 0, 0, 128, rr / r
55.         CircleFill xc, yc, rr
56.     NEXT
57.     FOR i = 0 TO 4
58.         tp(i, 0) = xc + r * COS(a)
59.         tp(i, 1) = yc + r * SIN(a)
60.         FOR rr = cRadius TO pRadius STEP -1
61.             COLOR _RGB((rr - pRadius) / (cRadius - pRadius) * 255 * (cRadius - rr + pRadius) / cRadius, 0, 0)
62.             xx = tp(i, 0): yy = tp(i, 1)
63.             CircleFill xx, yy, rr
64.         NEXT
65.         a = a + a3
66.     NEXT
67.     xx = tp(0, 0): yy = tp(0, 1)
68.     dist = distance##(xx, yy, xc, yc)
69.     FOR pnt = 0 TO 4
70.         FOR dis = 0 TO .5 * dist STEP 10
71.             dGray = 255 * dis / dist
72.             xx = tp(pnt, 0): yy = tp(pnt, 1)
73.             midpoint xx, yy, xc, yc, dis / dist, midx, midy
74.             FOR r = pRadius * (dist - dis) / dist TO 0 STEP -1
75.                 midInk dGray, dGray, dGray, 255, 255, 255, (pRadius - r) / pRadius
76.                 CircleFill midx, midy, r
77.             NEXT
78.         NEXT
79.         tp2(pnt, 0) = midx
80.         tp2(pnt, 1) = midy
81.     NEXT
82. END SUB
83.  
84.  
85. SUB Lightning (x1, y1, x2, y2, d)
86.     IF d < 5 THEN
87.         COLOR _RGB(225, 225, 245)
88.         LINE (x1, y1)-(x2, y2)
89.     ELSE
90.         mx = (x2 + x1) / 2
91.         my = (y2 + y1) / 2
92.         mx = mx + -.5 * RND * d * .4 * rand&&(-2, 2)
93.         my = my + -.5 * RND * d * .4 * rand&&(-2, 2)
94.         Lightning x1, y1, mx, my, d / 2
95.         Lightning x2, y2, mx, my, d / 2
96.     END IF
97. END SUB
98.  
99. 'Steve McNeil's
100. SUB CircleFill (CX AS LONG, CY AS LONG, R AS LONG)
101.     DIM Radius AS LONG, RadiusError AS LONG
102.     DIM X AS LONG, Y AS LONG
103.  
104.     Radius = ABS(R)
105.     RadiusError = -Radius
106.     X = Radius
107.     Y = 0
108.  
109.     IF Radius = 0 THEN PSET (CX, CY): EXIT SUB
110.  
111.     ' Draw the middle span here so we don't draw it twice in the main loop,
112.     ' which would be a problem with blending turned on.
113.     LINE (CX - X, CY)-(CX + X, CY), , BF
114.  
115.     WHILE X > Y
116.         RadiusError = RadiusError + Y * 2 + 1
117.         IF RadiusError >= 0 THEN
118.             IF X <> Y + 1 THEN
119.                 LINE (CX - Y, CY - X)-(CX + Y, CY - X), , BF
120.                 LINE (CX - Y, CY + X)-(CX + Y, CY + X), , BF
121.             END IF
122.             X = X - 1
123.             RadiusError = RadiusError - X * 2
124.         END IF
125.         Y = Y + 1
126.         LINE (CX - X, CY - Y)-(CX + X, CY - Y), , BF
127.         LINE (CX - X, CY + Y)-(CX + X, CY + Y), , BF
128.     WEND
129. END SUB
130.  
131. SUB midpoint (x1, y1, x2, y2, fraction, midx, midy)
132.     midx = (x2 - x1) * fraction + x1
133.     midy = (y2 - y1) * fraction + y1
134. END SUB
135.  
136. SUB midInk (r1, g1, b1, r2, g2, b2, fr)
137.     COLOR _RGB(r1 + (r2 - r1) * fr, g1 + (g2 - g1) * fr, b1 + (b2 - b1) * fr)
138. END SUB
139.  
140. FUNCTION distance## (x1##, y1##, x2##, y2##)
141.     distance## = ((x1## - x2##) ^ 2 + (y1## - y2##) ^ 2) ^ .5
142. END FUNCTION
143.  
144. FUNCTION rand&& (lo&&, hi&&)
145.     rand&& = INT(RND * (hi&& - lo&& + 1)) + lo&&
146. END FUNCTION
147.  

[Petr]

Very nice BPlus. All what miss me, is Faraday's cage and Nikola Tesla inside. He was the first to do these high voltage experiments. :)

[Ashish]

Beautiful! I can watch this for hours. I'm big fan of Nikola Tesla.