Google
 

Trailing-Edge - PDP-10 Archives - decuslib20-05 - decus/20-0141/dacopy.for
There are 2 other files named dacopy.for in the archive. Click here to see a list.
      SUBROUTINE DACOPY(INITAL,INTRVL,IBUFFR,IBEGIN,IFINAL,
     1JFINAL,JUSED,JBUFFR,NXTINI,NXTBGN,MAXPRT)
C     RENBR(/COPY BUFFER EXPANDING TABS TO SPACES)
C
C     DONALD BARTH, HARVARD BUSINESS SCHOOL
C
C     THE TAB CHARACTER IS A  NONPRINTING  CHARACTER  WHICH
C     CAUSES  THE FOLLOWING CHARACTER TO APPEAR IN THE NEXT
C     COLUMN BEYOND THE NEXT MULTIPLE OF THE TAB STOP.
C
C     INITAL = LESS THAN ZERO,  PROVIDING  THAT  INTRVL  IS
C              GREATER  THAN  ZERO,  THE  NUMBER  OF  EXTRA
C              SPACES INDICATED BY THE  ABSOLUTE  VALUE  OF
C              INITAL  ARE  TO  BE INSERTED AT THE START OF
C              THE JBUFFR ARRAY BEFORE THE CONTENTS OF  THE
C              IBUFFR  ARRAY  IS  COPIED  INTO  THE  JBUFFR
C              ARRAY.  THE FIRST TAB STOP WILL  BE  OF  THE
C              WIDTH  INDICATED  BY  INTRVL.   IF INTRVL IS
C              LESS THAN OR EQUAL TO ZERO, THEN NO  LEADING
C              SPACES  WILL  BE  INSERTED  INTO  THE JBUFFR
C              ARRAY WHETHER  REQUESTED  BY  INITAL  OR  BY
C              LEADING SPACES OR TABS IN THE IBUFFR ARRAY.
C            = EQUAL TO OR GREATER THAN ZERO, INITAL IS THE
C              NUMBER  OF SPACES TO THE FIRST TAB STOP.  IF
C              INITAL IS ZERO,  THEN  COPYING  HAS  ALREADY
C              PASSED  BEYOND  THE  FIRST  TAB STOP AND THE
C              DISTANCE TO THE NEXT TAB STOP  IS  TAKEN  AS
C              THE  ABSOLUTE VALUE OF INTRVL.  IF THE FIRST
C              CHARACTER IN THE INPUT BUFFER IS A  TAB,  IT
C              WILL  BE  EXPANDED TO THIS NUMBER OF SPACES.
C              INITAL CAN EQUAL EITHER ZERO OR THE VALUE OF
C              INTRVL IF THE FIRST TAB STOP IS TO BE OF THE
C              SAME WIDTH AS THOSE WHICH FOLLOW IT.
C     INTRVL = THE ABSOLUTE VALUE OF INTRVL IS THE TAB STOP
C              INTERVAL.   A  TAB  CHARACTER  IN  THE INPUT
C              BUFFER CAUSES THE FOLLOWING CHARACTER TO  GO
C              INTO THE NEXT POSITION BEYOND THE SUM OF THE
C              ABSOLUTE VALUE OF INITAL AND  NEXT  MULTIPLE
C              OF THE ABSOLUTE VALUE OF INTRVL.
C            = LESS THAN ZERO, NO LEADING SPACES ARE TO  BE
C              INSERTED   INTO  THE  JBUFFR  ARRAY  WHETHER
C              REQUESTED BY A NEGATIVE VALUE OF  INITAL  OR
C              BY  LEADING  SPACES  OR  TABS  IN THE IBUFFR
C              ARRAY.  ONCE A PRINTING CHARACTER  HAS  BEEN
C              COPIED  INTO THE JBUFFR ARRAY, HOWEVER, THEN
C              ALL REMAINING SPACES WILL BE COPIED AND  ALL
C              REMAINING TABS WILL BE EXPANDED TO SPACES.
C            = ZERO, NO SPACES ARE TO BE INSERTED INTO  THE
C              JBUFFR  ARRAY.  TABS IN THE IBUFFR ARRAY ARE
C              IGNORED, AND SPACES ARE NOT COPIED.
C            = GREATER  THAN  ZERO,  ALL   SPACES   WHETHER
C              REQUESTED  BY  A NEGATIVE VALUE OF INITAL OR
C              BY SPACES OR TABS IN THE  IBUFFR  ARRAY  ARE
C              INSERTED INTO THE JBUFFR ARRAY.
C     IBUFFR = THE INPUT BUFFER WHICH IS TO BE COPIED  INTO
C              THE  OUTPUT BUFFER EXPANDING ANY TABS FOUND.
C              IBUFFR  CONTAINS  CHARACTERS  READ   BY   A1
C              FORMAT.
C     IBEGIN = SUBSCRIPT IN IBUFFR ARRAY AT WHICH IS TO  BE
C              FOUND THE FIRST CHARACTER TO BE COPIED.
C     IFINAL = SUBSCRIPT IN IBUFFR ARRAY AT WHICH IS TO  BE
C              FOUND THE FINAL CHARACTER TO BE COPIED.
C     JFINAL = THE DIMENSION OF JBUFFR ARRAY.
C     JUSED  = SUBSCRIPT OF THE LOWEST LOCATION  IN  JBUFFR
C              ARRAY  WHICH  IS  CURRENTLY IN USE AND WHICH
C              CONTAINS  DATA  WHICH  MUST  BE  MAINTAINED.
C              JUSED  IS  RETURNED CONTAINING THE SUBSCRIPT
C              OF THE HIGHEST LOCATION  INTO  WHICH  DACOPY
C              HAS PLACED A CHARACTER.
C     JBUFFR = ARRAY INTO WHICH THE CONTENTS OF IBUFFR  ARE
C              TO BE COPIED EXPANDING TABS TO SPACES.
C     NXTINI = RETURNED CONTAINING  VALUE NEXT  TO BE GIVEN
C              TO INITAL  IF THE  CURRENT  CALL  COULD  NOT
C              COMPLETELY  REPESENT  THE  CONTENTS  OF  THE
C              IBUFFR  ARRAY  DUE  TO THE ROOM AVAILABLE IN
C              JBUFFR  BEING  TOO  SMALL.   IF  A  TAB  WAS
C              ENCOUNTERED  IN  IBUFFR  BUT  COULD  NOT  BE
C              COMPLETELY REPRESENTED, THEN NXTINI WILL  BE
C              NEGATIVE.  IF THE LAST CHARACTER ENCOUNTERED
C              IN THE IBUFFR ARRAY  WAS  NOT  A  TAB,  THEN
C              NXTINI  WILL  BE RETURNED WITH THE REMAINING
C              DISTANCE TO THE NEXT TAB STOP.
C     NXTBGN = RETURNED CONTAINING THE SUBSCRIPT WITHIN THE
C              IBUFFR ARRAY OF THE FIRST LETTER WHICH COULD
C              NOT BE REPRESENTED IN THE OUTPUT BUFFER.  IF
C              ALL   LETTERS  COULD  BE  REPRESENTED,  THEN
C              NXTBGN WILL BE RETURNED CONTAINING IFINAL+1.
C              NOTE  THAT  IF  A TAB IS REPRESENTED EVEN BY
C              SINGLE SPACE, THEN NXTBGN IS  PASSED  BEYOND
C              THIS  TAB ALTHOUGH THERE MIGHT NOT BE ENOUGH
C              ROOM IN THE OUTPUT BUFFER TO FILL COMPLETELY
C              TO THE NEXT TAB STOP.
C     MAXPRT = RETURNED CONTAINING THE SUBSCRIPT OF HIGHEST
C              LOCATION  IN  JBUFFR ARRAY INTO WHICH DACOPY
C              HAS PLACED A PRINTING CHARACTER.
C
      DIMENSION IBUFFR(IFINAL),JBUFFR(JFINAL)
C
C     ISPACE = THE SPACE CHARACTER
C     ITAB   = THE TAB CHARACTER
      DATA ISPACE,ITAB/1H ,1H	/
C
C     INITIAL POINTERS
      INDEX=IBEGIN-1
      IPRINT=JUSED
      LIMIT=INITAL
C
C     INSERT EXTRA SPACES AT START IF INITAL.LT.0
      IF(INTRVL.LE.0)GO TO 2
      JNTRVL=INTRVL
      NONSPC=1
    1 IF(LIMIT.GE.0)GO TO 4
      LIMIT=-LIMIT
      GO TO 6
    2 JNTRVL=-INTRVL
      NONSPC=0
      GO TO 4
C
C     TEST IF ARE AT END OF EITHER INPUT OR OUTPUT BUFFERS
    3 LIMIT=0
    4 INDEX=INDEX+1
      IF(JUSED.GE.JFINAL)GO TO 11
      IF(INDEX.GT.IFINAL)GO TO 11
C
C     ADJUST NUMBER OF COLUMNS LEFT UNTIL NEXT TAB STOP
      IF(LIMIT.LE.0)LIMIT=JNTRVL
      LIMIT=LIMIT-1
C
C     TEST IF NEW CHARACTER IS A SPACE OR A TAB
      IF(IBUFFR(INDEX).EQ.ISPACE)GO TO 7
      IF(IBUFFR(INDEX).NE.ITAB)GO TO 8
C
C     IF FIND A TAB, COPY IN THE SPACES TO NEXT TAB STOP
      IF(NONSPC.EQ.0)GO TO 3
    5 JUSED=JUSED+1
      JBUFFR(JUSED)=ISPACE
      IF(LIMIT.LE.0)GO TO 4
    6 IF(JUSED.GE.JFINAL)GO TO 10
      LIMIT=LIMIT-1
      GO TO 5
C
C     IF FIND CHARACTER OTHER THAN A TAB, JUST COPY IT
    7 IF(NONSPC.EQ.0)GO TO 4
      GO TO 9
    8 IPRINT=JUSED+1
      NONSPC=JNTRVL
    9 JUSED=JUSED+1
      JBUFFR(JUSED)=IBUFFR(INDEX)
      GO TO 4
C
C     NOT ENOUGH ROOM FOR ALL SPACES IN TAB EXPANSION
   10 LIMIT=-LIMIT
      INDEX=INDEX+1
C
C     RETURN TO CALLING PROGRAM
   11 NXTINI=LIMIT
      NXTBGN=INDEX
      MAXPRT=IPRINT
      RETURN
C243897269317
      END