blbates@AERO4.LARC.NASA.GOV (Bates TAD/HRNAB ms294 x2601) (03/15/88)
program solidshade
character file*80,reverse*1,type*1
integer*2 bx,by,numdev,numlights,sleep,val
integer*4 ax,ay,curentdev(0:3),dev,fovy,g,i,inorm(162,66,4),lamps
integer*4 nullwin,oldwin,rankleft,rankmid,rankright,shadesolid
integer*4 xwinlen,xwinorg,ywinlen,ywinorg
integer*4 j,k,nx(4),ny(4),nz(4)
logical bflag,btogl,cflag,ctogl,extflag,currentwin,front
logical ltemp,mflag,pflag,sflag,stogl
logical xflag,xtogl,yflag,ytogl,zflag,ztogl
real data(3,162,66,4),far,lightlen,mag,magrate
real near,nmag1,nmag2,nmag3,nmag4
real norm(3,162,66,4),normlength
real nx1,nx2,nx3,nx4,ny1,ny2,ny3,ny4,nz1,nz2,nz3,nz4
real rprate,rxrate,ryrate,rzrate,scale,tempdircos
real totdircos,totext,txrate,tyrate
real viewpnt,vx1,vx2,vx3,vx4,vy1,vy2,vy3,vy4,vz1,vz2,vz3,vz4
real xangle,xdiff,xdircos(3),xmax,xmid,xmin,xpos
real yangle,ydiff,ydircos(3),ymax,ymid,ymin,ypos
real zangle,zdircos(3),zmax,zmid,zmin
$ include /usr/include/fgl.h
$ include /usr/include/fdevice.h
call getarg(2,file)
call getarg(3,type)
call getarg(4,reverse)
if(type.eq.'b') then
open(79,file=file,form='binary')
read(79) ngrid
read(79) (nx(i),ny(i),nz(i),i=1,ngrid)
do 20 g=1,ngrid
write(*,1000) g,nx(g),g,ny(g),g,nz(g)
if(reverse.eq.'r') then
read(79)(((data(1,i,j,g),i=1,nx(g)),j=ny(g),1,-1),k=1,nz(g)),
. (((data(2,i,j,g),i=1,nx(g)),j=ny(g),1,-1),k=1,nz(g)),
. (((data(3,i,j,g),i=1,nx(g)),j=ny(g),1,-1),k=1,nz(g))
else
read(79)(((data(1,i,j,g),i=1,nx(g)),j=1,ny(g)),k=1,nz(g)),
. (((data(2,i,j,g),i=1,nx(g)),j=1,ny(g)),k=1,nz(g)),
. (((data(3,i,j,g),i=1,nx(g)),j=1,ny(g)),k=1,nz(g))
endif
if(nz(g).gt.1) then
open(80,file='out.bin',form='binary')
write(80) ngrid
write(*,1000) g,nx(g),g,ny(g),g,1
write(80) (nx(i),ny(i),1,i=1,ngrid)
write(80)((data(1,i,j,g),i=1,nx(g)),j=1,ny(g)),
. ((data(2,i,j,g),i=1,nx(g)),j=1,ny(g)),
. ((data(3,i,j,g),i=1,nx(g)),j=1,ny(g))
endif
20 continue
else
open(79,file=file,form='formatted')
read(79,*) ngrid
read(79,*) (nx(i),ny(i),nz(i),i=1,ngrid)
do 30 g=1,ngrid
write(*,1000) g,nx(g),g,ny(g),g,nz(g)
if(reverse.eq.'r') then
read(79,*)(((data(1,i,j,g),i=1,nx(g)),j=ny(g),1,-1),k=1,nz(g)),
. (((data(2,i,j,g),i=1,nx(g)),j=ny(g),1,-1),k=1,nz(g)),
. (((data(3,i,j,g),i=1,nx(g)),j=ny(g),1,-1),k=1,nz(g))
else
read(79,*)(((data(1,i,j,g),i=1,nx(g)),j=1,ny(g)),k=1,nz(g)),
. (((data(2,i,j,g),i=1,nx(g)),j=1,ny(g)),k=1,nz(g)),
. (((data(3,i,j,g),i=1,nx(g)),j=1,ny(g)),k=1,nz(g))
endif
nz(g)=1
30 continue
open(80,file='out.bin',form='binary')
write(80) ngrid
write(80) (nx(i),ny(i),nz(i),i=1,ngrid)
do 40 g=1,ngrid
write(*,1000) g,nx(g),g,ny(g),g,nz(g)
c if(g.ne.3) then
write(80)(((data(1,i,j,g),i=1,nx(g)),j=1,ny(g)),k=1,nz(g)),
. (((data(2,i,j,g),i=1,nx(g)),j=1,ny(g)),k=1,nz(g)),
. (((data(3,i,j,g),i=1,nx(g)),j=1,ny(g)),k=1,nz(g))
c else
c write(80)(((data(1,i,j,g),i=1,nx(g)),j=ny(g),1,-1),k=1,nz(g)),
c . (((data(2,i,j,g),i=1,nx(g)),j=ny(g),1,-1),k=1,nz(g)),
c . (((data(3,i,j,g),i=1,nx(g)),j=ny(g),1,-1),k=1,nz(g))
c endif
40 continue
endif
close(79)
close(80)
extflag=.true.
do 220 g=1,ngrid
do 220 i=1,nx(g)
do 220 j=1,ny(g)
x1=data(1,i,j,g)
y1=data(2,i,j,g)
z1=data(3,i,j,g)
if(i.gt.1.and.i.lt.nx(g).and.j.gt.1.and.j.lt.ny(g)) then
vx1=data(1,i+1,j,g)-x1
vy1=data(2,i+1,j,g)-y1
vz1=data(3,i+1,j,g)-z1
vx2=data(1,i,j+1,g)-x1
vy2=data(2,i,j+1,g)-y1
vz2=data(3,i,j+1,g)-z1
vx3=data(1,i-1,j,g)-x1
vy3=data(2,i-1,j,g)-y1
vz3=data(3,i-1,j,g)-z1
vx4=data(1,i,j-1,g)-x1
vy4=data(2,i,j-1,g)-y1
vz4=data(3,i,j-1,g)-z1
nx1=vy1*vz2-vz1*vy2
ny1=vz1*vx2-vx1*vz2
nz1=vx1*vy2-vy1*vx2
nmag1=sqrt(nx1*nx1+ny1*ny1+nz1*nz1)
if(nmag1.gt.0) then
nx1=nx1/nmag1
ny1=ny1/nmag1
nz1=nz1/nmag1
endif
nx2=vy2*vz3-vz2*vy3
ny2=vz2*vx3-vx2*vz3
nz2=vx2*vy3-vy2*vx3
nmag2=sqrt(nx2*nx2+ny2*ny2+nz2*nz2)
if(nmag2.gt.0) then
nx2=nx2/nmag2
ny2=ny2/nmag2
nz2=nz2/nmag2
endif
nx3=vy3*vz4-vz3*vy4
ny3=vz3*vx4-vx3*vz4
nz3=vx3*vy4-vy3*vx4
nmag3=sqrt(nx3*nx3+ny3*ny3+nz3*nz3)
if(nmag3.gt.0) then
nx3=nx3/nmag3
ny3=ny3/nmag3
nz3=nz3/nmag3
endif
nx4=vy4*vz1-vz4*vy1
ny4=vz4*vx1-vx4*vz1
nz4=vx4*vy1-vy4*vx1
nmag4=sqrt(nx4*nx4+ny4*ny4+nz4*nz4)
if(nmag4.gt.0) then
nx4=nx4/nmag4
ny4=ny4/nmag4
nz4=nz4/nmag4
endif
norm(1,i,j,g)=nx1+nx2+nx3+nx4
norm(2,i,j,g)=ny1+ny2+ny3+ny4
norm(3,i,j,g)=nz1+nz2+nz3+nz4
else if(i.eq.1.and.j.eq.ny(g)) then
vx1=data(1,i+1,j,g)-x1
vy1=data(2,i+1,j,g)-y1
vz1=data(3,i+1,j,g)-z1
vx4=data(1,i,j-1,g)-x1
vy4=data(2,i,j-1,g)-y1
vz4=data(3,i,j-1,g)-z1
nx4=vy4*vz1-vz4*vy1
ny4=vz4*vx1-vx4*vz1
nz4=vx4*vy1-vy4*vx1
nmag4=sqrt(nx4*nx4+ny4*ny4+nz4*nz4)
if(nmag4.gt.0) then
nx4=nx4/nmag4
ny4=ny4/nmag4
nz4=nz4/nmag4
endif
norm(1,i,j,g)=nx4
norm(2,i,j,g)=ny4
norm(3,i,j,g)=nz4
else if(i.eq.1.and.j.eq.1) then
vx1=data(1,i+1,j,g)-x1
vy1=data(2,i+1,j,g)-y1
vz1=data(3,i+1,j,g)-z1
vx2=data(1,i,j+1,g)-x1
vy2=data(2,i,j+1,g)-y1
vz2=data(3,i,j+1,g)-z1
nx1=vy1*vz2-vz1*vy2
ny1=vz1*vx2-vx1*vz2
nz1=vx1*vy2-vy1*vx2
nmag1=sqrt(nx1*nx1+ny1*ny1+nz1*nz1)
if(nmag1.gt.0) then
nx1=nx1/nmag1
ny1=ny1/nmag1
nz1=nz1/nmag1
endif
norm(1,i,j,g)=nx1
norm(2,i,j,g)=ny1
norm(3,i,j,g)=nz1
else if(i.eq.nx(g).and.j.eq.ny(g)) then
vx3=data(1,i-1,j,g)-x1
vy3=data(2,i-1,j,g)-y1
vz3=data(3,i-1,j,g)-z1
vx4=data(1,i,j-1,g)-x1
vy4=data(2,i,j-1,g)-y1
vz4=data(3,i,j-1,g)-z1
nx3=vy3*vz4-vz3*vy4
ny3=vz3*vx4-vx3*vz4
nz3=vx3*vy4-vy3*vx4
nmag3=sqrt(nx3*nx3+ny3*ny3+nz3*nz3)
if(nmag3.gt.0) then
nx3=nx3/nmag3
ny3=ny3/nmag3
nz3=nz3/nmag3
endif
norm(1,i,j,g)=nx3
norm(2,i,j,g)=ny3
norm(3,i,j,g)=nz3
else if(i.eq.nx(g).and.j.eq.1) then
vx2=data(1,i,j+1,g)-x1
vy2=data(2,i,j+1,g)-y1
vz2=data(3,i,j+1,g)-z1
vx3=data(1,i-1,j,g)-x1
vy3=data(2,i-1,j,g)-y1
vz3=data(3,i-1,j,g)-z1
nx2=vy2*vz3-vz2*vy3
ny2=vz2*vx3-vx2*vz3
nz2=vx2*vy3-vy2*vx3
nmag2=sqrt(nx2*nx2+ny2*ny2+nz2*nz2)
if(nmag2.gt.0) then
nx2=nx2/nmag2
ny2=ny2/nmag2
nz2=nz2/nmag2
endif
norm(1,i,j,g)=nx2
norm(2,i,j,g)=ny2
norm(3,i,j,g)=nz2
else if(i.eq.1.and.j.gt.1.and.j.lt.ny(g)) then
vx1=data(1,i+1,j,g)-x1
vy1=data(2,i+1,j,g)-y1
vz1=data(3,i+1,j,g)-z1
vx2=data(1,i,j+1,g)-x1
vy2=data(2,i,j+1,g)-y1
vz2=data(3,i,j+1,g)-z1
vx4=data(1,i,j-1,g)-x1
vy4=data(2,i,j-1,g)-y1
vz4=data(3,i,j-1,g)-z1
nx1=vy1*vz2-vz1*vy2
ny1=vz1*vx2-vx1*vz2
nz1=vx1*vy2-vy1*vx2
nmag1=sqrt(nx1*nx1+ny1*ny1+nz1*nz1)
if(nmag1.gt.0) then
nx1=nx1/nmag1
ny1=ny1/nmag1
nz1=nz1/nmag1
endif
nx4=vy4*vz1-vz4*vy1
ny4=vz4*vx1-vx4*vz1
nz4=vx4*vy1-vy4*vx1
nmag4=sqrt(nx4*nx4+ny4*ny4+nz4*nz4)
if(nmag4.gt.0) then
nx4=nx4/nmag4
ny4=ny4/nmag4
nz4=nz4/nmag4
endif
norm(1,i,j,g)=nx1+nx4
norm(2,i,j,g)=ny1+ny4
norm(3,i,j,g)=nz1+nz4
else if(i.eq.nx(g).and.j.gt.1.and.j.lt.ny(g)) then
vx2=data(1,i,j+1,g)-x1
vy2=data(2,i,j+1,g)-y1
vz2=data(3,i,j+1,g)-z1
vx3=data(1,i-1,j,g)-x1
vy3=data(2,i-1,j,g)-y1
vz3=data(3,i-1,j,g)-z1
vx4=data(1,i,j-1,g)-x1
vy4=data(2,i,j-1,g)-y1
vz4=data(3,i,j-1,g)-z1
nx2=vy2*vz3-vz2*vy3
ny2=vz2*vx3-vx2*vz3
nz2=vx2*vy3-vy2*vx3
nmag2=sqrt(nx2*nx2+ny2*ny2+nz2*nz2)
if(nmag2.gt.0) then
nx2=nx2/nmag2
ny2=ny2/nmag2
nz2=nz2/nmag2
endif
nx3=vy3*vz4-vz3*vy4
ny3=vz3*vx4-vx3*vz4
nz3=vx3*vy4-vy3*vx4
nmag3=sqrt(nx3*nx3+ny3*ny3+nz3*nz3)
if(nmag3.gt.0) then
nx3=nx3/nmag3
ny3=ny3/nmag3
nz3=nz3/nmag3
endif
norm(1,i,j,g)=nx2+nx3
norm(2,i,j,g)=ny2+ny3
norm(3,i,j,g)=nz2+nz3
else if(i.gt.1.and.i.lt.nx(g).and.j.eq.ny(g)) then
vx1=data(1,i+1,j,g)-x1
vy1=data(2,i+1,j,g)-y1
vz1=data(3,i+1,j,g)-z1
vx3=data(1,i-1,j,g)-x1
vy3=data(2,i-1,j,g)-y1
vz3=data(3,i-1,j,g)-z1
vx4=data(1,i,j-1,g)-x1
vy4=data(2,i,j-1,g)-y1
vz4=data(3,i,j-1,g)-z1
nx3=vy3*vz4-vz3*vy4
ny3=vz3*vx4-vx3*vz4
nz3=vx3*vy4-vy3*vx4
nmag3=sqrt(nx3*nx3+ny3*ny3+nz3*nz3)
if(nmag3.gt.0) then
nx3=nx3/nmag3
ny3=ny3/nmag3
nz3=nz3/nmag3
endif
nx4=vy4*vz1-vz4*vy1
ny4=vz4*vx1-vx4*vz1
nz4=vx4*vy1-vy4*vx1
nmag4=sqrt(nx4*nx4+ny4*ny4+nz4*nz4)
if(nmag4.gt.0) then
nx4=nx4/nmag4
ny4=ny4/nmag4
nz4=nz4/nmag4
endif
norm(1,i,j,g)=nx3+nx4
norm(2,i,j,g)=ny3+ny4
norm(3,i,j,g)=nz3+nz4
else if(i.gt.1.and.i.lt.nx(g).and.j.eq.1) then
vx1=data(1,i+1,j,g)-x1
vy1=data(2,i+1,j,g)-y1
vz1=data(3,i+1,j,g)-z1
vx2=data(1,i,j+1,g)-x1
vy2=data(2,i,j+1,g)-y1
vz2=data(3,i,j+1,g)-z1
vx3=data(1,i-1,j,g)-x1
vy3=data(2,i-1,j,g)-y1
vz3=data(3,i-1,j,g)-z1
nx1=vy1*vz2-vz1*vy2
ny1=vz1*vx2-vx1*vz2
nz1=vx1*vy2-vy1*vx2
nmag1=sqrt(nx1*nx1+ny1*ny1+nz1*nz1)
if(nmag1.gt.0) then
nx1=nx1/nmag1
ny1=ny1/nmag1
nz1=nz1/nmag1
endif
nx2=vy2*vz3-vz2*vy3
ny2=vz2*vx3-vx2*vz3
nz2=vx2*vy3-vy2*vx3
nmag2=sqrt(nx2*nx2+ny2*ny2+nz2*nz2)
if(nmag2.gt.0) then
nx2=nx2/nmag2
ny2=ny2/nmag2
nz2=nz2/nmag2
endif
norm(1,i,j,g)=nx1+nx2
norm(2,i,j,g)=ny1+ny2
norm(3,i,j,g)=nz1+nz2
endif
c if(y1.eq.0) norm(2,i,j,g)=0.0
normlength=sqrt(norm(1,i,j,g)*norm(1,i,j,g)+
. norm(2,i,j,g)*norm(2,i,j,g)+
. norm(3,i,j,g)*norm(3,i,j,g))
norm(1,i,j,g)=norm(1,i,j,g)/normlength
norm(2,i,j,g)=norm(2,i,j,g)/normlength
norm(3,i,j,g)=norm(3,i,j,g)/normlength
if(extflag) then
xmax=x1
xmin=x1
ymax=y1
ymin=y1
zmax=z1
zmin=z1
extflag=.false.
else
if(x1.gt.xmax) then
xmax=x1
else if(x1.lt.xmin) then
xmin=x1
endif
if(y1.gt.ymax) then
ymax=y1
else if(y1.lt.ymin) then
ymin=y1
endif
if(z1.gt.zmax) then
zmax=z1
else if(z1.lt.zmin) then
zmin=z1
endif
endif
220 continue
write(*,'(''Enter number of light sources:'',$)')
read(*,*) numlights
do 225 k=1,numlights
write(*,1010) k,k,k
read(*,*) xdircos(k),ydircos(k),zdircos(k)
225 continue
xmid=(xmax+xmin)/2.0
ymid=(ymax+ymin)/2.0
zmid=(zmax+zmin)/2.0
totext=max(abs(xmax-xmin),abs(ymax-ymin),abs(zmax-zmin))*1.25
scale=totext/875.0
curentdev(0)=0
curentdev(1)=0
curentdev(2)=0
curentdev(3)=0
fovy=200
mag=0.10
magrate=0.0
numdev=0
rankleft=0
rankmid=0
rankright=0
rxrate=0.0
ryrate=0.0
rzrate=0.0
txrate=0.0
tyrate=0.0
xangle=0.0
xpos=0.0
yangle=0.0
ypos=0.0
viewpnt=0.0
zangle=0.0
bflag=.false.
btogl=.true.
cflag=.false.
ctogl=.true.
mflag=.true.
pflag=.false.
sflag=.false.
stogl=.true.
xflag=.false.
xtogl=.true.
yflag=.true.
ytogl=.false.
zflag=.true.
ztogl=.false.
lamps=14
call lampon(lamps)
call foregr
shadesolid=winope('solidshade',5)
oldwin=winatt()
currentwin=.true.
call double
call gconfi
call qdevic(redraw)
call qdevic(bkey)
call qdevic(ckey)
call qdevic(ekey)
call qdevic(lkey)
call qdevic(mkey)
call qdevic(pkey)
call qdevic(skey)
call qdevic(xkey)
call qdevic(ykey)
call qdevic(zkey)
call qdevic(uparro)
call qdevic(downar)
call qdevic(leftmo)
call qdevic(middle)
call qdevic(rightm)
call tie(leftmo,mousex,mousey)
call tie(middle,mousex,mousey)
call tie(rightm,mousex,mousey)
call noise(mousex,2)
call noise(mousey,2)
call backfa(.true.)
print *,'Making color map'
do 230 i=768,1023
c call mapcol(i,i-768,i-768,i-768)
call mapcol(i-256,0,0,i-768)
call mapcol(i,i-768,i-768,255)
C call mapcol(i-512,0,0,i-768)
C call mapcol(i-256,0,i-768,255)
C call mapcol(i,i-768,255,255)
230 continue
call getori(xwinorg,ywinorg)
call getsiz(xwinlen,ywinlen)
240 print *,'Calculating surface shading colors'
do 245 k=1,numlights
lightlen=sqrt(xdircos(k)*xdircos(k)+ydircos(k)*ydircos(k)+
. zdircos(k)*zdircos(k))
xdircos(k)=xdircos(k)/lightlen
ydircos(k)=ydircos(k)/lightlen
zdircos(k)=zdircos(k)/lightlen
245 continue
do 250 g=1,ngrid
do 250 i=1,nx(g)
do 250 j=1,ny(g)
totdircos=0.0
do 255 k=1,numlights
tempdircos=norm(1,i,j,g)*xdircos(k)+
. norm(2,i,j,g)*ydircos(k)+
. norm(3,i,j,g)*zdircos(k)
if(tempdircos.gt.0) then
totdircos=totdircos+tempdircos
endif
255 continue
c inorm(i,j,g)=768+nint(255*totdircos)
c if(inorm(i,j,g).gt.1023) then
c inorm(i,j,g)=1023
c else if(inorm(i,j,g).lt.768) then
c inorm(i,j,g)=768
c endif
inorm(i,j,g)=512+nint(511*totdircos)
if(inorm(i,j,g).gt.1023) then
inorm(i,j,g)=1023
else if(inorm(i,j,g).lt.511) then
inorm(i,j,g)=511
endif
C inorm(i,j,g)=256+nint(767*totdircos)
C if(inorm(i,j,g).gt.1023) then
C inorm(i,j,g)=1023
C else if(inorm(i,j,g).lt.256) then
C inorm(i,j,g)=256
C endif
250 continue
call qreset
260 call frontb(.true.)
front=.true.
sleep=0
270 continue
if(bflag) call zclear
call color(black)
call clear
call pushma
viewpnt=viewpnt-magrate
xpos=xpos+txrate
ypos=ypos+tyrate
fovy=fovy+rprate
if(fovy.lt.2) then
fovy=2
else if(fovy.gt.1800) then
fovy=1800
endif
far=totext*1.5-viewpnt
if(far.le.0) then
far=totext*1.0e-4
endif
near=-viewpnt
if(near.ge.far.or.near.le.far*1.0e-3.or.near.le.0) then
near=far*1.0e-2
endif
if(bflag) then
call perspe(fovy,real(xwinlen)/real(ywinlen),near,far)
else
call perspe(fovy,real(xwinlen)/real(ywinlen),0.0,far)
endif
call lookat(viewpnt-totext,xpos,ypos,viewpnt,xpos,ypos,-900)
xangle=xangle+rxrate
yangle=yangle+ryrate
zangle=zangle+rzrate
call rot(zangle,'z')
call rot(yangle,'y')
call rot(xangle,'x')
call color(green)
call move(0.0,0.0,0.0)
call draw(10.0*scale,0.0,0.0)
call move(10.0*scale,0.0,-0.5*scale)
call draw(10.5*scale,0.0,0.5*scale)
call move(10.0*scale,0.0,0.5*scale)
call draw(10.5*scale,0.0,-0.5*scale)
call color(cyan)
call move(0.0,0.0,0.0)
call draw(0.0,10.0*scale,0.0)
call move(0.0,10.0*scale,0.5*scale)
call draw(0.0,10.25*scale,0.0)
call draw(0.0,10.25*scale,-0.5*scale)
call move(0.0,10.5*scale,0.5*scale)
call draw(0.0,10.25*scale,0.0)
call color(magent)
call move(0.0,0.0,0.0)
call draw(0.0,0.0,10.0*scale)
call move(0.25*scale,0.0,11.25*scale)
call draw(-0.25*scale,0.0,11.25*scale)
call draw(0.25*scale,0.0,10.25*scale)
call draw(-0.25*scale,0.0,10.25*scale)
call transl(-xmid,0.0,-zmid)
call color(white)
if(sflag) then
if(cflag) then
do 280 g=1,ngrid
do 280 j=1,ny(g)-1
do 280 i=1,nx(g)-1
call setsha(inorm(i,j,g))
call pmv(data(1,i,j,g),
. -data(2,i,j,g),data(3,i,j,g))
call setsha(inorm(i,j+1,g))
call pdr(data(1,i,j+1,g),
. -data(2,i,j+1,g),data(3,i,j+1,g))
call setsha(inorm(i+1,j+1,g))
call pdr(data(1,i+1,j+1,g),
. -data(2,i+1,j+1,g),data(3,i+1,j+1,g))
call setsha(inorm(i+1,j,g))
call pdr(data(1,i+1,j,g),
. -data(2,i+1,j,g),data(3,i+1,j,g))
call spclos
280 continue
endif
do 290 g=1,ngrid
do 290 j=1,ny(g)-1
do 290 i=1,nx(g)-1
call setsha(inorm(i,j,g))
call pmv(data(1,i,j,g),
. data(2,i,j,g),data(3,i,j,g))
call setsha(inorm(i+1,j,g))
call pdr(data(1,i+1,j,g),
. data(2,i+1,j,g),data(3,i+1,j,g))
call setsha(inorm(i+1,j+1,g))
call pdr(data(1,i+1,j+1,g),
. data(2,i+1,j+1,g),data(3,i+1,j+1,g))
call setsha(inorm(i,j+1,g))
call pdr(data(1,i,j+1,g),
. data(2,i,j+1,g),data(3,i,j+1,g))
call spclos
290 continue
else
if(cflag) then
do 300 g=1,ngrid
do 310 j=1,ny(g)
call move(data(1,1,j,g),
. -data(2,1,j,g),data(3,1,j,g))
do 310 i=2,nx(g)
call draw(data(1,i,j,g),
. -data(2,i,j,g),data(3,i,j,g))
310 continue
do 320 i=1,nx(g)
call move(data(1,i,1,g),
. -data(2,i,1,g),data(3,i,1,g))
do 320 j=2,ny(g)
call draw(data(1,i,j,g),
. -data(2,i,j,g),data(3,i,j,g))
320 continue
300 continue
endif
do 330 g=1,ngrid
do 340 j=1,ny(g)
call move(data(1,1,j,g),data(2,1,j,g),data(3,1,j,g))
do 340 i=2,nx(g)
call draw(data(1,i,j,g),data(2,i,j,g),data(3,i,j,g))
340 continue
do 350 i=1,nx(g)
call move(data(1,i,1,g),data(2,i,1,g),data(3,i,1,g))
do 350 j=2,ny(g)
call draw(data(1,i,j,g),data(2,i,j,g),data(3,i,j,g))
350 continue
330 continue
endif
call popmat
if(front.and.btogl) then
call frontb(.false.)
front=.false.
endif
370 if(qtest().eq.0) then
if(btogl) call swapbu
else
sleep=0
dev=qread(val)
if(dev.eq.redraw.and.val.eq.shadesolid) then
call reshap
call getori(xwinorg,ywinorg)
call getsiz(xwinlen,ywinlen)
curentdev(0)=0
curentdev(1)=0
curentdev(2)=0
curentdev(3)=0
numdev=0
rankleft=0
rankmid=0
rankright=0
magrate=0.0
rprate=0.0
rxrate=0.0
ryrate=0.0
rzrate=0.0
txrate=0.0
tyrate=0.0
call qreset
goto 260
else if(dev.eq.inptch) then
if(val.eq.shadesolid) then
curentdev(0)=0
curentdev(1)=0
curentdev(2)=0
curentdev(3)=0
numdev=0
rankleft=0
rankmid=0
rankright=0
magrate=0.0
rprate=0.0
rxrate=0.0
ryrate=0.0
rzrate=0.0
txrate=0.0
tyrate=0.0
currentwin=.true.
call qreset
goto 260
else
currentwin=.false.
endif
else if(dev.eq.uparro) then
if(val.gt.0) then
mag=mag*1.5
txrate=txrate*1.5
tyrate=tyrate*1.5
rprate=rprate*1.5
rxrate=rxrate*1.5
ryrate=ryrate*1.5
rzrate=rzrate*1.5
magrate=magrate*1.5
endif
else if(dev.eq.downar) then
if(val.gt.0) then
mag=mag/1.5
txrate=txrate/1.5
tyrate=tyrate/1.5
rprate=rprate/1.5
rxrate=rxrate/1.5
ryrate=ryrate/1.5
rzrate=rzrate/1.5
magrate=magrate/1.5
endif
else if(dev.eq.middle) then
if(val.gt.0) then
dev=qread(bx)
dev=qread(by)
if(numdev.lt.3.and.rankmid.eq.0) then
numdev=numdev+1
rankmid=numdev
curentdev(numdev)=middle
endif
else
dev=qread(bx)
dev=qread(by)
magrate=0.0
rprate=0.0
rxrate=0.0
if(numdev.gt.0) then
do 380 i=rankmid,numdev-1
curentdev(i)=curentdev(i+1)
380 continue
curentdev(numdev)=0
numdev=numdev-1
rankmid=0
endif
endif
else if(dev.eq.leftmo) then
if(val.gt.0) then
dev=qread(bx)
dev=qread(by)
if(numdev.lt.3.and.rankleft.eq.0) then
numdev=numdev+1
rankleft=numdev
curentdev(numdev)=leftmo
endif
else
dev=qread(bx)
dev=qread(by)
rzrate=0.0
ryrate=0.0
if(numdev.gt.0) then
do 390 i=rankleft,numdev-1
curentdev(i)=curentdev(i+1)
390 continue
curentdev(numdev)=0
numdev=numdev-1
rankleft=0
endif
endif
else if(dev.eq.rightm) then
if(val.gt.0) then
dev=qread(bx)
dev=qread(by)
if(numdev.lt.3.and.rankright.eq.0) then
numdev=numdev+1
rankright=numdev
curentdev(numdev)=rightm
endif
else
dev=qread(bx)
dev=qread(by)
txrate=0.0
tyrate=0.0
if(numdev.gt.0) then
do 400 i=rankright,numdev-1
curentdev(i)=curentdev(i+1)
400 continue
curentdev(numdev)=0
numdev=numdev-1
rankright=0
endif
endif
else if(dev.eq.mkey) then
if(val.gt.0) then
call lampof(15)
if(mflag) then
mflag=.false.
lamps=iand(lamps,7)
call lampon(lamps)
else
mflag=.true.
pflag=.false.
xflag=.false.
lamps=iand(lamps,14)
lamps=ior(lamps,8)
call lampon(lamps)
endif
endif
else if(dev.eq.pkey) then
if(val.gt.0) then
if(pflag) then
pflag=.false.
else
call lampof(15)
pflag=.true.
mflag=.false.
xflag=.false.
lamps=iand(lamps,6)
call lampon(lamps)
endif
endif
else if(dev.eq.bkey) then
if(val.gt.0) then
ltemp=bflag
bflag=btogl
btogl=ltemp
if(bflag) then
call single
call gconfi
call setdep($0000,$7fff)
call zbuffe(bflag)
call zclear
sleep=sleep+3
else
call zbuffe(bflag)
call double
call gconfi
endif
call backfa(.true.)
front=.true.
call qreset
goto 270
else if(bflag) then
sleep=sleep+3
call qreset
endif
else if(dev.eq.ckey) then
if(val.gt.0) then
ltemp=cflag
cflag=ctogl
ctogl=ltemp
goto 270
endif
else if(dev.eq.lkey) then
if(val.gt.0) then
call noport
nullwin=winope('null',4)
oldwin=winatt()
call winclo(nullwin)
print *,''
do 410 k=1,numlights
read(*,*) xdircos(k),ydircos(k),zdircos(k)
410 continue
call winset(shadesolid)
oldwin=winatt()
call qreset
goto 240
endif
else if(dev.eq.skey) then
if(val.gt.0) then
ltemp=sflag
sflag=stogl
stogl=ltemp
goto 270
endif
else if(dev.eq.zkey) then
if(val.gt.0) then
call lampof(15)
ltemp=zflag
zflag=ztogl
ztogl=ltemp
lamps=ieor(lamps,4)
call lampon(lamps)
endif
else if(dev.eq.ykey) then
if(val.gt.0) then
call lampof(15)
ltemp=yflag
yflag=ytogl
ytogl=ltemp
lamps=ieor(lamps,2)
call lampon(lamps)
endif
else if(dev.eq.xkey) then
if(val.gt.0) then
call lampof(15)
if(xflag) then
xflag=.false.
lamps=iand(lamps,14)
call lampon(lamps)
else
xflag=.true.
mflag=.false.
pflag=.false.
lamps=iand(lamps,7)
lamps=ior(lamps,1)
call lampon(lamps)
endif
endif
else if(dev.eq.ekey) then
call curson
call lampof(15)
stop
endif
endif
if(curentdev(numdev).ne.0) then
if(currentwin) then
ax=getval(mousex)
ay=getval(mousey)
if(ax.ne.bx.and.ay.ne.by) then
xdiff=ax-bx
ydiff=ay-by
if(ax.ge.1023) then
ax=1
call setval(mousex,ax,0,1023)
else if(ax.le.0) then
ax=1022
call setval(mousex,ax,0,1023)
endif
if(ay.ge.767) then
ay=1
call setval(mousey,ay,0,767)
else if(ay.le.0) then
ay=766
call setval(mousey,ay,0,767)
endif
bx=ax
by=ay
if(curentdev(numdev).eq.leftmo) then
if(zflag) rzrate=rzrate+xdiff*mag/50.0
if(yflag) ryrate=ryrate+ydiff*mag/50.0
else if(curentdev(numdev).eq.middle) then
if(mflag) then
magrate=magrate+ydiff*mag/10.0*scale
else if(pflag) then
rprate=rprate+xdiff*mag/40.0
else if(xflag) then
rxrate=rxrate+xdiff*mag/40.0
endif
else if(curentdev(numdev).eq.rightm) then
txrate=txrate+xdiff*mag/40.0*scale
tyrate=tyrate-ydiff*mag/40.0*scale
endif
endif
else
goto 270
endif
else
sleep=sleep+1
if(bflag) sleep=sleep+2
if(sleep.ge.3) then
sleep=3
goto 370
endif
endif
goto 270
stop
1000 format(' nx(',i1,')=',i3,' ny(',i1,')=',i3,' nz(',i1,')=',i3)
1010 format('Enter xdircos(',i1,'),ydircos(',i1,'),zdircos(',i1,'):',$)
end