'By Fryer - Please Upload.
'textured cube demo - R.Fryer

gosub setup

label loop
  gosub db
  gosub control
  gosub rotate
  gosub draw
goto loop

label draw
  for i=1 to mf
    p1=p(i,1)
    p2=p(i,2)
    p3=p(i,3)
if (sx(p2)-sx(p1))*(sy(p3)-sy(p1))-(sx(p3)-sx(p1))*(sy(p2)-sy(p1))>0 goto nopoly
    if face(i)=1 then 
      tx(1,1)=0
      ty(1,1)=0
      tx(2,1)=8
      ty(2,1)=0
      tx(3,1)=8
      ty(3,1)=8
    else
      tx(1,1)=8
      ty(1,1)=8
      tx(2,1)=0
      ty(2,1)=8
      tx(3,1)=0
      ty(3,1)=0
    fi
    tex=tex(i)
    vx(1,1)=rx(p1)
    vy(1,1)=ry(p1)
    vz(1,1)=rz(p1)
    vx(2,1)=rx(p2)
    vy(2,1)=ry(p2)
    vz(2,1)=rz(p2)
    vx(3,1)=rx(p3)
    vy(3,1)=ry(p3)
    vz(3,1)=rz(p3)
    gosub t
label nopoly
  next i
return

label t
  level=level+1
  if level<4 goto nl
    z=400/vz(1,level)
    sx1=vx(1,level)*z
    sy1=vy(1,level)*z
    z=400/vz(2,level)
    sx2=vx(2,level)*z
    sy2=vy(2,level)*z
    z=400/vz(3,level)
    sx3=vx(3,level)*z
    sy3=vy(3,level)*z
    tx=tx(1,level):ty=ty(1,level)
    r1=r(tx,ty,tex)
    g1=g(tx,ty,tex)
    b1=b(tx,ty,tex)
    tx=tx(2,level):ty=ty(2,level)
    r2=r(tx,ty,tex)
    g2=g(tx,ty,tex)
    b2=b(tx,ty,tex)
    tx=tx(3,level):ty=ty(3,level)
    r3=r(tx,ty,tex)
    g3=g(tx,ty,tex)
    b3=b(tx,ty,tex)
    setrgb 1,r1,g1,b1
    setrgb 2,r2,g2,b2
    setrgb 3,r3,g3,b3
    gtriangle sx1,sy1 to sx2,sy2 to sx3,sy3
    goto n
label nl
    vx(4,level)=(vx(1,level)+vx(2,level))/2
    vy(4,level)=(vy(1,level)+vy(2,level))/2
    vz(4,level)=(vz(1,level)+vz(2,level))/2
    vx(5,level)=(vx(2,level)+vx(3,level))/2
    vy(5,level)=(vy(2,level)+vy(3,level))/2
    vz(5,level)=(vz(2,level)+vz(3,level))/2
    vx(6,level)=(vx(3,level)+vx(1,level))/2
    vy(6,level)=(vy(3,level)+vy(1,level))/2
    vz(6,level)=(vz(3,level)+vz(1,level))/2
    tx(4,level)=(tx(1,level)+tx(2,level))/2
    ty(4,level)=(ty(1,level)+ty(2,level))/2
    tx(5,level)=(tx(2,level)+tx(3,level))/2
    ty(5,level)=(ty(2,level)+ty(3,level))/2
    tx(6,level)=(tx(3,level)+tx(1,level))/2
    ty(6,level)=(ty(3,level)+ty(1,level))/2
    vx(1,1+level)=vx(1,level)
    vy(1,1+level)=vy(1,level)
    vz(1,1+level)=vz(1,level)
    vx(2,1+level)=vx(4,level)
    vy(2,1+level)=vy(4,level)
    vz(2,1+level)=vz(4,level)
    vx(3,1+level)=vx(6,level)
    vy(3,1+level)=vy(6,level)
    vz(3,1+level)=vz(6,level)
    tx(1,1+level)=tx(1,level)
    ty(1,1+level)=ty(1,level)
    tx(2,1+level)=tx(4,level)
    ty(2,1+level)=ty(4,level)
    tx(3,1+level)=tx(6,level)
    ty(3,1+level)=ty(6,level)
    gosub t
    vx(1,1+level)=vx(5,level)
    vy(1,1+level)=vy(5,level)
    vz(1,1+level)=vz(5,level)
    tx(1,1+level)=tx(5,level)
    ty(1,1+level)=ty(5,level)
    gosub t
    vx(3,1+level)=vx(2,level)
    vy(3,1+level)=vy(2,level)
    vz(3,1+level)=vz(2,level)
    tx(3,1+level)=tx(2,level)
    ty(3,1+level)=ty(2,level)
    gosub t
    vx(2,1+level)=vx(3,level)
    vy(2,1+level)=vy(3,level)
    vz(2,1+level)=vz(3,level)
    vx(3,1+level)=vx(6,level)
    vy(3,1+level)=vy(6,level)
    vz(3,1+level)=vz(6,level)
    tx(2,1+level)=tx(3,level)
    ty(2,1+level)=ty(3,level)
    tx(3,1+level)=tx(6,level)
    ty(3,1+level)=ty(6,level)
    gosub t
label n  
  level=level-1
return

label control
  a=mod(a+3,360)
  b=mod(b+2,360)
  c=mod(c+1,360)
return

label setup
  open window 640,512
  window origin "CC"
  read mp,mf
  dim vx(10,10),vz(10,10),vy(10,10)
  dim tx(10,10),ty(10,10)
  dim r(100,100,6),b(100,100,6),g(100,100,6)
  dim sx(mp),sy(mp)
  dim x(mp),y(mp),z(mp),p(mf,3),tex(mf),face(mf)
  dim rx(mp),ry(mp),rz(mp)
  dim sn(360),cs(360)
  for i=0 to 360
    cs(i)=cos(i/180*pi)
    sn(i)=sin(i/180*pi)
  next i
  for y=0 to 31
    for x=0 to 31
      r(x,y,1)=255*and(x+y,1)
      g(x,y,1)=255*and(x,1)
      b(x,y,1)=255*and(y,1)
      r(x,y,2)=255*and(x+y,1)
      g(x,y,2)=255*and(x+y,1)
      b(x,y,2)=255*and(x+y,1)
      r(x,y,3)=100+100*sn(mod(y*40,360))*cs(mod(x*50,360))
      g(x,y,3)=0
      b(x,y,3)=150
      r(x,y,4)=rm+ran(250)
      g(x,y,4)=gm+ran(250)
      b(x,y,4)=bm+ran(250)
      r(x,y,5)=100+100*sn(mod(y*60,360))*cs(mod(x*70,360))
      g(x,y,5)=100+100*sn(mod(y*90,360))*cs(mod(x*20,360))
      b(x,y,5)=0
      r(x,y,6)=100+100*sn(mod(y*60,360))*cs(mod(x*70,360))
      g(x,y,6)=0
      b(x,y,6)=255*and(x,1)
    next x
  next y
  for i=1 to mp
    read x(i),y(i),z(i)
  next i
  for i=1 to mf
    read p(i,1),p(i,2),p(i,3),tex(i),face(i)
  next i
  a=0
  b=0
  c=0
return

label db
  setdispbuf db
  db=1-db
  setdrawbuf db
  clear window
return

label rotate
  csa=cs(a):sna=sn(a)
  csb=cs(b):snb=sn(b)
  csc=cs(c):snc=sn(c)
  for i=1 to mp
    tz=z(i)*csa+x(i)*sna
    tx=x(i)*csa-z(i)*sna
    rx=tx*csb+y(i)*snb
    ty=y(i)*csb-tx*snb
    rz=300+tz*csc-ty*snc
    ry=ty*csc+tz*snc
    z=400/rz
    sx(i)=rx*z
    sy(i)=ry*z
    rx(i)=rx
    ry(i)=ry
    rz(i)=rz
  next i
return

data 8,12
data -100,-100,-100
data -100,-100,100
data 100,-100,100
data 100,-100,-100
data -100,100,-100
data -100,100,100
data 100,100,100
data 100,100,-100

data 1,2,6,1,1,6,5,1,1,2
data 2,3,7,2,1,7,6,2,2,2
data 3,4,8,3,1,8,7,3,3,2
data 4,1,5,4,1,5,8,4,4,2
data 5,6,7,5,1,7,8,5,5,2
data 1,4,3,6,1,3,2,1,6,2










