rem #####################################################
rem #     Program : boing
rem # 
rem #      Author : Marc Gale (Xalthorn)
rem #
rem #        Date : 2nd February 2002
rem #
rem # Description : A box containing some balls that 
rem #               bounce around, colliding with each
rem #               other as well.
rem #
rem #####################################################

gosub initialise
gosub main_loop
exit

rem #####################################################
label main_loop
 repeat
  setdispbuf curbuf 
  curbuf=1-curbuf
  setdrawbuf curbuf
  clear window
  gosub drawbox
  gosub drawballs
  gosub moveballs
 until (1=2)
return

rem #####################################################
label drawbox
 setrgb 1,0,0,255
 setrgb 2,0,0,255
 setrgb 3,0,0,50
 gtriangle bx(3),by(3) to bx(1),by(1) to bx(5),by(5)
 gtriangle bx(1),by(1) to bx(2),by(2) to bx(6),by(6)
 gtriangle bx(2),by(2) to bx(4),by(4) to bx(6),by(6)
 gtriangle bx(3),by(3) to bx(4),by(4) to bx(8),by(8)
 setrgb 2,0,0,50
 gtriangle bx(3),by(3) to bx(5),by(5) to bx(7),by(7)
 gtriangle bx(1),by(1) to bx(5),by(5) to bx(6),by(6)
 gtriangle bx(4),by(4) to bx(6),by(6) to bx(8),by(8)
 gtriangle bx(3),by(3) to bx(7),by(7) to bx(8),by(8)
 setrgb 1,0,0,50
 fill triangle bx(7),by(7) to bx(5),by(5) to bx(6),by(6)
 fill triangle bx(7),by(7) to bx(6),by(6) to bx(8),by(8)

 setrgb 1,0,0,255
 line bx(1),by(1) to bx(5),by(5)
 line bx(2),by(2) to bx(6),by(6)
 line bx(3),by(3) to bx(7),by(7)
 line bx(4),by(4) to bx(8),by(8)
 rectangle bx(5),by(5) to bx(8),by(8)
return

rem #####################################################
label drawball
 ang=0
 repeat
  xo1=cosines(ang)*r:yo1=sines(ang)*r
  xo2=cosines(ang+20)*r:yo2=sines(ang+20)*r
  gtriangle x,y to x+xo1,y+yo1 to x+xo2,y+yo2
  gtriangle x,y to x-xo1,y+yo1 to x-xo2,y+yo2
  gtriangle x,y to x-xo1,y-yo1 to x-xo2,y-yo2
  gtriangle x,y to x+xo1,y-yo1 to x+xo2,y-yo2
  ang=ang+20
 until (ang>90)
return

rem #####################################################
label drawshad
 setrgb 1,0,0,0
 ang=0
 repeat
  xo1=cosines(ang)*r:yo1=sines(ang)*r2
  xo2=cosines(ang+30)*r:yo2=sines(ang+30)*r2
  fill triangle x,y to x+xo1,y+yo1 to x+xo2,y+yo2
  fill triangle x,y to x-xo1,y+yo1 to x-xo2,y+yo2
  fill triangle x,y to x-xo1,y-yo1 to x-xo2,y-yo2
  fill triangle x,y to x+xo1,y-yo1 to x+xo2,y-yo2
  ang=ang+30
 until (ang>90)
return

rem #####################################################
label drawballs
 setrgb 2,0,0,0
 setrgb 3,0,0,0
 for ball=1 to numballs
  x=ballx(ball)
  y=bally(ball)
  z=ballz(ball)
  s=200/((z/focus)+1)
  x=x/((z/focus)+1)
  y=y/((z/focus)+1)
  tempx(ball)=x
  tempy(ball)=y
  tempz(ball)=z
  temps(ball)=s
 next ball

 for a=1 to numballs-1
  for b=a+1 to numballs
   if tempz(a)<tempz(b) then
    tx=tempx(a)
    ty=tempy(a)
    tz=tempz(a)
    ts=temps(a)
    tempx(a)=tempx(b)
    tempy(a)=tempy(b)
    tempz(a)=tempz(b)
    temps(a)=temps(b)
    tempx(b)=tx
    tempy(b)=ty
    tempz(b)=tz
    temps(b)=ts
   fi
  next b
 next a

 for ball=1 to numballs
  x=tempx(ball)
  z=tempz(ball)
  s=temps(ball)
  bri=128-(z/2)
  r=bri/5
  r2=r/2
  y=s+r
  gosub drawshad
 next ball

 for ball=1 to numballs
  x=tempx(ball)
  y=tempy(ball)
  z=tempz(ball)
  s=temps(ball)
  bri=128-(z/2)
  r=bri/5
  setrgb 1,bri+100,bri/2,bri/2
  gosub drawball
 next ball
return

rem #####################################################
label moveballs
 for a=1 to numballs
  x=ballx(a):xd=ballxd(a)
  y=bally(a):yd=ballyd(a)
  z=ballz(a):zd=ballzd(a)
  x=x+xd:y=y+yd:z=z+zd
  if xd>8 then xd=xd-1 fi
  if xd<-8 then xd=xd+1 fi
  if zd>8 then zd=zd-1 fi
  if zd<-8 then zd=zd+1 fi

  yd=yd+1
  if yd=0 then yd=1 fi
  if yd>20 then yd=20 fi

  if x<-200 or x>200 then
   xd=-xd
   if x<-200 then x=-200 fi
   if x>200 then x=200 fi
  fi

  if y<-200 or y>200 then
   yd=-yd
   if y<-200 then
    y=-200
   fi
   if y>200 then
    y=200
    if yd<0 then yd=yd+3 fi
   fi
  fi

  if z<-100 or z>200 then
   zd=-zd
   if z<-100 then z=-100 fi
   if z>200 then z=200 fi
  fi

  if a<numballs then
   for b=a+1 to numballs
    dx=x-ballx(b)
    dy=y-bally(b)
    dz=z-ballz(b)
    d=sqrt(dx^2+dy^2+dz^2)/10
    if d<5 then
     xd=xd+dx/d
     yd=yd+dy/d
     zd=zd+dz/d
     ballxd(b)=ballxd(b)-dx/d
     ballyd(b)=ballyd(b)-dy/d-int(ran(20))
     ballzd(b)=ballzd(b)-dz/d
    fi    
   next b
  fi

  ballx(a)=x
  bally(a)=y
  ballz(a)=z
  ballxd(a)=xd
  ballyd(a)=yd
  ballzd(a)=zd
 next a
return

rem #####################################################
label initialise
 open window 640,512
 window origin "cc"
 curbuf=0
 setrgb 2,0,0,0
 setrgb 3,0,0,0

 numballs=6

 dim cosines(360)
 dim sines(360)
 for angle=0 to 360
  cosines(angle)=cos(angle*(pi/180))
  sines(angle)=sin(angle*(pi/180))
 next angle

 dim ballx(numballs)
 dim bally(numballs)
 dim ballz(numballs)
 dim ballxd(numballs)
 dim ballyd(numballs)
 dim ballzd(numballs)
 dim tempx(numballs)
 dim tempy(numballs)
 dim tempz(numballs)
 dim temps(numballs)

 for a=1 to numballs
  ballx(a)=int(ran(300))-100
  bally(a)=int(ran(300))-100
  ballz(a)=int(ran(300))-100
  ballxd(a)=int(ran(6))+2
  ballyd(a)=int(ran(6))+2
  ballzd(a)=int(ran(6))+2
 next a

 focus=800
 dim bx(8)
 dim by(8)
 for a=1 to 8
  read x
  read y
  read z
  x=x/((z/focus)+1)
  y=y/((z/focus)+1)
  bx(a)=x
  by(a)=y
 next a

return

data -200,-200,-200
data 200,-200,-200
data -200,200,-200
data 200,200,-200
data -200,-200,200
data 200,-200,200
data -200,200,200
data 200,200,200
