Author Topic: Mapped demo  (Read 2481 times)

0 Members and 1 Guest are viewing this topic.

Offline Shockwave

  • good/evil
  • Founder Member
  • DBF Aficionado
  • ********
  • Posts: 17414
  • Karma: 498
  • evil/good
    • View Profile
    • My Homepage
Mapped demo
« on: October 19, 2006 »
Brings back happy memories after conding this! :)
I still like this demo now.

Code: [Select]
' 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


Shockwave ^ Codigos
Challenge Trophies Won: