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