rem #####################################################
rem #     Program : linedemo
rem # 
rem #      Author : Marc Gale (Xalthorn)
rem #
rem #        Date : 10th October 2001
rem #
rem # Description : A 3D line object that is rotated. 
rem #               The object also morphs between
rem #               various different shapes.
rem #
rem #####################################################

gosub initialise
gosub main_loop
exit

rem #####################################################
label main_loop
 repeat
  gosub flip_screen
  clear window

  gosub draw_stars
  gosub display_scroller
  gosub morph
  gosub rotchange
  gosub cycle_colour

 until (1=2)
return

rem #####################################################
label display_scroller
 setrgb 1,255,255,255
 mx=mx-2
 if mx<=0 then 
  mx=mx+10
  mpos=mpos+1
  if mpos>len(m$) then
   mpos=0
  fi
 fi

 text mx-10,500,mid$(m$,mpos,65)
return

rem #####################################################
label cycle_colour
 if red=tred and green=tgreen and blue=tblue then
  tred=int(ran(100))/100
  tblue=int(ran(100))/100
  tgreen=int(ran(100))/100
  return
 fi

 if red<>tred then

  if red<tred then
   red=red+0.01
   if red>tred then
    red=tred
   fi
  fi

  if red>tred then
   red=red-0.01
   if red<tred then
    red=tred
   fi
  fi
 fi

 if green<>tgreen then

  if green<tgreen then
   green=green+0.01
   if green>tgreen then
    green=tgreen
   fi
  fi

  if green>tgreen then
   green=green-0.01
   if green<tgreen then
    green=tgreen
   fi
  fi
 fi

 if blue<>tblue then

  if blue<tblue then
   blue=blue+0.01
   if blue>tblue then
    blue=tblue
   fi
  fi

  if blue>tblue then
   blue=blue-0.01
   if blue<tblue then
    blue=tblue
   fi
  fi
 fi
return

rem #####################################################
label rotchange
 xrot=mod(xrot+xroto,360)
 yrot=mod(yrot+yroto,360)
 zrot=mod(zrot+zroto,360)
return

rem #####################################################
label draw_stars
 focus=2000

 new curve
 for star=1 to numstars
  xx=starx(star)
  y=stary(star)
  z=starz(star)

  rem x rotation
  yy=y*cosines(xrot)+z*sines(xrot)
  zz=z*cosines(xrot)-y*sines(xrot)

  rem y rotation
  x=xx*cosines(yrot)-zz*sines(yrot)
  z=xx*sines(yrot)+zz*cosines(yrot)

  rem perspective transformation
  xx=x/((z/focus)+1)
  y=yy/((z/focus)+1)

  brightness=128-(z/2)
  setrgb 1,red*brightness,green*brightness,blue*brightness
  line to ox+xx,oy+y
 next star
return

rem #####################################################
label flip_screen
 setdispbuf curbuf 
 curbuf=1-curbuf
 setdrawbuf curbuf
return

rem #####################################################
label setup_shapes

 dim shapes(numshapes,numstars,3)
 dim shapename$(numshapes)

 for a=1 to numstars
  z=int(cos((a*40)*(pi/180))*200)
  if z>0 then z=0 fi
  shapes(1,a,1)=int(sin((a*10)*(pi/180))*200)
  shapes(1,a,2)=int(cos((a*10)*(pi/180))*200)
  shapes(1,a,3)=z
 next a

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

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

 long=0
 lat=0
 for a=1 to numstars
  if long>360 then
   long=long-360
   lat=lat+15
  fi
  shapes(4,a,1)=int(sin(long*(pi/180))*sin(lat*(pi/180))*200)
  shapes(4,a,2)=int(sin(long*(pi/180))*cos(lat*(pi/180))*200)
  shapes(4,a,3)=int(cos(long*(pi/180))*200)
  long=long+90
 next a

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

 for a=1 to numstars
  r=200-(mod(a,5)*20)
  shapes(6,a,1)=int(sin((a*8)*(pi/180))*r)
  shapes(6,a,2)=int(cos((a*8)*(pi/180))*r)
  shapes(6,a,3)=0
 next a

 for a=1 to numstars
  r=200-(mod(a,5)*40)
  shapes(7,a,1)=int(sin((a*8)*(pi/180))*r)
  shapes(7,a,2)=int(cos((a*8)*(pi/180))*r)
  shapes(7,a,3)=0
 next a

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

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

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

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

 for a=1 to numstars
  z=int(cos((a*15)*(pi/180))*200)
  if z>0 then z=0 fi
  shapes(12,a,1)=int(sin((a*15)*(pi/180))*200)
  shapes(12,a,2)=int(cos((a*15)*(pi/180))*200)
  shapes(12,a,3)=z
 next a

 for a=1 to numstars
  z=int(cos((a*7.5)*(pi/180))*200)
  if z>0 then z=0 fi
  shapes(13,a,1)=int(sin((a*15)*(pi/180))*200)
  shapes(13,a,2)=int(cos((a*15)*(pi/180))*200)
  shapes(13,a,3)=z
 next a

return

rem #####################################################
label set_target
 for a=1 to numstars
  startx(a)=shapes(targetshape,a,1)
  starty(a)=shapes(targetshape,a,2)
  startz(a)=shapes(targetshape,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<tx then
   x=x+changespeed
   if x>tx then x=tx fi
   change=1
  fi
  if x>tx then
   x=x-changespeed
   if x<tx then x=tx fi
   change=1
  fi

  if y<ty then
   y=y+changespeed
   if y>ty then y=ty fi
   change=1
  fi
  if y>ty then
   y=y-changespeed
   if y<ty then y=ty fi
   change=1
  fi

  if z<tz then
   z=z+changespeed
   if z>tz then z=tz fi
   change=1
  fi
  if z>tz then
   z=z-changespeed
   if z<tz then z=tz fi
   change=1
  fi

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

  if change=0 then
   if name$="" then
    name$=shapename$(targetshape)
    textlife=255
   fi
   changewait=changewait-1
   if changewait<=0 then
    name$=""
    changewait=changedelay
    targetshape=int(ran(numshapes))+1
    gosub set_target
   fi
  fi
return

rem #####################################################
label setup_message
 m$="                                                 "
 m$=m$+"                    "
 m$=m$+"Welcome to the line demo. "
 m$=m$+"The shape morphs between "+str$(numshapes)
 m$=m$+" preset shapes.  "
 m$=m$+"You can add your own shapes by increasing the "
 m$=m$+"numshapes variable in the initialise routine ("
 m$=m$+"at the end of the code) and by adding your own "
 m$=m$+"bit of code in the setup_shapes routine.  Oh, "
 m$=m$+"and don't forget to give your shape a name.  "
 m$=m$+"Finally a little hello to some of the folks at "
 m$=m$+"www.yabasic.co.uk.  Hiya doctor, keep up the "
 m$=m$+"good work and determination.  Mr. Shockwave, keep"
 m$=m$+" those demos and games coming.  Rafryer. "
 m$=m$+"Jacob busby.  Master Tonberry.  Ps2yabasic, "
 m$=m$+"thank you again and again for giving us the "
 m$=m$+"site.  And to everyone else I have momentarily "
 m$=m$+"forgotten."
return

rem #####################################################
label initialise
 sw=640
 sh=512
 ox=sw/2
 oy=sh/2
 curbuf=0
 open window sw,sh

 numstars=50
 numshapes=13
 targetshape=1
 changespeed=4
 changedelay=100
 changewait=changedelay
 mx=10
 mpos=0

 red=1:blue=1:green=1
 tred=1:tblue=0:tgreen=0

 gosub setup_message

 dim starx(numstars)
 dim stary(numstars)
 dim starz(numstars)

 dim startx(numstars)
 dim starty(numstars)
 dim startz(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

 for a=1 to numstars
  starx(a)=0
  stary(a)=0
  starz(a)=0
 next a

 gosub set_target
 xrot=0:xroto=1
 yrot=0:yroto=1
return




