Brings back happy memories after conding this! :)
I still like this demo now.
' The Manic Cube Demo By Shockwave. (C) 2002.
' ===========================================
'
' I just had to do one of these demos so that I can say
' that I've done it. This isn't much of a progression
' from my Televisual demo, except that it's probably
' Doing A Little More number crunching. :o)
'
' It's also similar to Parabellums Yacube Demo. (Cool btw)
' ========================================================
'
' Greetings (In No Order);
'
' Xalthorn, Snakedogg, Parabellum, Demoneye, Jim, Tappi,
' Trickykeyboard, Doctor, Kyata, Jinx, Fryer, Jo, Stel,
' Whitey, and al the rest of you ;o) Sorry If I forgot to
' mention you.
'#########################################################
gosub initialise
'^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
repeat
setdrawbuf dw
dw=1-dw
setdispbuf dw
q=3+3*sin(mm)
mm=mm+.1
setrgb 1,20,40,10
setrgb 2,10,20,80
setrgb 3,80,40,20
gtriangle 0,0 to 640,512 to 0,512
gtriangle 0,0 to 640,512 to 640,0
gosub rotate
gosub construct
gosub logo1
setrgb 1,255,255,255
fill rect 0,0 to 640,3
fill rect 0,512 to 640,510
gosub logo2
gosub writer
until (and(peek("port1"),16384)<>0)
exit
'=========================================================
' This Subroutine Does The Bouncy Greetings Thing;
'=========================================================
label writer
mnm=mnm+.04
if mnm>7 then
mnm=0
mc=mc+1
if mc>messages mc=1
fi
setrgb 1,255,255,255
text 320,522+70*sin(mnm),m$(mc),"cc"
return
' Logo Back Letters;
'---------------------------------------------------------
label logo1
setrgb 1,250,250,250
's
fill rect 11,211 to 71,221
fill rect 11,291 to 71,281
fill rect 11,246 to 71,256
fill rect 11,211 to 21,256
fill rect 71,256 to 61,291
fill rect 71,246 to 51,291
'o
fill rect 151,211 to 211,221
fill rect 151,291 to 211,281
fill rect 151,211 to 161,291
fill rect 211,211 to 201,291
fill rect 151,246 to 171,291
'k
fill rect 291,211 to 301,291
fill rect 291,246 to 351,256
fill rect 351,246 to 331,291
fill rect 321,211 to 331,246
'a
fill rect 431,211 to 441,291
fill rect 491,211 to 481,291
fill rect 431,211 to 491,221
fill rect 431,246 to 491,256
fill rect 431,246 to 451,291
'e
fill rect 571,211 to 581,291
fill rect 571,211 to 631,221
fill rect 571,281 to 631,291
fill rect 571,246 to 611,256
fill rect 571,246 to 591,291
'h
fill rect 81,211 to 91,291
fill rect 141,211 to 131,291
fill rect 141,246 to 81,256
fill rect 81,246 to 101,291
'c
fill rect 221,211 to 281,221
fill rect 221,291 to 281,281
fill rect 221,211 to 231,291
fill rect 221,246 to 241,291
'w
fill rect 361,211 to 371,291
fill rect 361,246 to 381,291
fill rect 361,291 to 421,281
fill rect 421,291 to 411,211
fill rect 391,291 to 401,246
'v
fill rect 501,211 to 511,291
fill rect 511,246 to 521,291
fill rect 561,211 to 551,246
fill rect 501,281 to 546,291
fill triangle 546,291 to 541,281 to 551,246
fill triangle 561,246 to 551,246 to 546,291
rect 6,206 to 636,297
return
' Logo Front Letters;
'---------------------------------------------------------
label logo2
setrgb 1,100,0,150
's
fill rect 10,210 to 70,220
fill rect 10,290 to 70,280
fill rect 10,245 to 70,255
fill rect 10,210 to 20,255
fill rect 70,255 to 60,290
fill rect 70,245 to 50,290
'o
fill rect 150,210 to 210,220
fill rect 150,290 to 210,280
fill rect 150,210 to 160,290
fill rect 210,210 to 200,290
fill rect 150,245 to 170,290
'k
fill rect 290,210 to 300,290
fill rect 290,245 to 350,255
fill rect 350,245 to 330,290
fill rect 320,210 to 330,245
'a
fill rect 430,210 to 440,290
fill rect 490,210 to 480,290
fill rect 430,210 to 490,220
fill rect 430,245 to 490,255
fill rect 430,245 to 450,290
'e
fill rect 570,210 to 580,290
fill rect 570,210 to 630,220
fill rect 570,280 to 630,290
fill rect 570,245 to 610,255
fill rect 570,245 to 590,290
setrgb 1,0,150,100
'h
fill rect 80,210 to 90,290
fill rect 140,210 to 130,290
fill rect 140,245 to 80,255
fill rect 80,245 to 100,290
'c
fill rect 220,210 to 280,220
fill rect 220,290 to 280,280
fill rect 220,210 to 230,290
fill rect 220,245 to 240,290
'w
fill rect 360,210 to 370,290
fill rect 360,245 to 380,290
fill rect 360,290 to 420,280
fill rect 420,290 to 410,210
fill rect 390,290 to 400,245
'v
fill rect 500,210 to 510,290
fill rect 510,245 to 520,290
fill rect 560,210 to 550,245
fill rect 500,280 to 545,290
fill triangle 545,290 to 540,280 to 550,245
fill triangle 560,245 to 550,245 to 545,290
rect 5,204 to 635,296
return
label construct2
setrgb 2,0,0,0
setrgb 3,0,0,0
for aa=1 to faces
gosub draw2
next aa
return
'---------------------------------------------------------
' Draw A Face Of The Central Cube;
'---------------------------------------------------------
label draw2
x1=tx(f1(aa)+o)
x2=tx(f2(aa)+o)
x3=tx(f3(aa)+o)
x4=tx(f4(aa)+o)
y1=ty(f1(aa)+o)
y2=ty(f2(aa)+o)
y3=ty(f3(aa)+o)
y4=ty(f4(aa)+o)
vx1= x1-x2
vy1= y1-y2
vx2= x3-x2
vy2= y3-y2
nn= vx1*vy2-vx2*vy1
if nn<0 then
setrgb 1,r(aa)+n,g(aa)+n,b(aa)+n
gtriangle x1,y1 to x2,y2 to x3,y3
gtriangle x1,y1 to x4,y4 to x3,y3
' if cls(aa)=1 then
setrgb 1,0,0,0
line x1,y1 to x2,y2
line x2,y2 to x3,y3
line x3,y3 to x4,y4
line x4,y4 to x1,y1
' fi
fi
return
'---------------------------------------------------------
' Draw The Object;
'---------------------------------------------------------
label construct
setrgb 2,0,0,0
setrgb 3,0,0,0
for a=1 to faces
gosub draw
next a
return
'---------------------------------------------------------
' Draw A Face Of The Object;
'---------------------------------------------------------
label draw
x1=tx(f1(a))
x2=tx(f2(a))
x3=tx(f3(a))
x4=tx(f4(a))
y1=ty(f1(a))
y2=ty(f2(a))
y3=ty(f3(a))
y4=ty(f4(a))
vx1= x1-x2
vy1= y1-y2
vx2= x3-x2
vy2= y3-y2
n= vx1*vy2-vx2*vy1
if n<0 then
n=-(n/1500)
setrgb 1,r(a)+n,g(a)+n,b(a)+n
gtriangle x1,y1 to x2,y2 to x3,y3
gtriangle x1,y1 to x4,y4 to x3,y3
' if cls(a)=1 then
setrgb 1,0,0,0
line x1,y1 to x2,y2
line x2,y2 to x3,y3
line x3,y3 to x4,y4
line x4,y4 to x1,y1
' fi
n=n*1.5
o=do(a)
gosub construct2
fi
return
label rotate
'###############################################
'## Rotate And Scale Each Point! Store Result ##
'###############################################
crx=cs(xr)
srx=sn(xr)
cry=cs(yr)
sry=sn(yr)
crz=cs(zr)
srz=sn(zr)
for a=1 to 8
x1=x(a)/1.8
y1=y(a)/1.8
z1=z(a)/1.8
'######################
'## X,Y,Z rotations! ##
'######################
xx=x1
yy=y1*crx+z1*srx
zz=z1*crx-y1*srx
y1=yy
x1=xx*cry-zz*sry
z1=xx*sry+zz*cry
zz=z1
xx=x1*crz-y1*srz
yy=x1*srz+y1*crz
x(a+8)=10
y(a+8)=yy
z(a+8)=zz
x(a+16)=-10
y(a+16)=yy
z(a+16)=zz
x(a+24)=xx
y(a+24)=10
z(a+24)=zz
x(a+32)=xx
y(a+32)=-10
z(a+32)=zz
x(a+40)=xx
y(a+40)=yy
z(a+40)=10
x(a+48)=xx
y(a+48)=yy
z(a+48)=-10
next a
for a=1 to points
x1=x(a)
y1=y(a)
z1=z(a)
'######################
'## X,Y,Z rotations! ##
'######################
xx=x1
yy=y1*crx+z1*srx
zz=z1*crx-y1*srx
y1=yy
x1=xx*cry-zz*sry
z1=xx*sry+zz*cry
zz=z1
xx=x1*crz-y1*srz
yy=x1*srz+y1*crz
'########################
'## Apply Perspective! ##
'########################
dv=(zz/40)+1
xx=size*(xx/dv)+320
yy=size*(yy/dv)+256
tx(a)=xx
ty(a)=yy
tz(a)=zz
next a
xr=xr+q
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
messages=24:REM How Many Greetings?
mc=1
dim m$(messages):REM Set Space For Them
for a=1 to messages:REM Read Them In
read m$(a)
next a
data "SHOCKWAVE GREETS THESE","PEOPLE FROM THE BOARD:"
data "PARBELLUM, RAFRYER, XALTHORN","JINX, DOCTOR, JO"
data "JACOB, SNAKEDOGG, DEMONEYE","LOOPY, ZING, PYRO"
data "TAPPI, TRICKYKEYBOARD, CK0","AZ, KYATAAVL, DREW"
data "JIM SHAW, TONBERRY, BALROQ","AND EVERYONE I FORGOT!"
data "SORRY IF I DIDN'T MENTION YOU!","THIS DEMO WAS INSPIRED"
data "BY PARABELLUM'S YACUBE DEMO","THIS CHEATS A BIT!"
data "BUT WHO CARES? IT LOOKS OKAY.","THE LOGO'S BEEN USED"
data "TOO MANY TIMES NOW","I NEED SOME NEW ONES!"
data "ANYONE UP FOR DOING SOME?","CONTACT ADDRESSES:"
data "SHOCKWAVE@PS2-YABASIC.CO.UK","WWW.YABASIC.CO.UK"
data "WWW.PS2-YABASIC.CO.UK","AND THAT'S ALL FOLKS!"
'---------------------------------------------------------
' Define the necessary variables;
'---------------------------------------------------------
size=16: rem how big do you want it?
dw=1 : Rem Double buffering Variable
points=56 : Rem The amount of points in the object
faces=6 : Rem The Amount of faces in the object
dim x(points): Rem Original X co-ordinate store
dim y(points): Rem Original Y co-ordinate store
dim z(points): Rem Original Z co-ordinate store
dim tx(points): Rem Transformed X co-ordinate store
dim ty(points): Rem Transformed Y co-ordinate store
dim tz(points): Rem Transformed Z co-ordinate store
dim f1(faces):rem Connections definition
dim f2(faces):rem Connections definition
dim f3(faces):rem Connections definition
dim f4(faces):rem Connections definition
dim r(faces):rem Red Component
dim g(faces):rem Green Component
dim b(faces):rem Blue Component
dim cls(faces):rem Cell Shade Face?
dim do(6)
'---------------------------------------------------------
' Define Sine Tables for faster matrix calculations;
'---------------------------------------------------------
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's points;
'---------------------------------------------------------
for a=1 to 8
read x(a),y(a),z(a)
next a
'---------------------------------------------------------
' Read In Connections and face parameters;
'---------------------------------------------------------
for a=1 to faces
read f1(a)
read f2(a)
read f3(a)
read f4(a)
read r(a),g(a),b(a),cls(a)
next a
for a=1 to 6
read do(a)
next a
'^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
' The Object Description As Data!
' The Data Below Describes A Cube.
'^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
'Points definition;
'~~~~~~~~~~~~~~~~~~
'Below are the points of the object defined as x,y,z;
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
'Connection definition;
'Below are the faces of the object defined as vertice
'numbers, specified in clockwise order. These are followed
'by r,g,b values for the face and finally cell shaded
'parameter (0)=off (1)=on.
data 1,2,3,4,60,60,0,0
data 5,8,7,6,60,60,0,0
data 6,2,1,5,0,60,60,0
data 8,4,3,7,0,60,60,0
data 2,6,7,3,60,0,60,0
data 8,5,1,4,60,0,60,0
data 40,48,24,32,8,16
return