RetroBASIC

Basicprogramming(.org) => Code and examples => Topic started by: B+ on April 26, 2017, 11:53:02 PM

Title: Rain drain.bas
Post by: B+ on April 26, 2017, 11:53:02 PM

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

Title: Re: Rain drain.bas
Post by: Aurel on April 27, 2017, 05:55:31 AM

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. 

Title: Re: Rain drain.bas
Post by: B+ on April 27, 2017, 03:45:30 PM

 ;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.

Title: Re: Rain drain.bas
Post by: Aurel on April 27, 2017, 04:42:22 PM

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.