A (sort of) Glenze demo with a morphing object.
'300 Line Demo! Yanimotion Demo.
' A 3D demo with a twist! Coded by Shockwave (C) 2002.
'%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
gosub setup:REM SET UP ALL VARIABLES
' Start Loop;
'---------------------------------------------------------
repeat
fd=fad/10 : setrgb 0,0,0,fd
setdrawbuf dw
dw=1-dw
setdispbuf dw
setrgb 1,200,255,200
setrgb 2,200,150,200
setrgb 3,255,255,255
gtriangle 0,0 to 640,500 to 0,500
gtriangle 0,0 to 640,500 to 640,0
setrgb 1,170,170,210
setrgb 2,170,170,210
setrgb 3,190,190,250
gtriangle 0,400 to 640,512 to 640,400
gtriangle 0,400 to 640,512 to 0,512
gosub rotate:REM ROTATE OBJECT
gosub construct:REM DRAW OBJECT
gosub logo
mh=mh+1
if mh>250 gosub morph
if mh>500 then
mt=mt+1:if mt>mxo mt=1
mh=0
fi
setrgb 1,255,255,255: text scx,256,mid$(s$,p,67)
setrgb 1,0,0,0: text scx+2,258,mid$(s$,p,67)
scx=scx-1
if scx<-10 then
scx=scx+10: p=p+1
if p>len(s$) p=0
fi
until (1=2)
' ^ End Loop OO
label logo
'---------------------------------------------------------
' Logo Image;
'---------------------------------------------------------
setrgb 1,10,10,20
fill rect 10,10 to 70,20
fill rect 10,90 to 70,80
fill rect 10,45 to 70,55
fill rect 10,10 to 20,55
fill rect 70,55 to 60,90
fill rect 70,45 to 50,90
fill rect 80,10 to 90,90
fill rect 140,10 to 130,90
fill rect 140,45 to 80,55
fill rect 80,45 to 100,90
fill rect 150,10 to 210,20
fill rect 150,90 to 210,80
fill rect 150,10 to 160,90
fill rect 210,10 to 200,90
fill rect 150,45 to 170,90
fill rect 220,10 to 280,20
fill rect 220,90 to 280,80
fill rect 220,10 to 230,90
fill rect 220,45 to 240,90
fill rect 290,10 to 300,90
fill rect 290,45 to 350,55
fill rect 350,45 to 330,90
fill rect 320,10 to 330,45
fill rect 360,10 to 370,90
fill rect 360,45 to 380,90
fill rect 360,90 to 420,80
fill rect 420,90 to 410,10
fill rect 390,90 to 400,45
fill rect 430,10 to 440,90
fill rect 490,10 to 480,90
fill rect 430,10 to 490,20
fill rect 430,45 to 490,55
fill rect 430,45 to 450,90
fill rect 500,10 to 510,90
fill rect 510,45 to 520,90
fill rect 560,10 to 550,45
fill rect 500,80 to 545,90
fill triangle 545,90 to 540,80 to 550,45
fill triangle 560,45 to 550,45 to 545,90
fill rect 570,10 to 580,90
fill rect 570,10 to 630,20
fill rect 570,80 to 630,90
fill rect 570,45 to 610,55
fill rect 570,45 to 590,90
rect 5,5 to 635,95
return
label morph
for a=1 to points
if x(a)<mx(a,mt) x(a)=x(a)+.05
if x(a)>mx(a,mt) x(a)=x(a)-.05
if y(a)<my(a,mt) y(a)=y(a)+.05
if y(a)>my(a,mt) y(a)=y(a)-.05
if z(a)<mz(a,mt) z(a)=z(a)+.05
if z(a)>mz(a,mt) z(a)=z(a)-.05
next a
return
' Control sub to Draw The Object;
'---------------------------------------------------------
label construct
for a=1 to faces:REM DO EACH FACE IN TURN
ffg(a)=0
gosub draw
next a
setrgb 1,60,70,110
for a=1 to faces
if ffg(a)=0 then
triangle tx(f1(a)),ty(f1(a)) to tx(f2(a)),ty(f2(a)) to tx(f3(a)),ty(f3(a))
triangle tx(f1(a)),(-ty(f1(a))/4)+ro to tx(f2(a)),(-ty(f2(a))/4)+ro to tx(f3(a)),(-ty(f3(a))/4)+ro
fi
next a
return
' Draw A Face Of The Object;
'---------------------------------------------------------
label draw:REM CROSS PRODUCT CALC \/
vx1 = tx(f1(a))-tx(f2(a)) : vy1= ty(f1(a))-ty(f2(a))
vx2 = tx(f3(a))-tx(f2(a)) : vy2= ty(f3(a))-ty(f2(a))
n = vx1*vy2-vx2*vy1
if n<0 then:REM IF NEGATIVE SURVACE VISIBLE
ffg(a)=1
n=-(n/700)
if n>220 n=220:REM LIMIT MAX COLOUR
setrgb 2,30,n,n
setrgb 3,n,30,n
setrgb 1,r(a)+n,g(a)+n,b(a)+n
gtriangle tx(f1(a)),ty(f1(a)) to tx(f2(a)),ty(f2(a)) to tx(f3(a)),ty(f3(a))
n=n/4
setrgb 1,r(a)+n,g(a)+n,b(a)+n
gtriangle tx(f1(a)),(-ty(f1(a))/4)+ro to tx(f2(a)),(-ty(f2(a))/4)+ro to tx(f3(a)),(-ty(f3(a))/4)+ro
if cls(a)=1 then:REM DRAW BORDER IF CELL SHAD ON
l=n*8
setrgb 1,l,l,50+l
triangle tx(f1(a)),ty(f1(a)) to tx(f2(a)),ty(f2(a)) to tx(f3(a)),ty(f3(a))
triangle tx(f1(a)),(-ty(f1(a))/4)+ro to tx(f2(a)),(-ty(f2(a))/4)+ro to tx(f3(a)),(-ty(f3(a))/4)+ro
fi
fi
return
' Object Rotation and offset;
'---------------------------------------------------------
label rotate
'## Rotate And Scale Each Point! Store Result ##
for a=1 to points
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/18)+1
xx=size*(xx/dv)+320
yy=size*(yy/dv)+226
tx(a)=xx
ty(a)=yy
tz(a)=zz
next a
xr=xr+3 : yr=yr+2
zr=zr+3
if xr>720 xr=xr-720 : if yr>720 yr=yr-720
if zr>720 zr=zr-720
return
label setup
open window 640,512
' 3D Object Variables;
'---------------------------------------------------------
p=0
scx=0
s$=" "
s$=s$+"SHOCKWAVE IS BACK WITH A NICE NEW DEMO... ALL THE"
s$=s$+" CODE, GRAPHICS, OBJECTS AND DESIGN ARE BY "
s$=s$+"SHOCKWAVE... LOOK CLOSELY AT THE OBJECT... "
s$=s$+"THINGS ARE HAPPENING TO IT.... I WAS THE FIRST TO"
s$=s$+" GIVE YOU GLASS OBJECTS, NOW I'M GIVING YOU GLASS "
s$=s$+"MORPHING OBJECTS. ALL IN 50FPS OF COURSE... "
s$=s$+" EVEN THE COLOUR SCHEME I HAVE USED IS A BIT "
s$=s$+"DIFFERENT TO MOST DEMOS.... YOU MAY FIND IT "
s$=s$+"A BIT BRIGHT, I LIKE IT THOUGH..... AND IT'S "
s$=s$+"MY DEMO SO IT'S STAYING! "
s$=s$+"I'VE TRIED MY BEST TO GIVE THE FACES A KIND OF "
s$=s$+"OILY SHEEN SIMILAR TO THE COLOURS YOU'D SEE IF YOU"
s$=s$+" WERE LOOKING AT A THIN PATCH OF OIL ON WATER.. "
s$=s$+"ANYHOW I RECKON IT MUST BE THAT TIME AGAIN... "
s$=s$+"SUPERFLUOUS SHOUT OUTS GO TO THESE PEOPLE "
s$=s$+"(IN NO SPECIAL ORDER) : "
s$=s$+"FRYER (REALLY LOOKING FORWARD TO F1 M8, YOUR STUFF"
s$=s$+" NEVER CEASES TO AMAZE ME) XALTHORN (I KNOW THAT "
s$=s$+"YOU ARE SIMULTANIOUSLY WORKING ON YOUR 3D STUFF, "
s$=s$+"I'LL BE INTERESTED AS ALWAYS TO SEE WHAT YOU'VE "
s$=s$+"COME UP WITH) JIM SHAW (YOU CONTINUE TO PUSH "
s$=s$+"THE BOUNDARYS OF WHAT'S POSSIBLE BY PROVIDING YOUR"
s$=s$+" EXPERIENCE AND KNOWLEDGE TO THE FORUMS YOU'RE A "
s$=s$+"BIG HELP AND INSPIRATION) DOCTOR (I KNOW YOU HAVE"
s$=s$+" SOME INTERESTING PROJECTS IN THE PIPELINE, GOOD "
s$=s$+"LUCK WITH THEM!) JOMORROW (THANKS FOR THE LOGO, "
s$=s$+"SORRY I DIDN'T USE IT BUT I'L FIND SOMETHING IT "
s$=s$+"SUITS SOON) SNAKEDOGG (POST MORE CODE, I LIKE "
s$=s$+"YOUR STUFF) DEMONEYE (NICE JOB ON THE FORUMS M8!)"
s$=s$+" PARABELLUM (WTF ARE YOU THESE DAYS M8?) DREW "
s$=s$+"(THANKS FOR MERGING THE SHOOTER FORUM CODE) "
s$=s$+"AND ALSO BIG HELLOS TO THESE PEOPLE: "
s$=s$+"JINX, KYATAAVL, BALROQ, AZ, BONGOTRUMMOR, "
S$=S$+"SEPHIROTH, ZINGY, PYRO, TONBERRY, JACOB, "
s$=s$+"ELL, BRUASET, LOOPY, COMBATKING AND ALL THE "
s$=s$+"REST OF YOU. SORRY IF YOU WERE FORGOTTEN.. "
s$=s$+"POST MORE... CONTACT THE FORUMS: "
s$=s$+"WWW.YABASIC.CO.UK WWW.PS2-YABASIC.CO.UK "
s$=s$+"OR EMAIL ME: SHOCKWAVE@PS2-YABASIC.CO.UK "
s$=s$+" GOOD LUCK IN THE 300 LINE DEMO COMP IF YOU ARE "
s$=s$+"ENTERING, BUT I'LL WRAP THIS UP NOW... SO ENDS "
s$=s$+"ANOTHER BORING SHOCKWAVE TEXT...... "
size=23: rem how big do you want it?
ro=570
points=14 : Rem The amount of points in the object
faces=24 : Rem The Amount of faces in the object
mt=2 : mxo=5
dim ffg(faces)
dim x(points),y(points),z(points)
dim mx(points,mxo),my(points,mxo),mz(points,mxo)
dim tx(points),ty(points),tz(points),f1(faces),f2(faces)
dim f3(faces),f4(faces),r(faces),g(faces),b(faces)
dim cls(faces)
' Define Sine Tables for faster matrix calculations;
'---------------------------------------------------------
dim cs(1440),sn(1440)
for ang=0 to 1440
cs(ang)=cos(ang*(pi/360)) : sn(ang)=sin(ang*(pi/360))
next ang
' Read in the object's points;
'---------------------------------------------------------
for a=1 to points
read x(a),y(a),z(a)
mx(a,1)=x(a)
my(a,1)=y(a)
mz(a,1)=z(a)
next a
for b=2 to mxo
for a=1 to points
read mx(a,b),my(a,b),mz(a,b)
next a
next b
' Read In Connections and face parameters;
'---------------------------------------------------------
for a=1 to faces
read f1(a),f2(a),f3(a),f4(a),r(a),g(a),b(a),cls(a)
next a
'^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
' The Object And Face Connection Description As Data!
'^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
data 5,-5,-5,5,5,-5,-5,5,-5,-5,-5,-5,0,0,-8,8,0,0,0
data 8,0,-8,0,0,0,-8,0,5,-5,5,5,5,5,-5,5,5,-5,-5,5,0,0,8
data 5,-5,-5,5,5,-5,-5,5,-5,-5,-5,-5
data 0,0,-5,5,0,0,0
data 5,0,-5,0,0,0,-5,0,5,-5,5,5,5,5,-5,5,5,-5,-5,5,0,0,5
data 4,-4,-4,4,4,-4,-4,4,-4,-4,-4,-4,0,0,-8,8,0,0,0
data 8,0,-8,0,0,0,-8,0,4,-4,4,4,4,4,-4,4,4,-4,-4,4,0,0,8
data 2,-5,-5,2,5,-5,-2,5,-5,-2,-5,-5
data 0,0,-5,2,0,0,0
data 5,0,-2,0,0,0,-5,0,2,-5,5,2,5,5,-2,5,5,-2,-5,5,0,0,5
data 1,-5,-5,1,5,-5,-1,5,-5,-1,-5,-5
data 0,0,-5,7,0,0,0
data 5,0,-7,0,0,0,-5,0,1,-5,5,1,5,5,-1,5,5,-1,-5,5,0,0,5
data 10,9,13,13,50,0,0,1
data 14,10,13,13,0,50,0,1
data 14,13,12,12,0,50,0,1
data 8,12,13,13,0,0,50,1
data 4,8,13,13,0,0,50,1
data 10,14,11,11,0,50,0,1
data 10,11,6,6,50,0,50,1
data 4,13,9,9,50,0,0,1
data 1,4,9,9,50,0,0,1
data 1,9,10,10,50,0,0,1
data 6,1,10,10,50,0,50,1
data 5,4,1,1,0,50,50,1
data 8,4,3,3,0,0,50,1
data 3,12,8,8,0,0,50,1
data 3,4,5,5,0,50,50,1
data 7,12,3,3,50,50,0,1
data 14,12,11,11,0,50,0,1
data 11,12,7,7,50,50,0,1
data 6,11,2,2,50,0,50,1
data 11,7,2,2,50,50,0,1
data 1,6,2,2,50,0,50,1
data 2,5,1,1,0,50,50,1
data 2,7,3,3,50,50,0,1
data 2,3,5,5,0,50,50,1
return
