Trailing-Edge
-
PDP-10 Archives
-
decuslib10-08
-
43,50476/daiblt.for
There are 2 other files named daiblt.for in the archive. Click here to see a list.
SUBROUTINE DAIBLT( LINE ,ILEFT ,
1 IRIGHT,LFTCOL,MAXBFR,IBUFFR,MAXLIN,MAXPRT,MAXUSD)
C RENBR(/IDENTIFY COLUMN NUMBERS)
C
C DONALD BARTH, CHEM. DEPT., HARVARD UNIVERSITY
C JAN 2, 1970
C
C WHEN A PROGRAM NEEDS TO DISPLAY TO THE USER A LINE OF
C CHARACTERS IN WHICH THE CHARACTERS ARE ORIENTED BY
C COLUMNS, A BAND OF NUMBERS IDENTIFYING THE COLUMNS
C CAN BE PRINTED, EITHER ABOVE OR BELOW THE MAIN
C DISPLAY, BY CALLING THE DAIBLT ROUTINE TO GENERATE
C EACH LINE OF THE REPRESENTATION OF THE COLUMN NUMBERS
C IN A BUFFER ARRAY WHICH THE CALLING PROGRAM CAN THEN
C PRINT WITH A MULTIPLE OF AN A1 FORMAT. DAIBLT IS
C CALLED AS MANY TIMES AS THERE ARE LINES IN THE
C REPRESENTATION OF THE COLUMN NUMBERS, THE CALLING
C PROGRAM PRINTING THE RETURNED CHARACTERS BEFORE AGAIN
C ASKING DAIBLT TO GENERATE THE NEXT LINE.
C
C EACH LINE OF THE NUMBER REPRESENTATION GENERATED BY
C THIS ROUTINE CONTAINS DIGITS CORRESPONDING TO THE
C SAME POWER OF 10 AS IN THE FOLLOWING EXAMPLE.
C
C 5432109876543210123456789012345
C 111111--------- 111111
C ------
C
C THE FOLLOWING ARE INPUT ARGUMENTS LEFT UNCHANGED.
C
C LINE = SELECTS WHICH LINE OF REPRESENTATION OF
C NUMBERS IS TO BE CONSTRUCTED. LINE EQUAL 1
C WILL SELECT DIGITS OF LOWEST SIGNIFICANCE.
C LINE SET EQUAL TO MAXLIN (OR TO ZERO) WILL
C SELECT MINUS SIGNS OR DIGITS OF HIGHEST
C SIGNIFICANCE IF POSITIVE OF NUMBER OR
C NUMBERS REQUIRING MOST CHARACTERS TO
C REPRESENT. MAXPRT AND MAXUSD ARE BOTH
C RETURNED EQUAL TO INPUT VALUE OF LFTCOL IF
C LINE IS INPUT GREATER THAN MAXLIN.
C
C SINCE EFFECTIVE VALUE OF MAXLIN IS NOT KNOWN
C PRIOR TO FIRST CALL TO THIS ROUTINE, LINE
C CAN BE SET TO ZERO TO REPRESENT SAME LINE AS
C IF LINE WAS INPUT EQUAL TO RETURNED VALUE OF
C MAXLIN. LINE IS RETURNED UNCHANGED, SO
C CALLING PROGRAM WOULD IN THIS CASE HAVE TO
C SET LINE EQUAL TO RETURNED VALUE OF MAXLIN-1
C PRIOR TO SECOND CALL TO THIS ROUTINE.
C
C ILEFT = THE LEFT OR FIRST NUMBER TO BE REPRESENTED.
C
C IRIGHT = THE RIGHT OR FINAL LIMIT OF NUMBERS TO BE
C REPRESENTED. UNLIKE ILEFT WHICH IS ALWAYS
C REPRESENTED, IRIGHT IS REPRESENTED ONLY IF
C BUFFER IS LARGE ENOUGH TO INCLUDE NUMBERS
C THROUGH IRIGHT. IRIGHT MUST BE EQUAL TO OR
C GREATER THAN ILEFT.
C
C LFTCOL = THE SUBSCRIPT OF IBUFFR ARRAY LOCATION TO
C IMMEDIATE LEFT OF LOCATION INTO WHICH IS TO
C BE PLACED DIGIT OR SIGN FORMING
C REPRESENTATION UPON CURRENT LINE OF LEFT
C NUMBER.
C
C MAXBFR = SUBSCRIPT OF HIGHEST LOCATION IN IBUFFR
C ARRAY INTO WHICH CAN BE PLACED
C REPRESENTATIONS OF NUMBERS FROM ILEFT
C THROUGH IRIGHT. THIS WOULD NORMALLY BE
C DIMENSION OF IBUFFR ARRAY.
C
C FOLLOWING ARGUMENTS ARE USED FOR OUTPUT. THEIR INPUT
C VALUES ARE IGNORED.
C
C IBUFFR = ARRAY IN WHICH NUMBERS ARE TO BE REPRESENTED
C AND WHICH CAN THEN BE PRINTED BY CALLING
C PROGRAM USING MULTIPLE OF A1 FORMAT.
C
C MAXLIN = RETURNED CONTAINING NUMBER OF LINES NEEDED
C TO REPRESENT NUMBERS ILEFT THROUGH IRIGHT.
C ACTUAL NUMBER OF LINES WHICH WOULD INCLUDE
C PRINTING CHARACTERS MAY BE LESS SINCE RIGHT
C NUMBER ACTUALLY DISPLAYED CAN REQUIRE FEWER
C CHARACTERS FOR ITS REPRESENTATION THAN WOULD
C IRIGHT.
C
C MAXPRT = RETURNED CONTAINING SUBSCRIPT OF RIGHT
C LOCATION IN IBUFFR ARRAY CONTAINING PRINTING
C CHARACTER GENERATED BY THIS ROUTINE. IF
C CURRENT CALL TO THIS ROUTINE HAS NOT ADDED
C ANY PRINTING CHARACTERS TO IBUFFR, THEN
C MAXPRT WILL BE RETURNED EQUAL TO LFTCOL.
C
C MAXUSD = RETURNED CONTAINING SUBSCRIPT OF RIGHT
C LOCATION IN IBUFFR ARRAY CONTAINING ANY
C CHARACTER GENERATED BY THIS ROUTINE. IF
C LINE IS LESS THAN OR EQUAL TO MAXLIN, THEN
C MAXUSD WILL BE RETURNED EQUAL TO VALUE OF
C MAXPRT WHICH WOULD BE RETURNED IF LINE WAS
C INPUT AS 1. SINCE RIGHTMOST PRINTING
C CHARACTER GENERATED BY CURRENT CALL TO THIS
C ROUTINE CAN BE TO LEFT OF THAT GENERATED IF
C LINE IS 1, ARRAY LOCATIONS STARTING AT
C IBUFFR(MAXPRT+1) THROUGH IBUFFR(MAXUSD) WILL
C CONTAIN SPACES. IF LINE IS GREATER THAN
C RETURNED VALUE OF MAXLIN, THEN MAXUSD IS
C RETURNED EQUAL TO LFTCOL.
C
DIMENSION IBUFFR(MAXBFR),IDGT(10)
DATA IDGT/1H0,1H1,1H2,1H3,1H4,1H5,1H6,1H7,1H8,1H9/
DATA IBLANK,IMINUS/1H ,1H-/
C
MAXPRT=LFTCOL
MAXUSD=LFTCOL
MAXLIN=0
IF(ILEFT.GT.IRIGHT)GO TO 13
IF(LFTCOL.GE.MAXBFR)GO TO 13
IZERO=LFTCOL-ILEFT+1
MOST=IRIGHT+IZERO
IF(MOST.GT.MAXBFR)MOST=MAXBFR
INTRVL=1
LIMIT=ILEFT
IF(LIMIT.LT.0)LIMIT=-10*LIMIT
IF(LIMIT.LT.IRIGHT)LIMIT=IRIGHT
IPWR10=1
1 MAXLIN=MAXLIN+1
IF(LINE.EQ.MAXLIN)INTRVL=IPWR10
IPWR10=10*IPWR10
IF(IPWR10.LE.LIMIT)GO TO 1
IF(LINE.GT.MAXLIN)GO TO 13
C
C DETERMINE LEFT DIGIT
LIMIT=ILEFT
IF(ILEFT.LT.0)LIMIT=-LIMIT
LIMIT=LIMIT/INTRVL
INDEX=LIMIT-(10*(LIMIT/10))+1
IF(ILEFT.GE.0)GO TO 2
LIMIT=IZERO-(INTRVL*LIMIT)-INTRVL
GO TO 3
2 LIMIT=IZERO+(INTRVL*LIMIT)-1
3 IF(MAXUSD.GE.IZERO)GO TO 4
IF(MAXUSD.LT.(IZERO-1))GO TO 5
IF(INTRVL.LE.1)GO TO 9
GO TO 7
4 IF(MAXUSD.LT.(IZERO+INTRVL-1))GO TO 7
GO TO 9
5 IF(MAXUSD.LT.(IZERO-INTRVL))GO TO 9
C
C PUT IN MINUS SIGNS IF NECESSARY
LIMIT=IZERO-(INTRVL/10)
IF(LIMIT.GT.MOST)LIMIT=MOST
6 MAXUSD=MAXUSD+1
IBUFFR(MAXUSD)=IMINUS
IF(MAXUSD.LT.LIMIT)GO TO 6
MAXPRT=MAXUSD
IF(MAXUSD.GE.MOST)GO TO 13
C
C PUT IN BLANKS IF NECESSARY
7 LIMIT=IZERO+INTRVL-1
IF(LIMIT.GT.MOST)LIMIT=MOST
8 MAXUSD=MAXUSD+1
IBUFFR(MAXUSD)=IBLANK
IF(MAXUSD.LT.LIMIT)GO TO 8
GO TO 11
C
C PUT IN DIGITS
9 LIMIT=LIMIT+INTRVL
IF(LIMIT.GT.MOST)LIMIT=MOST
10 MAXUSD=MAXUSD+1
IBUFFR(MAXUSD)=IDGT(INDEX)
IF(MAXUSD.LT.LIMIT)GO TO 10
MAXPRT=MAXUSD
11 IF(MAXUSD.GE.MOST)GO TO 13
C
C INCREMENT THE DIGIT
IF(MAXUSD.GE.IZERO)GO TO 12
INDEX=INDEX-1
IF(INDEX.LE.0)INDEX=10
GO TO 3
12 INDEX=INDEX+1
IF(INDEX.GT.10)INDEX=1
GO TO 3
C
C RETURN TO CALLING PROGRAM
13 RETURN
C INDEX = DIGIT PRESENTLY BEING PUT INTO ARRAY.
C INTRVL = REPETITIONS OF DIGIT BEFORE INCREMENT.
C IZERO = SUBSCRIPT CORRESPONDING TO ZERO (0).
C MAXUSD = NUMBER OF CHARACTERS IN IBUFFR ARRAY.
C LIMIT = SUBSCRIPT CORRESPONDING TO RIGHT
C APPEARANCE OF PRESENTLY ADDED DIGIT.
C MOST = SUBSCRIPT CORRESPONDING TO IRIGHT.
C536160823302
END