Trailing-Edge
-
PDP-10 Archives
-
decus_20tap5_198111
-
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