File: FIPLOT.FT of Tape: Various/System-Tapes/eb-plot
(Source file text)
SUBROUTINE FIPLOT (ICOM,ARG1,ARG2,IARG3,IARG4)
C -----------------
C
C GENERATE DEVICE INDEPENDENT PLOT FILE
C
DIMENSION ARG1(1) , ARG2(1) , IARG4(1)
C
LOGICAL SIZOUT
COMMON /FIBUFF/ XCUR , YCUR , IXCUR , IYCUR , STEPS ,
+ CHRH , CHRW , CHRCOS, CHRSIN, SIZOUT ,
+ CHRDX, CHRDY, ICHRDX, ICHRDY, IFONT ,
+ IPL , IBUF
C-----------------------------------------------------------------------
C DISPATCH
C
C MOVE
IF (ICOM .EQ. 16) GOTO 160
C CHAR STRING PLOT
IF (ICOM .EQ. 5) GOTO 50
C CHAR SIZE
IF (ICOM .EQ. 6) GOTO 60
C CHAR ROTATION
IF (ICOM .EQ. 51) GOTO 510
C INIT
IF (ICOM .EQ. -1) GOTO 5
C
C SEND COMMAND BYTE AS IS
C
CALL FIBYTE (ICOM+32)
C
C CHAR FONT
IF (ICOM .EQ. 52) GOTO 520
C NEW PEN (IMPLICIT PEN UP)
IF (ICOM .EQ. 4) GOTO 40
C DEFINE DASH PATTERN
IF (ICOM .EQ. 13) GOTO 130
C NEW PICTURE
IF (ICOM .EQ. 53) GOTO 530
C END OF PLOT
IF (ICOM .EQ. 15) GOTO 150
C ALL OTHERS ARE ONE BYTE COMMANDS WITHOUT BOOKEEPING
RETURN
C-----------------------------------------------------------------------
C INIT
C ----
5 IPL = IARG3
STEPS = ARG1(1)
IBUF = 0
C
C SET DEFAULTS
C
6 XCUR = 0.
YCUR = 0.
IXCUR = 0
IYCUR = 0
CHRH = 0.
CHRW = 0.
CHRCOS = 1.
CHRSIN = 0.
SIZOUT = .FALSE.
RETURN
C-----------------------------------------------------------------------
C NEW PEN
C -------
40 CALL FIBYTE (IARG3+32)
RETURN
C-----------------------------------------------------------------------
C SYMBOL STRING
C -------------
50 IF (SIZOUT) GOTO 51
C
C SEND SYMBOL SCALING INFORMATION
C
TEMP = STEPS*CHRW
CHRDX = CHRCOS*TEMP
ICHRDX = CHRDX
CHRDY = CHRSIN*TEMP
ICHRDY = CHRDY
CALL FIBYTE (38)
CALL FIDELT (ICHRDX,ICHRDY)
TEMP = STEPS * CHRH
IDX =-CHRSIN * TEMP
IDY = CHRCOS * TEMP
CALL FIDELT (IDX,IDY)
SIZOUT = .TRUE.
C
51 NCHAR = IARG3
IF (IFONT) 999,57,52
C
C SEND SYMBOLS FONT 1-3,11,12
C
52 CALL FIBYTE (37)
CALL FIBYTE (NCHAR+32)
DO 54 I = 1,NCHAR
54 CALL FIBYTE (IARG4(I))
GOTO 59
C
C SEND SYMBOLS FONT 0
C
57 CALL FIBYTE (86)
CALL FIBYTE (NCHAR+32)
DO 58 I = 1,NCHAR
K = IARG4(I)
L = K/16
CALL FIBYTE (L + 32)
58 CALL FIBYTE (K - L*16 + 32)
C
C UPDATE CURRENT POSITION
C
59 IF (IFONT .EQ. 3) RETURN
IXCUR = IXCUR + NCHAR*ICHRDX
IYCUR = IYCUR + NCHAR*ICHRDY
XCUR = XCUR + NCHAR*CHRDX
YCUR = YCUR + NCHAR*CHRDY
RETURN
C-----------------------------------------------------------------------
C SYMBOL SIZE DEFINITION
C ----------------------
60 CHRW = ARG1(1)
CHRH = ARG2(1)
SIZOUT = .FALSE.
RETURN
C-----------------------------------------------------------------------
C DASH PATTERN DEFINITION
C -----------------------
130 I = IARG4(1)
CALL FIBYTE (I+32)
L = IARG3
CALL FIBYTE (L+32)
DO 133 I = 1,L
IDX = ARG1(I) * STEPS
IDY = ARG2(I) * STEPS
133 CALL FIDELT (IDX,IDY)
RETURN
C-----------------------------------------------------------------------
C END OF PLOT (FLUSH BUFFER , DISABLE PLOT ROUTINES)
C -----------
150 CALL FIBYTE (0)
IPL = -1
RETURN
C-----------------------------------------------------------------------
C MOVE
C ----
160 DX = ARG1(1)*STEPS
DY = ARG2(1)*STEPS
XCUR = XCUR + DX
YCUR = YCUR + DY
161 IDX = XCUR - IXCUR
IDY = YCUR - IYCUR
IXCUR = IXCUR + IDX
IYCUR = IYCUR + IDY
CALL FIDELT (IDX,IDY)
RETURN
C-----------------------------------------------------------------------
C SYMBOL ANGLE DEFINITION
C -----------------------
510 CHRCOS = ARG1(1)
CHRSIN = ARG2(1)
SIZOUT = .FALSE.
RETURN
C-----------------------------------------------------------------------
C SYMBOL FONT DEFINITION
C -----------------------
520 IFONT = IARG3
CALL FIBYTE (IFONT+32)
RETURN
C-----------------------------------------------------------------------
C START OF NEW PICTURE
C --------------------
530 IDX = ARG1(1) * STEPS
IDY = ARG2(1) * STEPS
CALL FIDELT (IDX,IDY)
GOTO 6
C-----------------------------------------------------------------------
C ILLEGAL ARGS
C ------------
999 PAUSE 2
RETURN
END