SUBROUTINE INTCLP
COMMON/FREE/FUM(3),LISTST
COMMON/CLIP5/XRES,YRES
COMMON/INTENS/ITENHI,ITENLO,IBACKG,IFX1,IFY1,FIELD
COMMON/EYES/FLDVU,DUM(2),IBACK,TENHIH,TENLOW,IX,IY
COMMON/CLIP4/U2
U2=-10.**36
TENHIH=ITENHI-ITENLO
TENLOW=ITENLO-2048
IBACK=IBACKG-2048
IX=IFX1
IY=IFY1
FLDVU=FIELD/2.
FLDVU=SIND(FLDVU)/COSD(FLDVU)
LISTST=-1
XRES=(IX-1)/2.0
YRES=IY/2.0
RETURN
END
SUBROUTINE POLMAK
COMMON/FREE/POLY(1)
COMMON/CLIP1/POLYPT,ABOVL,ABOVR,BLOWL,BLOWR,HOLDU,HOLDD
1,HOLDL,HOLDR,XRGHT,YABOV,ZFRON
COMMON/CLIP2/CX,CY,CZ,CD,COLOR,SHDRUL
IMPLICIT INTEGER (A-Z)
CALL GETVAR(POLYPT,4)
POLY(POLYPT)=0
POLY(POLYPT+1)=0
POLY(POLYPT+2)=SHDRUL
POLY(POLYPT+3)=COLOR
ABOVL=.FALSE.
ABOVR=.FALSE.
BLOWL=.FALSE.
BLOWR=.FALSE.
HOLDL=.FALSE.
HOLDR=.FALSE.
HOLDU=.FALSE.
HOLDD=.FALSE.
XRGHT=.FALSE.
YABOV=.FALSE.
ZFRON=.FALSE.
IF ((CD.XOR.CX).LT.0) XRGHT=.TRUE.
IF ((CD.XOR.CY).LT.0) YABOV=.TRUE.
IF ((CD.XOR.CZ).LT.0) ZFRON=.TRUE.
RETURN
END
SUBROUTINE EDGMAK
COMMON/FREE/POLY(3),LISTST
COMMON/EYES/FLDVU,Q1(3),TENHIH
COMMON/COLOUR/IOUT(6),AA
COMMON/CLIP1/POLYPT,ABOVL,ABOVR,BLOWL,BLOWR,HOLDU,HOLDD
1,HOLDL,HOLDR,XRGHT,YABOV,ZFRON
COMMON/CLIP2/CX,CY,CZ,CD
COMMON/CLIP3/XPT1,YPT1,ZPT1,XPT2,YPT2,ZPT2,LASEDG
COMMON/CLIP4/U2
COMMON/CLIP5/XR,YR
IMPLICIT INTEGER (A-Z)
REAL CX,CY,CZ,CD,U2,T1,T2,XTEMP,YTEMP,ZTEMP,VX(8),VY(8),VZ(8)
1,XR,YR,XSLOPE,ZSLOPE,DX,DY,DZ,XPT1,YPT1,ZPT1,XPT2,YPT2,ZPT2
2,FLDVU,TENHIH,AA
DX=ZPT1*FLDVU
DY=ZPT2*FLDVU
DO 20 I=1,3,2
VX(I)=XPT1
VX(I+1)=XPT2
VY(I)=YPT1
VY(I+1)=YPT2
VZ(I)=DX
20 VZ(I+1)=DY
YB=1
YE=2
DX=VX(2)-VX(1)
DY=VY(2)-VY(1)
DZ=VZ(2)-VZ(1)
T3=0
T4=0
T1=VZ(1)-VY(1)
T2=VZ(2)-VY(2)
IF ((T1.XOR.T2).GE.0) GO TO 28
22 ZTEMP=(DY*VZ(3)-DZ*VY(3))/(DY-DZ)
YTEMP=ZTEMP
XTEMP=VX(1)+DX*T1/(T1-T2)
IF (T1.LT.0) GO TO 24
VX(4)=XTEMP
VY(4)=YTEMP
VZ(4)=ZTEMP
GO TO 26
24 VX(3)=XTEMP
VY(3)=YTEMP
VZ(3)=ZTEMP
26 IF (-XTEMP.GT.ZTEMP) ABOVL=.NOT.ABOVL
IF (ZTEMP.GE.ABS(XTEMP)) HOLDU=.NOT.HOLDU
28 T1=VZ(1)+VY(1)
T2=VZ(2)+VY(2)
IF ((T1.XOR.T2).GE.0) GO TO 38
ZTEMP=(DY*VZ(3)-DZ*VY(3))/(DY+DZ)
YTEMP=-ZTEMP
XTEMP=VX(1)+DX*T1/(T1-T2)
T1=VZ(3)+VY(3)
T2=VZ(4)+VY(4)
IF ((T1.XOR.T2).GE.0) GO TO 36
IF (T1.LT.0) GO TO 34
VX(4)=XTEMP
VY(4)=YTEMP
VZ(4)=ZTEMP
GO TO 36
34 VX(3)=XTEMP
VY(3)=YTEMP
VZ(3)=ZTEMP
36 IF (XTEMP.GT.ZTEMP) BLOWR=.NOT.BLOWR
IF (ZTEMP.GE.ABS(XTEMP)) HOLDD=.NOT.HOLDD
38 T1=VZ(1)-VX(1)
T2=VZ(2)-VX(2)
IF ((T1.XOR.T2).GE.0) GO TO 48
ZTEMP=(DX*VZ(3)-DZ*VX(3))/(DX-DZ)
XTEMP=ZTEMP
YTEMP=VY(1)+DY*T1/(T1-T2)
T1=VZ(3)-VX(3)
T2=VZ(4)-VX(4)
IF ((T1.XOR.T2).GE.0) GO TO 46
T4=1
IF (T1.LT.0) GO TO 44
VX(4)=XTEMP
VY(4)=YTEMP
VZ(4)=ZTEMP
GO TO 46
44 VX(3)=XTEMP
VY(3)=YTEMP
VZ(3)=ZTEMP
46 IF (YTEMP.GE.ZTEMP) ABOVR=.NOT.ABOVR
48 T1=VX(1)+VZ(1)
T2=VX(2)+VZ(2)
IF ((T1.XOR.T2).GE.0) GO TO 58
ZTEMP=(DX*VZ(3)-DZ*VX(3))/(DX+DZ)
XTEMP=-ZTEMP
YTEMP=VY(1)+DY*T1/(T1-T2)
T1=VX(3)+VZ(3)
T2=VX(4)+VZ(4)
IF ((T1.XOR.T2).GE.0) GO TO 56
T3=1
IF (T1.LT.0) GO TO 54
VX(4)=XTEMP
VY(4)=YTEMP
VZ(4)=ZTEMP
GO TO 56
54 VX(3)=XTEMP
VY(3)=YTEMP
VZ(3)=ZTEMP
56 IF (-YTEMP.GE.ZTEMP) BLOWL=.NOT.BLOWL
58 IF (ABS(VY(3)).GT.VZ(3)) GO TO 75
IF (ABS(VX(3)).GT.VZ(3)) GO TO 75
YB=3
IF (-VX(3).NE.VZ(3)) YB=4
IF (T3.GT.0) GO TO 68
64 YE=3
IF (VX(3).NE.VZ(3)) YE=4
IF (T4.GT.0) GO TO 70
66 YX=3
YZ=4
ASSIGN 75 TO IJMP
GO TO 90
68 IF (HOLDL) GO TO 72
HOLDL=.TRUE.
VX(5)=VX(YB)
VY(5)=VY(YB)
VZ(5)=VZ(YB)
GO TO 64
70 IF (HOLDR) GO TO 74
HOLDR=.TRUE.
VX(6)=VX(YE)
VY(6)=VY(YE)
VZ(6)=VZ(YE)
GO TO 66
72 HOLDL=.FALSE.
YX=YB
YZ=5
ASSIGN 64 TO IJMP
GO TO 90
74 HOLDR=.FALSE.
YX=YE
YZ=6
ASSIGN 66 TO IJMP
GO TO 90
75 IF (.NOT.LASEDG) RETURN
IF (.NOT.(ABOVL.OR.BLOWL.OR.ABOVR.OR.BLOWR)) GO TO 98
YX=1
YZ=2
IF (.NOT.HOLDL) GO TO 80
YZ=5
ASSIGN 80 TO IJMP
IF (ABOVL.AND.(YABOV.OR..NOT.BLOWL)) GO TO 83
YX=2
GO TO 84
80 IF (.NOT.HOLDR) GO TO 81
YX=1
YZ=6
ASSIGN 81 TO IJMP
IF (ABOVR.AND.(YABOV.OR..NOT.BLOWR)) GO TO 86
YX=2
GO TO 88
81 YX=1
YZ=2
ASSIGN 82 TO IJMP
FUDD1=.NOT.(HOLDU.OR.HOLDD).AND.ZFRON
FUDD2=((HOLDU.OR.HOLDD).AND.(.NOT.XRGHT.OR.(CX.EQ.0))).OR.FUDD1
IF (.NOT.HOLDL.AND.ABOVL.AND.BLOWL.AND.FUDD2) GO TO 83
82 IF (HOLDR) GO TO 98
YX=1
YZ=2
ASSIGN 98 TO IJMP
FUDD1=((HOLDU.OR.HOLDD).AND.(XRGHT.OR.(CX.EQ.0))).OR.FUDD1
IF (.NOT.HOLDR.AND.ABOVR.AND.BLOWR.AND.FUDD1) GO TO 86
GO TO 98
83 VX(1)=-CD/(CX-CY-CZ)
VY(1)=-VX(1)
VZ(1)=-VX(1)
IF (YZ.EQ.5) GO TO 90
84 VX(2)=-CD/(CX+CY-CZ)
VY(2)=VX(2)
VZ(2)=-VX(2)
GO TO 90
86 VX(1)=-CD/(CX+CY+CZ)
VY(1)=VX(1)
VZ(1)=VX(1)
IF (YZ.EQ.6) GO TO 90
88 VX(2)=-CD/(CX-CY+CZ)
VY(2)=-VX(2)
VZ(2)=VX(2)
90 VX(7)=(VX(YX)/VZ(YX))*XR+XR
VX(8)=(VX(YZ)/VZ(YZ))*XR+XR
VY(7)=(VY(YX)/VZ(YX))*YR+YR
VY(8)=(VY(YZ)/VZ(YZ))*YR+YR
VZ(7)=1./(VZ(YX)+1.00000002)
VZ(8)=1./(VZ(YZ)+1.00000002)
YX=7
YZ=8
92 IF (VY(7).LT.VY(8)) GO TO 94
YX=8
YZ=7
94 I1=VY(YX)
I2=VY(YZ)
IF (I1.EQ.I2) GO TO 96
IF (VZ(YX).GT.U2) U2=VZ(YX)
IF (VZ(YZ).GT.U2) U2=VZ(YZ)
IVX1=VX(YX)*1024.
IVX2=VX(YZ)*1024.
IVY1=VY(YX)*1024.
IVY2=VY(YZ)*1024.
IXSL=-(IVX1-IVX2)*1024/(IVY1-IVY2)
ZSLOPE=-(VZ(YX)-VZ(YZ))/(VY(YX)-VY(YZ))
IZSL=ZSLOPE*268435456.0
IXBEG=IVX2-IXSL*(I2*1024-IVY2)/1024
IZBEG=(VZ(YZ)-ZSLOPE*(I2-VY(YZ)))*268435456.0
CALL GETVAR(I,5)
INLIST=LISTST
IF (LISTST.LT.0) LISTST=I
NXLIST=LISTST
IF (INLIST.LT.0) GO TO 97
91 IF (NXLIST.LT.0) GO TO 95
IF (I2.GT.POLY(NXLIST+4)) GO TO 93
INLIST=NXLIST
CALL LDRPT(NXLIST,POLY(NXLIST+3))
GO TO 91
93 IF (NXLIST.EQ.INLIST) GO TO 89
CALL STRPT(I,POLY(INLIST+3))
ID=NXLIST
GO TO 99
95 CALL STRPT(I,POLY(INLIST+3))
97 ID=-1
GO TO 99
89 ID=LISTST
LISTST=I
99 POLY(I+4)=I2-1
I1=I1-I2
CALL PACK(I,POLYPT,ID,MORE,I1,IXBEG,IZBEG,IXSL,IZSL)
96 GO TO IJMP
98 AA=TENHIH/(1.1*U2)
RETURN
END
SUBROUTINE SIGNME(POLBEG,ZCOMP,NUMEDG,CX,CY,CZ,CD)
COMMON/FREE/POLY(1)
COMMON/X/X(1)/Y/Y(1)/Z/Z(1)
COMMON/EYES/A,Q(5),IFX,IFY
INTEGER POLY,POLBEG
IPOL=POLBEG+1
K=1
J=0
ZCOMP=0
6 I=-1
IF (K.GT.0) GO TO 8
CALL LDRPT(J1,POLY(IPOL))
IPOL=IPOL+1
CALL LDLPT(J2,POLY(IPOL))
GO TO 9
8 CALL LDLPT(J1,POLY(IPOL))
CALL LDRPT(J2,POLY(IPOL))
9 J3=J2
K1=J1
K2=J2
GO TO 11
10 IF (Z(J1).LT.0) GO TO 17
ZCOMP=(X(J1)/Z(J1)-X(J2)/Z(J2))*(Y(J3)/Z(J3)-Y(J4)/Z(J4))
1-(X(J3)/Z(J3)-X(J4)/Z(J4))*(Y(J1)/Z(J1)-Y(J2)/Z(J2))+ZCOMP
J=J+1
IF (J.EQ.NUMEDG) GO TO 18
J1=J3
J2=J4
J3=J4
IF (I.GT.0) GO TO 16
11 K=-K
IF (K.GT.0) GO TO 12
IPOL=IPOL+1
CALL LDLPT(J4,POLY(IPOL))
GO TO 14
12 CALL LDRPT(J4,POLY(IPOL))
14 IF (J4.LT.0) I=1
J4=IABS(J4)
GO TO 10
16 IF (I.EQ.3) GO TO 6
I=I+1
J4=K1
K1=K2
GO TO 10
17 ZCOMP=-1.0
18 C1=Y(J2)-Y(J1)
C2=Z(J4)-Z(J1)
C3=Y(J4)-Y(J1)
C4=Z(J2)-Z(J1)
C5=X(J4)-X(J1)
C6=X(J2)-X(J1)
CX=C1*C2-C3*C4
CY=C5*C4-C6*C2
CZ=C6*C3-C5*C1
CD=-X(J1)*CX-Y(J1)*CY-Z(J1)*CZ
RETURN
END
SUBROUTINE HIDDEN(PIX,STAT)
COMMON/FREE/EDGE(1)
COMMON/EYES/Q1(6),FRAMEX,FRAMEY
IMPLICIT INTEGER (A-Z)
COMMON/SCOPE/VISSEG(1024)
DIMENSION SEG(1)
EQUIVALENCE (EDGE,SEG)
DIMENSION ZS(5),SAM(2)
C INITIALIZATION.
C
EDGEPT=EDGE(4)
CALL LSTSET(11)
SEGXST=0
C SCAN LINE COMPUTATION.
IY=FRAMEY-1
204 CONTINUE
SEGCNT=0
C SCAN PREPARATION PROCESSING.
C GET EDGES AND BUILD THE SEGMENT LIST (SEG).
210 IF(EDGEPT.LT.0)GO TO 242
IF(EDGE(EDGEPT+4).LT.IY) GO TO 242
CALL UNPACK(EDGEPT,POLYPT,EDGEPT,MORE,DELY,IX,IZ,XSLOPE,ZSLOPE)
POLYPT=POLYPT*262144
CALL LDLPT(IXE,IX)
IF(IXE.LT.0.OR.IXE.GE.FRAMEX)PAUSE 'OUT OF BOUNDS #1'
SEGPT=SEGXST
PREV=0
SPLIT=.FALSE.
CALL GETBLK(I)
SEG(I+2)=0
SEG(I+1)=POLYPT
SEG(I+3)=IX
SEG(I+4)=XSLOPE
CALL STLPT(DELY,SEG(I+2))
SEG(I+8)=ZSLOPE
SEG(I+7)=IZ
214 IF(SEGPT.EQ.0)GO TO 226
CALL LDLPT(YEND1,SEG(SEGPT+2))
CALL LDRPT(YEND2,SEG(SEGPT+2))
IF(POLYPT.NE.(SEG(SEGPT+1).AND..NOT.262143))GO TO 220
TE1=IX-SEG(SEGPT+3)
IF(TE1.EQ.0)TE1=XSLOPE-SEG(SEGPT+4)
TE2=IX-SEG(SEGPT+5)
IF(TE2.EQ.0)TE2=XSLOPE-SEG(SEGPT+6)
IF(YEND1.GE.0)GO TO 217
IF(TE1.LT.0)GO TO 226
IF(SPLIT) GO TO 219
IF(YEND2.GE.0)GO TO 219
IF(TE2.GE.0)GO TO 219
SPLIT=.TRUE.
SEG(I+5)=SEG(SEGPT+5)
SEG(I+6)=SEG(SEGPT+6)
SEG(I+9)=SEG(SEGPT+9)
SEG(I+10)=SEG(SEGPT+10)
CALL STRPT(YEND2,SEG(I+2))
CALL STRPT(0,SEG(SEGPT+2))
GO TO 219
217 IF(YEND2.GE.0)GO TO 219
IF(TE2.LT.0)GO TO 226
219 PREV=SEGPT
CALL LDRPT(SEGPT,SEG(SEGPT))
GO TO 214
220 IXE=IX.AND..NOT.262143
IF(YEND1.GE.0)GO TO 221
IF((IXE-(SEG(SEGPT+3).AND..NOT.262143)).LT.0)GO TO 226
GO TO 219
221 IF(YEND2.GE.0)GO TO 219
IF((IXE-(SEG(SEGPT+5).AND..NOT.262143)).LT.0)GO TO 226
GO TO 219
226 SEG(I)=SEGPT
IF(PREV.NE.0)SEG(PREV)=I
IF(PREV.EQ.0)SEGXST=I
GO TO 210
242 IY=IY-1
SEGS2=0
SEGL2=0
SAM(2)=0
SEGACT=0
281 SAM(1)=SAM(2)
SAM(2)=FRAMEX-1
ZS(1)=0
FROM=0
SEGPT=SEGACT
SEGACT=0
301 IF (SEGPT.EQ.0) GO TO 304
NEXT=SEG(SEGPT+1).AND.262143
XLEFT=SEG(SEGPT+3)-SEG(SEGPT+4)
XRIGHT=SEG(SEGPT+5)-SEG(SEGPT+6)
ZLEFT=SEG(SEGPT+7)-SEG(SEGPT+8)
ZRIGHT=SEG(SEGPT+9)-SEG(SEGPT+10)
CALL LDLPT(IXE,XLEFT)
CALL LDLPT(IXX,XRIGHT)
IF(SAM(1).GE.IXX)GO TO 345
GO TO 315
304 SEGPT=SEGXST
IF(SEGPT.EQ.0)GO TO 350
IF(SEG(SEGPT+2).NE.0)GO TO 235
CALL LDRPT(SEGXST,SEG(SEGPT))
CALL RETBLK(SEGPT)
GO TO 304
235 IF(SEG(SEGPT+2).LT.0)GO TO 236
CALL STLPT(SEG(SEGPT+2),SEG(SEGPT+2))
CALL STRPT(0,SEG(SEGPT+2))
SEG(SEGPT+3)=SEG(SEGPT+5)
SEG(SEGPT+4)=SEG(SEGPT+6)
SEG(SEGPT+7)=SEG(SEGPT+9)
SEG(SEGPT+8)=SEG(SEGPT+10)
236 CALL LDLPT(IXE,SEG(SEGPT+3))
IF(SAM(2).LT.IXE)GO TO 350
FROM=-1
CALL LDRPT(YEND2,SEG(SEGPT+2))
IF(YEND2.LT.0)GO TO 305
POLYPT=SEG(SEGPT+1).AND..NOT.262143
CALL LDRPT(NEXT,SEG(SEGPT))
237 IF(NEXT.EQ.0)GO TO 241
IF((SEG(NEXT+1).AND..NOT.262143).NE.POLYPT)GO TO 239
CALL LDLPT(YEND1,SEG(NEXT+2))
IF (YEND1.GE.0) GO TO 238
CALL STRPT(YEND1,SEG(SEGPT+2))
CALL STLPT(0,SEG(NEXT+2))
SEG(SEGPT+5)=SEG(NEXT+3)
SEG(SEGPT+6)=SEG(NEXT+4)
SEG(SEGPT+9)=SEG(NEXT+7)
SEG(SEGPT+10)=SEG(NEXT+8)
GO TO 305
238 CALL LDRPT(YEND2,SEG(NEXT+2))
IF (YEND2.GE.0) GO TO 239
CALL STRPT(YEND2,SEG(SEGPT+2))
SEG(NEXT+2)=0
SEG(SEGPT+5)=SEG(NEXT+5)
SEG(SEGPT+6)=SEG(NEXT+6)
SEG(SEGPT+9)=SEG(NEXT+9)
SEG(SEGPT+10)=SEG(NEXT+10)
GO TO 305
239 CALL LDRPT(NEXT,SEG(NEXT))
GO TO 237
241 PAUSE 'UNCLOSED POLYGON'
SEG(SEGPT+5)=SEG(SEGPT+3)
SEG(SEGPT+6)=SEG(SEGPT+4)
CALL STRPT(-1,SEG(SEGPT+2))
305 CALL LDRPT(SEGXST,SEG(SEGPT))
XLEFT=SEG(SEGPT+3)
XRIGHT=SEG(SEGPT+5)
ZLEFT=SEG(SEGPT+7)
ZRIGHT=SEG(SEGPT+9)
CALL LDLPT(IXX,XRIGHT)
SEG(SEGPT+3)=SEG(SEGPT+3)+SEG(SEGPT+4)
SEG(SEGPT+5)=SEG(SEGPT+5)+SEG(SEGPT+6)
SEG(SEGPT+7)=SEG(SEGPT+7)+SEG(SEGPT+8)
SEG(SEGPT+9)=SEG(SEGPT+9)+SEG(SEGPT+10)
CALL LDLPT(YEND1,SEG(SEGPT+2))
CALL LDRPT(YEND2,SEG(SEGPT+2))
YEND1=YEND1+1
YEND2=YEND2+1
CALL STLPT(YEND1,SEG(SEGPT+2))
CALL STRPT(YEND2,SEG(SEGPT+2))
IF(SEG(SEGPT+2).NE.0)GO TO 3091
CALL RETBLK(SEGPT)
GO TO 312
C BACK POINTERS NEEDED ON NEW LIST.
3091 CALL LDLPT(IX,SEG(SEGPT+3))
IF(YEND1.GE.0)CALL LDLPT(IX,SEG(SEGPT+5))
IF (IX.LT.0.OR.IX.GE.FRAMEX)PAUSE 'OUT OF BOUNDS #2'
S2=0
S1=SEGL2
3092 IF(S1.EQ.0)GO TO 3094
CALL LDLPT(IX1,SEG(S1+3))
IF(SEG(S1+2).GE.0)CALL LDLPT(IX1,SEG(S1+5))
IF(IX.GE.IX1)GO TO 3094
S2=S1
CALL LDLPT(S1,SEG(S1))
GO TO 3092
3094 IF(S2.NE.0)SEG(SEGPT)=S2
CALL STLPT(S1,SEG(SEGPT))
IF(S2.NE.0)CALL STLPT(SEGPT,SEG(S2))
IF(S2.EQ.0)SEGL2=SEGPT
IF(S1.NE.0)CALL STRPT(SEGPT,SEG(S1))
IF(S1.EQ.0)SEGS2=SEGPT
312 IF (IXE.GE.IXX) GO TO 345
315 CONTINUE
C ADDITION TIME ONE.
ABLLE=.FALSE.
ABRLE=.FALSE.
IF(SAM(1).GE.IXE)ABLLE=.TRUE.
IF(SAM(2).GE.IXX)ABRLE=.TRUE.
XLCLIP=SAM(1)
IF(.NOT.ABLLE)XLCLIP=IXE
XRCLIP=SAM(2)
IF(ABRLE)XRCLIP=IXX
J0BOX=.FALSE.
JBOXES=.TRUE.
XLEFT=XLEFT/256
XRIGHT=XRIGHT/256
ZLEFT=ZLEFT/256
ZRIGHT=ZRIGHT/256
DELNEW=(IXX-IXE)*1024
ADJNEW=.FALSE.
IF(ZLEFT.LT.ZRIGHT)ADJNEW=.TRUE.
IF((ZS(1).EQ.0).AND..NOT.ABLLE)GO TO 335
IF(IXE.GE.SAM(2))GO TO 335
JBOXES=.FALSE.
IF((ZS(1).EQ.0).AND.ABLLE)GO TO 3311
DEL=DELNEW
IF(DELNEW.LT.ZSDEL)DEL=ZSDEL
XAMXL=XLEFT-(XLCLIP+1)*1024
XBMXL=XRIGHT-(XLCLIP+1)*1024
XAMXR=XLEFT-XRCLIP*1024
XBMXR=XRIGHT-XRCLIP*1024
ZAL=ZLEFT
ZBL=ZRIGHT
ZAR=ZLEFT
ZBR=ZRIGHT
IF(ADJNEW)GO TO 320
ZBL=ZLEFT
ZAL=ZRIGHT
ZBR=ZLEFT
ZAR=ZRIGHT
320 XCMXL=ZS(2)-(XLCLIP+1)*1024
XDMXL=ZS(3)-(XLCLIP+1)*1024
XCMXR=ZS(2)-XRCLIP*1024
XDMXR=ZS(3)-XRCLIP*1024
ZCL=ZS(4)
ZDL=ZS(5)
ZCR=ZS(4)
ZDR=ZS(5)
ABBCKL=.FALSE.
ABBCKR=.FALSE.
CDBCKL=.FALSE.
CDBCKR=.FALSE.
DELZ=.FALSE.
C CLIP STATE *** ONE ADD TIME EACH PASS.
323 CONTINUE
XHOLDL=(XAMXL+XBMXL)/2
ZHOLDL=(ZAL+ZBL)/2
XHOLDR=(XAMXR+XBMXR)/2
ZHOLDR=(ZAR+ZBR)/2
XTEMPL=(XCMXL+XDMXL)/2
ZTEMPL=(ZCL+ZDL)/2
XTEMPR=(XCMXR+XDMXR)/2
ZTEMPR=(ZCR+ZDR)/2
DEL=DEL/2
C %%%%
IF(ZAL-ZDL.GE.0)CDBCKL=.TRUE.
IF(ZCL-ZBL.GE.0)ABBCKL=.TRUE.
IF(ZAR-ZDR.GE.0)CDBCKR=.TRUE.
IF(ZCR-ZBR.GE.0)ABBCKR=.TRUE.
IF(DEL.EQ.0)DELZ=.TRUE.
JCLIP=.NOT.((ABBCKL.AND.ABBCKR).OR.(CDBCKL.AND.CDBCKR)
1.OR.DELZ.OR.(.NOT.ABLLE.AND..NOT.ABBCKL.AND.CDBCKL))
IF(JCLIP)GO TO 325
J0BOX=((ABBCKL.AND.ABBCKR).OR.(ABBCKL.AND.
1.NOT.CDBCKR.AND.DELZ).OR.(ABBCKR.AND..NOT.CDBCKL.AND.DELZ)
2.OR.(.NOT.CDBCKL.AND..NOT.CDBCKR.AND.DELZ))
IF(J0BOX)GO TO 335
J1BOX=ABLLE.AND.((.NOT.ABBCKL.AND.CDBCKL.AND.CDBCKR).OR.
1(.NOT.ABBCKR.AND.CDBCKL.AND.CDBCKR).OR.(.NOT.ABBCKL.AND.
1.NOT.ABBCKR.AND.DELZ.AND.(CDBCKL.OR.CDBCKR)))
IF(J1BOX)GO TO 3311
JINTER=(DELZ.AND.((ABBCKL.AND..NOT.CDBCKL.AND..NOT.ABBCKR.AND.
1CDBCKR).OR.(.NOT.ABBCKL.AND.CDBCKL.AND.ABBCKR
2.AND..NOT.CDBCKR.AND.ABLLE)))
IF(JINTER)GO TO 326
JBOXES=.TRUE.
GO TO 335
C JBOXES=.NOT.ABLLE.AND.((.NOT.ABBCKL.AND.CDBCKL).OR.(.NOT.
C 1ABBCKR.AND.CDBCKL.AND.CDBCKR).OR.(.NOT.ABBCKL.AND..NOT.
C 1ABBCKR.AND.CDBCKR.AND.DELZ))
325 IF(XHOLDL.GE.0)XBMXL=XHOLDL
IF(XHOLDL.GE.0.AND.ADJNEW)ZBL=ZHOLDL
IF(XHOLDL.GE.0.AND.(.NOT.ADJNEW))ZAL=ZHOLDL
IF(XHOLDL.LT.0)XAMXL=XHOLDL
IF(XHOLDL.LT.0.AND.ADJNEW)ZAL=ZHOLDL
IF(XHOLDL.LT.0.AND.(.NOT.ADJNEW))ZBL=ZHOLDL
IF(XHOLDR.GE.0)XBMXR=XHOLDR
IF(XHOLDR.GE.0.AND.ADJNEW)ZBR=ZHOLDR
IF(XHOLDR.GE.0.AND.(.NOT.ADJNEW))ZAR=ZHOLDR
IF(XHOLDR.LT.0)XAMXR=XHOLDR
IF(XHOLDR.LT.0.AND.ADJNEW)ZAR=ZHOLDR
IF(XHOLDR.LT.0.AND.(.NOT.ADJNEW))ZBR=ZHOLDR
IF(XTEMPL.GE.0)XDMXL=XTEMPL
IF(XTEMPL.GE.0.AND.ADJOLD)ZDL=ZTEMPL
IF(XTEMPL.GE.0.AND.(.NOT.ADJOLD))ZCL=ZTEMPL
IF(XTEMPL.LT.0)XCMXL=XTEMPL
IF(XTEMPL.LT.0.AND.ADJOLD)ZCL=ZTEMPL
IF(XTEMPL.LT.0.AND.(.NOT.ADJOLD))ZDL=ZTEMPL
IF(XTEMPR.GE.0)XDMXR=XTEMPR
IF(XTEMPR.GE.0.AND.ADJOLD)ZDR=ZTEMPR
IF(XTEMPR.GE.0.AND.(.NOT.ADJOLD))ZCR=ZTEMPR
IF(XTEMPR.LT.0)XCMXR=XTEMPR
IF(XTEMPR.LT.0.AND.ADJOLD)ZCR=ZTEMPR
IF(XTEMPR.LT.0.AND.(.NOT.ADJOLD))ZDR=ZTEMPR
GO TO 323
326 XAMXL=(XLCLIP+1)*1024
XBMXL=XRCLIP*1024
C %%%%
IF(CDBCKL)ZAL=ZAL-ZDL
IF(ABBCKL)ZAL=ZCL-ZBL
IF(CDBCKR)ZBL=ZCR-ZBR
IF(ABBCKR)ZBL=ZAR-ZDR
327 ZHOLDL=(ZAL+ZBL)/2
XHOLDL=(XAMXL+XBMXL)/2
IF(((XAMXL.XOR.XBMXL).AND..NOT.1023).EQ.0)GO TO 328
IF(ZHOLDL.GE.0)XAMXL=XHOLDL
IF(ZHOLDL.LT.0)XBMXL=XHOLDL
IF(ZHOLDL.GE.0)ZAL=ZHOLDL
IF(ZHOLDL.LT.0)ZBL=ZHOLDL
GO TO 327
328 SAM(2)=XAMXL/1024
IF(CDBCKL)GO TO 3312
GO TO 335
C MAKE A ONE ELEMENT BOX.
3311 IF(ABRLE)SAM(2)=IXX
3312 ZS(1)=SEGPT
ZS(2)=XLEFT
ZS(3)=XRIGHT
IF(ADJNEW)ZS(4)=ZLEFT
IF(.NOT.ADJNEW)ZS(4)=ZRIGHT
IF(ADJNEW)ZS(5)=ZRIGHT
IF(.NOT.ADJNEW)ZS(5)=ZLEFT
ADJOLD=ADJNEW
ZSDEL=DELNEW
335 CONTINUE
IF(J0BOX.AND.ABRLE) GO TO 345
CALL STRPT(SEGACT,SEG(SEGPT+1))
SEGACT=SEGPT
IF(JBOXES)SAM(2)=IXE
345 SEGPT=NEXT
IF(FROM.EQ.0)GO TO 301
GO TO 304
C OUTPUT SEGMENTS.
350 CONTINUE
IF(SEGCNT.EQ.0)GO TO 372
IF(ZS(1).NE.PRESEG)GO TO 372
GO TO 374
372 SEGCNT=SEGCNT+1
PRESEG=ZS(1)
374 VISSEG(SEGCNT)=SAM(2)
CALL STLPT(ZS(1),VISSEG(SEGCNT))
IF(SAM(2).NE.FRAMEX-1)GO TO 281
C BACK POINTER NOT NEEDED NOW.
IF(SEGL2.NE.0)SEG(SEGL2)=0
SEGXST=SEGS2
IF(PIX.NE.0)CALL SHOW
IF(IY.GE.0)GO TO 204
RETURN
END
SUBROUTINE SHOW
COMMON /FREE/POLY(1)
COMMON /EYES/XE,YE,ZE,IBACK,TENHIH,TENLOW,FRAMEX,FRAMEY
COMMON /COLOUR/IOUT(6),A
COMMON /SCOPE/SEGMNT(0/1023)
COMMON/FREE3/DUM1(4),MODE
EQUIVALENCE (POLY,RPOLY)
DIMENSION D(2),RPOLY(1),COL(4)
INTEGER FRAMEX,FRAMEY,SEGMNT,POLY
ISEG=-1
1 ISEG=ISEG+1
CALL LDRPT(IXEND,SEGMNT(ISEG))
IF (IXEND.NE.FRAMEX-1) GO TO 1
2 CALL LDLPT(NSEG,SEGMNT(ISEG))
IXSTRT=0
IF (ISEG.LE.0) GO TO 3
ISEG=ISEG-1
CALL LDRPT(IXSTRT,SEGMNT(ISEG))
IXSTRT=IXSTRT+1
3 IF (NSEG.EQ.0) GO TO 10
CALL LDLPT(IPOLY,POLY(NSEG+1))
I=POLY(IPOLY+3).AND.511
COL(1)=I/511.0
I=POLY(IPOLY+3).AND.261632
COL(2)=I/261632.0
I=POLY(IPOLY+3).AND.133955584
COL(3)=I/133955584.0
CALL LDLPT(I,POLY(IPOLY+3))
I=I.AND.261632
COL(4)=I/261632.0
XP=IXSTRT
XL=POLY(NSEG+3)/262144.0
XR=POLY(NSEG+5)/262144.0
ZL=POLY(NSEG+7)/68719476736.0
ZR=POLY(NSEG+9)/68719476736.0
ZN=(ZL-ZR)/(XL-XR)
DO 7 I=1,2
D(I)=0
JK=1
IF(MODE.NE.0)JK=MODE
ZZ=(ZN*(XP-XR)+ZR)*A
CC=RPOLY(IPOLY+2)*ZZ
C=COL(4)*ZZ*(RPOLY(IPOLY+2)**3)
5 CCC=COL(JK)*CC
IF(C.GT.CCC)CCC=C
D(I)=D(I)+CCC
IF(MODE.NE.0)GO TO 6
JK=JK+1
IF(JK.LE.3)GO TO 5
D(I)=D(I)/3.
6 CONTINUE
7 XP=IXEND
DELTA=(D(2)-D(1))/(IXEND-IXSTRT)
D(1)=D(1)-DELTA+TENLOW
DO 8 J=IXSTRT,IXEND
D(1)=D(1)+DELTA
SEGMNT(J)=D(1)
8 CONTINUE
GO TO 12
10 DO 11 J=IXSTRT,IXEND
SEGMNT(J)=IBACK
11 CONTINUE
12 IXEND=IXSTRT-1
IF (IXEND.GE.0) GO TO 2
CALL SHOWLN
RETURN
END
SUBROUTINE INFREE(I,LENGTH)
COMMON/CORE/FREEST,LEN,FREEPT/FREE/FREE(1)
IMPLICIT INTEGER (A-Z)
IF(I.LE.0)GO TO 2
DO 1 K=1,I
1 FREE(K)=0
2 LEN=LENGTH
FREEST=1+I
RETURN
END
SUBROUTINE GETVAR(INDEX,LENGTH)
COMMON/CORE/FREEST,LEN,FREEPT
IMPLICIT INTEGER (A-Z)
INDEX=FREEST
FREEST=FREEST+LENGTH
IF(FREEST.LT.LEN)RETURN
TYPE 2
CALL EXIT
2 FORMAT(' NOT ENOUGH STORAGE ALLOCATED.')
END
SUBROUTINE LSTSET(N)
COMMON/CORE/FREEST,LEN,FREEPT/FREE/FREE(1)
IMPLICIT INTEGER (A-Z)
FREEPT=0
K=LEN-N+1
IF(K.LT.FREEST)RETURN
FREEPT=FREEST
DO 1 I=FREEST,K,N
M=I
1 FREE(I)=I+N
FREE(M)=0
RETURN
END
SUBROUTINE GETBLK(INDEX)
COMMON/CORE/FREEST,LEN,FREEPT/FREE/FREE(1)
IMPLICIT INTEGER (A-Z)
IF(FREEPT.EQ.0)GO TO 1
INDEX=FREEPT
FREEPT=FREE(FREEPT)
RETURN
1 TYPE 2
CALL EXIT
2 FORMAT(' NOT ENOUGH STORAGE ALLOCATED.')
END
SUBROUTINE RETBLK(INDEX)
COMMON/CORE/FREEST,LEN,FREEPT/FREE/FREE(1)
IMPLICIT INTEGER (A-Z)
FREE(INDEX)=FREEPT
FREEPT=INDEX
RETURN
END
SUBROUTINE SETPT(I)
COMMON/CORE/FREEST
IF (I.EQ.1) SAVEPT=FREEST
IF (I.EQ.2) FREEST=SAVEPT
RETURN
END
TITLE SUBS3
INTERN LDLPT,LDRPT,KEY,STLPT,STRPT,SHOWAD,TRPSET
;SUBROUTINE LDLPT(PT,WORD) LOADS LEFT HALF OF WORD INTO PT.
LDLPT: 0
HLRE 0,@1(16)
MOVEM 0,@0(16)
JRA 16,2(16)
;SUBROUTINE LDRPT(PT,WORD) LOADS RIGHT HALF OF WORD INTO PT.
LDRPT: 0
HRRE 0,@1(16)
MOVEM 0,@0(16)
JRA 16,2(16)
;SUBROUTINE STLPT(PT,WORD) STORES PT INTO LEFT HALF OF WORD.
STLPT: 0
MOVE 0,@0(16)
HRLM 0,@1(16)
JRA 16,2(16)
;SUBROUTINE STRPT(PT,WORD) STORES PT INTO RIGHT HALF OF WORD.
STRPT: 0
MOVE 0,@0(16)
HRRM 0,@1(16)
JRA 16,2(16)
KEY: 0
RSW @0(16)
JRA 16,1(16)
HTABLE: 103002000000
030000055000
55000
122001000000
37770
77770
200000037770
122001000000
0
0
200000077770
122001000000
0
0
200000000000
INTERN SHOWAD
SHOWAD: 0
JSA 16,TRPSET
CONO 400,440000
LOOPMH: MOVSI 1,-17
HRRI 1,HTABLE
DATAO 400,(1)
MOVEI 2,4
SOJG 2,.
AOBJN 1,.-3
MOVE 1,FRAMEX
MOVEI 2,77770
IDIV 2,1
HRLZI 3,122002
HRLZI 4,200000
MOVEI 5,SCOPE+1
LOOPH: MOVE 1,(5)
ADDI 1,4000
LSH 1,3
HRRM 1,4
DATAO 400,3
DATAO 400,4
AOS 5
ADD 3,2
CAMG 3,[122002077770]
JRST LOOPH
DATAI 0,1
TRNE 1,1
JRST LOOPMH
JRA 16,(16)
TRPSET: 0
SETZM 0
CALLI 0,36
JRA 16,(16)
SETZM 0
CALLI 0,25
CALLI 12
JRA 16,(16)
INTERN SETSCP,SHOWLN,SETADG,PACK,UNPACK
EXTERN EYES,SCOPE,FREE,X,Y,Z
FRAMEX=EYES+6
FRAMEY=EYES+7
SCOPEM: BLOCK 1
DELX: BLOCK 1
DELY: BLOCK 1
GP10=420
SETSCP: 0
JSA 16,TRPSET
MOVE 1,FRAMEX
SUBI 1,1
ANDI 1,7777
MOVE 0,[400000000000]
LSHC 0,-1
JUMPN 1,.-1
LSH 0,1
MOVEM 0,DELX
MOVE 1,FRAMEY
SUBI 1,1
ANDI 1,7777
MOVE 0,[100000000]
LSHC 0,-1
JUMPN 1,.-1
MOVEM 0,DELY
MOVE 0,[377737774000]
MOVEM 0,SCOPEM
CONO GP10,7000
DATAO GP10,0
JRA 16,0(16)
SHOWLN: 0
MOVE 1,FRAMEX
CONO GP10,5000
MOVE 0,SCOPEM
CONO APR,1000
DATAO GP10,0
CONSO APR,1000
JRST .-2
CONSO GP10,400000
JRST .-5
JRST LOOP+1
LOOP: SUB 0,DELX
DATAO GP10,0
MOVEI 2,12
HRR 0,SCOPE-1(1)
DATAO GP10,0
SOJGE 2,.
HRRI 0,4000
DATAO GP10,0
SOJN 1,LOOP
MOVE 0,SCOPEM
CONO GP10,7000
SUB 0,DELY
TLO 0,100
MOVEM 0,SCOPEM
DATAO GP10,0
JRA 16,0(16)
POLYST=FREE+1
POLY=FREE
NUM1: BLOCK 1
DIR: BLOCK 1
FIRST: BLOCK 1
LR=5
INIT=6
TERM=7
POLNXT=10
IX1=3
DATA=IX1+1
POLYPT=1
SETADG: 0
JSA 16,TRPSET
CONO 400,440000
DATAO 400,[103002000000]
DATAO 400,[30000055000]
DATAO 400,[55000]
DATAO 400,[102001000000]
DATAO 400,[103006000000]
DATAO 400,[121002077770]
DATAO 400,[77770]
DATAO 400,[0]
DATAO 400,[341200000000]
TOP: MOVE POLNXT,POLYST
JUMPE POLNXT,OUT
MOVE POLYPT,POLNXT
HRRZ POLNXT,POLY-1(POLNXT)
HLRZ 5,POLY-1(POLYPT)
MOVEM 5,NUM1
SETO LR,
SETO INIT,
RESET: SETCA INIT,
SOSGE NUM1
JRST TOP+1
JUMPN LR,.+3
HRRE TERM,POLY-1(POLYPT)
JRST .+3
AOJ POLYPT,
HLRE TERM,POLY-1(POLYPT)
SETCA LR,
JUMPN INIT,NEWLIN
MOVEM TERM,FIRST
; ****SET DIRECTIVE FOR LOADING SAVEPOINT****
MOVEI 2,341600
MOVEM 2,DIR
NEWLIN: CONSO 400,20000
JRST .-1
MOVM 2,TERM
MOVE IX1,X-1(2)
MULI IX1,400
TSC IX1,IX1
ASH DATA,-243(IX1)
HRLI DATA,20000
DATAO 400,DATA
MOVE IX1,Y-1(2)
MULI IX1,400
TSC IX1,IX1
ASH DATA,-243(IX1)
HRRZI DATA,(DATA)
DATAO 400,DATA
MOVE IX1,Z-1(2)
FMPR IX1,EYES
MULI IX1,400
TSC IX1,IX1
ASH DATA,-243(IX1)
HRRZI DATA,(DATA)
DATAO 400,DATA
HRL DATA,DIR
DATAO 400,DATA
;*****SET DIRECTIVE FOR LOADING ACC AND CLIPPING***
; *****THEN HAVE CLIPPER SAVE NEW PT IN SAVEPT**
MOVEI 2,342700
MOVEM 2,DIR
JUMPE INIT,RESET
CAMN TERM,FIRST
JRST RESET
JUMPGE TERM,RESET+1
MOVE TERM,FIRST
JRST NEWLIN
OUT: RSW DATA
JUMPL DATA,TOP
JRA 16,0(16)
; SUBROUTINE PACK(EDGEPT,POLYPT,NEXTEDG,MORE,DELY
; ,XBEG,ZBEG,XSLOPE,XSLOPE)
PACK: BLOCK 1
MOVE 2,@0(16)
MOVE 0,@10(16)
MOVE 1,@6(16)
LSH 1,10
LSHC 0,10
MOVEM 0,FREE-1(2)
LSHC 0,24
MOVE 1,@7(16)
LSH 1,20
LSHC 0,20
MOVEM 0,FREE(2)
LSHC 0,4
MOVE 1,@5(16)
LSH 1,20
LSHC 0,24
MOVE 1,@4(16)
LSH 1,31
LSHC 0,13
MOVE 1,@3(16)
LSHC 0,1
MOVEM 0,FREE+1(2)
MOVE 0,@2(16)
HRL 0,@1(16)
MOVEM 0,FREE+2(2)
JRA 16,11(16)
; SUBROUTINE UNPACK(EDGEPT,POLYPT,NEXTEDG,MORE,DELY
; ,XBEG,ZBEG,XSLOPE,ZSLOPE)
UNPACK: BLOCK 1
MOVE 2,@0(16)
MOVE 0,FREE+2(2)
HLREM 0,@1(16)
HRREM 0,@2(16)
MOVE 0,FREE+1(2)
SETZ 1,
LSHC 0,-1
MOVEM 1,@3(16)
LSHC 0,-13
ASH 1,-31
MOVEM 1,@4(16)
SETZ 1,
LSHC 0,-24
LSH 1,-10
MOVEM 1,@5(16)
SETZ 1,
LSHC 0,-4
MOVE 0,FREE(2)
LSHC 0,-20
ASH 1,-10
MOVEM 1,@7(16)
SETZ 1,
LSHC 0,-24
MOVE 0,FREE-1(2)
LSHC 0,-10
LSH 0,10
MOVEM 1,@6(16)
MOVEM 0,@10(16)
JRA 16,11(16)
INTERN ICHAR,PUTINW
ICHAR: 0
MOVEM 1,TEMP#
MOVE 0,@0(16)
MOVE 1,@1(16)
IMULI 1,7
SUBI 1,^D36
LSH 0,0(1)
ANDI 0,177
MOVE 1,TEMP
JRA 16,2(16)
PUTINW: 0
MOVEM 0,TEMP
MOVEM 1,T1#
MOVE 0,@0(16)
MOVE 1,@1(16)
IMULI 1,-7
ADDI 1,^D36
LSH 0,0(1)
ORM 0,@2(16)
MOVE 0,TEMP
MOVE 1,T1
JRA 16,3(16)
END
TITLE KKK
ENTRY ICHAR,PUTINW
ICHAR: 0
MOVEM 1,TEMP#
MOVE 0,@0(16)
MOVE 1,@1(16)
IMULI 1,7
SUBI 1,^D36
LSH 0,0(1)
ANDI 0,177
MOVE 1,TEMP
JRA 16,2(16)
PUTINW: 0
MOVEM 0,TEMP
MOVEM 1,T1#
MOVE 0,@0(16)
MOVE 1,@1(16)
IMULI 1,-7
ADDI 1,^D36
LSH 0,0(1)
ORM 0,@2(16)
MOVE 0,TEMP
MOVE 1,T1
JRA 16,3(16)
END