Trailing-Edge
-
PDP-10 Archives
-
decuslib20-02
-
decus/20-0049/prthlb.for
There is 1 other file named prthlb.for in the archive. Click here to see a list.
SUBROUTINE PENHLT (LASTX,LASTY,NEWX,NEWY)
C PENHLT MULTIPLE PAGE A4 PRINTER 03/23/68
C GENPLT-II COUPLING SUBROUTINE PENHLT FOR 12 PAGE A4 FORMAT PLOTS
C DONALD BARTH, C/O K.B. WIBERG, DEPT. OF CHEMISTRY, YALE UNIVERSITY
C
DIMENSION MASTER(16),LIST(32),IBCD(13)
COMMON/PPARM/FACTOR,OFSETX,OFSETY,IERR,IPEN,NTAPE,MODE,IPOINT,
1IFREER,ILINE
COMMON/PRINTR/NUMBER(2592),ITWO(30),ICOL,IBITS,IUP,IDWN,MISS,
1MINX,MAXX,IADDX,IDIVX,MINY,MAXY,IADDY,IDIVY
DATA MASTER /4H ,4H X,4H X ,4H XX,4H X ,
1 4H X X,4H XX ,4H XXX,4HX ,4HX X,4HX X ,4HX XX,4HXX ,4HXX X,
2 4HXXX ,4HXXXX/
DATA IBCD/4H1 ,4H2 ,4H3 ,4H4 ,4H5 ,4H6 ,4H7 ,
1 4H8 ,4H9 ,4HA ,4HB ,4HC ,4HD /
DATA IPLOT/0/
C
IF(IPLOT)1,1,4
1 IPLOT=1
C
C ************************DEFINE PLOT FORMAT************************
C
C VARIABLES LTTRS, LINES, IDIVX, IDIVY, ICHAR CONTROL PLOT FORMAT.
C THESE CAN BE MODIFIED IF DIMENSIONS ARE INCREASED WHEN NECESSARY.
C MINIMUM NUMBER ARRAY DIMENSION IS = LINES*((LTTRS+IBITS-1)/IBITS).
C MINIMUM LIST ARRAY DIMENSION IS = 8*((ICHAR-6)/IBITS).
C MINIMUM IBCD DIMENSION = ONE PLUS WIDTH OF PLOT IN PAGES.
C DO LOOPS REQUIRE CHANGE IF COUNT OF BITS USED PER WORD IS CHANGED.
C
C LTTRS = MINIMUM COUNT OF CHARACTERS TO BE PRINTED ACROSS PLOT
C
C LINES = COUNT OF LINES CORRESPONDING TO HEIGHT OF PLOT
C
C IDIVX = COUNT OF LINES WHICH CORRESPONDS TO A PLOT HEIGHT OF ONE
C
C IDIVY = COUNT OF LETTERS IN LINE WHICH CORRESPONDS TO WIDTH OF ONE
C
C ICHAR = MAXIMUM NUMBER OF CHARACTERS TO BE TYPED ACROSS PAGE WIDTH
C
C NTAPE = TAPE UNIT ON WHICH THE PLOTS ARE TO BE PRINTED AS OUTPUT
C
C IBITS = COUNT OF BITS USED PER WORD OF NUMBER STORAGE ARRAY.
C
C THIS SUBROUTINE IS PRESENTLY SET UP TO STORE PLOTS AS 216 LINES
C (LINES=216) EACH CONTAINING 360 CHARACTERS (LTTRS=360).
C FOR PRINTING, THE PLOT WILL BE BROKEN INTO 3 PANELS 1 PAGE WIDE
C BY 216 LINES LONG SINCE UP TO 132 CHARACTERS (ICHAR=132) CAN BE
C PRINTED ACROSS THE WIDTH OF A SINGLE PAGE.
C LEFT AND RIGHT MARGINS ARE 10 CHARACTERS WIDE ((LTTRS-IDIVY)/2=10)
C UPPER AND LOWER MARGINS ARE 6 LINES WIDE ((LINES-IDIVX)/2=6).
C POINTS OR LINES OUTSIDE THESE ERROR MARGINS WILL NOT BE SHOWN.
C
LTTRS=360
LINES=216
IDIVX=204
IDIVY=340
ICHAR=132
NTAPE=6
C
C **************INITIALIZE CONTENTS OF LABELED COMMON***************
IBITS=30
ICOL=(LTTRS+IBITS-1)/IBITS
IWIDE=(ICHAR-6)/IBITS
IPAGE=(ICOL+IWIDE-1)/IWIDE
LIMIT=ICOL*LINES
DO 2 I=1,LIMIT
2 NUMBER(I)=0
ITWO(1)=1
DO 3 I=2,IBITS
3 ITWO(I)=2*ITWO(I-1)
IUP=0
IDWN=0
MISS=0
MINX=0
MAXX=(IBITS*ICOL)-1
IADDX=IDIVX*(1+(ICOL*IBITS-IDIVY)/2)
MINY=0
MAXY=LINES-1
IADDY=IDIVY*(1+(LINES+IDIVX)/2)-1
MOST=IDIVX*IDIVY
FACTOR=MOST-1
OFSETX=0.0
OFSETY=0.0
IERR=0
RETURN
C
C *******WRITE THE PLOT IN HOLLERITH FORM ON TAPE UNIT NTAPE********
4 IERR=MISS
DO 5 I=1,LIMIT
IF(NUMBER(I))5,5,7
5 CONTINUE
IF(IUP)6,6,13
6 RETURN
7 CALL PENUP (LASTX,LASTY, -1,MOST)
CALL PENDWN(LASTX,LASTY,MOST,MOST)
CALL PENDWN(LASTX,LASTY,MOST, -1)
CALL PENDWN(LASTX,LASTY, -1, -1)
CALL PENDWN(LASTX,LASTY, -1,MOST)
DO 11 KOLUMN=1,IPAGE
KOUNT=(KOLUMN*IWIDE)-ICOL
WRITE(NTAPE,8)
8 FORMAT(1H1)
DO 11 LINE=1,LINES
KOUNT=KOUNT+ICOL-IWIDE
ILIST=0
DO 10 J=1,IWIDE
KOUNT=KOUNT+1
ILIST=ILIST+8
INDEX7=NUMBER(KOUNT)/4
INDEX6=INDEX7/16
INDEX5=INDEX6/16
INDEX4=INDEX5/16
INDEX3=INDEX4/16
INDEX2=INDEX3/16
INDEX1=INDEX2/16
INDEX8=4*(NUMBER(KOUNT)-4*INDEX7)
INDEX7=INDEX7-(16*INDEX6)
INDEX6=INDEX6-(16*INDEX5)
INDEX5=INDEX5-(16*INDEX4)
INDEX4=INDEX4-(16*INDEX3)
INDEX3=INDEX3-(16*INDEX2)
INDEX2=INDEX2-(16*INDEX1)
LIST(8*J) =MASTER(INDEX8+1)
LIST(8*J-1)=MASTER(INDEX7+1)
LIST(8*J-2)=MASTER(INDEX6+1)
LIST(8*J-3)=MASTER(INDEX5+1)
LIST(8*J-4)=MASTER(INDEX4+1)
LIST(8*J-5)=MASTER(INDEX3+1)
LIST(8*J-6)=MASTER(INDEX2+1)
LIST(8*J-7)=MASTER(INDEX1+1)
NUMBER(KOUNT)=0
IF(KOUNT-LINE*ICOL)10,9,9
9 KOUNT=KOUNT+IWIDE-J
GO TO 11
10 CONTINUE
11 WRITE(NTAPE,12)IBCD(KOLUMN),(LIST(I),I=1,ILIST),IBCD(KOLUMN+1)
12 FORMAT(1H ,1A1,20(7A4,1A2))
IUP=IUP-1
IDWN=IDWN-4
13 WRITE(NTAPE,14)IPLOT,IUP,IDWN,IERR
14 FORMAT(1H0,6X,4HPLOT,1I3,8H SUMMARY/1H ,1I5,16H PENUP COMMANDS/1H
1 ,1I5,16H PENDWN COMMANDS/1H ,1I5,16H LINES NOT SHOWN)
MISS=0
IUP=0
IDWN=0
IPLOT=IPLOT+1
RETURN
END