C********************************************************************
	PROGRAM PRUNE
C********************************************************************
C    FILTER A PS FILE TO REMOVE REDUNDANT lineto's.
C                                             Robert S. Lawrence
C                                             (303) 442-7534
C                                                   June 1, 1990
C
	CHARACTER*12 FNAM            ! INPUT FILE NAME
	CHARACTER*80 LINE(3)         ! LINE-BUFFER PUSH-DOWN STACK.
	CHARACTER*6 COM(3)           ! COMMAND STACK
C
	INTEGER IX(3),IY(3),LL(3)    ! COORDINATE AND LENGTH STACKS
C
	WRITE(6,*) 'PRUNE -- FILTERS A PS FILE.'
C    OPEN THE INPUT FILE.
  12	WRITE(6,121)
  121	FORMAT(1X,'         FILE NAME [PSFILE.PS]: ',$)
	READ(*,'(A)') FNAM
        if (fnam.eq.'            ')fnam='PSFILE.PS'
	OPEN(UNIT=1,FILE=FNAM,STATUS='OLD',ERR=12)
C    ACCEPT THE TOLLERANCE LIMIT.
	WRITE(6,111)
  111	FORMAT(1X,'PRUNING FACTOR [10]: ',$)
	READ(*,'(i4)') LT
        if(lt.eq.0)lt=10.
C    OPEN THE OUTPUT FILE.
	OPEN(UNIT=2,FILE='PRUNED.PS',STATUS='UNKNOWN')
C    INITIALIZE LINE-BUFFER STACK.
	READ(1,'(1X,A)',END=39) LINE(1)
	LL(1)=LENB(LINE(1))
	WRITE(2,'(1X,A)') LINE(1)(1:LL(1))
	READ(1,'(1X,A)',END=39) LINE(2)
	LL(2)=LENB(LINE(2))
	WRITE(2,'(1X,A)') LINE(2)(1:LL(2))
C    LOOP TO PROCESS RECORDS.
  31	READ(1,'(1X,A)',END=39) LINE(3)
	LL(3)=LENB(LINE(3))
C	WRITE(6,*) '31A -- COMMAND: ',LINE(3)(20:25)
	IF(LINE(3)(20:25).NE.'lineto') GOTO 35
	IF(LINE(2)(20:25).NE.'lineto') GOTO 35
	IF(LINE(1)(20:25).NE.'lineto') GOTO 35
C    ..THREE CONSECUTIVE lineto's.
	DO I=1,3
	  READ(LINE(I),332) IX(I),IY(I),COM(I)
  332	  FORMAT(1X,I6,3X,I6,4X,A6)
	END DO
C    ....CHECK IF THE CENTER POINT IS REMOVABLE.
C	WRITE(6,*) '34 -- IX(1),IX(2),IX(3): ',IX(1),IX(2),IX(3)
	IF(IABS(IX(2)-(IX(1)+IX(3))/2).GT.LT) GOTO 35
	IF(IABS(IY(2)-(IY(1)+IY(3))/2).GT.LT) GOTO 35
C    ....YES.  REMOVE IT.
	LINE(2)=LINE(3)
	LL(2)=LL(3)
C    ....AND GO TO READ A NEW LINE TO REPLACE IT.
	GOTO 31
C    ..WRITE LINE(2)
  35	WRITE(2,'(1X,A)') LINE(2)(1:LL(2))
	LINE(1)=LINE(2)
	LL(1)=LL(2)
	LINE(2)=LINE(3)
	LL(2)=LL(3)
	GOTO 31
C    END OF FILE.
  39	WRITE(2,'(1X,A)') LINE(3)(1:LL(3))
	CLOSE(UNIT=1)
	CLOSE(UNIT=2)
	WRITE(6,*) 'NEW FILE "PRUNED.PS" HAS BEEN WRITTEN.'
	END


C**********************************************************************
	FUNCTION LENB(S)
C********************************************************************
C    LENGTH, EXCLUDING TRAILING BLANKS, OF A CHARACTER ENTITY.
C                                                     RSL    6/23/86
C    INPUT:
C        S     A CHARACTER ENTITY.
C    OUTPUT:
C        LENB  THE LENGTH OF S, EXCLUDING TRAILING BLANKS.
C
	CHARACTER*(*) S
C
	LENB=LEN(S)
	DO 22 I=LENB,1,-1
	  IF(S(I:I).NE.' ') GOTO 4
  22	CONTINUE
	LENB=0
	GOTO 9
  4	LENB=I
  9	RETURN
	END
