_TITLE "Bonkers Synphony #37 by bplus, press spacebar for different view"
' Bonkers Symphony no 37.bas for QB64 fork (B+=MGA) trans 2017-09-15
' from: Bonkers Symphony Number 37.bas SmallBASIC 0.12.8 [B+=MGA] 2017-04-21
gravity = 3
'balls
bR = 10
n = 12
speed = 12
DIM x
(n
), y
(n
), a
(n
), c
(n
), rr
(n
), gg
(n
), bb
(n
), rd
(n
) x(i) = rand(xmax / 2 - 10, xmax / 2 + 10)
y(i) = rand(-200, 0)
rd(i) = rand(3, 20)
a
(i
) = _PI(.5) + _PI(1 / 90) * rdir
rr(i) = rand(60, 100)
gg(i) = rand(60, 100)
bb(i) = rand(60, 100)
'pins
pR = 25
maxrow = 7
nP = maxrow * (maxrow + 1) * .5
pxo = xmax / (maxrow + 1) 'pin space along x
pyo = ymax / (maxrow + 1) 'pin spacing along y
pidx = pidx + 1
px(pidx) = pxo * col + (maxrow - row) * .5 * pxo
py(pidx) = pyo * row
clrMode = 1
'draw pins
COLOR _RGB(r
/ pR
* 255, r
/ pR
* 255, r
/ pR
* 255) fcirc px(i), py(i), r
'calc collsions
IF SQR((x
(i
) - px
(j
)) ^ 2 + (y
(i
) - py
(j
)) ^ 2) < rd
(i
) + pR
THEN a
(i
) = _ATAN2(y
(i
) - py
(j
), x
(i
) - px
(j
)) fcirc px(j), py(j), pR
snd 120 + py(j) / ymax * 5000, px(j) / xmax * 55
IF SQR((x
(i
) - x
(j
)) ^ 2 + (y
(i
) - y
(j
)) ^ 2) < rd
(i
) + rd
(j
) THEN a
(i
) = _ATAN2(y
(i
) - y
(j
), x
(i
) - x
(j
)) a
(j
) = _ATAN2(y
(j
) - y
(i
), x
(j
) - x
(i
)) c(i) = 1: c(j) = 1
'update balls
dy
= SIN(a
(i
)) * speed
+ gravity
x
(i
) = x
(i
) + COS(a
(i
)) * speed
y
(i
) = y
(i
) + SIN(a
(i
)) * speed
IF x
(i
) < rd
(i
) OR x
(i
) > xmax
+ rd
(i
) OR y
(i
) > ymax
+ rd
(i
) THEN x(i) = rand(xmax / 2 - 10, xmax / 2 + 10)
y(i) = rand(-250, -bR)
a
(i
) = _PI(.5) + _PI(1 / 90) * rdir
COLOR _RGB(255 - rr
(i
) - 150 * r
/ rd
(i
), 255 - gg
(i
) - 150 * r
/ rd
(i
), 255 - bb
(i
) - 150 * r
/ rd
(i
)) fcirc x(i), y(i), r
c(i) = 0
rand
= (RND * (hi
- lo
+ 1)) \
1 + lo
'Steve McNeil's copied from his forum note: Radius is too common a name
RadiusError = -subRadius
X = subRadius
Y = 0
' Draw the middle span here so we don't draw it twice in the main loop,
' which would be a problem with blending turned on.
LINE (CX
- X
, CY
)-(CX
+ X
, CY
), , BF
RadiusError = RadiusError + Y * 2 + 1
LINE (CX
- Y
, CY
- X
)-(CX
+ Y
, CY
- X
), , BF
LINE (CX
- Y
, CY
+ X
)-(CX
+ Y
, CY
+ X
), , BF
X = X - 1
RadiusError = RadiusError - X * 2
Y = Y + 1
LINE (CX
- X
, CY
- Y
)-(CX
+ X
, CY
- Y
), , BF
LINE (CX
- X
, CY
+ Y
)-(CX
+ X
, CY
+ Y
), , BF
SOUND frq
/ 2.2, dur
* .01