Google
 

Trailing-Edge - PDP-10 Archives - decuslib20-05 - decus/20-0141/damove.for
There are 2 other files named damove.for in the archive. Click here to see a list.
      SUBROUTINE DAMOVE(JSTIFY,IFILL ,LFTCOL,LTREND,IERR  ,
     1    IBUFFR,KOUNT )
C     RENBR(/JUSTIFY ITEM IN FIELD OF SPACES)
C
C     DONALD BARTH, HARVARD BUSINESS SCHOOL
C
C     JSTIFY = -1, DO NOT  MOVE  ITEM  IN  IBUFFR(LFTCOL+1)
C              THROUGH IBUFFR(KOUNT).
C            = 0,  THE  ITEM  IN  IBUFFR(LFTCOL+1)  THROUGH
C              IBUFFR(KOUNT) IS TO BE CENTERED IN THE FIELD
C              STARTING AT IBUFFR(LFTCOL+1)  AND  EXTENDING
C              THROUGH  IBUFFR(LTREND).   THE  IBUFFR ARRAY
C              LOCATIONS TO THE LEFT OF THE ITEM  ARE  THEN
C              FILLED WITH SPACES.
C            = 1,  THE  ITEM  IN  IBUFFR(LFTCOL+1)  THROUGH
C              IBUFFR(KOUNT) IS TO BE MOVED TO THE RIGHT SO
C              THAT THE CHARACTER INPUT IN IBUFFR(KOUNT) IS
C              PLACED   INTO  IBUFFR(LTREND).   THE  IBUFFR
C              ARRAY LOCATIONS TO THE LEFT OF THE ITEM  ARE
C              THEN FILLED WITH SPACES.
C     IFILL  = 0, DO NOT FILL PORTION  OF  FIELD  RIGHT  OF
C              ITEM WITH SPACES.  THE VALUE OF IFILL HAS NO
C              EFFECT ON THE CHARACTERS OF THE ITEM ITSELF.
C              KOUNT  WILL  BE  RETURNED  POINTING  TO  THE
C              RIGHTMOST CHARACTER OF THE ITEM.
C            = 1, FILL THE FIELD  RIGHT  OF  THE  ITEM  AND
C              EXTENDING    THROUGH   IBUFFR(LTREND)   WITH
C              SPACES.  KOUNT  WILL  BE  RETURNED  RETURNED
C              POINTING TO IBUFFR(LTREND).
C     LFTCOL = SUBSCRIPT OF THE IBUFFR ARRAY ENTRY  TO  THE
C              IMMEDIATE LEFT OF THE FIRST CHARACTER IN THE
C              ITEM.
C     LTREND = SUBSCRIPT OF THE IBUFFR  ARRAY  ENTRY  WHICH
C              FORMS THE RIGHT END OF THE FIELD WHICH IS TO
C              CONTAIN THE ITEM.   IF  JSTIFY=1,  THEN  THE
C              RIGHTMOST  CHARACTER  OF  THE  ITEM  WILL BE
C              PLACED INTO IBUFFR(LTREND).
C     IERR   = -1,   FILL   THE   FIELD    STARTING    WITH
C              IBUFFR(LFTCOL+1)   AND   EXTENDING   THROUGH
C              IBUFFR(LTREND)  WITH  ASTERISKS  AND  RETURN
C              KOUNT POINTING TO IBUFFR(LTREND).
C            = ZERO OR GREATER,  MOVE  THE  ITEM  INPUT  IN
C              IBUFFR(LFTCOL+1)  THROUGH IBUFFR(KOUNT) INTO
C              THE POSITION INDICATED BY JSTIFY.
C     IBUFFR = INPUT CONTAINING THE ITEM  TO  BE  MOVED  IN
C              LOCATIONS      IBUFFR(LFTCOL+1)      THROUGH
C              IBUFFR(KOUNT).  THIS ITEM IS  POSITIONED  IN
C              THE  FIELD  STARTING AT IBUFFR(LFTCOL+1) AND
C              EXTENDING THROUGH IBUFFR(LTREND) AS DIRECTED
C              BY JSTIFY.
C     KOUNT  = INPUT CONTAINING THE SUBSCRIPT IN THE IBUFFR
C              ARRAY OF THE RIGHTMOST CHARACTER OF THE ITEM
C              TO BE POSITIONED AS DIRECTED BY JSTIFY.
C            = RETURNED POINTING TO THE RIGHTMOST CHARACTER
C              DEFINED IN THE FIELD AFTER THE ITEM HAS BEEN
C              MOVED, AND  SPACES  ADDED  IF  REQUESTED  BY
C              IFILL.
C
      DIMENSION IBUFFR(LTREND)
      DATA ISTAR,IBLANK/1H*,1H /
C
C     DETERMINE HOW FAR TO SHIFT ITEM TO RIGHT
      IF(IERR.LT.0)GO TO 5
      IF(KOUNT.LE.LFTCOL)GO TO 3
      IF(JSTIFY.LT.0)GO TO 3
      J=LTREND-KOUNT
      IF(JSTIFY.EQ.0)J=J/2
      IF(J.LE.0)GO TO 3
      I=KOUNT
      J=J+KOUNT
      KOUNT=J
C
C     SHIFT ITEM TO RIGHT IF CENTERING OR RIGHT JUSTIFYING
    1 IF(I.LE.LFTCOL)GO TO 2
      IBUFFR(J)=IBUFFR(I)
      J=J-1
      I=I-1
      GO TO 1
C
C     INSERT BLANKS TO LEFT OF RIGHT SHIFTED ITEM
    2 IF(J.LE.LFTCOL)GO TO 3
      IBUFFR(J)=IBLANK
      J=J-1
      GO TO 2
C
C     FILL OUT REST OF FIELD WITH BLANKS
    3 IF(IFILL.LE.0)GO TO 7
    4 IF(KOUNT.GE.LTREND)GO TO 7
      KOUNT=KOUNT+1
      IBUFFR(KOUNT)=IBLANK
      GO TO 4
C
C     FILL FIELD WITH ASTERISKS IF ITEM CANNOT FIT
    5 KOUNT=LFTCOL
    6 IF(KOUNT.GE.LTREND)GO TO 7
      KOUNT=KOUNT+1
      IBUFFR(KOUNT)=ISTAR
      GO TO 6
C
C     RETURN TO CALLING PROGRAM
    7 RETURN
C165672143471
      END