'+ + + + + + + + + + + + + + + + + + + + + + + + + + + + +
'+             3D Prism Demo by Gareth Bailey            +
'+                       July 2002                       +
'+ + + + + + + + + + + + + + + + + + + + + + + + + + + + +

open window 640,512
gosub setup


label loop 
  clear window 
  gosub rotate 
  gosub changecol
  gosub drawobject
  gosub db
goto loop


label rotate
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

for b=1 to 2

  for a=1 to pts 
    x1=x(a,b)
    y1=y(a,b)
    z1=z(a,b)
    xx=x1
    yy=y1*cosi(xr)+z1*sine(xr)
    zz=z1*cosi(xr)-y1*sine(xr)
    y1=yy
    x1=xx*cosi(yr)-zz*sine(yr)
    z1=xx*sine(yr)+zz*cosi(yr)
    zz=z1
    xx=x1*cosi(zr)-y1*sine(zr)
    yy=x1*sine(zr)+y1*cosi(zr)

    dx(a,b)=xx
    dy(a,b)=yy:dz(a,b)=zz
    xx(a,b)=dx(a,b)/((dz(a,b)/focus)+1)+320
    yy(a,b)=dy(a,b)/((dz(a,b)/focus)+1)+256
  next a
next b
return

label changecol
con=peek("port1")
if and(con,16384) <> 0 rc=rc+.02
if and(con, 8192) <> 0 gc=gc+.02
if and(con,32768) <> 0 bc=bc+.02
if and(con,   64) <> 0 rc=rc-.02
if and(con,   32) <> 0 gc=gc-.02
if and(con,  128) <> 0 bc=bc-.02
if rc>2 rc=2
if rc<0 rc=0
if gc>2 gc=2
if gc<0 gc=0
if bc>2 bc=2
if bc<0 bc=0
return

label drawobject

for b=1 to 2
  drawme=cp(1,2,3,b)
  
  for a=1 to (pts-1)

   c1=(100-dz(1,b))
   setrgb 1,rc*c1,gc*c1,bc*c1
   if (b=1 and drawme>0) or (b=2 and drawme<0) then 
     c=a+1
     fill triangle xx(1,b),yy(1,b) to xx(a,b),yy(a,b) to xx(c,b),yy(c,b)
   fi
  next a
next b

for a=1 to pts
 c=a+1
 if a=pts c=1
 c1=(100-dz(a,1))
 c2=(100-dz(a,2))
setrgb 1,rc*c1,gc*c1,bc*c1
setrgb 2,rc*c1,gc*c1,bc*c1
setrgb 3,rc*c2,gc*c2,bc*c2
  if (xx(a,1)-xx(a,2))*(yy(c,1)-yy(a,2))-(xx(c,1)-xx(a,2))*(yy(a,1)-yy(a,2))>0 then
   gtriangle xx(a,1),yy(a,1) to xx(c,1),yy(c,1) to xx(a,2),yy(a,2)
setrgb 2,rc*c2,gc*c2,bc*c2
  gtriangle xx(c,1),yy(c,1) to xx(c,2),yy(c,2) to xx(a,2),yy(a,2)
  fi
next a
return


label db
setdispbuf draw
draw =1-draw
setdrawbuf draw
return

sub cp(a,b,c,cs)
cp=(xx(a,cs)-xx(b,cs))*(yy(c,cs)-yy(b,cs))-(xx(c,cs)-xx(b,cs))*(yy(a,cs)-yy(b,cs))
return cp
end sub


label setup
print "+ + + + + + + + + + + + + + + + + + + + + + + + + "
print "+        3D Prism Demo by Gareth Bailey         + "
print "+                  July 2002                    + "
print "+ + + + + + + + + + + + + + + + + + + + + + + + + "
print ""
print "PLEASE ENTER THE NUMBER OF SIDES WHICH YOU ";
print "REQUIRE"
repeat:input "NUMBER OF SIDES: " pts:
until (pts>2)
print "\nPLEASE SELECT COLOUR VALUES FOR THE OBJECT"
input "RED  : "rc :rc=rc/100
input "GREEN: "gc :gc=gc/100
input "BLUE : "bc :bc=bc/100


focus=500:size=100:s=1
dim x(pts,2),y(pts,2),z(pts,2),xx(pts,2),yy(pts,2) 
dim dx(pts,2),dy(pts,2),dz(pts,2),ang(pts,2) 
dim sine(361),cosi(361) 

for a=0 to 361
  cosi(a)=cos(a*(pi/180)) 
  sine(a)=sin(a*(pi/180)) 
next a 

for b=1 to 2 

  for a=1 to pts 
    ang(a,b)=(360/pts)*a
    x(a,b)=(cos(ang(a,b)*(pi/180))*size) REM
    y(a,b)=(sin(ang(a,b)*(pi/180))*size) REM
    z(a,b)=100
    if b=2 z(a,b)=-100
  next a
next b
return


