rem #####################################################
rem #     Program : balldemo
rem # 
rem #      Author : Marc Gale (Xalthorn)
rem #
rem #        Date : 2nd February 2002
rem #
rem # Description : A set of balls that arrange 
rem #               themselves into different patterns.
rem #
rem #####################################################

rem #####################################################
gosub initialise
gosub main_loop
exit

rem #####################################################
label main_loop
 repeat
  setdispbuf curbuf 
  curbuf=1-curbuf
  setdrawbuf curbuf
  clear window
  gosub draw_stars
  gosub morph
  xrot=xrot+4
  yrot=yrot+4
  if xrot=360 then xrot=0 fi
  if yrot=360 then yrot=0 fi
 until (1=2)
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 draw_stars
 focus=2000

 for star=1 to numstars
  x=starx(star)
  y=stary(star)
  z=starz(star)
  yy=y*cosines(xrot)+z*sines(xrot)
  zz=z*cosines(xrot)-y*sines(xrot)
  xx=x*cosines(yrot)-zz*sines(yrot)
  z=x*sines(yrot)+zz*cosines(yrot)
  xx=xx/((z/focus)+1)
  yy=yy/((z/focus)+1)
  tempx(star)=xx
  tempy(star)=yy
  tempz(star)=z
 next star

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

 for star=1 to numstars
  x=tempx(star)
  y=tempy(star)
  z=tempz(star)
  bri=128-(z/2)
  r=bri/5
  setrgb 1,bri,bri,bri
  gosub drawball
 next star
return

rem #####################################################
label setup_shapes
 numshapes=3
 dim shapes(numshapes,numstars,3)
 full=360/numstars

 for a=1 to numstars
  shapes(1,a,1)=int(sin((a*full)*(pi/180))*200)
  shapes(1,a,2)=int(cos((a*full)*(pi/180))*200)
  shapes(1,a,3)=int(sin((a*full*2)*(pi/180))*200)
 next a

 for a=1 to numstars
  shapes(2,a,1)=int(sin((a*full)*(pi/180))*200)
  shapes(2,a,2)=int(cos((a*full)*(pi/180))*200)
  shapes(2,a,3)=0
 next a

 for a=1 to numstars
  shapes(3,a,1)=int(sin((a*full*2)*(pi/180))*100)
  shapes(3,a,2)=int(cos((a*full*2)*(pi/180))*100)
  shapes(3,a,3)=int(sin((a*full)*(pi/180))*200)
 next a
return

rem #####################################################
label settarget
 for a=1 to numstars
  startx(a)=shapes(ts,a,1)
  starty(a)=shapes(ts,a,2)
  startz(a)=shapes(ts,a,3)
 next a
return

rem #####################################################
label morph
 change=0
 for a=1 to numstars
  x=starx(a):tx=startx(a)
  y=stary(a):ty=starty(a)
  z=starz(a):tz=startz(a)

  if x+y+z<>tx+ty+tz then
   change=1
  fi

  if x<tx then x=x+1 fi
  if x>tx then x=x-1 fi
  if y<ty then y=y+1 fi
  if y>ty then y=y-1 fi
  if z<tz then z=z+1 fi
  if z>tz then z=z-1 fi

  starx(a)=x:stary(a)=y:starz(a)=z
 next a

 if change=0 then
  cw=cw-1
  if cw<=0 then
   cw=cd
   ts=ts+1
   if ts>numshapes then
    ts=1
   fi
   gosub settarget
  fi
 fi
return

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

 numstars=10
 ts=1
 cd=100
 cw=cd

 dim starx(numstars)
 dim stary(numstars)
 dim starz(numstars)
 dim startx(numstars)
 dim starty(numstars)
 dim startz(numstars)
 dim tempx(numstars)
 dim tempy(numstars)
 dim tempz(numstars)

 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

 gosub setup_shapes
 gosub settarget
return

