Google
 

Trailing-Edge - PDP-10 Archives - decuslib10-02 - 43,50247/prtpac.f4
There are no other files named prtpac.f4 in the archive.
      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