CP/M/CPM_CDROM.iso/simtel/cpmug/cpmug091.ark/HI.FOR

Text File | 1984-04-29 | 5.2 KB | 202 lines

C *******************************************************
C
C            PLOT ROUTINES FOR DMP2 PLOTTER
C
C  Written by Victor DePinto,  1980, 1981, 1982
C  Last revised Jan. 26, 1982
C
C ******************************************************
C
C The following routine returns the plotter pen to
C the lower left of the display space.
C
      SUBROUTINE HOME
      CALL DRAW ( 0.0, 0.0, .FALSE. )
      RETURN
      END
C
C *********************************************
C
C Draws a border
C
      SUBROUTINE BORDER
      Y = 0.0
      X = 1.0
      CALL DRAW (X, Y, .TRUE.)
      Y = 1.0
      CALL DRAW (X, Y, .TRUE.)
      X = 0.0
      CALL DRAW (X, Y, .TRUE.)
      Y = 0.0
      CALL DRAW (X, Y, .TRUE.)
      CALL HOME
      RETURN
      END
C
C **********************************************
C
C Draws gridlines
C
      SUBROUTINE GRID
      WRITE (1,1)
1     FORMAT (' How many horizontal zones?'/)
      READ (1,3) HZONS
3     FORMAT (F10.0)
      WRITE (1,5)
5     FORMAT ('+How many vertical zones?'/)
      READ (1,3) VZONS
      IHLINS = HZONS - 1
      IVLINS = VZONS - 1
      X = 0.0
      DO 7 J = 1,IVLINS
      Y = J / VZONS
      CALL DRAW (X, Y, .FALSE.)
      IF (X .EQ. 0) GO TO 30
      X = 0.0
      GO TO 7
30    X = 1.0
7     CALL DRAW (X, Y, .TRUE.)
      Y = 1.0
      DO 10 J = 1,IHLINS
      X = J / HZONS
      CALL DRAW (X, Y, .FALSE.)
      IF (Y .EQ. 0.0 ) GO TO 40
      Y = 0.0
      GO TO 10
40    Y = 1.0
10    CALL DRAW (X, Y, .TRUE.)
      CALL HOME
      END
C
C ***********************************************************
C
C The following routine sets the pen speed of the plotter.
C
      SUBROUTINE SPEED
      INTEGER D
      DATA R, C / 200.0, 0.000477 /
      WRITE (1,10)
10    FORMAT (' Enter pen speed in inches per second
     X (2.4 is max): ')
      READ (1,20) S
20    FORMAT (F10.0)
C The following code computes the integer delay constant, D, a
C parameter indicating delay in tenth milliseconds.
C Where:    D = Delay of delay routine in tenths of milliseconds.
C           S = Desired pen speed in inches per second.
C           R = Steps per inch of plotter.
C           C = The time required to compute the step.
C Note: The DMP2 can be strapped for either 100 or 200 steps per inch.
      D = 10000.0 * (1.0/(R*S) - C)
      CALL SETTIM ( D )
      RETURN
      END
C
C **********************************************************
C
C This routine moves to problem space position X, Y.
C X and Y are unity full scale. 0,0 is lower left.
C If DRWFLG is true on entry, a line is drawn; otherwise,
C it is just a move.
C
      SUBROUTINE DRAW ( X, Y, DRWFLG )
      LOGICAL DRWFLG, STATUS
      INTEGER XD, YD, XPEN, YPEN, XWNDOW, YWNDOW
      INTEGER XMOV, YMOV, ESTAT
      COMMON /FISH/XMOV,YMOV
      DATA XPEN, YPEN, XWNDOW, YWNDOW / 0, 0, 2000, 1400 /
     X          ,STATUS / 0 /
C EXPLAINATION OF STATUS BYTE:
C BIT    MEANING
C  0     Pen down
C  1     Draw (move with pen down)
C  2     Previous destination offscale
C  3     Entry destination offscale
C
C Set the "Destination Offscale" and "Draw" bits in the status word
C so that it correctly reflects status on entry to this routine.
      STATUS = STATUS .AND. X'F5'
      STATUS = STATUS .OR. ( 8 .AND. ( X .LT. 0.0 .OR. X .GT. 1.0
     X         .OR. Y .LT. 0.0 .OR. Y .GT. 1.0 ) )
     X         .OR. ( 2 .AND. DRWFLG )
C This indicates status on entry to this routine.
      ESTAT = STATUS + 1
C Take action as required by plot algorithm.
      GO TO (30,25,26,30,28,60,28,60,30,25,30,25,60,60,60), ESTAT
      RETURN
25    CALL PENUP
      STATUS = STATUS .AND. X'FE'
      GO TO 30
26    CALL PENDN
      STATUS = STATUS .OR. 1
      GO TO 30
28    STATUS = STATUS .AND. X'FB'
30    GO TO (50,50,50,50,50,60,50,60,40,40,40,40,60,60,60), ESTAT
      RETURN
40    STATUS = STATUS .OR. 4
      GO TO 60
C
C Do the move.
C
C Convert to display space.
50    XD = X * XWNDOW
      YD = Y * YWNDOW
C Compute the move.
      XMOV = XD - XPEN
      YMOV = YD - YPEN
      CALL VECTOR
C Update the pen position.
      XPEN = XD
      YPEN = YD
60    RETURN
      END
C
C ***********************************************************
C
C The following routine draws a vector on the the DMP2.
C Entry parameters are X and Y.
C This routine is taken from the Houston Instruments manual.
C
      SUBROUTINE VECTOR
      LOGICAL ASTR(16), CHAR
      INTEGER D,E,F,I,T,X,Y,Z
      COMMON /FISH/X,Y
      DATA ASTR/'p','q','r','q','r','s','t','s','t',
     + 'u','v','u','v','w','p','w'/
130   F = IABS(X) + IABS(Y)
140   IF (F.EQ.0) GO TO 470
150   D = IABS(Y) - IABS(X)
180   I = 0
190   IF (Y.LT.0) GO TO 210
200   I=2
210   T=X+Y
220   IF (T.LT.0) GO TO 240
230   I=I+2
240   T=Y-X
250   IF (T.LT.0) GO TO 270
260   I=I+2
270   IF (X.LT.0) GO TO 300
280   I=8-I
290   GO TO 310
300   I=I+10
310   IF (D.LT.0) GO TO 350
320   T=IABS(X)
330   D = -D
340   GO TO 360
350   T=IABS(Y)
360   E=0
370   Z=T+D+E+E
380   IF (Z.LT.0) GO TO 430
390   E=E+D
400   F=F-2
410   CHAR = ASTR(I)
      CALL PRINT (CHAR)
420   GO TO 460
430   E=E+T
440   F=F-1
450   CHAR = ASTR(I-1)
      CALL PRINT (CHAR)
460   IF (F.GT.0) GO TO 370
470   RETURN
                  E  N  D