Trailing-Edge
-
PDP-10 Archives
-
decuslib20-02
-
decus/20-0049/calpac.for
There is 1 other file named calpac.for in the archive. Click here to see a list.
SUBROUTINE PENBGN (LASTX,LASTY,NEWX,NEWY)
C PENBGN CALCOMP DRUM PLOTTER (GENERAL) 03/23/68
C GENPLT-II GENERAL COUPLING ROUTINE FOR CALCOMP DRUM PLOTTERS.
C
C DONALD BARTH, C/O K.B. WIBERG, DEPT. OF CHEMISTRY, YALE UNIVERSITY
C
C THE STANDARD CALCOMP ROUTINE PLOT(XPAGE,YPAGE,IC) IS CALLED.
C FOR SUBROUTINE PLOT XPAGE = HORIZONTAL POSITION GIVEN IN INCHES.
C YPAGE = VERTICAL POSITION GIVEN IN INCHES.
C IC = -3 SHIFTS THE ORIGIN TO (XPAGE,YPAGE)
C IC = 2 MOVES LOWERED PEN TO (XPAGE,YPAGE)
C IC = 3 LIFTS PEN AND MOVES TO (XPAGE,YPAGE)
C
C ROUTINE PLOTS(BUFFER,NBUF,NTAPE) MUST BE CALLED FOR OFFLINE PLOTS.
C FOR SUBROUTINE PLOTS BUFFER = ARRAY FOR COLLECTING DATA FOR TAPE.
C NBUF = NUMBER OF LOCATIONS IN BUFFER ARRAY.
C NTAPE = LOGICAL TAPE UNIT FOR OUTPUT.
C LENGTH OF BUFFER AND TAPE NUMBER DEPEND ON SYSTEM CONFIGURATION.
C DIMENSION BUFFER(4096)
COMMON/PPARM/FACTOR,OFSETX,OFSETY,IERR,IPEN,NTAPE,MODE,IPOINT,
1IFREER,ILINE
COMMON/CALCMP/WIDTH,MINX,MAXX,MINY,MAXY,MISS
C CONSULT SYSTEM PROGRAMMER ABOUT BUFFER AND TAPE FOR OFF-LINE PLOTS
C CALL PLOTS(BUFFER,4096,8)
C DEFINITION OF WIDTH MUST BE CHANGED TO MATCH WIDTH OF PLOTTER.
C FOR EXAMPLE, A 29.5 INCH WIDTH PLOTTER WOULD HAVE WIDTH = 29.5
WIDTH=10.23
FACTOR=1000.0*WIDTH
OFSETX=0.
OFSETY=0.
MINX=0
MINY=0
MAXX=FACTOR+0.5
MAXY=FACTOR+0.5
MISS=0
IERR=0
RETURN
END
SUBROUTINE PENUP (LASTX,LASTY,NEWX,NEWY)
C PENUP CALCOMP DRUM PLOTTER (GENERAL) 03/23/68
C GENPLT-II GENERAL COUPLING ROUTINE FOR CALCOMP DRUM PLOTTERS.
C
C DONALD BARTH, C/O K.B. WIBERG, DEPT. OF CHEMISTRY, YALE UNIVERSITY
C
COMMON/CALCMP/WIDTH,MINX,MAXX,MINY,MAXY,MISS
LASTX=NEWX
LASTY=NEWY
IF(LASTX-MINX)5,1,1
1 IF(LASTX-MAXX)2,2,5
2 IF(LASTY-MINY)5,3,3
3 IF(LASTY-MAXY)4,4,5
4 XPAGE=0.001*FLOAT(NEWX)
YPAGE=0.001*FLOAT(NEWY)
CALL PLOT (XPAGE,YPAGE,3)
5 RETURN
END
SUBROUTINE PENDWN (LASTX,LASTY,NEWX,NEWY)
C PENDWN CALCOMP DRUM PLOTTER (GENERAL) 03/23/68
C GENPLT-II GENERAL COUPLING ROUTINE FOR CALCOMP DRUM PLOTTERS.
C
C DONALD BARTH, C/O K.B. WIBERG, DEPT. OF CHEMISTRY, YALE UNIVERSITY
C
COMMON/CALCMP/WIDTH,MINX,MAXX,MINY,MAXY,MISS
ILASTX=LASTX
ILASTY=LASTY
INOWX=NEWX
INOWY=NEWY
IF(LASTX-MINX)8,1,1
1 IF(LASTX-MAXX)2,2,8
2 IF(NEWX-MINX)8,3,3
3 IF(NEWX-MAXX)4,4,8
4 IF(LASTY-MINY)8,5,5
5 IF(LASTY-MAXY)6,6,8
6 IF(NEWY-MINY)8,7,7
7 IF(NEWY-MAXY)39,39,8
C
C **********************LINE SEGMENT IN ERROR***********************
C THIS SECTION COULD BE USED WITHOUT ABOVE TESTS FOR ALL LINES
8 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(NEWX-LASTX)17,18,17
17 SLOPE=FLOAT(NEWY-LASTY)/FLOAT(NEWX-LASTX)
ILASTY=LASTY+IFIX(SLOPE*FLOAT(ILASTX-LASTX))
INOWY=NEWY-IFIX(SLOPE*FLOAT(NEWX-INOWX))
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(NEWY-LASTY)27,28,27
27 SLOPE=FLOAT(NEWX-LASTX)/FLOAT(NEWY-LASTY)
ILASTX=LASTX+IFIX(SLOPE*FLOAT(ILASTY-LASTY))
INOWX=NEWX-IFIX(SLOPE*FLOAT(NEWY-INOWY))
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)39,39,38
C RETURN IF NO PORTION OF LINE IS ON PLOTTER TABLE
37 MISS=MISS+1
LASTX=NEWX
LASTY=NEWY
RETURN
C
C ******BEGIN LINE SEGMENT EXTENDING FROM OUTSIDE PLOTTER TABLE*****
38 XPAGE=0.001*FLOAT(ILASTX)
YPAGE=0.001*FLOAT(ILASTY)
CALL PLOT (XPAGE,YPAGE,3)
C
C **********************PLOT THE LINE SEGMENT***********************
39 XPAGE=0.001*FLOAT(INOWX)
YPAGE=0.001*FLOAT(INOWY)
CALL PLOT (XPAGE,YPAGE,2)
LASTX=NEWX
LASTY=NEWY
RETURN
END
SUBROUTINE PENHLT (LASTX,LASTY,NEWX,NEWY)
C PENHLT CALCOMP DRUM PLOTTER (GENERAL) 03/23/68
C GENPLT-II GENERAL COUPLING ROUTINE FOR CALCOMP DRUM PLOTTERS.
C
C DONALD BARTH, C/O K.B. WIBERG, DEPT. OF CHEMISTRY, YALE UNIVERSITY
C
COMMON/PPARM/FACTOR,OFSETX,OFSETY,IERR,IPEN,NTAPE,MODE,IPOINT,
1IFREER,ILINE
COMMON/CALCMP/WIDTH,MINX,MAXX,MINY,MAXY,MISS
CALL PLOT (WIDTH,0.0,-3)
IERR=MISS
MISS=0
LASTX=-2000
RETURN
END
SUBROUTINE PENEND (LASTX,LASTY,NEWX,NEWY)
C PENEND CALCOMP DRUM PLOTTER (GENERAL) 03/23/68
C GENPLT-II GENERAL COUPLING ROUTINE FOR CALCOMP DRUM PLOTTERS.
C
C DONALD BARTH, C/O K.B. WIBERG, DEPT. OF CHEMISTRY, YALE UNIVERSITY
C
COMMON/CALCMP/WIDTH,MINX,MAXX,MINY,MAXY,MISS
IF(LASTX+2000)1,2,1
1 CALL PLOT (WIDTH,0.0,-3)
2 CALL PLOT (0.0,0.0,999)
RETURN
END