Trailing-Edge
-
PDP-10 Archives
-
decus_20tap2_198111
-
decus/20-0049/prtpac.for
There is 1 other file named prtpac.for in the archive. Click here to see a list.
SUBROUTINE PENBGN (LASTX,LASTY,NEWX,NEWY)
C PENBGN PRINT 03/23/68
C GENPLT-II COUPLING SUBROUTINE PENBGN FOR PRINTER PLOTS
C
C DONALD BARTH, C/O K.B. WIBERG, DEPT. OF CHEMISTRY, YALE UNIVERSITY
C
C SUBROUTINE PENHLT CONTROLS SIZE AND RESOLUTION OF PRINTER PLOTS
C PENHLT VERSIONS ARE AVAILABLE FOR 12 PAGE PLOTS IN A4 OR A6 FORMAT
C ANOTHER PENHLT VERSION PRINTS FAST BUT LOW RESOLUTION 1 PAGE PLOTS
C
C PENHLT IS CALLED TO SPECIFY THE CONTENTS OF LABELED COMMON PRINTR
C
C COMMON/PRINTR/NUMBER(2592),ITWO(30),ICOL,IBITS,IUP,IDWN,MISS,
C 1MINX,MAXX,IADDX,IDIVX,MINY,MAXY,IADDY,IDIVY
C
C NUMBER = ARRAY IN WHICH THE PLOT WILL BE STORED PRIOR TO PRINTING
C ITWO = ARRAY CONTAINING POWERS OF TWO FROM 2**0 THROUGH 2**IBITS
C ICOL = COUNT OF NUMBER ARRAY ELEMENTS USED FOR EACH LINE OF PLOT
C IBITS = COUNT OF BITS IN EACH NUMBER ARRAY WORD USED FOR STORAGE
C IUP = COUNT OF CALLS TO PENUP, SET INITIALLY AT ZERO
C IDWN = COUNT OF CALLS TO PENDWN, SET INITIALLY AT ZERO
C MISS = COUNT OF LINES WHICH ARE COMPLETELY OUTSIDE THE PLOT AREA
C MINX = HORIZONTAL GRID COORDINATE OF LEFT EDGE OF PLOT AREA
C MAXX = HORIZONTAL GRID COORDINATE OF RIGHT EDGE OF PLOT AREA
C IADDX = INTEGER TO BE ADDED TO HORIZONTAL INPUT COORDINATES
C IDIVX = INTEGER BY WHICH ABOVE SUM IS DIVIDED TO PLACE ON GRID
C MINY = VERTICAL GRID COORDINATE OF UPPER EDGE OF PLOT AREA
C MAXY = VERTICAL GRID COORDINATE OF LOWER EDGE OF PLOT AREA
C IADDY = INTEGER FROM WHICH VERTICAL COORDINATES ARE SUBTRACTED
C IDIVY = INTEGER BY WHICH ABOVE DIFFERENCE IS DIVIDED
C
C PENHLT ALSO DEFINES THE FOLLOWING CONTENTS OF LABELED COMMON PPARM
C
C COMMON/PPARM/FACTOR,OFSETX,OFSETY,IERR,IPEN,NTAPE,MODE,IPOINT,
C 1IFREER,ILINE
C
C FACTOR = NUMBER OF GRID DIVISIONS ALONG LONGEST EDGE OF PLOT AREA
C OFSETX = OFFSET TO BE ADDED TO HORIZONTAL COORDINATES
C OFSETY = OFFSET TO BE ADDED TO VERTICAL COORDINATES
C IERR = NUMBER OF LINES ENTIRELY OUTSIDE PLOT AREA ON PRIOR PLOT
C NTAPE = TAPE UNIT ON WHICH PLOTS ARE TO BE PRINTED
C
CALL PENHLT(LASTX,LASTY,NEWX,NEWY)
RETURN
END
SUBROUTINE PENUP (LASTX,LASTY,NEWX,NEWY)
C PENUP PRINT 03/23/68
C GENPLT-II COUPLING SUBROUTINE PENUP FOR PRINTER PLOTS
C
C DONALD BARTH, C/O K.B. WIBERG, DEPT. OF CHEMISTRY, YALE UNIVERSITY
C
COMMON/PRINTR/NUMBER(2592),ITWO(30),ICOL,IBITS,IUP,IDWN,MISS,
1MINX,MAXX,IADDX,IDIVX,MINY,MAXY,IADDY,IDIVY
IUP=IUP+1
LASTX=((IADDX+NEWX)/IDIVX)-1
LASTY=((IADDY-NEWY)/IDIVY)-1
IF(LASTX-MINX)6,1,1
1 IF(LASTX-MAXX)2,2,6
2 IF(LASTY-MINY)6,3,3
3 IF(LASTY-MAXY)4,4,6
4 KOUNT=(LASTX+IBITS)/IBITS
MOVE=(IBITS*KOUNT)-LASTX
KOUNT=KOUNT+(ICOL*LASTY)
KOMPAR=NUMBER(KOUNT)/ITWO(MOVE)
IF(KOMPAR-(2*(KOMPAR/2)))5,5,6
5 NUMBER(KOUNT)=NUMBER(KOUNT)+ITWO(MOVE)
6 RETURN
END
SUBROUTINE PENDWN (LASTX,LASTY,NEWX,NEWY)
C PENDWN PRINT 03/23/68
C GENPLT-II COUPLING SUBROUTINE PENDWN FOR PRINTER PLOTS
C
C DONALD BARTH, C/O K.B. WIBERG, DEPT. OF CHEMISTRY, YALE UNIVERSITY
C
COMMON/PRINTR/NUMBER(2592),ITWO(30),ICOL,IBITS,IUP,IDWN,MISS,
1MINX,MAXX,IADDX,IDIVX,MINY,MAXY,IADDY,IDIVY
IDWN=IDWN+1
NOWX=((IADDX+NEWX)/IDIVX)-1
NOWY=((IADDY-NEWY)/IDIVY)-1
ILASTX=LASTX
ILASTY=LASTY
INOWX=NOWX
INOWY=NOWY
IF(LASTX-MINX)8,1,1
1 IF(LASTX-MAXX)2,2,8
2 IF(NOWX-MINX)8,3,3
3 IF(NOWX-MAXX)4,4,8
4 IF(LASTY-MINY)8,5,5
5 IF(LASTY-MAXY)6,6,8
6 IF(NOWY-MINY)8,7,7
7 IF(NOWY-MAXY)40,40,8
C
C **********************LINE SEGMENT IN ERROR***********************
C THIS SECTION COULD BE USED WITHOUT ABOVE TESTS FOR ALL LINES
8 MOVEX=NOWX-LASTX
MOVEY=NOWY-LASTY
MULT=0
C TEST HORIZONTAL COORDINATES FOR LINE SEGMENT OUTSIDE PLOTTER TABLE
IF(ILASTX-MINX)9,10,10
9 ILASTX=MINX
MULT=1
IF(INOWX-MINX)37,14,14
10 IF(ILASTX-MAXX)12,12,11
11 ILASTX=MAXX
MULT=1
IF(INOWX-MAXX)12,12,37
12 IF(INOWX-MINX)13,14,14
13 INOWX=MINX
GO TO 16
14 IF(INOWX-MAXX)16,16,15
15 INOWX=MAXX
16 IF(MOVEX)17,18,17
17 ILASTY=LASTY+((MOVEY*(ILASTX-LASTX))/MOVEX)
INOWY=NOWY-((MOVEY*(NOWX-INOWX))/MOVEX)
C TEST VERTICAL COORDINATES FOR LINE SEGMENT OUTSIDE PLOTTER TABLE
18 IF(ILASTY-MINY)19,20,20
19 ILASTY=MINY
MULT=1
IF(INOWY-MINY)37,24,24
20 IF(ILASTY-MAXY)22,22,21
21 ILASTY=MAXY
MULT=1
IF(INOWY-MAXY)22,22,37
22 IF(INOWY-MINY)23,24,24
23 INOWY=MINY
GO TO 26
24 IF(INOWY-MAXY)26,26,25
25 INOWY=MAXY
26 IF(MOVEY)27,28,27
27 ILASTX=LASTX+((MOVEX*(ILASTY-LASTY))/MOVEY)
INOWX=NOWX-((MOVEX*(NOWY-INOWY))/MOVEY)
28 IF(ILASTX-MINX)29,30,30
29 ILASTX=MINX
30 IF(ILASTX-MAXX)32,32,31
31 ILASTX=MAXX
32 IF(INOWX-MINX)33,34,34
33 INOWX=MINX
34 IF(INOWX-MAXX)36,36,35
35 INOWX=MAXX
36 IF(MULT)40,40,38
C RETURN IF NO PORTION OF LINE IS ON PLOTTER TABLE
37 MISS=MISS+1
LASTX=NOWX
LASTY=NOWY
RETURN
C
C ******BEGIN LINE SEGMENT EXTENDING FROM OUTSIDE PLOTTER TABLE*****
38 KOUNT=(ILASTX+IBITS)/IBITS
MOVE=(IBITS*KOUNT)-ILASTX
KOUNT=KOUNT+(ICOL*ILASTY)
KOMPAR=NUMBER(KOUNT)/ITWO(MOVE)
IF(KOMPAR-(2*(KOMPAR/2)))39,39,40
39 NUMBER(KOUNT)=NUMBER(KOUNT)+ITWO(MOVE)
C
C **********************PLOT THE LINE SEGMENT***********************
40 MOVEX=INOWX-ILASTX
MOVEY=INOWY-ILASTY
JUMPX=MOVEX
JUMPY=MOVEY
IF(MOVEX)44,41,45
41 IF(MOVEY)42,54,43
42 JUMPY=-MOVEY
43 LAGX=0
LAGY=0
MULT=JUMPY
GO TO 51
44 JUMPX=-MOVEX
45 IF(MOVEY)47,46,48
46 LAGX=0
LAGY=0
MULT=JUMPX
GO TO 51
47 JUMPY=-MOVEY
48 LAGX=(MOVEX*JUMPY)/(2*JUMPX)
LAGY=(JUMPX*MOVEY)/(2*JUMPY)
IF(JUMPX-JUMPY)49,50,50
49 MULT=JUMPY
GO TO 51
50 MULT=JUMPX
51 DO 53 J=1,MULT
MODX=ILASTX+(((J*MOVEX)+LAGX)/MULT)
MODY=ILASTY+(((J*MOVEY)+LAGY)/MULT)
KOUNT=(MODX+IBITS)/IBITS
MOVE=(IBITS*KOUNT)-MODX
KOUNT=KOUNT+(ICOL*MODY)
KOMPAR=NUMBER(KOUNT)/ITWO(MOVE)
IF(KOMPAR-(2*(KOMPAR/2)))52,52,53
52 NUMBER(KOUNT)=NUMBER(KOUNT)+ITWO(MOVE)
53 CONTINUE
54 LASTX=NOWX
LASTY=NOWY
RETURN
END
SUBROUTINE PENEND (LASTX,LASTY,NEWX,NEWY)
C PENEND PRINT 03/23/68
C GENPLT-II COUPLING SUBROUTINE PENEND FOR PRINTER PLOTS
C
C DONALD BARTH, C/O K.B. WIBERG, DEPT. OF CHEMISTRY, YALE UNIVERSITY
C
CALL PENHLT(LASTX,LASTY,NEWX,NEWY)
RETURN
END