' The "Real Time" Demo By Shockwave.
' =================================
'
' This one is interesting so a few notes on it's creation.
' It was inspired by one of the first yabasic demos that I
' ever clapped eyes on. The demo was called "analog clock"
' and it was written by Xalthorn. It basically turned the
' internal time into a 2D analog clock display.
'
' I remember liking the demo when I saw it. Lately I have
' been looking for new ideas for 3D objects, I remembered
' Xalthorn's clock demo, it's ironic that Xalthorn wrote
' the original when I look at the problem I had with this.
'
' I created the clock object with my vector editor, I did
' my usual feasibility tests, it all looked viable and I
' made a rotating clock in 3D. Unfortunately when reading
' the internal clock, something screwed up, I found a bug
' in Yabasic, a memory leakage bug with the split()
' function I as using to extract the time from the PS2's
' clock.
'
' My clock worked but as the memory leaked away the demo
' crawled. Ironically Xalthorn found a way around it when
' he suggested reading the clock once before the demo
' started and then just adding constants to the time in
' line with a 50fps update which is such a nice, clean
' and simple solution that I had not thought of it.
'
' Thank you Xalthorn, I would not have released this if it
' wasn't for you.
'
' Press F9 now to see it working.
'
'#########################################################

gosub initialise
'^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^

'%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
'                    Thanks Xalthorn;
'%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
num=split(time$,field$(),"-")
mn=((val(field$(2))+45)*6)
hr=((mn-260)/12)
hr=hr+(val(field$(1))-3)/(12/360)
sec=((val(field$(3))-15)*6)
'---------------------------------------------------------
'                   Main Loop Starts;
'---------------------------------------------------------
repeat
    setdrawbuf dw
    dw=1-dw
    setdispbuf dw
    setrgb 1,15,8,12
    setrgb 2,25,15,16
    setrgb 3,15,25,22
    gtriangle -320,-256 to 320,256 to -320,256
    gtriangle -320,-256 to 320,256 to 320,-256
    gosub stars
    gosub calc_hands
    gosub rotate
    gosub construct 
    if peek("port1")=0 pressed=0
    if peek("port1")=16384 and pressed=0 then
    pressed=1
    halt=-halt
    fi
setrgb 1,55,20,20
fill rect -250,-194 to 250,-215
fill rect -250,194 to 250,215

setrgb 1,255,255,155
text 0,-200,"'REAL-TIME' BY SHOCKWAVE WITH HELP FROM XALTHORN","cc"
rect -250,-194 to 250,-215
rect -250,194 to 250,215
txtm=txtm+1
if txtm<100 fad=fad+2
if txtm>500 fad=fad-2
if txtm>600 then
    txtm=0
    fad=0
    mp=mp+1
    if mp>10 mp=1
fi
setrgb 1,55+fad,20+fad,20
text 0,210,m$(mp),"cc"
until (1=2)
'---------------------------------------------------------
'                  MAIN LOOP CLOSES OO
'---------------------------------------------------------
label stars
setrgb 1,250,100,100
for a=1 to nst
tx=xst(a)/zst(a)
ty=yst(a)/zst(a)

  s=7-zst(a)
  c=(s*30)-30
  setrgb 1,c,20,20
  fill triangle tx,ty-s-s to tx+s,ty+s to tx-s,ty+s
  fill triangle tx,ty+s+s to tx+s,ty-s to tx-s,ty-s

zst(a)=zst(a)-.05
if tx<-320 or tx>320 or ty<-256 or ty>256 then
 xst(a)=-3000+ran(6000)
 yst(a)=-3000+ran(6000)
zst(a)=5
fi
next a
return

'---------------------------------------------------------
'                     You need hands;
'---------------------------------------------------------
label calc_hands
    sec=mod(sec+0.12,360):rem      < Xalthorn's nice
    mn=mod(mn+0.002,360):rem       < Little dodge
    hr=mod(hr+0.00016667,360):rem  < Part 2.
     x(26)=(10*cos(sec*pi/180))
     y(26)=(10*sin(sec*pi/180))
     x(27)=(9*cos(mn*pi/180))
     y(27)=(9*sin(mn*pi/180))
     x(28)=(6*cos(hr*pi/180))
     y(28)=(6*sin(hr*pi/180))
     x(29)=x(26)
     y(29)=y(26)
     x(30)=x(27)
     y(30)=y(27)
     x(31)=x(28)
     y(31)=y(28)
return

'---------------------------------------------------------
'                  Draw Visible polygons;
'---------------------------------------------------------
label construct
r=24:g=12:b=0
f1=17:f2=16:f3=15:f4=14
gosub drawq
if n>0 gosub front
f1=23:f2=15:f3=16:f4=22
gosub drawq
f1=17:f2=25:f3=22:f4=16
gosub drawq
f1=24:f2=25:f3=17:f4=14
gosub drawq
f1=23:f2=22:f3=25:f4=24
gosub drawq
f1=14:f2=15:f3=23:f4=24
gosub drawq
return

label drawq
'###############################
'## Draw A Face Of The object ##
'###############################
  vx1= tx(f1)-tx(f2)
  vy1= ty(f1)-ty(f2)
  vx2= tx(f3)-tx(f2)
  vy2= ty(f3)-ty(f2)
  n= (vx1*vy2-vx2*vy1)
if n>0 then
l=n/2000
setrgb 1,r+l,g+l,b+l
fill triangle tx(f1),ty(f1) to tx(f2),ty(f2) to tx(f3),ty(f3)
fill triangle tx(f1),ty(f1) to tx(f3),ty(f3) to tx(f4),ty(f4)
setrgb 1,0,0,0
line tx(f1),ty(f1) to tx(f2),ty(f2)
line tx(f2),ty(f2) to tx(f3),ty(f3)
line tx(f3),ty(f3) to tx(f4),ty(f4)
line tx(f4),ty(f4) to tx(f1),ty(f1)
fi

return

'%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
'Draw The Clock Face!
'%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
label front
setrgb 1,l+15,l,l
fill triangle tx(18),ty(18) to tx(19),ty(19) to tx(20),ty(20)
fill triangle tx(21),ty(21) to tx(18),ty(18) to tx(20),ty(20)
setrgb 1,90+l,90+l,50+l
line tx(18),ty(18) to tx(19),ty(19)
line tx(19),ty(19) to tx(20),ty(20)
line tx(20),ty(20) to tx(21),ty(21)
line tx(21),ty(21) to tx(18),ty(18)

'clock face Background;
setrgb 1,35+l,l,l
fill triangle tx(6),ty(6) to tx(7),ty(7) to tx(13),ty(13)
fill triangle tx(8),ty(8) to tx(9),ty(9) to tx(13),ty(13)
fill triangle tx(10),ty(10) to tx(11),ty(11) to tx(13),ty(13)
fill triangle tx(12),ty(12) to tx(3),ty(3) to tx(13),ty(13)
fill triangle tx(1),ty(1) to tx(2),ty(2) to tx(13),ty(13)
fill triangle tx(4),ty(4) to tx(5),ty(5) to tx(13),ty(13)

setrgb 1,l+20,l,l+30
fill triangle tx(5),ty(5) to tx(6),ty(6) to tx(13),ty(13)
fill triangle tx(7),ty(7) to tx(8),ty(8) to tx(13),ty(13)
fill triangle tx(9),ty(9) to tx(10),ty(10) to tx(13),ty(13)
fill triangle tx(11),ty(11) to tx(12),ty(12) to tx(13),ty(13)
fill triangle tx(3),ty(3) to tx(1),ty(1) to tx(13),ty(13)
fill triangle tx(2),ty(2) to tx(4),ty(4) to tx(13),ty(13)
setrgb 1,150+l,150+l,100+l
for a=1 to 12
fill rect tx(a)-1,ty(a)-1 to tx(a)+1,ty(a)+1
next a
setrgb 1,120+l,30+l,30+l
line tx(6),ty(6) to tx(7),ty(7)
line tx(6),ty(6) to tx(5),ty(5)
line tx(5),ty(5) to tx(4),ty(4)
line tx(4),ty(4) to tx(2),ty(2)
line tx(2),ty(2) to tx(1),ty(1)
line tx(1),ty(1) to tx(3),ty(3)
line tx(3),ty(3) to tx(12),ty(12)
line tx(12),ty(12) to tx(11),ty(11)
line tx(11),ty(11) to tx(10),ty(10)
line tx(10),ty(10) to tx(9),ty(9)
line tx(9),ty(9) to tx(8),ty(8)
line tx(8),ty(8) to tx(7),ty(7)
setrgb 1,0,0,0
line tx(13),ty(13) to tx(26),ty(26)
line tx(13),ty(13) to tx(27),ty(27)
line tx(13),ty(13) to tx(28),ty(28)

setrgb 1,255,255,255
line tx(38),ty(38) to tx(26),ty(26)
line tx(38),ty(38) to tx(27),ty(27)
line tx(38),ty(38) to tx(28),ty(28)
line tx(38),ty(38) to tx(13),ty(13)
line tx(32),ty(32) to tx(33),ty(33)
line tx(34),ty(34) to tx(35),ty(35)
line tx(36),ty(36) to tx(35),ty(35)
line tx(36),ty(36) to tx(37),ty(37)
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! ##
'########################
  pp=(zz/50)+1
  xx=13*(xx/pp)
  yy=13*(yy/pp)
  tx(a)=xx
  ty(a)=yy
  tz(a)=zz
 next a
if halt=1 then
xr=xr+1
yr=yr+1
zr=zr+1
if xr>360 xr=xr-360
if yr>360 yr=yr-360
if zr>360 zr=zr-360
fi
return
label initialise
'^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
' This Sub-Routine Initialises The Program.
'^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
'######################
'## Open Gfx Screen! ##
'######################
open window 640,512
window origin "cc"
'#####################################
'## Define the necessary variables! ##
'#####################################
txtm=0
mp=1
dim m$(10)
m$(1)="HECK, IS THAT THE TIME??   WELL... YES IT IS!"
m$(2)="YOU CAN FREEZE AND RESTART ROTATIONS WITH (X)"
m$(3)="THIS DEMO WAS CODED BY SHOCKWAVE IN 2002."
m$(4)="MANY THANKS TO XALTHORN FOR BUG FIXING!"
m$(5)="HE OFFERED A CLEVER WAY AROUND A YABASIC BUG"
m$(6)="THAT I DISCOVERED WHEN MAKING THIS DEMO."
m$(7)="CHEERS M8!"
m$(8)="THE OTHER EFFECTS ARE JUST ADDED FOR FUN!"
m$(9)="GREETS TO ALL WHO KNOW ME."
m$(10)="VISIT: WW.PS2-YABASIC.CO.UK."

dw=1 : Rem            Double buffering Variable
polys=38 : Rem        The amount of Vertices in the object
halt=1
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 field$(4)
nst=21
dim xst(nst),yst(nst),zst(nst)
for a=1 to nst
 xst(a)=-2000+ran(4000)
 yst(a)=-2000+ran(4000)
 zst(a)=ran(5)
next a
'##########################
'## Define Sine Tables!! ##
'##########################
 dim cs(360)
 dim sn(360)
 for ang=0 to 360
  cs(ang)=cos(ang*(pi/180))
  sn(ang)=sin(ang*(pi/180))
 next ang
'#########################
'## Read in the object! ##
'#########################
for a=1 to 25
 read x(a),y(a),z(a)
next a
for a=26 to 28
z(a)=-4.3
next a
for a=29 to 31
  z(a)=-4.2
next a
for a=32 to polys
 read x(a),y(a),z(a)
next a

'^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
'   The Object Description As Data!
'   The Data Below Describes A Clock.
'^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
data -5,9,-4,-9,5,-4,0,10,-4,-10,0,-4,-9,-5,-4,-5,-9,-4,0,-10,-4,5,-9,-4,9,-5,-4,10,0,-4,9,5,-4,5,9,-4,0,0,-4
data 12,12,-4,-12,12,-4,-12,-12,-4,12,-12,-4
data 11,-11,-4,11,11,-4,-11,11,-4,-11,-11,-4
data -10,-8,4,-10,12,4,10,12,4,10,-8,4
data -1,-11,-4,-1,-10,-4
data 1,-11,-4 , 2,-10.7,-4
data 1,-10,-4
data 2,-10,-4
data 0,0,-4.3
return

















