Author Topic: Rain drain.bas  (Read 119 times)

B+

  • Sr. Member
  • ****
  • Posts: 419
    • View Profile
Rain drain.bas
« on: 27. April 2017, 01:53:02 »
Code: [Select]
'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

Aurel

  • Regular Member
  • Sr. Member
  • *
  • Posts: 272
    • View Profile
Re: Rain drain.bas
« Reply #1 on: 27. April 2017, 07:55:31 »
It works ..nice  :)
oooh long time ago i used SB... i almost forget that i have editor
for SB and that i can run this program..funny. 
new basic pro forum on;
http://basicpro.spacefor.site/smf/
GUEST posting enabled

B+

  • Sr. Member
  • ****
  • Posts: 419
    • View Profile
Re: Rain drain.bas
« Reply #2 on: 27. April 2017, 17:45:30 »
 ;D Yep, SB has editor built in so if you have SB, then you have editor for it. Plus! You can use plenty of other editors for it but they might not have the help provided by the built-in editor.

Aurel

  • Regular Member
  • Sr. Member
  • *
  • Posts: 272
    • View Profile
Re: Rain drain.bas
« Reply #3 on: 27. April 2017, 18:42:22 »
Yeah..YEP
You know that i dont like this strange unfriendly editor so i use my own
so that's why i said that i dforget that i have my own.
new basic pro forum on;
http://basicpro.spacefor.site/smf/
GUEST posting enabled