CS$========================================================================
CS$                               GIS.FOR
CS$	DATE: December 1987			AUTHOR: Clif Collins
CS$						 PHONE: (713) 682-1556
CS$					       COMPANY: COLLINS SOFTWARE
CS$------------------------------------------------------------------------
CS$	COPYRIGHT (C) 1987, COLLINS SOFTWARE, HOUSTON, TEXAS
CS$ 	ALL RIGHT RESERVED.
CS$
CS$	THIS SOFTWARE MAY NOT BE PROVIDED OR OTHERWISE MADE AVAILABLE
CS$	TO ANY OTHER PERSON OR COMPANY.
CS$
CS$	NO TITLE OF OWNERSHIP OF THIS SOFTWARE IS HEREBY TRANSFERRED.
CS$========================================================================
C				CLL$BEGIN
C+	begin center line expand of an element
C==========================================================================
	LOGICAL *4 FUNCTION CLL$BEGIN(GE)
	INCLUDE 'CLL.DEF'
	RECORD /GIS_DEF/ GE
	RECORD /GIS_LIN/ LIN1,LIN2,TLIN
	RECORD /GIS_ARC/ ARC1,ARC2,TARC
	REAL *8 GIS$SWEEP
	LOGICAL *4 STATUS
	LOGICAL *4 GIS$LIN_PARM,GIS$EXPAND_LIN
	LOGICAL *4 GIS$ARC_PARM,GIS$EXPAND_ARC

	U(1).SIZE = 0
	U(2).SIZE = 0

	UNIT = 0
	CLL$BEGIN = GIS$_FAIL

	U(1).WIDTH = GE.SI.WIDTH
	U(2).WIDTH = GE.SI.WIDTH
	WIDTH = GE.SI.WIDTH
	IF (WIDTH .LE. 0) RETURN

	IF (GE.TYPE .EQ. GIS$C_LIN) GO TO 10
	IF (GE.TYPE .EQ. GIS$C_ARC) GO TO 20
	IF (GE.TYPE .EQ. GIS$C_CIR) GO TO 30
	RETURN
C----------------------------------------------------------------------
C				LINE
C----------------------------------------------------------------------
10	CONTINUE
	STATUS = GIS$LIN_PARM(GE)
	IF (.NOT. STATUS) RETURN

	UNIT = C$LINE

	UP.XORG   = GE.LIN.PNT1.X
	UP.YORG   = GE.LIN.PNT1.Y
	UP.ANGLE  = GE.LIN.PM.ANGLE
	UP.LENGTH = GE.LIN.PM.LENGTH

	TLIN = GE.LIN
	CALL CLL$MAP_LIN(TLIN)

	LIN(1).PM.SET = .FALSE.
	LIN(2).PM.SET = .FALSE.
	CLL$BEGIN = GIS$EXPAND_LIN(TLIN,LIN(1),LIN(2),WIDTH)
	IF (.NOT. CLL$BEGIN) RETURN

	CALL CLL$STORE(1,LIN(1).PNT1,LIN(1).PNT2,ORIGIN)  ! STORE END POINTS
	CALL CLL$STORE(2,LIN(2).PNT1,LIN(2).PNT2,ORIGIN)
	RETURN
C----------------------------------------------------------------------
C				ARC
C----------------------------------------------------------------------
20	CONTINUE
	UP.XORG   = GE.ARC.CENTER.X
	UP.YORG   = GE.ARC.CENTER.Y
	UP.ANGLE  = GE.ARC.EDIR
	UP.SWEEP  = GE.ARC.SWEEP
	UP.REV    = GE.ARC.REV

	CLL$BEGIN = GIS$EXPAND_ARC(GE,ARC(1),ARC(2),WIDTH)
	IF (.NOT. CLL$BEGIN) RETURN

	UNIT = C$ARC
	DEG1 = GE.ARC.EDIR
	DEG2 = GE.ARC.SDIR

	IF (ARC(1).TYPE .NE. 0) CALL CLL$STORE_ARC(1,DEG1,DEG2,ORIGIN)
	IF (ARC(2).TYPE .NE. 0) CALL CLL$STORE_ARC(2,DEG1,DEG2,ORIGIN)
	RETURN
C----------------------------------------------------------------------
C				CIRCLE
C----------------------------------------------------------------------
30	CONTINUE
	UP.XORG   = GE.CIR.CENTER.X
	UP.YORG   = GE.CIR.CENTER.Y
	UP.ANGLE  = 0
	UP.SWEEP  = P360
	UP.REV    = .FALSE.

	CLL$BEGIN = GIS$EXPAND_ARC(GE,ARC(1),ARC(2),WIDTH)
	IF (.NOT. CLL$BEGIN) RETURN

	UNIT = C$CIRCLE

	RETURN
C======================================================================
C				CLL$FIRST
C======================================================================
	ENTRY CLL$FIRST

	UP.FIRST = .TRUE.
	RETURN


C======================================================================
C				CLL$EXPAND
C+	expand "unit" against this unit
C======================================================================
	ENTRY CLL$EXPAND(GE)

	IF (GE.TYPE .EQ. GIS$C_LIN) GO TO 40
	IF (GE.TYPE .EQ. GIS$C_ARC) GO TO 50
	IF (GE.TYPE .EQ. GIS$C_CIR) GO TO 50
	RETURN
C----------------------------------------------------------------------
C				LINE
C----------------------------------------------------------------------
40	CONTINUE
	WIDTH = GE.SI.WIDTH

	TLIN = GE.LIN
	CALL CLL$MAP_LIN(TLIN)

	LIN1.PM.SET = .FALSE.
	LIN2.PM.SET = .FALSE.
	IF (.NOT. GIS$EXPAND_LIN(TLIN,LIN1,LIN2,WIDTH)) RETURN

	IF (UNIT .EQ. C$LINE) CALL CLL$LIN_LIN(LIN1,LIN2)
	IF (UNIT .NE. C$LINE) CALL CLL$LIN_ARC(LIN1,LIN2)
	RETURN
C----------------------------------------------------------------------
C				ARC/CIRCLE
C----------------------------------------------------------------------
50	CONTINUE
	WIDTH = GE.SI.WIDTH

	TARC = GE.ARC
	CALL CLL$MAP_ARC(TARC)

	IF (.NOT. GIS$EXPAND_ARC(TARC,ARC1,ARC2,WIDTH)) RETURN

	IF (UNIT .EQ. C$LINE) CALL CLL$ARC_LIN(ARC1,ARC2)
	IF (UNIT .NE. C$LINE) CALL CLL$ARC_ARC(ARC1,ARC2)
	RETURN
	END

C======================================================================
C			CLL$MAP_LIN
C======================================================================
	SUBROUTINE CLL$MAP_LIN(L1)
	INCLUDE 'CLL.DEF'
	RECORD /GIS_LIN/ L1
	RECORD /GIS_ARC/ A1

	IF (UNIT .NE. C$LINE) RETURN

	L1.PNT1.X = L1.PNT1.X - UP.XORG
	L1.PNT1.Y = L1.PNT1.Y - UP.YORG

	L1.PNT2.X = L1.PNT2.X - UP.XORG
	L1.PNT2.Y = L1.PNT2.Y - UP.YORG

	L1.PM.SET = .FALSE.
	CALL GIS$R_PNT(L1.PNT1,-UP.ANGLE)
	CALL GIS$R_PNT(L1.PNT2,-UP.ANGLE)

	RETURN
C======================================================================
C			CLL$UNMAP_LIN
C======================================================================
	ENTRY CLL$UNMAP_LIN(L1)

	IF (UNIT .NE. C$LINE) RETURN

	CALL GIS$R_PNT(L1.PNT1,UP.ANGLE)
	CALL GIS$R_PNT(L1.PNT2,UP.ANGLE)

	L1.PNT1.X = L1.PNT1.X + UP.XORG
	L1.PNT1.Y = L1.PNT1.Y + UP.YORG

	L1.PNT2.X = L1.PNT2.X + UP.XORG
	L1.PNT2.Y = L1.PNT2.Y + UP.YORG

	L1.PM.SET = .FALSE.
	RETURN

C======================================================================
C			CLL$MAP_ARC
C======================================================================
	ENTRY CLL$MAP_ARC(A1)

	IF (UNIT .NE. C$LINE) RETURN

	A1.CENTER.X = A1.CENTER.X - UP.XORG
	A1.CENTER.Y = A1.CENTER.Y - UP.YORG

	A1.EDIR = A1.EDIR - UP.ANGLE
	A1.EDIR = DMOD(A1.EDIR+P360,P360)
	A1.SDIR = A1.EDIR + A1.SWEEP
	RETURN

C======================================================================
C			CLL$UNMAP_ARC
C======================================================================
	ENTRY CLL$UNMAP_ARC(A1)

	IF (UNIT .NE. C$LINE) RETURN

	A1.CENTER.X = A1.CENTER.X + UP.XORG
	A1.CENTER.Y = A1.CENTER.Y + UP.YORG

	A1.EDIR = A1.EDIR + UP.ANGLE
	A1.EDIR = DMOD(A1.EDIR+P360,P360)
	A1.SDIR = A1.EDIR + A1.SWEEP
	RETURN
	END

C======================================================================
C			CLL$DEFINE_ARC
C+	define arc skip/draw pp/draw 
C======================================================================
	LOGICAL *4 FUNCTION CLL$DEFINE_ARC(A,B,C,D,PHY)
	INCLUDE 'CLL.DEF'
	RECORD /CLE_POINT/ A(2),B(2),C(2),D(2)
	INTEGER *4 PHY,PAB,PCD
	LOGICAL CLL$SET,CLL$ONLY,FIRST
	REAL *8 GIS$A_PNT_PNT

	PARAMETER SKP$A2B2 = '00 A0'X	! 0000 0000 1010 0000
	PARAMETER SKP$A1B1 = '00 50'X	! 0000 0000 0101 0000
	PARAMETER SKP$C2D2 = '00 0A'X	! 0000 0000 0000 1010
	PARAMETER SKP$C1D1 = '00 05'X	! 0000 0000 0000 0101

	PARAMETER SKP$A1A2 = '00 C0'X	! 0000 0000 1100 0000
	PARAMETER SKP$B1B2 = '00 30'X	! 0000 0000 0011 0000
	PARAMETER SKP$C1C2 = '00 0C'X	! 0000 0000 0000 1100
	PARAMETER SKP$D1D2 = '00 03'X	! 0000 0000 0000 0011

	PARAMETER SKP$A1C1 = '00 44'X	! 0000 0000 0100 0100
	PARAMETER SKP$B1D1 = '00 11'X	! 0000 0000 0001 0001
	PARAMETER SKP$A2C2 = '00 88'X	! 0000 0000 1000 1000
	PARAMETER SKP$B2D2 = '00 22'X	! 0000 0000 0010 0010

	PAB = PHY .AND. 'F0'X		! UNIT AB
	PCD = PHY .AND. '0F'X		! UNIT CD

C	IF(.NOT. UP.FIRST) GO TO 11
C	UP.FIRST = .FALSE.
C	  CALL PUT$TEXT(A(1),'A1')
C	  CALL PUT$TEXT(B(1),'B1')
C	  CALL PUT$TEXT(C(1),'C1')
C	  CALL PUT$TEXT(D(1),'D1')
C
C	  CALL PUT$TEXT(A(2),'A2')
C	  CALL PUT$TEXT(B(2),'B2')
C	  CALL PUT$TEXT(C(2),'C2')
C	  CALL PUT$TEXT(D(2),'D2')
C
C11	CONTINUE
C	WRITE(2,101) PAB,PCD,UP.SWEEP,UP.ANGLE
C101	FORMAT(' -- PAB: ',Z4.4,'   PCD: ',Z4.4,
C	1	' SWEEP',F12.6,' ANGLE: ',F12.6)
C
C	CALL WRTD('A1',A(1).PNT.X,A(1).PNT.Y,A(1).PHY,A(1).LOG)
C	CALL WRTD('B1',B(1).PNT.X,B(1).PNT.Y,B(1).PHY,B(1).LOG)
C	CALL WRTD('C1',C(1).PNT.X,C(1).PNT.Y,C(1).PHY,C(1).LOG)
C	CALL WRTD('D1',D(1).PNT.X,D(1).PNT.Y,D(1).PHY,D(1).LOG)
C
C	CALL WRTD('A2',A(2).PNT.X,A(2).PNT.Y,A(2).PHY,A(2).LOG)
C	CALL WRTD('B2',B(2).PNT.X,B(2).PNT.Y,B(2).PHY,B(2).LOG)
C	CALL WRTD('C2',C(2).PNT.X,C(2).PNT.Y,C(2).PHY,C(2).LOG)
C	CALL WRTD('D2',D(2).PNT.X,D(2).PNT.Y,D(2).PHY,D(2).LOG)
C----------------------------------------------------------------------
C				A1 --
C----------------------------------------------------------------------	
	IF (.NOT. A(1).PHY) GO TO 20
	  IF (.NOT. (B(1).PHY .OR. B(1).LOG)) GO TO 10
C	     WRITE(2,*) 'skip -- A1 -- A1/B1'
	     CALL CLL$SKIP(1,A(1),B(1),SKIP)
	     GO TO 20
10	CONTINUE
C	     WRITE(2,*) 'skip 1 -- A1 -- A1/A2'
	     CALL CLL$SKIP(1,A(1),A(2),SKIP)
C----------------------------------------------------------------------
C				B1 --
C----------------------------------------------------------------------
20	CONTINUE
	IF (.NOT. B(1).PHY) GO TO 30
	  IF (.NOT. (A(1).PHY .OR. A(1).LOG)) GO TO 30
C	     WRITE(2,*) 'skip 1 -- B1 -- B1/A1'
	    CALL CLL$SKIP(1,B(1),A(1),SKIP)
C----------------------------------------------------------------------
C				C1 --
C----------------------------------------------------------------------
30	CONTINUE
	IF (.NOT. C(1).PHY) GO TO 40
	  IF (.NOT. (D(1).PHY .OR. D(1).LOG)) GO TO 35
C	     WRITE(2,*) 'skip 2 -- C1 -- C1/D1'
	     CALL CLL$SKIP(2,C(1),D(1),SKIP)
	     GO TO 40
35	CONTINUE
C	     WRITE(2,*) 'skip 2 -- C1 -- C1/C2'
	     CALL CLL$SKIP(2,C(1),C(2),SKIP)
C----------------------------------------------------------------------
C				D1 --
C----------------------------------------------------------------------
40	CONTINUE
	IF (.NOT. D(1).PHY) GO TO 200
	  IF (.NOT. (C(1).PHY .OR. C(1).LOG)) GO TO 200
C	   WRITE(2,*) 'skip 2 -- D1 -- D1/C1'
	   CALL CLL$SKIP(2,D(1),C(1),SKIP)
C======================================================================
C				A2 --
C======================================================================
200	CONTINUE
	IF (.NOT. A(2).PHY) GO TO 220
	  IF (.NOT. (B(2).PHY .OR. B(2).LOG)) GO TO 210
C	     WRITE(2,*) 'skip 1 -- A2 -- A2/B2'
	     CALL CLL$SKIP(1,A(2),B(2),SKIP)
	     GO TO 220
210	CONTINUE
C	     WRITE(2,*) 'skip 1 -- A2 -- A1/A2'
	     CALL CLL$SKIP(1,A(1),A(2),SKIP)
C----------------------------------------------------------------------
C				B2 --
C----------------------------------------------------------------------
220	CONTINUE
	IF (.NOT. B(2).PHY) GO TO 230
	  IF (.NOT. (A(2).PHY .OR. A(2).LOG)) GO TO 230
C	   WRITE(2,*) 'skip 1 -- B2 -- B2/A2'
	  CALL CLL$SKIP(1,B(2),A(2),SKIP)
C----------------------------------------------------------------------
C				C2 --
C----------------------------------------------------------------------
230	CONTINUE
	IF (.NOT. C(2).PHY) GO TO 240
	  IF (.NOT. D(2).PHY .OR. D(2).LOG) GO TO 235
C	     WRITE(2,*) 'skip 2 -- D1 -- C2/D2'
	     CALL CLL$SKIP(2,C(2),D(2),SKIP)
	     GO TO 240
235	CONTINUE
C	   WRITE(2,*) 'skip 2 -- C2 -- C1/C2'
	     CALL CLL$SKIP(2,C(1),C(2),SKIP)
C----------------------------------------------------------------------
C				D2 --
C----------------------------------------------------------------------
240	CONTINUE
	IF (.NOT. D(2).PHY) GO TO 300
	  IF (.NOT. (C(2).PHY .OR. C(2).LOG)) GO TO 300
C	   WRITE(2,*) 'skip 2 -- D2 -- D2/C2'
	  CALL CLL$SKIP(2,D(2),C(2),SKIP)
300	CONTINUE
	RETURN
	END

C======================================================================
C				WRTD
C======================================================================
	SUBROUTINE WRTD(NAME,X,Y,PHY,LOG)
	INCLUDE 'CLL.DEF'
	REAL *8 X,Y,DIR,angle$
	BYTE NAME(1),PHY,LOG

	DIR = ANGLE$(UP.XORG,UP.YORG,X,Y)

	DO I = 1,20
	  IF (NAME(I) .EQ. 0) GO TO 10
	END DO

10	CONTINUE
	WRITE(2,100) (NAME(J),J=1,I),DIR,PHY,LOG
100	FORMAT(1X,A1,3X,F20.8,'    phy: ',I5,'    log :',I5)
	RETURN
	END

C======================================================================
C				WRT
C======================================================================
	SUBROUTINE WRT(NAME,X,Y,PHY)
	REAL *8 X,Y
	BYTE NAME(1),PHY

	DO I = 1,20
	  IF (NAME(I) .EQ. 0) GO TO 10
	END DO

10	CONTINUE
C	WRITE(2,100) (NAME(J),J=1,I),X,Y,PHY
100	FORMAT(1X,A1,3X,2F12.3,4X,I5)
	RETURN
	END

C======================================================================
C			CLL$DEFINE_LIN
C+	Define line expansion points
C======================================================================
	SUBROUTINE CLL$DEFINE_LIN(A,B,C,D)
	INCLUDE 'CLL.DEF'
	RECORD /CLE_POINT/ A,B,C,D,T1,T2
	INTEGER *4 PHY

C	CALL WRT('A',A.PNT.X,A.PNT.Y,A.PHY)
C	CALL WRT('B',B.PNT.X,B.PNT.Y,B.PHY)
C	CALL WRT('C',C.PNT.X,C.PNT.Y,C.PHY)
C	CALL WRT('D',D.PNT.X,D.PNT.Y,D.PHY)
C
C	IF (A.PHY .OR. B.PHY) WRITE(2,*) '--SKIP A/B--'
C	IF (C.PHY .OR. D.PHY) WRITE(2,*) '--SKIP C/D--'

	IF (A.PHY .OR. B.PHY) CALL CLL$SKIP(1,A,B)
	IF (C.PHY .OR. D.PHY) CALL CLL$SKIP(2,C,D)

	IF (A.PHY .AND. B.PHY) RETURN
	IF (C.PHY .AND. D.PHY) RETURN
C----------------------------------------------------------------------
C				DRAW BETWEEW A-B
C----------------------------------------------------------------------
	IF (.NOT. (C.PHY .OR. D.PHY)) GO TO 20
	  T1.PNT = LIN(1).PNT1
	  T2.PNT = LIN(1).PNT2

	  IF (D.PHY) GO TO 10
C	  WRITE(2,*) '--DRAW B--'
	  IF (B.PNT.X .LT. 0) CALL CLL$DRAW(1,B,T1)
	  IF (B.PNT.X .GT. 0) CALL CLL$DRAW(1,T2,B)
	  RETURN
10	CONTINUE
C	  WRITE(2,*) '--DRAW A--'
	  IF (A.PNT.X .LT. 0) CALL CLL$DRAW(1,A,T1)
	  IF (A.PNT.X .GT. 0) CALL CLL$DRAW(1,T2,A)
	RETURN
C----------------------------------------------------------------------
C				DRAW BETWEEW C-D
C----------------------------------------------------------------------
20	CONTINUE
	IF (.NOT. (A.PHY .OR. B.PHY)) RETURN
	  T1.PNT = LIN(2).PNT1
	  T2.PNT = LIN(2).PNT2

	  IF (B.PHY) GO TO 30
C	  WRITE(2,*) '--DRAW D--'
	  IF (D.PNT.X .LT. 0) CALL CLL$DRAW(2,D,T1)
	  IF (D.PNT.X .GT. 0) CALL CLL$DRAW(2,T2,D)
	  RETURN
30	CONTINUE
C	  WRITE(2,*) '--DRAW C--'
	  IF (C.PNT.X .LT. 0) CALL CLL$DRAW(2,C,T1)
	  IF (C.PNT.X .GT. 0) CALL CLL$DRAW(2,T2,C)
	RETURN
	END

C======================================================================
C				CLL$REMOVE_DRAW
C+	erase draw elements from a list of expansion points
C
C	1. DRAW ELEMENTS PRIOR TO FIRST POINT OF "I" THAT PRECEDE
C	   A SKIP FUNCTION
C	2. DRAW ELEMENTS AFTER LST POINT OF "I" THAT TRAIL A SKIP
C	   FUNCTION
C----------------------------------------------------------------------
C
C	before	   2----0    3    1--------0     3   1------2
C----------------------------------------------------------------------
C	after	       20    3    1--------0     3   1
C======================================================================
	SUBROUTINE CLL$REMOVE_DRAW(P,NP)
	INCLUDE 'CLL.DEF'
	INTEGER *2 NP,FST
	RECORD /EXP_POINT/ P(1)
	LOGICAL *4 ISKIP

	IF (NP .LE. 2) RETURN		! NONE
C----------------------------------------------------------------------
C				REMOVE LEADING DRAWS
C----------------------------------------------------------------------
	ND = 0
	ISKIP = .FALSE.
	DO 80 I = 1,NP
	   IF (P(I).TYPE .EQ. ORIGIN) GO TO 85
	   IF (P(I).TYPE .EQ. DRAW) ND = ND + 1
	   IF (P(I).TYPE .EQ. DRAW) GO TO 80
	   ISKIP = .TRUE.
80	CONTINUE
	RETURN
C----------------------------------------------------------------------
C				REMOVE MULTPLE LEADING DRAW
C----------------------------------------------------------------------
85	CONTINUE
	IF (ISKIP) GO TO 90
	IF (ND .LE. 2) GO TO 200
	 N = ND / 2
	 P(1) = P(N)
	 P(2) = P(I-1)
	 P(2).UNIT = P(1).UNIT
	 IPOS = 3

	 DO J = I,NP
	   P(IPOS) = P(J)
	   IPOS = IPOS + 1
	 END DO

	NP = IPOS - 1
	IF (NP .LE. 4) RETURN
	GO TO 200
C----------------------------------------------------------------------
C			REMOVE ALL LEADING DRAW UNITS
C----------------------------------------------------------------------
90	CONTINUE
	POS = 1
	DO 95 J = 1,NP
	  IF (P(J).TYPE .EQ. ORIGIN) ISKIP = .FALSE.
	  IF (ISKIP .AND. P(J).TYPE .EQ. DRAW) GO TO 95
	  P(POS) = P(J)
	  POS = POS + 1
95	CONTINUE

	NP = POS - 1
	IF (NP .LE. 4) RETURN
C----------------------------------------------------------------------
C				REMOVE TRAILING UNITS
C----------------------------------------------------------------------
200	CONTINUE
	NI = 0
	DO I = 1,NP
	  IF (P(I).TYPE .EQ. ORIGIN) NI = NI + 1
	  IF (NI .EQ. 2) GO TO 250
	END DO
	RETURN

250	CONTINUE
	K = I+1
	ND = 0
	ISKIP = .FALSE.
	DO I = K,NP
	  IF (P(I).TYPE .EQ. DRAW) ND = ND + 1
	  IF (P(I).TYPE .NE. DRAW) ISKIP = .TRUE.
	END DO
C----------------------------------------------------------------------
C			REMOVE ALL BUT 1 DRAW
C----------------------------------------------------------------------
	IF (ISKIP) GO TO 400
	IF (ND .LE. 2) RETURN
	  N = ND / 2
	  P(K+1)    = P(K+N)
	  P(K).UNIT = P(K+1).UNIT
	  NP = K+1
	RETURN
C----------------------------------------------------------------------
C			REMOVE ALL TRAILING DRAW
C----------------------------------------------------------------------
400	CONTINUE
	POS = K

	DO 500 J = K,NP
	  IF (P(J).TYPE .EQ. DRAW) GO TO 500
	  P(POS) = P(J)
	  POS = POS + 1
500	CONTINUE

	NP = POS - 1
	RETURN
	END

C======================================================================
C				CLL$MAP_DIR
C======================================================================
	SUBROUTINE CLL$MAP_DIR(DIR1,DIR2)
	INCLUDE 'CLL.DEF'

	DIR1 = DIR1 - UP.ANGLE
	DIR2 = DIR2 - UP.ANGLE

10	CONTINUE
	DIR1 = DMOD(DIR1+P360,P360)
	IF (DIR1 .LT. 0) GO TO 10
20	CONTINUE
	DIR2 = DMOD(DIR2+P360,P360)
	IF (DIR2 .LT. 0) GO TO 20
C----------------------------------------------------------------------
C				OUTSIDE
C----------------------------------------------------------------------
	IF (DIR1 .GT. UP.SWEEP) GO TO 30
	IF (DIR2 .LE. UP.SWEEP) RETURN		! BOTH INSIDE

	DX2 = DIR2 - DIR1
	IF (DX2 .GT. P180) DIR2 = DIR2 - P360
	RETURN
C----------------------------------------------------------------------
C				DIR2
C----------------------------------------------------------------------
30	CONTINUE
	IF (DIR2 .GT. UP.SWEEP) RETURN

	DX1 = DIR1 - DIR2
	IF (DX1 .GT. P180) DIR1 = DIR1 - P360
	RETURN
	END

C======================================================================
C				CLL$OUTPUT
C+	output a line x1,y1,x2,y2
C======================================================================
	LOGICAL *4 FUNCTION CLL$OUTPUT(P1,P2,L,LUNIT,LSEQ)
        INCLUDE 'CLL.DEF'
	RECORD /EXP_POINT/ P1,P2
	RECORD /GIS_LIN/ LIN1
	RECORD /GIS_ARC/ ARC1
	RECORD /GIS_PNT/ PS,PM,PE
	REAL *8 S
	REAL *8 DX,DY,DIS
	REAL *8 DEGM,DEG1,DEG2,DA
	LOGICAL *4 GIS$EQUATE_ARC

	CLL$OUTPUT = .FALSE.
	IF (UNIT .NE. C$LINE) GO TO 20

	DX = P1.X - P2.X
	DY = P1.Y - P2.Y
	DIS = SQRT(DX*DX + DY*DY)
	IF (DIS .LE. .001D0) RETURN
C----------------------------------------------------------------------
C				LINE
C----------------------------------------------------------------------
	CALL GIS$EQUATE_LIN(LIN1,P1.PNT,P2.PNT)
	CALL CLL$UNMAP_LIN(LIN1)
	LIN1.SI = LIN(1).SI
	LIN1.PM.LENGTH = DIS
	CALL CLL$RESULT(LIN1,LUNIT,LSEQ,DIS)
	CLL$OUTPUT = .TRUE.
	RETURN
C----------------------------------------------------------------------
C				ARC
C----------------------------------------------------------------------
20	CONTINUE
	IF (ARC(L).RADIUS .LT. .01) RETURN		! NO ARC
	IF (ABS(P1.DEG-P2.DEG) .LT. .0001) RETURN	! NO ARC

	DA = ABS(P1.DEG - P2.DEG)
	DIS = DA * ARC(L).RADIUS
	
	DEGM = (((P2.DEG - P1.DEG) / 2.0) + P1.DEG) + UP.ANGLE
	DEG1 = P1.DEG + UP.ANGLE
	DEG2 = P2.DEG + UP.ANGLE

	PS.X    = ARC(L).RADIUS
	PS.Y    = 0

	PM = PS
	PE = PS

	CALL GIS$R_PNT(PS,DEG1)
	PS.X = PS.X + UP.XORG
	PS.Y = PS.Y + UP.YORG
	CALL GIS$R_PNT(PM,DEGM)
	PM.X = PM.X + UP.XORG
	PM.Y = PM.Y + UP.YORG
	CALL GIS$R_PNT(PE,DEG2)
	PE.X = PE.X + UP.XORG
	PE.Y = PE.Y + UP.YORG

	IF (.NOT. GIS$EQUATE_ARC(ARC1,PS,PM,PE)) RETURN
	ARC1.SI = ARC(1).SI
	ARC1.RADIUS = ARC(L).RADIUS

	CALL CLL$RESULT(ARC1,LUNIT,LSEQ,DIS)
	CLL$OUTPUT = .TRUE.
	RETURN
	END

C======================================================================
C				CLL$DRAW
C+	determine draw function
C	1. IF ARC - POINTS DEFINE ANGLE
C======================================================================
	SUBROUTINE CLL$DRAW(I,P1,P2)
	INCLUDE 'CLL.DEF'
	RECORD /CLE_POINT/ P1,P2
	RECORD /GIS_PNT/ PNT,T1,T2
	REAL *8 GIS$A_PNT_PNT
	REAL *8 GIS$SWEEP
	REAL *8 A1,A2
	LOGICAL *4 ON1,ON2

	IF (UNIT .EQ. C$ARC) GO TO 110
C----------------------------------------------------------------------
C				LINE UNIT
C----------------------------------------------------------------------
	DX = ABS(P1.PNT.X - P2.PNT.X)
	IF (ABS(DX) .GT. (U(I).WIDTH*2.5)) RETURN
	CALL CLL$STORE(I,P1.PNT,P2.PNT,DRAW)
	RETURN
C======================================================================
C				ARC UNIT
C======================================================================
110	CONTINUE
	IF (ARC(I).RADIUS .LE. .001) RETURN

	DIR1 = GIS$A_PNT_PNT(ARC(I).CENTER,P1.PNT)
	DIR2 = GIS$A_PNT_PNT(ARC(I).CENTER,P2.PNT)

	CALL CLL$STORE_ARC(I,DIR1,DIR2,DRAW)
	RETURN

C======================================================================
C				CLL$SKIP
C+	skip section
C======================================================================
	ENTRY CLL$SKIP(I,P1,P2)

	IF (UNIT .EQ. C$ARC) GO TO 400
	CALL CLL$STORE(I,P1.PNT,P2.PNT,SKIP)
	RETURN

C----------------------------------------------------------------------
C				ARC
C----------------------------------------------------------------------
400	CONTINUE
	DIR1 = GIS$A_PNT_PNT(ARC(I).CENTER,P1.PNT)
	DIR2 = GIS$A_PNT_PNT(ARC(I).CENTER,P2.PNT)
	CALL CLL$STORE_ARC(I,DIR1,DIR2,SKIP)
	RETURN
	END

C======================================================================
C				CLL$LIN_ARC
C+	routine to expand points on circle I
C	STORE EXPANDED ELEMENTS
C======================================================================
	SUBROUTINE CLL$LIN_ARC(LIN1,LIN2)
        INCLUDE 'CLL.DEF'
	RECORD /CLE_POINT/ A(2),B(2),C(2),D(2)
	INTEGER *4 PHY
	LOGICAL CLL$ISECT_LIN_LIN

	PHY = 0		! PHYSICAL INTERSECT MASK

	CALL CLL$ISECT_LIN_ARC(ARC(1),LIN1,A(1),A(2),PHY)
	CALL CLL$ISECT_LIN_ARC(ARC(1),LIN2,B(1),B(2),PHY)
	CALL CLL$ISECT_LIN_ARC(ARC(2),LIN1,C(1),C(2),PHY)
	CALL CLL$ISECT_LIN_ARC(ARC(2),LIN2,D(1),D(2),PHY)
	IF (PHY .EQ. 0) RETURN

	CALL CLL$DEFINE_ARC(A,B,C,D,PHY)
	RETURN

C======================================================================
C				CLL$ARC_LIN
C+	expand a line to an arc
C======================================================================
	ENTRY CLL$ARC_LIN(ARC1,ARC2)

	PHY = 0		! PHYSICAL INTERSECT MASK

	CALL CLL$ISECT_LIN_ARC(ARC1,LIN(1),A(1),A(2),PHY)
	CALL CLL$ISECT_LIN_ARC(ARC2,LIN(1),B(1),B(2),PHY)
	CALL CLL$ISECT_LIN_ARC(ARC1,LIN(2),C(1),C(2),PHY)
	CALL CLL$ISECT_LIN_ARC(ARC2,LIN(2),D(1),D(2),PHY)

	IF (PHY .EQ. 0) RETURN
	CALL CLL$DEFINE_LIN(A(1),B(1),C(1),D(1))
	CALL CLL$DEFINE_LIN(A(2),B(2),C(2),D(2))
	RETURN

C======================================================================
C				CLL$ARC_ARC
C+	expand an arc to an arc
C======================================================================
	ENTRY CLL$ARC_ARC(ARC1,ARC2)

	PHY = 0		! PHYSICAL INTERSECT MASK

	CALL CLL$ISECT_ARC_ARC(ARC(1),ARC1,A(1),A(2),PHY)
	CALL CLL$ISECT_ARC_ARC(ARC(1),ARC2,B(1),B(2),PHY)
	CALL CLL$ISECT_ARC_ARC(ARC(2),ARC1,C(1),C(2),PHY)
	CALL CLL$ISECT_ARC_ARC(ARC(2),ARC2,D(1),D(2),PHY)

	IF (PHY .EQ. 0) RETURN
	CALL CLL$DEFINE_ARC(A,B,C,D,PHY)
	RETURN


C======================================================================
C				CLL$LIN_LIN
C+	expand a line to a line
C======================================================================
	ENTRY CLL$LIN_LIN(L1,L2)

	IF (.NOT. CLL$ISECT_LIN_LIN(LIN(1),L1,A(1))) RETURN
	IF (.NOT. CLL$ISECT_LIN_LIN(LIN(1),L2,A(2))) RETURN
	IF (.NOT. CLL$ISECT_LIN_LIN(LIN(2),L1,B(1))) RETURN
	IF (.NOT. CLL$ISECT_LIN_LIN(LIN(2),L2,B(2))) RETURN

	CALL CLL$DEFINE_LIN(A(1),A(2),B(1),B(2))
	RETURN
	END

C======================================================================
C			CLL$SET
C+	determine if 2 a mask is set (bit wise)
C======================================================================
	LOGICAL *4 FUNCTION CLL$SET(LOG,MASK)
	IMPLICIT INTEGER *4 (A-Z)
	BYTE LOG,MASK

	CLL$SET = .TRUE.
	I = LOG .AND. MASK
	IF (I .EQ. MASK) RETURN		! YES
	CLL$SET = .FALSE.
	RETURN
C======================================================================
C			CLL$ONLY
C+	detemrine if only the specified bit is set
C======================================================================
	ENTRY CLL$ONLY(LOG,MASK)

	CLL$ONLY = .FALSE.
	I = LOG .XOR. MASK
	IF (I .NE. 0) RETURN		! NO
	CLL$ONLY = .TRUE.
	RETURN
	END
	
C======================================================================
C			CLL$ISECT_LIN_ARC
C+	intersect line to arc
C======================================================================
	LOGICAL *4 FUNCTION CLL$ISECT_LIN_ARC(ARC1,LIN1,P1,P2,PHY)
	INCLUDE 'CLL.DEF'
	RECORD /GIS_ARC/ ARC1,ARC2
	RECORD /GIS_LIN/ LIN1,ILIN
	RECORD /CLE_POINT/ P1,P2
	LOGICAL  ON,GIS$ON_ARC,GIS$ON_LIN
	INTEGER *4 PHY
	LOGICAL *4 GIS$ISECT_LIN_ARC
	LOGICAL *4 GIS$ISECT_CIR_CIR
	LOGICAL *4 GIS$ISECT_LIN_CIR

	PHY = PHY * 4		! SHIFT 2 BITS
	P1.LOG = .FALSE.
	P2.LOG = .FALSE.
	P1.PHY = .FALSE.
	P2.PHY = .FALSE.

	IF (ARC1.TYPE .EQ. 0) RETURN		! NOT DEFINED

	CLL$ISECT_LIN_ARC = GIS$ISECT_LIN_CIR(LIN1,ARC1,ILIN)
	IF (.NOT. CLL$ISECT_LIN_ARC) RETURN

	P1.PNT = ILIN.PNT1
	P2.PNT = ILIN.PNT2
	P1.LOG = .TRUE.
	P2.LOG = .TRUE.

	ON = GIS$ON_LIN(LIN1,P1.PNT)
	DIR = ANGLE$(ARC1.CENTER.X,ARC1.CENTER.Y,P1.PNT.X,P1.PNT.Y)
	IF (ON) ON = GIS$ON_ARC(ARC1,DIR)
	IF (.NOT. ON) GO TO 10
	PHY    = PHY + 1		! SET 1 PHYSICAL
	P1.PHY = .TRUE.
	P1.LOG = .FALSE.

10	CONTINUE
	ON = GIS$ON_LIN(LIN1,P2.PNT)
	DIR = ANGLE$(ARC1.CENTER.X,ARC1.CENTER.Y,P2.PNT.X,P2.PNT.Y)
	IF (ON) ON = GIS$ON_ARC(ARC1,DIR)
	IF (.NOT. ON) RETURN

	PHY    = PHY + 2		! SET 2 PHYSICAL
	P2.PHY = .TRUE.
	P1.LOG = .FALSE.
	RETURN
	
C======================================================================
C			CLL$ISECT_ARC_ARC
C+	intersect arc to arc
C======================================================================
	ENTRY CLL$ISECT_ARC_ARC(ARC1,ARC2,P1,P2,PHY)

	PHY = PHY * 4		! SHIFT 2 BITS
	P1.LOG = .FALSE.
	P2.LOG = .FALSE.
	P1.PHY = .FALSE.
	P2.PHY = .FALSE.

	IF (ARC1.TYPE .EQ. 0) RETURN		! NOT DEFINED
	IF (ARC2.TYPE .EQ. 0) RETURN		! NOT DEFINED

	IF (.NOT. GIS$ISECT_CIR_CIR(ARC1,ARC2,ILIN)) RETURN

	P1.PNT = ILIN.PNT1
	P2.PNT = ILIN.PNT2
	P1.LOG = .TRUE.
	P2.LOG = .TRUE.

	DIR = ANGLE$(ARC1.CENTER.X,ARC1.CENTER.Y,P1.PNT.X,P1.PNT.Y)
	ON = GIS$ON_ARC(ARC1,DIR)
	DIR = ANGLE$(ARC2.CENTER.X,ARC2.CENTER.Y,P1.PNT.X,P1.PNT.Y)
	IF (ON) ON = GIS$ON_ARC(ARC2,DIR)
	IF (.NOT. ON) GO TO 20
	PHY    = PHY + 1			! SET 1 PHYSICAL
	P1.PHY = .TRUE.
	P1.LOG = .FALSE.

20	CONTINUE
	DIR = ANGLE$(ARC1.CENTER.X,ARC1.CENTER.Y,P2.PNT.X,P2.PNT.Y)
	ON = GIS$ON_ARC(ARC1,DIR)

	DIR = ANGLE$(ARC2.CENTER.X,ARC2.CENTER.Y,P2.PNT.X,P2.PNT.Y)
	IF (ON) ON = GIS$ON_ARC(ARC2,DIR)
	IF (.NOT. ON) RETURN
	PHY    = PHY + 2			! SET 2 PHYSICAL
	P2.PHY = .TRUE.
	P2.LOG = .FALSE.
	RETURN
	END
	
C======================================================================
C			CLL$ISECT_LIN_LIN
C+	intersect line to line
C======================================================================
	LOGICAL *4 FUNCTION CLL$ISECT_LIN_LIN(LIN1,LIN2,P1)
	INCLUDE 'CLL.DEF'
	RECORD /CLE_POINT/ P1
	RECORD /GIS_LIN/ LIN1,LIN2
	LOGICAL  ON,GIS$ON_LIN
	LOGICAL *4 STATUS,GIS$ISECT_LIN_LIN

	P1.LOG = .FALSE.
	P1.PHY = .FALSE.

	STATUS = GIS$ISECT_LIN_LIN(LIN1,LIN2,P1.PNT)
	CLL$ISECT_LIN_LIN = STATUS
	IF (.NOT. CLL$ISECT_LIN_LIN) RETURN

	P1.LOG = .TRUE.

	ON = GIS$ON_LIN(LIN1,P1.PNT,DX)
	IF (ON) ON = GIS$ON_LIN(LIN2,P1.PNT,DX)
	IF (.NOT. ON) RETURN
	  P1.PHY = .TRUE.
	  P1.LOG = .FALSE.
	RETURN
	END

C======================================================================
C				CLL$STORE
C+	store all intersecting points of unit i
C======================================================================
	SUBROUTINE CLL$STORE(I,P1,P2,TYPE)
        INCLUDE 'CLL.DEF'
	BYTE TYPE
	RECORD /GIS_PNT/ P1,P2
C----------------------------------------------------------------------
C				STORE UNIT
C----------------------------------------------------------------------
	N = U(I).SIZE
	IF (N+2 .GE. MAX$PNT) RETURN

	U(I).P(N+1).PNT = P1
	U(I).P(N+1).TYPE = TYPE

	U(I).P(N+2).PNT = P2
	U(I).P(N+2).TYPE = TYPE

	U(I).P(N+1).UNIT = (N / 2) + 1
	U(I).P(N+2).UNIT = (N / 2) + 1

	U(I).SIZE = N + 2

	RETURN

C======================================================================
C				CLL$STORE_ARC
C+	store all intersecting arc sweep angles
C======================================================================
	ENTRY CLL$STORE_ARC(I,DEG1,DEG2,TYPE)
C----------------------------------------------------------------------
C				STORE UNIT
C----------------------------------------------------------------------
	N = U(I).SIZE
	IF (N+2 .GE. MAX$PNT) RETURN
C----------------------------------------------------------------------
C				STORE
C----------------------------------------------------------------------
	DIR1 = DEG1
	DIR2 = DEG2
	CALL CLL$MAP_DIR(DIR1,DIR2)
	U(I).P(N+1).DEG = DIR1
	U(I).P(N+1).TYPE = TYPE

	U(I).P(N+2).DEG = DIR2
	U(I).P(N+2).TYPE = TYPE

	U(I).P(N+1).UNIT = (N / 2) + 1
	U(I).P(N+2).UNIT = (N / 2) + 1

	U(I).SIZE = N + 2

	RETURN
	END

C======================================================================
C				CLL$FLUSH
C+	sort and output the expanding segments
C======================================================================
	SUBROUTINE CLL$FLUSH
        INCLUDE 'CLL.DEF'

	IF (U(1).SIZE .GT. 0) GO TO 10
	IF (UNIT .NE. S$CIRCLE) GO TO 20
	IF (ARC(1).TYPE .NE. 0) CALL CLL$RESULT(ARC(1),1,1)
	GO TO 20
C---------------------------------------------------------------------
C				UNIT 1
C---------------------------------------------------------------------
10	CONTINUE
	  CALL CLL$SORT(U(1).P,U(1).SIZE,1)
	  CALL CLL$UNIT(U(1).P,U(1).SIZE,1)
C----------------------------------------------------------------------
C				UNIT 2
C----------------------------------------------------------------------
20	CONTINUE
	IF (U(2).SIZE .GT. 0) GO TO 30
	IF (UNIT .NE. S$CIRCLE) RETURN
	IF (ARC(2).TYPE .NE. 0) CALL CLL$RESULT(ARC(2),2,1)
	RETURN
C---------------------------------------------------------------------
C				UNIT 1
C---------------------------------------------------------------------
30	CONTINUE
	  CALL CLL$SORT(U(2).P,U(2).SIZE,2)
	  CALL CLL$UNIT(U(2).P,U(2).SIZE,2)
	RETURN
	END

C======================================================================
C				PRN$UNIT
C+	print unit descriptor
C======================================================================
	SUBROUTINE PRN$UNIT(TEXT,P,NP)
	INCLUDE 'CLL.DEF'

	CHARACTER *(*) TEXT
	RECORD /EXP_POINT/ P(1)
	CHARACTER *8 KIND(3)
	DATA KIND /'Skip','Draw','PNT'/

	IF (.TRUE.) RETURN

	WRITE(4,100) TEXT,NP
100	FORMAT(1X,A,T50,I5,' UNITS')
	DO I = 1,NP
	   J = P(I).TYPE
	   WRITE(4,200) KIND(J),P(I).UNIT,P(I).X,P(I).Y,P(I).DEG
200	   FORMAT(1X,A,'  unit ',I4,'  x,y - ',
	1	      2F10.1,' deg - ',f10.5)
	END DO
	RETURN
	END

C======================================================================
C				CLL$DRAW_ORDER
C======================================================================
	LOGICAL *4 FUNCTION CLL$DRAW_ORDER(P1,P2)
	INCLUDE 'CLL.DEF'
	LOGICAL *1 SET(MAX$PNT)
	RECORD /EXP_POINT/ P1,P2

	CLL$DRAW_ORDER = .TRUE.			! ASSUME IN ORDER

	IF (P1.TYPE .EQ. ORIGIN) GO TO 100
	IF (P2.TYPE .EQ. ORIGIN) GO TO 200
	RETURN
C----------------------------------------------------------------------
C				ORIGIN - DRAW
C----------------------------------------------------------------------
100	CONTINUE
	IF (UNIT .NE. C$LINE) GO TO 110
	IF (P1.PNT.X .GT. .001) RETURN
	CLL$DRAW_ORDER = .FALSE.		! SWAP
	RETURN

110	CONTINUE
	IF (P1.DEG .GT. .001) RETURN
	CLL$DRAW_ORGER = .FALSE.		! SWAP
	RETURN
C----------------------------------------------------------------------
C				DRAW - ORIGIN
C----------------------------------------------------------------------
200	CONTINUE
	IF (UNIT .NE. C$LINE) GO TO 210
	IF (P1.PNT.X .LT. .001) RETURN
	CLL$DRAW_ORDER = .FALSE.			! SWAP
	RETURN

210	CONTINUE
	IF (P1.DEG .LT. .001) RETURN
	CLL$DRAW_ORGER = .FALSE.			! SWAP
	RETURN
	END

C======================================================================
C				CLL$SORT
C+ 	sort the order of expanding  points by X
C======================================================================
	SUBROUTINE CLL$SORT(P,NP)
        INCLUDE 'CLL.DEF'
	LOGICAL SAME
	LOGICAL *1 SET(MAX$PNT)
	RECORD /EXP_POINT/ P(1),TP
	REAL *8 GIS$A_PNT_PNT
	LOGICAL *4 CLL$DRAW_ORDER

	IF (UNIT .NE. C$LINE) GO TO 30

	DX = LIN(1).PNT1.X - LIN(1).PNT2.X
	IF (ABS(DX) .GT. .01) GO TO 20	! VERTICAL
C----------------------------------------------------------------------
C				SORT BY Y
C----------------------------------------------------------------------
	DO I = 1,NP - 1
	   DO 10 J = I+1,NP
	    IF (P(J).Y .GT. P(I).Y) GO TO 10
	    IF (P(J).Y .LT. P(I).Y) GO TO 8
	    IF (CLL$DRAW_ORDER(P(I),P(J))) GO TO 10	! DRAW ORDER
8	CONTINUE
	    TP   = P(I)
	    P(I) = P(J)
	    P(J) = TP
10	   CONTINUE
	END DO
	GO TO 50				! COMPRESS
C----------------------------------------------------------------------
C				SORT BY X
C----------------------------------------------------------------------
20	CONTINUE
	DO I = 1,NP - 1
	   DO 25 J = I+1,NP
	    IF (P(J).X .GT. P(I).X) GO TO 25
	    IF (P(J).X .LT. P(I).X) GO TO 21
	    IF (CLL$DRAW_ORDER(P(I),P(J))) GO TO 25	! DRAW ORDER
21	CONTINUE
	    TP   = P(I)
	    P(I) = P(J)
	    P(J) = TP
25	   CONTINUE
	END DO
	GO TO 50				! COMPRESS
C----------------------------------------------------------------------
C				SORT BY DEGREES
C----------------------------------------------------------------------
30	CONTINUE
	DO I = 1,NP - 1
	   DO 35 J = I+1,NP
	    IF (P(J).DEG .GT. P(I).DEG) GO TO 35
	    IF (P(J).DEG .LT. P(I).DEG) GO TO 31
	    IF (CLL$DRAW_ORDER(P(I),P(J))) GO TO 35	! DRAW ORDER
31	CONTINUE
	    TP   = P(I)
	    P(I) = P(J)
	    P(J) = TP
35	   CONTINUE
	END DO
C----------------------------------------------------------------------
C				COMPRESS DRAWS
C----------------------------------------------------------------------
50	CONTINUE
	CALL PRN$UNIT(%DESCR(' SORTED'),P,NP)
	NOLD = NP
	CALL CLL$REMOVE_DRAW(P,NP)

	CALL PRN$UNIT(%DESCR(' REMOVE DRAW'),P,NP)

	DO I = 1,NOLD
	   SET(I) = .FALSE.
	END DO

	ISKIP = .FALSE.
	SAME  = .FALSE.
	ISET = .FALSE.
	N = 0
	LEVEL = 0
	I = 0

55	CONTINUE
	I = I + 1
	IF (I .GT. NP) GO TO 77

	IF (P(I).TYPE .EQ. ORIGIN) ISET = .TRUE.
	IF (P(I).TYPE .EQ. ORIGIN) GO TO 80
	IF (P(I).TYPE .EQ. DRAW) GO TO 80
	IF (I .EQ. NP) GO TO 77
C----------------------------------------------------------------------
C				SKIP
C----------------------------------------------------------------------
	 SAME = .FALSE.
	 IF (SET(P(I).UNIT)) GO TO 60
	    SET(P(I).UNIT) = .TRUE.
	    IF (LEVEL .EQ. 0 .AND. N .GT. 0) P(N) = P(I)
	    LEVEL = LEVEL - 1
	    GO TO 55

60	CONTINUE
	SET(P(I).UNIT) = .FALSE.
	LEVEL = LEVEL + 1
	IF (I .EQ. NP) GO TO 77
	IF (.NOT. ISET) GO TO 55
C----------------------------------------------------------------------
C				ORIGINAL/DRAW
C----------------------------------------------------------------------
80	CONTINUE
	IF (SAME .OR. I .EQ. NP) GO TO 90
	IF (LEVEL .NE. 0) GO TO 55		! NOT IN

C----------------------------------------------------------------------
C				LINE
C----------------------------------------------------------------------
	IF (UNIT .NE. C$LINE) GO TO 81	
	  DX = P(I).X - P(I+1).X
	  DY = P(I).Y - P(I+1).Y
	  CDIS = SQRT(DX*DX + DY*DY)
	  IF (CDIS .LE. .01) GO TO 55		! SAME POINT
	GO TO 85
C----------------------------------------------------------------------
C				ARC
C----------------------------------------------------------------------
81	CONTINUE
	CDIS = P(I+1).DEG - P(I).DEG
	IF (ABS(CDIS) .LT. .0001) GO TO 55	! SAME SWEEP ANGLE 

85	CONTINUE
	  SAME = .TRUE.
	  ISET = .TRUE.
	  N = N + 1
	  P(N) = P(I)
	  N = N + 1
	  P(N) = P(I+1)
	  GO TO 55
C----------------------------------------------------------------------
C				MULTIPLE DRAWS
C----------------------------------------------------------------------
90	CONTINUE
	  IF (N .EQ. 0) GO TO 55
	  P(N) = P(I)
	  GO TO 55
C----------------------------------------------------------------------
C				COMPRESSED
C----------------------------------------------------------------------
77	CONTINUE
	CALL PRN$UNIT(%DESCR(' COMPRESSED'),P,N)
	NP = N
	RETURN
	END

C======================================================================
C				CLL$UNIT
C+	output segments
C======================================================================
	SUBROUTINE CLL$UNIT(P,INP,L)
        INCLUDE 'CLL.DEF'
	RECORD /EXP_POINT/ P(1)
	LOGICAL *4 CLL$OUTPUT
	LOGICAL*4 STATUS

	NP = INP
	IF (MOD(NP,2) .NE. 0) NP = NP - 1
	IF (NP .LE. 0) RETURN

	IF (UNIT .NE. C$LINE) GO TO 20
C----------------------------------------------------------------------
C				LINE OUTPUT
C----------------------------------------------------------------------
	LNUM = 1
	DO I = 1,NP,2
	  IF (I .GE. NP) RETURN
	  STATUS = CLL$OUTPUT(P(I),P(I+1),L,L,LNUM)
	  IF (STATUS) LNUM = LNUM + 1
	END DO
	RETURN
C----------------------------------------------------------------------
C				ARC OUTPUT
C----------------------------------------------------------------------
20	CONTINUE
	IF (.NOT. UP.REV) GO TO 30
	LNUM = 1
	LUNIT = L
	IF (L .EQ. 1) LUNIT = 2
	IF (L .EQ. 2) LUNIT = 1
	DO I = 1,NP,2
	  IF (I .GE. NP) RETURN
	  STATUS = CLL$OUTPUT(P(I),P(I+1),L,LUNIT,LNUM)
	  IF (STATUS) LNUM = LNUM + 1
	END DO
	RETURN
C----------------------------------------------------------------------
C			REVERSE ARC
C----------------------------------------------------------------------
30	CONTINUE
	LNUM = 1
	DO I = NP,1,-2
	  IF (I .LE. 1) RETURN
	  STATUS = CLL$OUTPUT(P(I),P(I-1),L,L,LNUM)
	  IF (STATUS) LNUM = LNUM + 1
	END DO
	RETURN
	END