You can not select more than 25 topics
Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.
99 lines
2.8 KiB
99 lines
2.8 KiB
C Copyright(C) 1999-2020 National Technology & Engineering Solutions
|
|
C of Sandia, LLC (NTESS). Under the terms of Contract DE-NA0003525 with
|
|
C NTESS, the U.S. Government retains certain rights in this software.
|
|
C
|
|
C See packages/seacas/LICENSE for details
|
|
|
|
C============================================================================
|
|
SUBROUTINE SETFOR (IFUNC, INLINE, IFLD, INTYP, CFIELD, *)
|
|
C============================================================================
|
|
|
|
C --*** SETFOR *** (BLOT) Process FOREGROUND command
|
|
C -- Written by John Glick - 2/27/89
|
|
C --
|
|
C --Parameters:
|
|
C -- IFUNC - IN - = 1 if the call is to parse the FOREGROUND
|
|
C -- command.
|
|
C -- = 2 if the call is to reset the foreground color
|
|
C -- to the default color.
|
|
C -- INLINE - IN/OUT - the parsed input lines for the log file
|
|
C -- IFLD, INTYP, CFIELD, - IN/OUT - the free-field reader
|
|
C -- index and character field.
|
|
C -- * - return statement if command error; message is printed.
|
|
|
|
include 'params.blk'
|
|
INTEGER IFUNC
|
|
CHARACTER*(*) INLINE(*)
|
|
INTEGER IFLD, INTYP(*)
|
|
CHARACTER*(*) CFIELD(*)
|
|
|
|
include 'plcolr.blk'
|
|
include 'plcol2.blk'
|
|
|
|
LOGICAL FFEXST
|
|
INTEGER IDCOL, LOCSTR
|
|
|
|
CHARACTER*(mxstln) COLA, COLF
|
|
include 'cmap-lst.blk'
|
|
INTEGER DEFFOR
|
|
SAVE DEFFOR
|
|
|
|
DATA DEFFOR / 2 /
|
|
|
|
c DATA FORGND /'WHITE '/
|
|
|
|
C *****************************************************************
|
|
|
|
IF (IFUNC .EQ. 1) THEN
|
|
|
|
IF (FFEXST (IFLD, INTYP)) THEN
|
|
|
|
C Check that next field has characters in it.
|
|
|
|
IF (INTYP(IFLD) .GE. 0) THEN
|
|
COLA = CFIELD(IFLD)
|
|
IFLD = IFLD + 1
|
|
CALL ABRSTR (COLF, COLA, COLLST)
|
|
IF (COLF .EQ. ' ') THEN
|
|
WRITE (*, 10000) COLA
|
|
10000 FORMAT (1X, A, ' not a valid color name.')
|
|
GO TO 100
|
|
ELSE
|
|
IDCOL = LOCSTR (COLF, NCOLOR, COLLST)
|
|
CALL FFADDC (COLF, INLINE)
|
|
IF (IDCOL .GT. 0) THEN
|
|
FORGND = COLF
|
|
IDFOR = IDCOL
|
|
IDFORT = IDCOL
|
|
ELSE
|
|
WRITE (*, 10000) COLA
|
|
GO TO 100
|
|
ENDIF
|
|
ENDIF
|
|
ELSE
|
|
CALL PRTERR ('CMDERR',
|
|
& 'Expected color name following FOREGROUND command')
|
|
GOTO 100
|
|
ENDIF
|
|
ELSE
|
|
|
|
CALL PRTERR ('CMDERR',
|
|
& 'Expected color name following FOREGROUND command')
|
|
GOTO 100
|
|
|
|
ENDIF
|
|
|
|
ELSE IF (IFUNC .EQ. 2) THEN
|
|
|
|
IDFOR = DEFFOR
|
|
IDFORT = DEFFOR
|
|
FORGND = 'WHITE '
|
|
|
|
ENDIF
|
|
|
|
RETURN
|
|
|
|
100 CONTINUE
|
|
RETURN 1
|
|
|
|
END
|
|
|