'By Fryer - Please Upload.
'strange light demo - R.Fryer
'inspired by some of shockwaves demos

read mp,mf
dim sx(mp),sy(mp)
dim rx(mp+mf),ry(mp+mf),rz(mp+mf),p(3)
dim xx(mp+mf),yy(mp+mf),zz(mp+mf),poly(mf,3)

for i=1 to mp
read xx(i),yy(i),zz(i)
next i

for i=1 to mf
read poly(i,1),poly(i,2),poly(i,3)
    p1=poly(i,1)
    p2=poly(i,2)
    p3=poly(i,3)
    vx1=xx(p2)-xx(p1)
    vy1=yy(p2)-yy(p1)
    vz1=zz(p2)-zz(p1)
    vx2=xx(p3)-xx(p1)
    vy2=yy(p3)-yy(p1)
    vz2=zz(p3)-zz(p1)
    vx=vy1*vz2-vz1*vy2
    vy=vz1*vx2-vx1*vz2
    vz=vx1*vy2-vy1*vx2
    d=1/sqrt(vx*vx+vy*vy+vz*vz)
    xx(i+mp)=vx*d
    yy(i+mp)=vy*d
    zz(i+mp)=vz*d

next i


dim cs(360),sn(360)
for i=0 to 360
sn(i)=sin(i/180*pi)
cs(i)=cos(i/180*pi)
next i

open window 640,512
window origin "CC"
ambient=.1
lx=400
ly=-600
lz=200
mfp=mf+mp
setrgb 3,0,0,50
setrgb 0,0,0,255
repeat
  setdispbuf db
  db=1-db
  setdrawbuf db
  a=mod(a+2,360)
  b=mod(b+1,360)
  c=mod(c+1,360)
  csa=cs(a):sna=sn(a)
  csb=cs(b):snb=sn(b)
  csc=cs(c):snc=sn(c)
  k=0
  repeat k=k+1
      tz=zz(k)*csa+xx(k)*sna
      tx=xx(k)*csa-zz(k)*sna
      rx=tx*csb+yy(k)*snb
      ty=yy(k)*csb-tx*snb
      rz=500+tz*csc-ty*snc
      ry=ty*csc+tz*snc
'      z=600/rz(k)
z=600/sqrt(rx*rx+ry*ry+rz*rz)
      sx(k)=rx*z
      sy(k)=ry*z
rx(k)=rx-lx
ry(k)=ry-ly
rz(k)=rz-lz
  until(k=mp)
  repeat k=k+1
      tz=zz(k)*csa+xx(k)*sna
      tx=xx(k)*csa-zz(k)*sna
      rx(k)=tx*csb+yy(k)*snb
      ty=yy(k)*csb-tx*snb
      rz(k)=tz*csc-ty*snc
      ry(k)=ty*csc+tz*snc
  until(k=mfp)
  k=0
f=max(min(f+ran(40)-20,255),0)
f2=max(min(f2+ran(100)-50,255),0)
f3=min(f,f2)

setrgb 3,f/3,min(f,f2)/3,0
setrgb 1,0,0,0
setrgb 2,0,0,0
x1=csa*500:y1=sna*500
gtriangle x1,y1 to y1,-x1 to 0,0
gtriangle -x1,-y1 to y1,-x1 to 0,0
gtriangle -x1,-y1 to -y1,x1 to 0,0
gtriangle x1,y1 to -y1,x1 to 0,0
  repeat k=k+1
    p1=poly(k,1)
    p2=poly(k,2)
    p3=poly(k,3)
if (sx(p2)-sx(p1))*(sy(p3)-sy(p1))-(sx(p3)-sx(p1))*(sy(p2)-sy(p1))>0 goto nopoly
    nx=rx(mp+k)
    ny=ry(mp+k)
    nz=rz(mp+k)
    tx=rx(p1)
    ty=ry(p1)
    tz=rz(p1)
    d=.5/sqrt(tx*tx+ty*ty+tz*tz)
    s=(tx*nx+ty*ny+tz*nz)*d
    r1=255*(ambient-min(s,0))
    dx=rx(p2)
    dy=ry(p2)
    dz=rz(p2)
    tx=tx+dx
    ty=ty+dy
    tz=tz+dz
    d=.5/sqrt(dx*dx+dy*dy+dz*dz)
    s=(dx*nx+dy*ny+dz*nz)*d
    r2=255*(ambient-min(s,0))
    dx=rx(p3)
    dy=ry(p3)
    dz=rz(p3)
    d=.5/sqrt(dx*dx+dy*dy+dz*dz)
    s=(dx*nx+dy*ny+dz*nz)*d
    r3=255*(ambient-min(s,0))
    dx=(tx+dx)/3
    dy=(ty+dy)/3
    dz=(tz+dz)/3
    tx=dx+lx
    ty=dy+ly
    tz=dz+lz
    d=1/sqrt(dx*dx+dy*dy+dz*dz)
    vx=dx*d
    vy=dy*d
    vz=dz*d
    s=(vx*nx+vy*ny+vz*nz)*2
    rx=nx*s-vx
    ry=ny*s-vy
    rz=nz*s-vz
    d=sqrt((rx*rx+ry*ry+rz*rz)/(tx*tx+ty*ty+tz*tz))
    q4=255*max((tx*rx+ty*ry+tz*rz)*d*2-1,0)
setrgb 3,f+q4,f3+q4,q4
tz=600/tz
sx=tx*tz
sy=ty*tz
    sx1=sx(p1):sy1=sy(p1)
    sx2=sx(p2):sy2=sy(p2)
    sx3=sx(p3):sy3=sy(p3)
setrgb 1,0,0,r1
setrgb 2,0,0,r2
    gtriangle sx1,sy1 to sx2,sy2 to sx,sy
setrgb 1,0,0,r3
    gtriangle sx3,sy3 to sx2,sy2 to sx,sy
setrgb 2,0,0,r1
    gtriangle sx3,sy3 to sx1,sy1 to sx,sy
clear triangle sx1,sy1 to sx2,sy2 to sx,sy
clear triangle sx3,sy3 to sx2,sy2 to sx,sy
label nopoly
  until(k=mf)
  k=0
setrgb 1,0,0,80
  repeat k=k+1
    p1=poly(k,1)
    p2=poly(k,2)
    p3=poly(k,3)
if (sx(p2)-sx(p1))*(sy(p3)-sy(p1))-(sx(p3)-sx(p1))*(sy(p2)-sy(p1))<0 goto nopoly2
    sx1=sx(p1):sy1=sy(p1)
    sx2=sx(p2):sy2=sy(p2)
    sx3=sx(p3):sy3=sy(p3)
sx=(sx1+sx2+sx3)/3
sy=(sy1+sy2+sy3)/3
triangle sx1,sy1 to sx2,sy2 to sx,sy
triangle sx3,sy3 to sx2,sy2 to sx,sy
label nopoly2
  until(k=mf)
until(1=0)
end

data 14,24
data -100,-100,-100,-100,-100,100
data 100,-100,100,100,-100,-100
data -100,100,-100,-100,100,100
data 100,100,100,100,100,-100
data -171,0,0,0,0,171,171,0,0,0,0,-171,0,171,0,0,-171,0
data 1,2,9,2,6,9,6,5,9,5,1,9
data 2,3,10,3,7,10,7,6,10,6,2,10
data 3,4,11,4,8,11,8,7,11,7,3,11
data 4,1,12,1,5,12,5,8,12,8,4,12
data 5,6,13,6,7,13,7,8,13,8,5,13
data 2,1,14,3,2,14,4,3,14,1,4,14













