_TITLE "Bonkers Synphony #37 (2019 Xmas Update) press spacebar for different view" '2019-11-24 complete overhall for Xmas 2019 B+ from
' Bonkers Symphony no 37.bas for QB64 fork (B+=MGA) trans 2017-09-15 from
' from: Bonkers Symphony Number 37.bas SmallBASIC 0.12.8 [B+=MGA] 2017-04-21
CONST xmax
= 1000, ymax
= 740 CONST nB
= 12, gravity
= 4, speed
= 12 CONST maxLRow
= 9 'lights
DIM lc
, nx
, i
, j
, clrMode
, dx
, dy
'screen and "tree"
newBall i
initLights
drawLandscape
clrMode = 0: nx = 1
clrMode = 1 - clrMode
newBall i
initLights
drawLandscape
nx = 0
'draw lights
drawOrb L(i).x, L(i).y, L(i).r, L(i).rr, L(i).gg, L(i).bb, 0
'calc collsions
IF SQR((B
(i
).x
- L
(j
).x
) ^ 2 + (B
(i
).y
- L
(j
).y
) ^ 2) < B
(i
).r
+ L
(j
).r
THEN B
(i
).a
= _ATAN2(B
(i
).y
- L
(j
).y
, B
(i
).x
- L
(j
).x
) L(j).c = L(j).c + 1
IF L
(j
).c
> 5 THEN L
(j
).a
= 1 - L
(j
).a: L
(j
).c
= 0 snd L(j).y / ymax * maxLRow, L(j).x / xmax
drawOrb L(j).x, L(j).y, L(j).r, L(j).rr, L(j).gg, L(j).bb, 1
drawOrb L(j).x, L(j).y, L(j).r, L(j).rr, L(j).gg, L(j).bb, 3
IF SQR((B
(i
).x
- B
(j
).x
) ^ 2 + (B
(i
).y
- B
(j
).y
) ^ 2) < B
(i
).r
+ B
(j
).r
THEN B
(i
).a
= _ATAN2(B
(i
).y
- B
(j
).y
, B
(i
).x
- B
(j
).x
) B
(j
).a
= _ATAN2(B
(j
).y
- B
(i
).y
, B
(j
).x
- B
(i
).x
) B(i).c = 1: B(j).c = 1
'update balls
dy
= SIN(B
(i
).a
) * speed
+ gravity
B(i).x = B(i).x + dx
B(i).y = B(i).y + dy
IF B
(i
).x
< 0 OR B
(i
).x
> xmax
OR B
(i
).y
> ymax
THEN newBall i
'IF B(i).a > _PI(2) THEN B(i).a = B(i).a - _PI(2)
'IF B(i).a < 0 THEN B(i).a = B(i).a + _PI(2)
drawOrb B(i).x, B(i).y, B(i).r, B(i).rr, B(i).gg, B(i).bb, 2
B(i).c = 0
IF RND < .5 THEN B
(i
).x
= irnd
(xmax
/ 2 - 30, xmax
/ 2 - 5) ELSE B
(i
).x
= irnd
(xmax
/ 2 + 5, xmax
/ 2 + 30) B(i).y = irnd(-100, -10)
B(i).r = irnd(3, 10)
B
(i
).a
= _PI(.5) + _PI(1 / 90) * rdir
B(i).gg = irnd(60, 120)
B(i).rr = irnd(0, .5 * B(i).gg)
B(i).bb = irnd(0, .4 * B(i).gg)
DIM i
, lxo
, lyo
, row
, col
, y
nL = maxLRow * (maxLRow + 1) * .5
lxo = xmax / (maxLRow + 1)
lyo = (ymax - 5 * (maxLRow + 1) * maxLRow / 2) / (maxLRow + 1) 'more space for lower rows
i = 0: y = 0
y = y + lyo + 5 * row 'more space for lower rows
i = i + 1
L(i).x = lxo * col + (maxLRow - row) * .5 * lxo + irnd(-3 * row, 3 * row)
L(i).y = y + irnd(-15, 15)
L(i).r = 6 + irnd(row, row + 6) 'bigger for lower rows
L(i).rr = irnd(128, 255) 'red lights are great!
L(i).gg = irnd(128, 255) * irnd(0, 1) 'get rid of two many mixes
L(i).bb = irnd(128, 255) * irnd(0, 1)
SUB drawOrb
(x
, y
, r
, red
, green
, blue
, litMode
) 'make sphere if lit or not fcirc x
, y
, r
, _RGB32(red
, green
, blue
) fcirc x
, y
, rr
, _RGBA32(255, 255, 255, 1) fcirc x
, y
, rr
, _RGB32(red
- rr
* 7, green
- rr
* 7, blue
- rr
* 7) fcirc x
, y
, rr
, _RGB32(red
* (1 - rr
/ r
), green
* (1 - rr
/ r
), blue
* (1 - rr
/ r
)) fcirc x
, y
, r
, _RGB32(red
, green
, blue
) fcirc x
, y
, rr
, _RGBA32(0, 0, 0, 2)
Radius
= ABS(R
): RadiusError
= -Radius: X
= Radius: Y
= 0 LINE (CX
- X
, CY
)-(CX
+ X
, CY
), C
, BF
RadiusError = RadiusError + Y * 2 + 1
LINE (CX
- Y
, CY
- X
)-(CX
+ Y
, CY
- X
), C
, BF
LINE (CX
- Y
, CY
+ X
)-(CX
+ Y
, CY
+ X
), C
, BF
X = X - 1
RadiusError = RadiusError - X * 2
Y = Y + 1
LINE (CX
- X
, CY
- Y
)-(CX
+ X
, CY
- Y
), C
, BF
LINE (CX
- X
, CY
+ Y
)-(CX
+ X
, CY
+ Y
), C
, BF
SOUND 314.1592654 * (maxLRow
- frq
) + 220, dur
+ RND * .3
SUB drawLandscape
'needs midInk, irnd 'the sky
midInk 0, 0, 25, 14, 0, 44, i / ymax
'the land
startH = ymax - 400
rr = 40: gg = 50: bb = 60
Xright = 0
y = startH
' upDown = local up / down over range, change along Y
' range = how far up / down, along X
upDown
= (RND * .8 - .35) * (mountain
* .5) range = Xright + irnd(15, 25) * 2.5 / mountain
lastx = Xright - 1
y = y + upDown
LINE (lastx
, y
)-(X
, ymax
), , BF
'just lines weren't filling right lastx = X
Xright = range
rr = irnd(rr - 15, rr): gg = irnd(gg - 15, gg): bb = irnd(bb - 25, bb)
startH = startH + irnd(5, 20)
SUB midInk
(r1%
, g1%
, b1%
, r2%
, g2%
, b2%
, fr##
) COLOR _RGB32(r1%
+ (r2%
- r1%
) * fr##
, g1%
+ (g2%
- g1%
) * fr##
, b1%
+ (b2%
- b1%
) * fr##
)
FUNCTION irnd
(n1
, n2
) 'return random in interval IF n1
> n2
THEN l
= n2: h
= n1
ELSE l
= n1: h
= n2
