Wow Demo

[Shockwave]

Not the Spreadpoint Wow demo, something different and not as good

Code: [Select]

'                   **THE WOW!! DEMO**
'   @@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
'   @ This Demo Was Coded By Mr. Shockwave (C) 2002!! @
'   @-===============================================-@
'   @@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
' Greetings to al my friends and acquaintences on the
' Yabasic forums, especially these (In Random Order):
'
'  Xalthorn, Doctor, Jinx, Master Tonberry, Jacob Busby,
'    Dougal The Dogg, Demoneye, Asiv, Liquid Pia, Ian,
'     Static Gerbil, Verybasic, Snakedogg, Jomorrow.
'   And To All The Rest Of You Too :o) Enjoy The Demo!
'#########################################################

gosub initialise
'^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
repeat
setdrawbuf dw
dw=1-dw
setdispbuf dw
   setrgb 1,40+(rd/5),30,20
   setrgb 2,0,20+(bl/5),40
   setrgb 3,80,20,gr/5
    gtriangle 0,0 to 640,512 to 0,512
    setrgb 3,40,30,20
    gtriangle 0,0 to 640,512 to 640,0
    mm=mm+.05
    gosub rotatelights
gosub drawback
    gosub rotate
    gosub draw
gosub drawfront
setrgb 1,0,0,0
text 322,42,"THE WOW!! DEMO","cc"
text scx,258,mid$(s$,p,67)
setrgb 1,255,255,255
text 320,40,"THE WOW!! DEMO","cc"

text scx,256,mid$(s$,p,67)
scx=scx-1
if scx<-10 then
scx=scx+10
p=p+1
if p>len(s$) p=1
fi

until (and(peek("port1"),16384)<>0)
exit

label drawback
for a=1 to 3
if a=1 setrgb 1,255,0,0
if a=2 setrgb 1,0,255,0
if a=3 setrgb 1,0,0,255
if ltz(a)<0 then
sz=(ltz(a)/2)+30
 fill circle ltx(a),lty(a),sz
fi
next a
return

label drawfront
for a=1 to 3
if a=1 setrgb 1,255,0,0
if a=2 setrgb 1,0,255,0
if a=3 setrgb 1,0,0,255

if ltz(a)>=0 then
sz=(ltz(a)/2)+30
 fill circle ltx(a),lty(a),sz
fi
next a
return

label draw
'####################
'## Draw The Cube! ##
'####################
b=1

setrgb 1,255,200+fl,200+fl
  vx1= tx(1)-tx(2)
  vy1= ty(1)-ty(2)
  vx2= tx(3)-tx(2)
  vy2= ty(3)-ty(2)
  if  (vx1*vy2-vx2*vy1)<0 then
xp=(tx(1)+tx(2)+tx(3)+tx(4))/4
yp=(ty(1)+ty(2)+ty(3)+ty(4))/4
zp=(tz(1)+tz(2)+tz(3)+tz(4))/4
red=((ltz(1)-zp)*10)
grn=((ltz(2)-zp)*10)
blu=((ltz(3)-zp)*10)
setrgb 1,red,grn,blu


fill triangle tx(1),ty(1) to tx(2),ty(2) to tx(3),ty(3)
fill triangle tx(1),ty(1) to tx(4),ty(4) to tx(3),ty(3)

  fi

  vx1= tx(5)-tx(6)
  vy1= ty(5)-ty(6)
  vx2= tx(7)-tx(6)
  vy2= ty(7)-ty(6)
  if  (vx1*vy2-vx2*vy1)>0 then
xp=(tx(5)+tx(6)+tx(7)+tx(8))/4
yp=(ty(5)+ty(6)+ty(7)+ty(8))/4
zp=(tz(5)+tz(6)+tz(7)+tz(8))/4
red=((ltz(1)-zp)*10)
grn=((ltz(2)-zp)*10)
blu=((ltz(3)-zp)*10)
setrgb 1,red,grn,blu


fill triangle tx(5),ty(5) to tx(6),ty(6) to tx(7),ty(7)
fill triangle tx(5),ty(5) to tx(8),ty(8) to tx(7),ty(7)
  fi

  vx1= tx(5)-tx(1)
  vy1= ty(5)-ty(1)
  vx2= tx(8)-tx(1)
  vy2= ty(8)-ty(1)
  if  (vx1*vy2-vx2*vy1)<0 then

xp=(tx(1)+tx(4)+tx(8)+tx(5))/4
yp=(ty(1)+ty(4)+ty(8)+ty(5))/4
zp=(tz(1)+tz(4)+tz(8)+tz(5))/4
red=((ltz(1)-zp)*10)
grn=((ltz(2)-zp)*10)
blu=((ltz(3)-zp)*10)
setrgb 1,red,grn,blu

fill triangle tx(5),ty(5) to tx(1),ty(1) to tx(8),ty(8)
fill triangle tx(8),ty(8) to tx(1),ty(1) to tx(4),ty(4)
  fi

  vx1= tx(5)-tx(1)
  vy1= ty(5)-ty(1)
  vx2= tx(2)-tx(1)
  vy2= ty(2)-ty(1)
  if  (vx1*vy2-vx2*vy1)>0 then
xp=(tx(1)+tx(2)+tx(5)+tx(6))/4
yp=(ty(1)+ty(2)+ty(5)+ty(6))/4
zp=(tz(1)+tz(2)+tz(5)+tz(6))/4
red=((ltz(1)-zp)*10)
grn=((ltz(2)-zp)*10)
blu=((ltz(3)-zp)*10)
setrgb 1,red,grn,blu

fill triangle tx(5),ty(5) to tx(1),ty(1) to tx(2),ty(2)
fill triangle tx(2),ty(2) to tx(5),ty(5) to tx(6),ty(6)
  fi

  vx1= tx(7)-tx(3)
  vy1= ty(7)-ty(3)
  vx2= tx(2)-tx(3)
  vy2= ty(2)-ty(3)
  if  (vx1*vy2-vx2*vy1)<0 then
xp=(tx(7)+tx(2)+tx(3)+tx(6))/4
yp=(ty(7)+ty(2)+ty(3)+ty(6))/4
zp=(tz(7)+tz(2)+tz(3)+tz(6))/4
red=((ltz(1)-zp)*10)
grn=((ltz(2)-zp)*10)
blu=((ltz(3)-zp)*10)
setrgb 1,red,grn,blu

fill triangle tx(7),ty(7) to tx(3),ty(3) to tx(2),ty(2)
fill triangle tx(2),ty(2) to tx(6),ty(6) to tx(7),ty(7)
  fi

  vx1= tx(7)-tx(8)
  vy1= ty(7)-ty(8)
  vx2= tx(4)-tx(8)
  vy2= ty(4)-ty(8)
  if  (vx1*vy2-vx2*vy1)<0 then
xp=(tx(7)+tx(8)+tx(3)+tx(4))/4
yp=(ty(7)+ty(8)+ty(3)+ty(4))/4
zp=(tz(7)+tz(8)+tz(3)+tz(4))/4
red=((ltz(1)-zp)*10)
grn=((ltz(2)-zp)*10)
blu=((ltz(3)-zp)*10)
setrgb 1,red,grn,blu

fill triangle tx(7),ty(7) to tx(8),ty(8) to tx(4),ty(4)
fill triangle tx(7),ty(7) to tx(3),ty(3) to tx(4),ty(4)
  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! ##
'########################
  xx=size*(xx/((zz/70)+1))+320
  yy=size*(yy/((zz/70)+1))+256
  tx(a)=xx
  ty(a)=yy
  tz(a)=zz
 next a
xr=xr+3
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 rotatelights
'###############################################
'## Rotate And Scale Each Point! Store Result ##
'###############################################
 for a=1 to 3
  x1=lx(a)
  y1=ly(a)
  z1=lz(a)
'######################
'## X,Y,Z rotations! ##
'######################
  xx=x1
  yy=y1*cs(lxr(a))+z1*sn(lxr(a))
  zz=z1*cs(lxr(a))-y1*sn(lxr(a))
  y1=yy
  x1=xx*cs(lyr(a))-zz*sn(lyr(a))
  z1=xx*sn(lyr(a))+zz*cs(lyr(a))
  zz=z1
  xx=x1*cs(lzr(a))-y1*sn(lzr(a))
  yy=x1*sn(lzr(a))+y1*cs(lzr(a))
'########################
'## Apply Perspective! ##
'########################
  xx=size*(xx/((zz/70)+1))+320
  yy=size*(yy/((zz/70)+1))+256

  ltx(a)=xx
  lty(a)=yy
  ltz(a)=zz

lxr(a)=lxr(a)+a
lyr(a)=lyr(a)+a+1
lzr(a)=lzr(a)+a

if lxr(a)>720 lxr(a)=lxr(a)-720
if lyr(a)>720 lyr(a)=lyr(a)-720
if lzr(a)>720 lzr(a)=lzr(a)-720
next a
return

label initialise
'^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
' This Sub-Routine Initialises The Program.
'^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
'######################
'## Open Gfx Screen! ##
'######################
open window 640,512

s$="                                                                  "
s$=s$+"THIS IS ALL BEING DONE IN REAL TIME!!! ABSOLUTELY "
s$=s$+"NO PRECALCULATION AT ALL....   SHOCKWAVE PRESENTS "
s$=s$+"THE   WOW!! DEMO... I WAS BORED OF LOOKING AT MY "
s$=s$+"TIRED OLD IDEAS AND SIMPLE 3D ROUTINES SO I "
s$=s$+"DECIDED TO UP THE ANTE A LITTLE BIT...  BEAT THIS"
s$=s$+" ONE IF YOU CAN.....   YOU ARE LOOKING AT A CUBE"
s$=s$+" ROTATED IN REALTIME ABOUT ALL THREE AXIS WITH "
s$=s$+"THREE INDEPENDENT LIGHT SOURCES ALSO ROTATING "
s$=s$+"INDEPENDENTLY AROUND THE OBJECT WHICH REFLECTS "
s$=s$+"THIER LIGHT ACCORDING TO THE PROXIMITY OF THE "
s$=s$+"LIGHT SOURCES AS AN RGB COLOUR.....       "
s$=s$+"ONLY SHOCKWAVE MAKES IT POSSIBLE.....    "
s$=s$+"I'D LIKE TO DOFF MY CAP TO ALL THE YABASIC "
s$=s$+"COMMUNITY, I SALUTE THESE PEOPLE: "
s$=s$+"FRYER, XALTHORN, JIM SHAW.... YOUR PROGRAMS ARE "
s$=s$+"IN A LEAGUE ALL OF THIER OWN... HELLOS ALSO TO "
s$=s$+"THESE:  DOCTOR, JOMOROW, SNAKEDOGG, DEMONEYE, "
s$=s$+"ASIV, LIQUID, STATICGERBIL, JACOB BUSBY, MASTER "
s$=s$+"TONBERRY, DEMONEYE, DREW AND ALL THE OTHERS AT "
s$=s$+"THE YABASIC FORUMS, THERE'S JUST TOO MANY TO BE "
s$=s$+"ABLE TO REMEMBER YOU ALL NOWADAYS....  ANYWAY, "
s$=s$+"NUFF SAID... TAKE IT EASY....              "
'#####################################
'## Define the necessary variables! ##
'#####################################
size=14: rem how big do you want it?
dw=1 : Rem            Double buffering Variable
polys=8 : Rem        The amount of points 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 lx(3),ly(3),lz(3)
dim lxr(3),lyr(3),lzr(3)
dim ltx(3),lty(3),ltz(3)
'##########################
'## 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
 read x(a),y(a),z(a)
next a

for a=1 to 3
read lx(a),ly(a),lz(a)
next a

'^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
'   The Object Description As Data!
'   The Data Below Describes A Cube.
'^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^

data -10,10,10,10,10,10,10,-10,10,-10,-10,10
data -10,10,-10,10,10,-10,10,-10,-10,-10,-10,-10

data 0,0,20,0,0,-20,0,20,0
return