'         *** FILLED COMPLEX COLOUR OBJECTS ***
'   @@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
'   @ Vector Routine Coded By Mr. Shockwave (C) 2001! @
'   @-===============================================-@
'   @@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
'
' This one uses precalculated sine tables to speed up the
' routine. It also incorporates a Z rotation which I had 
' left out of my earlier demos. This Can do 29 polygons
' at full frame rate!!
'#########################################################

gosub initialise
'^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
repeat
c=peek("port1")
gosub buffer
setrgb 1,50,50,100
for a=1 to 25
xa=50*sin(a+mm/4)
rectangle sx(a)+xa,sy(a) to sx(a)+ss(a)+xa,sy(a)+ss(a)
sy(a)=sy(a)-ss(a)-ran(5)
if sy(a)<0 then
sy(a)=sy(a)+512
sx(a)=ran(640)
fi
next a
setrgb 1,0,0,0
gosub rotate
gosub sort
gosub draw
gosub writing
'#######################################################
'## The Main Loop. These Calls Are Repeated Until (X) ##
'#######################################################
until (and(c,16384)<>0)
'^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
exit

label writing
setrgb 1,250,250,200
text 152,58,"SHOCKWAVE PRESENTS: VECTORBALLS 2"
text scx,460,mid$(s$,p,67)
scx=scx-1
if scx<-10 then
scx=scx+10
p=p+1
if p>len(s$) p=0
fi
return

label buffer
setdrawbuf dw
dw=1-dw
setdispbuf dw
setrgb 1,20+20*sin(mm/2),20,40
setrgb 2,20,20+20*sin(mm/3),40
setrgb 3,20,20,40+40*sin(mm/4)
gtriangle 0,0 to 640,512 to 0,512
gtriangle 0,0 to 640,512 to 640,0
mm=mm+.1
setrgb 1,0,0,0
setrgb 2,0,0,0
rrz=4+(4*sin(mm/3))
rry=4+(4*sin(mm/4))
rrx=4+(4*sin(mm/5))
return

label sort
for fk=1 to polys/2
b=1
for a=1 to polys -1
if tz(b)< tz(b+1) then
 sz=tz(b)
 sy=ty(b)
 sx=tx(b)
 tz(b)=tz(b+inner+1)
 ty(b)=ty(b+inner+1)
 tx(b)=tx(b+inner+1)
 tz(b+1)=sz
 ty(b+1)=sy
 tx(b+1)=sx
end if
b=b+1
next a
next fk
return

label draw
'########################
'## Draw The object!!! ##
'########################
b=1
for a=1 to polys
 setrgb 3,0,70,400-(tz(a)*10)
 ox=tx(a)
 oy=ty(a)
 xdv=15+tz(a)
 ydv=15+tz(a)
 gosub ultcirc
next a
return

label rotate
'###############################################
'## Rotate And Scale Each Point! Store Result ##
'###############################################
sx=100*sin(mm/8)
sy=100*cos(mm/4)
sz=20*sin(mm/4)


 for a=1 to polys
  x1=x(a)
  y1=y(a)
  z1=z(a)
'######################
'## X,Y,Z rotations! ##
'######################
  xx=x1
  yy=y1*cs(xr)+z1*sn(xr)
  zz=z1*cs(xr)-y1*sn(xr)
  y1=yy
  x1=xx*cs(yr)-zz*sn(yr)
  z1=xx*sn(yr)+zz*cs(yr)
  zz=z1
  xx=x1*cs(zr)-y1*sn(zr)
  yy=x1*sn(zr)+y1*cs(zr)
'########################
'## Apply Perspective! ##
'########################
  zz=(zz+(sz))+15
  xx=size*(xx/((zz/20)+1))+320
  yy=size*(yy/((zz/20)+1))+256
  tx(a)=xx+sx
  ty(a)=yy+sy
  tz(a)=zz
 next a
xr=xr+rrx
yr=yr+rry
zr=zr+rrz
  if xr>720 xr=xr-720
  if yr>720 yr=yr-720
  if zr>720 zr=zr-720
return


'**
'** Step this way for turbo circles!
'**
label ultcirc
ll=ll+3
if ll>40 ll=ll-40
for uc=15+ll to 360+ll step 40
gtriangle ox+fsx(uc)/xdv,oy+fsy(uc)/ydv to ox+fsx(uc+40)/xdv,oy+fsy(uc+40)/ydv to  ox,oy 
next uc
return



label initialise

'^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
' This Sub-Routine Initialises The Program.
'^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
'
'
'
dim fsx(720)
dim fsy(720)
for a=1 to 720
  fsx(a)=800*sin(a*(pi/180))
  fsy(a)=800*cos(a*(pi/180))
next a


'######################
'## Open Gfx Screen! ##
'######################
open window 640,512
'#####################################
'## Define the necessary variables! ##
'#####################################
setrgb 2,0,0,0
setrgb 3,0,0,0
setrgb 0,30,30,30
size=25: rem how big do you want it?
dw=1 : Rem            Double buffering Variable
polys=9 : Rem        The amount of polygons in the object
dim x(polys) : Rem  Original X co-ordinate store
dim y(polys) : Rem  Original Y co-ordinate store
dim z(polys) : Rem  Original Z co-ordinate store
dim tx(polys) : Rem Transformed  X co-ordinate store
dim ty(polys) : Rem Transformed Y co-ordinate store
dim tz(polys) : Rem Transformed Z co-ordinate store
dim sx(25)
dim sy(25)
dim ss(25)
for a=1 to 21
 sx(a)=ran(640)
 sy(a)=ran(640)
 ss(a)=3+ran(3)
next a
'##########################
'## Define Sine Tables!! ##
'##########################
 dim cs(720)
 dim sn(720)
 for ang=0 to 720
  cs(ang)=cos(ang*(pi/360))
  sn(ang)=sin(ang*(pi/360))
 next ang
'#########################
'## Read in the object! ##
'#########################
a=1
for b=1 to polys
read x(b),y(b),z(b)
next b
'^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
'   The Object Description As Data!
'   (uses 3 points per polygon!)
'^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
data -5,-5,-5,5,-5,-5,5,5,-5,-5,5,-5
data -5,-5,5,5,-5,5,5,5,5,-5,5,5
data 0,0,0
P=0
s$="                                                                    "
s$=s$+"HI PEEPS!!   IT'S SHOCKWAVE WITH HIS NEWEST LITLE "
s$=s$+"DEMO FOR YOU!!!    A VASTLY IMPROVED 3D BALLS "
s$=s$+"ROUTINE..  I MUST SAY A BIG HELLO TO FRYER HERE, "
s$=s$+"THANK YOU FOR THE IDEA OF USING 'GOURAD BALLS' AS"
s$=s$+" THEY LOOK A LOT NICER... I HOPE YOU DON'T MIND ME"
s$=s$+" COPYING IT??  THEY LOOK FAR BETTER THAN THE ONES "
s$=s$+"I WAS USING AND STILL FAST ENOUGH..  THIS CODE CAN"
s$=s$+" HANDLE TWELVE VECTOR BALLS AT FULL FRAME RATE IF "
s$=s$+"YOU STRIP OUT THE UNNESCESSARY STUFF LIKE THE TEXT"
s$=s$+" ETC.. PRETTY FAST FOR YABASIC BUT I KNOW THAT "
s$=s$+"FRYER HAS MANAGED 11 WITH TRANSFORMATIONS.. THAT "
s$=s$+"DEMO IS REALLY GOOD.... THIS ONE HAS A FEW MORE "
s$=s$+"THINGS GOING ON SO THEREFORE IT DOESN'T DO AS MANY"
s$=s$+" BALLS....   A FEW GREETINGS (IN NO SPECIAL ORDER)"
s$=s$+":    ADAM LAY... THANK'S VERY MUCH FOR THE SITE!"
s$=s$+"     MATT MARTIN + PSI2 MAG... CHEERS FOR PUTTING"
s$=s$+" MY LITTLE PAC MAN CLONE ON YOUR DISK! MANY THANKS"
s$=s$+"     OPSM2 MAG... GREAT NEWS THAT YOU'RE GOING TO "
s$=s$+"BE PUBLISHING READERS YABASIC LISTINGS..."
s$=s$+"     DOCTOR...  THANKS FOR YOUR SUPPORT AND EMAILS"
s$=s$+"     XALTHORN... NICE GAMES M8."
s$=s$+"     VICKI... HOW THE HELL DO YOU PUT UP WITH ME? "
s$=s$+"LUV YOU SWEETHEART!!! "
s$=s$+"     FRYER... AMAZING PROGRAMS YOU SENT ME!! YOU "
s$=s$+"ARE AN AWESOME PROGRAMMER."
s$=s$+"     JINX... HIYA! GOOD TO SEE YOU ARE MAKING "
s$=s$+"PROGRESS.."
s$=s$+"     BAZ... HOPE YOU MANAGE MANIC MINER!!"
s$=s$+"     AND HANDSHAKES TO THESE:"
s$=s$+"     STATICGERBIL, MASTER TONBERRY, JACOB BUSBY, "
s$=s$+"JOMORROW, SNAKEDOGG, AND ALL THE OTHERS AT "
s$=s$+"WWW.YABASIC.CO.UK FORUMS...  IT'S A PLEASURE TO "
s$=s$+"CONTRIBUTE TO IT...  IF I FORGOT TO GREET YOU "
s$=s$+"THEN I'M SORRY... THAT'S ALL FOR NOW!!!   BYE!! "


p=0
scx=0
return






