Google
 

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