Google
 

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