Google
 

Trailing-Edge - PDP-10 Archives - decuslib10-02 - 43,50247/calard.f4
There are no other files named calard.f4 in the archive.
      SUBROUTINE PLOTP(INDEX)
C
C     DONALD BARTH, CHEMISTRY DEPT., HARVARD UNIVERSITY
C
C     ROUTINE TO SIMULATE OUTPUT FROM HARVARD VERSION
C     OF CALCOMP PLOT ROUTINE ON 1024X1024 CRT.  THE
C     FACTOR VARIABLE SHOULD BE CHANGED FROM 11.0 TO
C     10.23, AND THE DIMENSION STATEMENT AND THE CALL
C     TO THE ROUTINE PLOTS SHOULD BE REMOVED IN THE
C     STANDARD VERSION OF PENBGN FOR THE CALCOMP.
C
      DIMENSION IX(10),IY(10)
C     DEFINE CODE FOR RAISING PEN, LOWERING PEN AND END
C     (THE END CODE ALSO IS FIRST CODE GIVEN)
      DATA IUP,IDWN,IEND/32,16,63/
      DATA LOCK,NUMBER/0,0/
      DATA LASTX,LASTY/0,0/
      DATA IX/0,0,0,1,1,1,0,-1,-1,-1/
      DATA IY/-1,1,0,0,-1,1,0,0,-1,1/
C
      IF(INDEX.NE.IEND)GO TO 2
C
C     BEGIN OR TERMINATE PLOTTING
      IF(LOCK.NE.0)GO TO 1
      LOCK=1
      GO TO 7
    1 IF(LOCK.LT.0)RETURN
      LOCK=-1
      READ(5,6)I
      CALL CRTWIP
      RETURN
    2 IF(INDEX.NE.IUP)GO TO 3
C
C     TERMINATE PREVIOUS LINE AND TURN OFF BEAM (RAISE PEN)
      IF(NUMBER.NE.0)CALL CRTON (NOWX,NOWY)
      IDSPLY=0
      RETURN
    3 IF(INDEX.NE.IDWN)GO TO 4
C
C     TURN ON BEAM (LOWER PEN) AND INITIALIZE VECTOR TYPE
      IDSPLY=1
      NUMBER=0
      RETURN
C
C     CALCULATE NEW ABSOLUTE COORDINATES
    4 LASTX=LASTX+IX(INDEX)
      LASTY=LASTY+IY(INDEX)
C
C     ALLOW PEN TO TRAVEL TO RIGHT EDGE TO SET ORIGIN
      IF(LASTY.LT.0)LASTY=0
C
C     BEGIN NEW PLOT IF PEN TRAVELS RIGHT OF PLOT AREA
      IF(LASTX.LE.1023)GO TO 8
      LASTX=0
    5 READ(5,6)I
    6 FORMAT(1A1)
    7 CALL CRTWIP
      CALL CRTOFF(1023,1023)
      CALL CRTON (   0,1023)
      CALL CRTON (   0,   0)
      CALL CRTON (1023,   0)
      CALL CRTON (1023,1023)
      IF(INDEX.EQ.IEND)RETURN
C
C     PLOT PREVIOUS VECTOR IF NEW DIRECTION DIFFERENT
    8 IF(IDSPLY.EQ.0)RETURN
      IF(INDEX.EQ.NUMBER)GO TO 10
      NUMBER=INDEX
      IF(IDSPLY.LT.0)GO TO 9
      CALL CRTOFF(LASTX,LASTY)
      IDSPLY=-1
      GO TO 10
    9 CALL CRTON (NOWX,NOWY)
   10 NOWX=LASTX
      NOWY=LASTY
      RETURN
      END