'Rain Drain.bas SmallBASIC 0.12.9 [B+=MGA] 2017-04-26
def rand(lo, hi) = (rnd * (hi - lo + 1)) \ 1 + lo
def rdir = iff(rnd < .5, -1, 1)
def rclr = rgb(0, rand(200, 255), rand(200, 255))
label restart
balls = 130
dim b(balls)
for i = 1 to balls
b(i).x = rand(0, xmax - m)
b(i).y = 0
b(i).speed = rand(3, 15)
b(i).r = rand(5, 15)
b(i).c = rclr
next
m = 100
nbl = 20
dim bl(nbl)
for i = 1 to nbl
bl(i).x1 = rand(m, xmax - m)
bl(i).y1 = rand(m, ymax)
bl(i).d = 300
bl(i).a = rnd*pi/4*rdir + rand(0,1)*pi
bl(i).x2 = bl(i).x1 + bl(i).d * cos(bl(i).a)
bl(i).y2 = bl(i).y1 + bl(i).d * sin(bl(i).a)
next
while 1
cls
if pen(3) then goto restart
for j = 1 to balls
if b(j).y - b(j).r > ymax or b(j).x + b(j).r < 0 or b(j).x - b(j).r > xmax then
b(j).x = rand(m, xmax-m) : b(j).y = 0
fi
color b(j).c
circle b(j).x, b(j).y, b(j).r filled
testx = b(j).x + b(j).speed * cos(pi/2)
testy = b(j).y + b(j).speed * sin(pi/2)
cFlag = 0
for i = 1 to nbl
color 12
line bl(i).x1, bl(i).y1, bl(i).x2, bl(i).y2
if cFlag = 0 then
if ballCollide(testx, testy, b(j).r, bl(i).x1, bl(i).y1, bl(i).x2, bl(i).y2) then
bx1 = b(j).x + b(j).speed * cos(bl(i).a)
bx2 = b(j).x + b(j).speed * cos(pi - bl(i).a)
by1 = yy(bx1, bl(i).x1, bl(i).y1, bl(i).x2, bl(i).y2) - b(j).r - 1
by2 = yy(bx2, bl(i).x1, bl(i).y1, bl(i).x2, bl(i).y2) - b(j).r - 1
if by1 = (-9999 - b(j).r - 1) or by2 = (-9999 - b(j).r - 1) then
cFlag = 0 : exit for
fi
if by1 > by2 then b(j).y = by1 : b(j).x = bx1 else b(j).y = by2 : b(j).x = bx2
cFlag = 1
fi
fi
next
if cFlag = 0 then b(j).x = testx : b(j).y = testy
next
showpage
wend
func ballCollide(x, y, r, x1, y1, x2, y2)
if x1 > x2 then swap x1, x2 : swap y1, y2
if x < x1 or x > x2 then ballCollide = 0 : exit sub
if ((y2-y1)/(x2-x1))*(x - x1) + y1 - r < y and y < ((y2-y1)/(x2-x1))*(x - x1) + y1 + r then
ballCollide = 1
else
ballCollide = 0
fi
end
func yy(x, x1, y1, x2, y2)
if x1 > x2 then swap x1, x2 : swap y1, y2
if x1 <= x and x <= x2 then
yy = ((y2-y1)/(x2-x1)) * (x - x1) + y1
else
yy = -9999
fi
end
