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