Bonkers Symphony No. 37

[bplus]

"It doesn't alter the fact that you are all bonkers, nuts, potty, reactionary and mental."

While in the land of Potty, B+ comes up with this:

Code: QB64: [Select]

1. _TITLE "Bonkers Synphony #37  by bplus, press spacebar for different view"
2.  
3.  
4. ' Bonkers Symphony no 37.bas for QB64 fork (B+=MGA) trans 2017-09-15
5. ' from: Bonkers Symphony Number 37.bas  SmallBASIC 0.12.8 [B+=MGA] 2017-04-21
6. CONST xmax = 800
7. CONST ymax = 600
8.  
9. SCREEN _NEWIMAGE(xmax, ymax, 32)
10. gravity = 3
11.  
12. 'balls
13. bR = 10
14. n = 12
15. speed = 12
16. DIM x(n), y(n), a(n), c(n), rr(n), gg(n), bb(n), rd(n)
17. FOR i = 1 TO n
18.     x(i) = rand(xmax / 2 - 10, xmax / 2 + 10)
19.     y(i) = rand(-200, 0)
20.     rd(i) = rand(3, 20)
21.     a(i) = _PI(.5) + _PI(1 / 90) * rdir
22.     rr(i) = rand(60, 100)
23.     gg(i) = rand(60, 100)
24.     bb(i) = rand(60, 100)
25. NEXT
26.  
27. 'pins
28. pR = 25
29. maxrow = 7
30. nP = maxrow * (maxrow + 1) * .5
31. pxo = xmax / (maxrow + 1) 'pin space along x
32. pyo = ymax / (maxrow + 1) 'pin spacing along y
33. DIM px(nP), py(nP)
34. FOR row = 1 TO maxrow
35.     FOR col = 1 TO row
36.         pidx = pidx + 1
37.         px(pidx) = pxo * col + (maxrow - row) * .5 * pxo
38.         py(pidx) = pyo * row
39.     NEXT
40. NEXT
41.  
42. clrMode = 1
43. WHILE 1
44.  
45.     IF _KEYHIT = 32 THEN clrMode = clrMode * -1
46.     IF clrMode < 0 THEN CLS
47.  
48.     'draw pins
49.     FOR i = 1 TO nP
50.         FOR r = pR TO 1 STEP -1
51.             COLOR _RGB(r / pR * 255, r / pR * 255, r / pR * 255)
52.             fcirc px(i), py(i), r
53.         NEXT
54.     NEXT
55.  
56.     'calc collsions
57.     FOR i = 1 TO n
58.         FOR j = 1 TO nP
59.             IF SQR((x(i) - px(j)) ^ 2 + (y(i) - py(j)) ^ 2) < rd(i) + pR THEN
60.                 a(i) = _ATAN2(y(i) - py(j), x(i) - px(j))
61.                 COLOR _RGB(0, 0, 0)
62.                 fcirc px(j), py(j), pR
63.                 snd 120 + py(j) / ymax * 5000, px(j) / xmax * 55
64.                 EXIT FOR
65.             END IF
66.         NEXT
67.         FOR j = i + 1 TO n
68.             IF j <> i AND c(j) <> 1 THEN
69.                 IF SQR((x(i) - x(j)) ^ 2 + (y(i) - y(j)) ^ 2) < rd(i) + rd(j) THEN
70.                     a(i) = _ATAN2(y(i) - y(j), x(i) - x(j))
71.                     a(j) = _ATAN2(y(j) - y(i), x(j) - x(i))
72.                     c(i) = 1: c(j) = 1
73.                     EXIT FOR
74.                 END IF
75.             END IF
76.         NEXT
77.  
78.         'update balls
79.         dx = COS(a(i)) * speed
80.         dy = SIN(a(i)) * speed + gravity
81.         a(i) = _ATAN2(dy, dx)
82.         x(i) = x(i) + COS(a(i)) * speed
83.         y(i) = y(i) + SIN(a(i)) * speed
84.  
85.         IF x(i) < rd(i) OR x(i) > xmax + rd(i) OR y(i) > ymax + rd(i) THEN
86.             x(i) = rand(xmax / 2 - 10, xmax / 2 + 10)
87.             y(i) = rand(-250, -bR)
88.             a(i) = _PI(.5) + _PI(1 / 90) * rdir
89.         END IF
90.         IF a(i) > _PI(2) THEN a(i) = a(i) - _PI(2)
91.         IF a(i) < 0 THEN a(i) = a(i) + _PI(2)
92.  
93.         FOR r = rd(i) TO 1 STEP -1
94.             COLOR _RGB(255 - rr(i) - 150 * r / rd(i), 255 - gg(i) - 150 * r / rd(i), 255 - bb(i) - 150 * r / rd(i))
95.             fcirc x(i), y(i), r
96.         NEXT
97.         c(i) = 0
98.     NEXT
99.     _DISPLAY
100.     _LIMIT 20
101. WEND
102. FUNCTION rand (lo, hi)
103.     rand = (RND * (hi - lo + 1)) \ 1 + lo
104. END FUNCTION
105. FUNCTION rdir ()
106.     IF RND < .5 THEN rdir = -1 ELSE rdir = 1
107. END FUNCTION
108. 'Steve McNeil's  copied from his forum   note: Radius is too common a name
109. SUB fcirc (CX AS LONG, CY AS LONG, R AS LONG)
110.     DIM subRadius AS LONG, RadiusError AS LONG
111.     DIM X AS LONG, Y AS LONG
112.  
113.     subRadius = ABS(R)
114.     RadiusError = -subRadius
115.     X = subRadius
116.     Y = 0
117.  
118.     IF subRadius = 0 THEN PSET (CX, CY): EXIT SUB
119.  
120.     ' Draw the middle span here so we don't draw it twice in the main loop,
121.     ' which would be a problem with blending turned on.
122.     LINE (CX - X, CY)-(CX + X, CY), , BF
123.  
124.     WHILE X > Y
125.         RadiusError = RadiusError + Y * 2 + 1
126.         IF RadiusError >= 0 THEN
127.             IF X <> Y + 1 THEN
128.                 LINE (CX - Y, CY - X)-(CX + Y, CY - X), , BF
129.                 LINE (CX - Y, CY + X)-(CX + Y, CY + X), , BF
130.             END IF
131.             X = X - 1
132.             RadiusError = RadiusError - X * 2
133.         END IF
134.         Y = Y + 1
135.         LINE (CX - X, CY - Y)-(CX + X, CY - Y), , BF
136.         LINE (CX - X, CY + Y)-(CX + X, CY + Y), , BF
137.     WEND
138. END SUB
139. SUB snd (frq, dur)
140.     SOUND frq / 2.2, dur * .01
141. END SUB
142.  

[STxAxTIC]

I haven't seen or heard the likes of this behavior since my Atari caught a virus. Bad cartridge from the Russian underground.

[bplus]

No Atari's were harmed in the making of this code.

The Russians are underground now?