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