Trailing-Edge
-
PDP-10 Archives
-
decuslib20-02
-
decus/20-0049/prthlc.for
There is 1 other file named prthlc.for in the archive. Click here to see a list.
SUBROUTINE PENHLT (LASTX,LASTY,NEWX,NEWY)
C PENHLT SINGLE PAGE PRINTER 03/23/68
C GENPLT-II COUPLING SUBROUTINE PENHLT FOR ONE PAGE PRINTER PLOTS
C
C DONALD BARTH, C/O K.B. WIBERG, DEPT. OF CHEMISTRY, YALE UNIVERSITY
C
C SINGLE PAGE PLOTS ARE FOR TESTING NEW ROUTINES AT GENPLT-II LEVEL.
C SUCH MIGHT BE USED FOR TESTING NEW DATA PLOTTING METHODS OR FONTS.
C RESOLUTION IS TOO POOR FOR TESTING ROUTINES WHICH CALL GENPLT-II.
C
DIMENSION N1(16),N2(4),N3(2),N4(16),N5(4),LIST(31)
C
COMMON/PPARM/FACTOR,OFSETX,OFSETY,IERR,IPEN,NTAPE,MODE,IPOINT,
1IFREER,ILINE
C
COMMON/PRINTR/NUMBER(2592),ITWO(30),ICOL,IBITS,IUP,IDWN,MISS,
1MINX,MAXX,IADDX,IDIVX,MINY,MAXY,IADDY,IDIVY
C
DATA N1(01),N1(02),N1(03),N1(04),N1(05),N1(06),N1(07),N1(08),
1 N1(09),N1(10),N1(11),N1(12),N1(13),N1(14),N1(15),N1(16)/
2 4H ,4H X,4H X ,4H XX,4H X ,4H X X,4H XX ,4H XXX,
3 4HX ,4HX X,4HX X ,4HX XX,4HXX ,4HXX X,4HXXX ,4HXXXX/
C
DATA N2(01),N2(02),N2(03),N2(04)/4H1 ,4H1X ,4HX ,4HXX /
C
DATA N3(01),N3(02)/4H1 ,4HX /
C
DATA N4(01),N4(02),N4(03),N4(04),N4(05),N4(06),N4(07),N4(08),
1 N4(09),N4(10),N4(11),N4(12),N4(13),N4(14),N4(15),N4(16)/
2 4H----,4H---X,4H--X-,4H--XX,4H-X--,4H-X-X,4H-XX-,4H-XXX,
3 4HX---,4HX--X,4HX-X-,4HX-XX,4HXX--,4HXX-X,4HXXX-,4HXXXX/
C
DATA N5(01),N5(02),N5(03),N5(04)/4H1- ,4H1X ,4HX- ,4HXX /
C
DATA IPLOT/0/
C
IF(IPLOT)1,1,4
C
C **************INITIALIZE CONTENTS OF LABELED COMMON***************
1 IPLOT=1
DO 2 I=1,306
2 NUMBER(I)=0
ITWO(1)=1
DO 3 I=2,20
3 ITWO(I)=2*ITWO(I-1)
ICOL=6
IBITS=20
IUP=0
IDWN=0
MISS=0
MINX=0
MAXX=100
IADDX=204
IDIVX=204
MINY=0
MAXY=50
IADDY=21007
IDIVY=404
FACTOR=20603.0
OFSETX=0.0
OFSETY=0.0
IERR=0
NTAPE=6
RETURN
C
C *******WRITE THE PLOT IN HOLLERITH FORM ON TAPE UNIT NTAPE********
4 DO 5 I=1,306
IF(NUMBER(I))5,5,7
5 CONTINUE
IF(IUP)6,6,15
6 RETURN
7 LOCK=0
KOUNT=0
WRITE(NTAPE,8)
8 FORMAT(1H1)
DO 14 LINE=1,51
IF(LOCK)12,12,9
9 LOCK=LOCK-1
DO 10 KOLUMN=1,5
KOUNT=KOUNT+1
INDEX5=NUMBER(KOUNT)/16
INDEX4=INDEX5/16
INDEX3=INDEX4/4
INDEX2=INDEX3/16
INDEX1=INDEX2/16
INDEX6=NUMBER(KOUNT)-16*INDEX5
INDEX5=INDEX5-16*INDEX4
INDEX4=INDEX4-4*INDEX3
INDEX3=INDEX3-16*INDEX2
INDEX2=INDEX2-16*INDEX1
NUMBER(KOUNT)=0
LIST(6*KOLUMN) =N1(INDEX6+1)
LIST(6*KOLUMN-1)=N1(INDEX5+1)
LIST(6*KOLUMN-2)=N2(INDEX4+1)
LIST(6*KOLUMN-3)=N1(INDEX3+1)
LIST(6*KOLUMN-4)=N1(INDEX2+1)
10 LIST(6*KOLUMN-5)=N2(INDEX1+1)
KOUNT=KOUNT+1
INDEX1=1+(NUMBER(KOUNT)/524288)
NUMBER(KOUNT)=0
LIST(31)=N3(INDEX1)
WRITE(NTAPE,11)(LIST(I),I=1,31)
11 FORMAT(1X,10(A2,2A4),A1)
GO TO 14
12 LOCK=4
DO 13 KOLUMN=1,5
KOUNT=KOUNT+1
INDEX5=NUMBER(KOUNT)/16
INDEX4=INDEX5/16
INDEX3=INDEX4/4
INDEX2=INDEX3/16
INDEX1=INDEX2/16
INDEX6=NUMBER(KOUNT)-16*INDEX5
INDEX5=INDEX5-16*INDEX4
INDEX4=INDEX4-4*INDEX3
INDEX3=INDEX3-16*INDEX2
INDEX2=INDEX2-16*INDEX1
NUMBER(KOUNT)=0
LIST(6*KOLUMN) =N4(INDEX6+1)
LIST(6*KOLUMN-1)=N4(INDEX5+1)
LIST(6*KOLUMN-2)=N5(INDEX4+1)
LIST(6*KOLUMN-3)=N4(INDEX3+1)
LIST(6*KOLUMN-4)=N4(INDEX2+1)
13 LIST(6*KOLUMN-5)=N5(INDEX1+1)
KOUNT=KOUNT+1
INDEX1=1+(NUMBER(KOUNT)/524288)
NUMBER(KOUNT)=0
LIST(31)=N3(INDEX1)
WRITE(NTAPE,11)(LIST(I),I=1,31)
14 CONTINUE
15 WRITE(NTAPE,16)IPLOT,IUP,IDWN,MISS
16 FORMAT(1H0,4HPLOT,1I4,12H SUMMARY ***,1I6,19H PENUP COMMANDS ***,1
1I6,20H PENDWN COMMANDS ***,1I6,16H LINES NOT SHOWN)
IERR=MISS
MISS=0
IUP=0
IDWN=0
IPLOT=IPLOT+1
RETURN
END