'Competition legal "The Inside out demo" by Shockwave.
'---------------------------------------------------------
'This is just to give a simple example of a legal demo
'within 300 lines.
'---------------------------------------------------------
gosub initialise
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
repeat
setdrawbuf dw
dw=1-dw
setdispbuf dw
     gosub rotate
     gosub construct
     gosub dstars
setrgb 1,0,0,0
for a=0 to 640 step 12
fill rect a,0 to a+2,512
next a
for a=0 to 512 step 12
fill rect 0,a to 640,a+2
next a
setrgb 1,155,255,255
fill rect 0,0 to 640,3
fill rect 0,510 to 640,512
     gosub logo
     gosub scroll

until (1=2)
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
label scroll
setrgb 1,0,255,255
text scx,420,mid$(s$,p,67)
scx=scx-1
if scx<-10 then
scx=scx+10
p=p+1
if p>len(s$) p=0
fi
return
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
label logo
ls=ls+.1
lc=lc+.12
for a=1 to 5
lx=90*sin(ls+(a/23))
ly=30*cos(lc+(a/20))

setrgb 1,0,25*a,34*a
line 290+lx,50+ly to 350+lx,50+ly 
line 290+lx,50+ly to 290+lx,200+ly
line 350+lx,50+ly to 350+lx,200+ly
line 290+lx,125+ly to 350+lx,125+ly
rect 220+lx,50+ly to 280+lx,200+ly
line 220+lx,125+ly to 280+lx,125+ly
rect 150+lx,50+ly to 210+lx,125+ly
line 210+lx,200+ly to 210+lx,125+ly
line 150+lx,125+ly to 150+lx,200+ly
line 80+lx,50+ly to 80+lx,125+ly
line 80+lx,125+ly to 140+lx,125+ly
line 140+lx,50+ly to 140+lx,200+ly
line 140+lx,200+ly to 80+lx,200+ly
line 420+lx,50+ly to 360+lx,50+ly
line 360+lx,50+ly to 360+lx,125+ly
line 360+lx,125+ly to 420+lx,125+ly
line 420+lx,125+ly to 420+lx,200+ly
line 420+lx,200+ly to 360+lx,200+ly
line 430+lx,50+ly to 490+lx,50+ly
line 430+lx,200+ly to 490+lx,200+ly
line 460+lx,50+ly to 460+lx,200+ly
line 560+lx,50+ly to 500+lx,50+ly 
line 500+lx,50+ly to  500+lx,200+ly
line 500+lx,200+ly to 560+lx,200+ly
next a
return

'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
label dstars
setrgb 1,5,100,155
for a=1 to ds
  sz(a)=sz(a)-.05
  tx=(sx(a)/sz(a))+320
  ty=(sy(a)/sz(a))+256
  ts=6-sz(a)
  fill rect tx,ty to tx+ts,ty+ts
  if tx<0 or tx>640 or ty<0 or ty>512 then
  sx(a)=-1500+ran(3000)
  sy(a)=-1500+ran(3000)
  sz(a)=5
  fi
   
next a

return

'---------------------------------------------------------
'                Draw The Inner Ball Object;
'---------------------------------------------------------
label construct
setrgb 2,0,10,10
setrgb 3,0,10,10
 f1=8:f2=4:f3=3
 gosub draw
  f1=12:f2=8:f3=3
  gosub draw
   f1=12:f2=13:f3=8
   gosub draw
    f1=13:f2=4:f3=8
    gosub draw
     f1=12:f2=3:f3=7
     gosub draw
      f1=3:f2=4:f3=5
      gosub draw
       f1=13:f2=9:f3=4
       gosub draw
      f1=4:f2=9:f3=1
      gosub draw
     f1=4:f2=1:f3=5
     gosub draw
    f1=3:f2=5:f3=2
    gosub draw
   f1=5:f2=1:f3=2
   gosub draw
  f1=7:f2=3:f3=2
  gosub draw
 f1=6:f2=2:f3=1
 gosub draw
f1=11:f2=7:f3=2
gosub draw
 f1=11:f2=2:f3=6
 gosub draw
  f1=10:f2=11:f3=6
  gosub draw
   f1=10:f2=6:f3=1
   gosub draw
    f1=9:f2=10:f3=1
    gosub draw
     f1=13:f2=10:f3=9
     gosub draw
     f1=12:f2=7:f3=11
     gosub draw
      f1=12:f2=11:f3=14
      gosub draw
       f1=13:f2=12:f3=14
       gosub draw
        f1=13:f2=14:f3=10
        gosub draw
          f1=14:f2=11:f3=10
          gosub draw
return

'---------------------------------------------------------
'         Calculate Cross product and draw face;
'---------------------------------------------------------
label draw
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
'Draw A Face Of The Ball If Cross product Positive;

  vx1= tx(f1)-tx(f2):rem          Calculate Cross product;
  vy1= ty(f1)-ty(f2)
  vx2= tx(f3)-tx(f2)
  vy2= ty(f3)-ty(f2)
  n=(vx1*vy2-vx2*vy1)
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
if n>0 then:rem                    Cross product positive?
l=abs(n/2500)
setrgb 1,r+l,g+l,b+l:rem               Set colour for face
gtriangle tx(f1),ty(f1) to tx(f2),ty(f2) to tx(f3),ty(f3)
setrgb 1,l,l,l*2
triangle tx(f1),ty(f1) to tx(f2),ty(f2) to tx(f3),ty(f3)
fi
return
'---------------------------------------------------------
'Rotation and perspective transformations For Inner Object
'---------------------------------------------------------
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
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 matrix 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;
  zv=(zz/10)+1
  xx=size*(xx/zv)+320
  yy=size*(yy/zv)+256
  tx(a)=xx
  ty(a)=yy
  tz(a)=zz
 next a
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
xr=xr+1:rem                     Rotation Offset Additions;
yr=yr+2
zr=zr+3
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
if xr>720 xr=xr-720:rem                     Offset Resets;
if yr>720 yr=yr-720
if zr>720 zr=zr-720
return

'%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
'                  Initialise Program;
'%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
label initialise
    size=55:rem    Size and colour values for inside ball
    r=0:g=0:b=40
    open window 640,512:rem               Open GFX Screen
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
polys=14 : Rem          The amount of points in the object
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
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
s$="                                                     "
p=0
scx=0
s$=s$+"                  This demo conforms to the rules "
s$=s$+"of the competition... It is very quickly coded "
s$=s$+"so don't hold it against me, I reckon it will be "
s$=s$+"beaten by most of you :o)  Shockwave signing "
s$=s$+"off in August 2002...          "
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 ds=40
 dim sx(ds),sy(ds),sz(ds)
 for a=1 to ds
  sx(a)=-900+ran(1800)
  sy(a)=-900+ran(1800)
  sz(a)=ran(5)
 next a
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 dim cs(720):rem                    Sin/Cos Table Precalc;
 dim sn(720)
 for ang=0 to 720
  cs(ang)=cos(ang*(pi/360))
  sn(ang)=sin(ang*(pi/360))
 next ang
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
for a=1 to polys:rem                 Get Object from Data;
 read x(a),y(a),z(a)
next a
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
'               Ball Object (14 Points);
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
data 5,-5,-5,5,5,-5,-5,5,-5,-5,-5,-5,0,0,-8,8,0,0,0,8,0
data -8,0,0,0,-8,0,5,-5,5,5,5,5,-5,5,5,-5,-5,5,0,0,8
return



