'     Fantastic Voyage Coded By Shockwave (2) 2002
'    -============================================-
'Not especially clever but I did something like this on
'the Amiga and I wanted to make an updated version for
'Yabasic.
'#########################################################

gosub initialise
'^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
repeat
setdrawbuf dw
dw=1-dw
setdispbuf dw
setrgb 1,4,0,0
setrgb 2,0,4,0
setrgb 3,0,0,4
gtriangle 0,0 to 640,512 to 0,512
gtriangle 0,0 to 640,512 to 640,0
    gosub rotate

for a=7 to polys
 siz=6-(tz(a)/20)
setrgb 1,0,0,siz*30
 fill rect tx(a)-siz,ty(a)-siz to tx(a)+siz,ty(a)+siz
setrgb 1,170,170,siz*30
siz=siz-4
 fill rect tx(a)-siz,ty(a)-siz to tx(a)+siz,ty(a)+siz

 y(a)=y(a)-2
if y(a)<-40 y(a)=y(a)+80
next a

burn=0
r=90:g=90:b=90
f1=1:f2=3:f3=5
gosub draw
f1=2:f2=1:f3=5
gosub draw
r=50:g=80:b=50
f1=1:f2=4:f3=3
gosub draw
f1=2:f2=4:f3=1
gosub draw
r=40:g=40:b=100
f1=4:f2=3:f3=6
gosub draw
f1=2:f2=4:f3=6
gosub draw
burn=1
setrgb 1,155+lol,lol,lol
f1=3:f2=4:f3=5
gosub draw
setrgb 1,155+lol,lol,lol
f1=4:f2=2:f3=5
gosub draw
lol=100*sin(mm/4)
mm=mm+.5
setrgb 1,255,255,255
text 321,257,"THE VOYAGE DEMO BY SHOCKWAVE","cc"

setrgb 1,5,5,5
text 320,256,"THE VOYAGE DEMO BY SHOCKWAVE","cc"
until (and(peek("port1"),16384)<>0)
exit
label draw
'##############################
'## Draw A Face Of The Cube! ##
'##############################

  vx1= tx(f1)-tx(f2)
  vy1= ty(f1)-ty(f2)
  vx2= tx(f3)-tx(f2)
  vy2= ty(f3)-ty(f2)
  if  (vx1*vy2-vx2*vy1)<0 then
light=-(tz(f1)+tz(f2)+tz(f3))*5
if burn=0 setrgb 1,r+light,g+light,b+light
fill triangle tx(f1),ty(f1) to tx(f2),ty(f2) to tx(f3),ty(f3)
setrgb 1,0,0,0
triangle tx(f1),ty(f1) to tx(f2),ty(f2) to tx(f3),ty(f3)

fi
return

label rotate
'###############################################
'## Rotate And Scale Each Point! Store Result ##
'###############################################
 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! ##
'########################
dv=(zz/50)+1
  xx=size*(xx/dv)+320
  yy=size*(yy/dv)+256
  tx(a)=xx
  ty(a)=yy
  tz(a)=zz
 next a
xr=xr+1
yr=yr+2
zr=zr+1
if xr>720 xr=xr-720
if yr>720 yr=yr-720
if zr>720 zr=zr-720
return
label initialise
'^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
' This Sub-Routine Initialises The Program.
'^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
'######################
'## Open Gfx Screen! ##
'######################
open window 640,512
'#####################################
'## Define the necessary variables! ##
'#####################################
str=41
size=15: rem how big do you want it?
dw=1 : Rem            Double buffering Variable
polys=6+str : 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
'##########################
'## 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! ##
'#########################
for a=1 to polys
x(a)=-30+ran(60)
y(a)=-40+ran(80)
z(a)=-30+ran(60)
next a
for a=1 to polys-str
 read x(a),y(a),z(a)
next a

'^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
'   The Object Description As Data!
'   The Data Below Describes A Cube.
'^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
data 0,10,0,10,-10,0,-10,-10,0
data 0,-12,5,0,-14,-5
data 0,0,2.3
return











