'
'                   -=DIGITAL  ORGASM=-
'                   oOoOoOoOoOoOoOoOoOo
'
'         Coded By Mr.Shockwave (C) December 2001
'        oOoOoOoOoOoOoOoOoOoOoOoOoOoOoOoOoOoOoOoOo
'
'   This is the follow up to Awesome and Thunderstruck.
'   I have commented it but sorry newbies, this gets a
'   bit complicated.
'
'=========================================================
gosub initialise
'^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
off=0
coff=1
for aa=1 to 721
 gosub rotate
 gosub sort
 gosub store
next aa
off=0
coff=1

goto setup
label begin
repeat
mm=mm+.1
gosub buffer
gosub starfield
gosub draw
gosub scroll
until (and(peek("port1"),16384)<>0)
exit
label scroll
setrgb 1,155,155,255
text scx,260,mid$(s$,p,44)
setrgb 1,255,255,255
text scx+1,261,mid$(s$,p,44)
setrgb 1,0,0,0
text scx+2,262,mid$(s$,p,44)

setrgb 1,30,30,30
fill triangle 49,266 to 49,246 to 70,256
fill triangle 500,266 to 500,246 to 479,256
scx=scx-1
if scx<49 then
scx=scx+10
p=p+1
if p>len(s$) p=0
fi
return

label starfield
for a=1 to stars
     sxx=((sx(a)*25)/sz(a)*25)+275
     syy=((sy(a)*25)/sz(a)*25)+265
If sxx>50 and sxx<495 and syy>50 and syy<456 then
 setrgb 1,110-sz(a),110-sz(a),110-sz(a)
 fill rect sxx,syy to sxx+10-(sz(a)/10),syy+10-(sz(a)/10)

fi
 sz(a)=sz(a)-1
 if sz(a)<0 sz(a)=sz(a)+100

next a
return

label buffer
 setdrawbuf dw
 dw=1-dw
 setdispbuf dw
 setrgb 1,20+20*sin(mm),10,20
 setrgb 2,10,20+20*sin(mm/2),20
 setrgb 3,20,10,20+20*sin(mm/3)

 gtriangle 50,50 to 500,462 to 50,462
 gtriangle 50,50 to 500,462 to 500,50

return


label setup
'^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
' Draw All Static Graphics Now So We Can Have More Detail.
'^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
for a=1 to 2
setdrawbuf dw
dw=1-dw
    setrgb 1,80,30,30
    setrgb 2,30,80,30
    setrgb 3,30,30,80

       gtriangle 0,0 to 640,512 to 0,512
       gtriangle 0,0 to 640,512 to 640,0
       setrgb 1,255,255,255
       rect 48,48 to 502,464
       setrgb 1,155,155,155
       text 275,30,"-=DIGITAL ORGASM=-","cc"
       text 275,490,"-=WWW.PS2-YABASIC.CO.UK=-","cc"

       setrgb 1,250,250,250        
       text 276,31,"-=DIGITAL ORGASM=-","cc"
       text 276,491,"-=WWW.PS2-YABASIC.CO.UK=-","cc"
       setrgb 1,0,0,0        
       fill rect 50,50 to 500,462

       text 277,32,"-=DIGITAL ORGASM=-","cc"
       text 277,492,"-=WWW.PS2-YABASIC.CO.UK=-","cc"

      
x=30
y=20
rgb=0
for b=1 to 20
setrgb 1,rgb,rgb*2,rgb+30
rgb=rgb+5
       fill rect 530+x,20+y to 580+x,30+y
       fill rect 530+x,20+y to 540+x,50+y
       fill rect 540+x,50+y to 580+x,40+y
       fill rect 580+x,40+y to 570+x,60+y
       fill rect 580+x,60+y to 530+x,70+y
       fill rect 530+x,80+y to 540+x,120+y
       fill rect 570+x,80+y to 580+x,120+y
       fill rect 570+x,95+y to 530+x,105+y
       fill rect 530+x,130+y to 580+x,140+y
       fill rect 530+x,160+y to 580+x,170+y
       fill rect 530+x,130+y to 540+x,170+y
       fill rect 580+x,130+y to 570+x,170+y
       fill rect 530+x,180+y to 580+x,190+y
       fill rect 530+x,210+y to 580+x,220+y
       fill rect 530+x,180+y to 540+x,210+y
       fill rect 530+x,230+y to 540+x,270+y
       fill rect 570+x,230+y to 560+x,250+y
       fill rect 580+x,250+y to 570+x,270+y
       fill rect 530+x,245+y to 580+x,255+y
       fill rect 530+x,280+y to 540+x,320+y
       fill rect 580+x,320+y to 570+x,280+y
       fill rect 550+x,295+y to 560+x,320+y
       fill rect 530+x,320+y to 580+x,310+y
       fill rect 530+x,330+y to 540+x,370+y
       fill rect 580+x,330+y to 570+x,370+y
       fill rect 530+x,330+y to 580+x,340+y
       fill rect 530+x,345+y to 580+x,355+y
       fill rect 530+x,380+y to 540+x,420+y
       fill rect 580+x,380+y to 570+x,420+y
       fill rect 580+x,420+y to 530+x,410+y
       fill rect 530+x,430+y to 540+x,480+y
       fill rect 530+x,430+y to 580+x,440+y
       fill rect 530+x,480+y to 580+x,470+y
       fill rect 530+x,450+y to 570+x,460+y
x=x-1
y=y-1
next b
next a
'^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
'                   Starfield Definition:
'^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
stars=79
dim sx(stars),sy(stars),sz(stars)
b=0
for a=1 to stars
sx(a)=-20+ran(40)
sy(a)=-20+ran(40)
sz(a)=b
b=b+100/stars
next a
'^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
'                   Scrolling Message:
'^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
s$="                                             "
s$=s$+"A different sort of a name for a demo I know but "
s$=s$+"look at it... What else could I call it?? Heh!   "
s$=s$+"I Really like this one and I hope that you do too."
s$=s$+"  It was made quite quickly after I finished my "
s$=s$+" latest game... -=Spaced invaders=-  Which was "
s$=s$+"very easy to program but it turned out quite nice,"
s$=s$+" certainly better than the first Yabasic game I "
s$=s$+"did (Blue meanies) which was a load of sh*t.    "
s$=s$+"Anyway I have had a busy time of late, work has "
s$=s$+"been very, very busy but all will change soon. "
s$=s$+"Christmas is just around the corner and somehow I "
s$=s$+"have managed to code 2 games (Defence command and "
s$=s$+"Spaced invaders) and this pretty little demo. "
s$=s$+"  The forums at Yabasic.co are nice and busy and "
s$=s$+"I'd like to say hello to all the members who are "
s$=s$+"constructively contributing to the site, I won't "
s$=s$+"mention any specific names hare as there are rathe"
s$=s$+"r a lot of you now... Anyway, until my next demo "
s$=s$+"(I won't be doing another game for a while) take "
s$=s$+"it easy guys and I'll see you all soon...        "

scx=60
goto begin

label sort
for fk=1 to polys
b=1
for a=1 to polys -1
if tz(b)+tz(b+1)+tz(b+2) < tz(b+3)+tz(b+4)+tz(b+5) then
for inner=0 to 2
 sz=tz(b+inner)
 sy=ty(b+inner)
 sx=tx(b+inner)
 tz(b+inner)=tz(b+inner+3)
 ty(b+inner)=ty(b+inner+3)
 tx(b+inner)=tx(b+inner+3)
 tz(inner+b+3)=sz
 ty(inner+b+3)=sy
 tx(inner+b+3)=sx
next inner
 sr=tr(a+1)
 sg=tg(a+1)
 sb=tb(a+1)
 tr(a+1)=tr(a)
 tg(a+1)=tg(a)
 tb(a+1)=tb(a)
 tr(a)=sr
 tg(a)=sg
 tb(a)=sb
end if
b=b+3
next a
next fk
return

label store
'#########################
'## Store The object!!! ##
'#########################
for a=0 to polys-1
str(coff)=tr(a+1)
stg(coff)=tg(a+1)
stb(coff)=tb(a+1)
coff=coff+1
next a

for a=1 to polys *3
 stx(off)=tx(a)
 sty(off)=ty(a)
 ltz(off)=tz(a)
 off=off+1
next a
return


label draw
'########################
'## Draw The object!!! ##
'########################
setrgb 2,0,0,0
setrgb 3,0,0,0
size=2+1.2*sin(mm/3)
for a=1 to polys

sa=(ltz(off)+ltz(off+1)+ltz(off+2))*20

setrgb 1,str(coff)-sa,stg(coff)-sa,stb(coff)-sa

gtriangle 275+(stx(off)/size),256+(sty(off)/size) to 275+(stx(off+1)/size),256+(sty(off+1)/size) to 275+(stx(off+2)/size),256+(sty(off+2)/size)
off=off+3
coff=coff+1

next a

if off>17300 then coff=1 : off=0:fi
return

label rotate
'###############################################
'## Rotate And Scale Each Point! Store Result ##
'###############################################
 for a=1 to polys*3
  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))
  yy=size*(yy/((zz/70)+1))
  tx(a)=xx
  ty(a)=yy
  tz(a)=zz
  tr(a)=r(a)
  tg(a)=g(a)
  tb(a)=b(a)
 next a
xr=xr+rrx
yr=yr+rry
zr=zr+rrz
  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 window 640,512
setrgb 0,5,10,20
clear window

setrgb 1,155,155,155
text 320,236,"DIGITAL ORGASM DEMO CODED BY SHOCKWAVE","cc"
text 320,256,"CONTACT : SHOCKWAVE@PS2-YABASIC.CO.UK (CODERS ONLY)","cc"
text 320,276,"NOW PREPARE TO BE AMAZED","cc"

setrgb 1,255,255,255
text 321,237,"DIGITAL ORGASM DEMO CODED BY SHOCKWAVE","cc"
text 321,257,"CONTACT : SHOCKWAVE@PS2-YABASIC.CO.UK (CODERS ONLY)","cc"
text 321,277,"NOW PREPARE TO BE AMAZED","cc"

setrgb 1,0,0,0
text 322,238,"DIGITAL ORGASM DEMO CODED BY SHOCKWAVE","cc"
text 322,258,"CONTACT : SHOCKWAVE@PS2-YABASIC.CO.UK (CODERS ONLY)","cc"
text 322,278,"NOW PREPARE TO BE AMAZED","cc"


size=22: rem how big do you want it?
rrx=1
rry=2
rrz=3
dw=1 : Rem            Double buffering Variable
polys=8 : Rem        The amount of polygons in the object
dim x(polys*3) : Rem  Original X co-ordinate store
dim y(polys*3) : Rem  Original Y co-ordinate store
dim z(polys*3) : Rem  Original Z co-ordinate store
dim r(polys*3) : Rem  Original Red component store
dim g(polys*3) : Rem  Original Green component store
dim b(polys*3) : Rem  Original Blue Component store
dim tx(polys*3) : Rem Transformed  X co-ordinate store
dim ty(polys*3) : Rem Transformed Y co-ordinate store
dim tz(polys*3) : Rem Transformed Z co-ordinate store
dim tr(polys*3) : Rem Transformed Red component store
dim tg(polys*3) : Rem Transformed Green component store
dim tb(polys*3) : Rem Transformed Blue Component store

dim stx((polys*3)*722)
dim sty((polys*3)*722)
dim str((polys*3)*722)
dim stg((polys*3)*722)
dim stb((polys*3)*722)
dim ltz((polys*3)*722)

'##########################
'## 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! ##
'#########################
a=1
for b=1 to polys
read x(a),y(a),z(a),x(a+1),y(a+1),z(a+1),x(a+2),y(a+2),z(a+2),r(b),g(b),b(b)
a=a+3
next b
'^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
'   The Object Description As Data!
'   (uses 3 points per polygon!)
'^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
data -5,-1,5,5,-1,5,0,-6,0,0,155,0
data 5,-1,5,5,-1,-5,0,-6,0,155,0,0
data 5,-1,-5,-5,-1,-5,0,-6,0,0,155,0
data -5,-1,-5,-5,-1,5,0,-6,0,155,0,0
data -5,1,5,5,1,5,0,6,0,0,155,0
data 5,1,5,5,1,-5,0,6,0,0,0,155
data 5,1,-5,-5,1,-5,0,6,0,0,155,0
data -5,1,-5,-5,1,5,0,6,0,0,0,155
return