PROGRAM NUMGEN
	IMPLICIT NONE
C******************************************************************************
C***
C***	This program generates integer numbers and imbeds them in a string then 
C***	outputs the string to the terminal, a file, or to DCL for processing.
C***
C***	This program uses the following routines :
C***
C***		RT_ERROR.FOR
C***		GET_PID.FOR
C***		LENGTH.FOR
C***		UPCASE.FOR
C***
C***	Author :	Jeff Cameron
C***
C***	Modification history :
C***
C***	Programmer	Date		Description
C*** ----------------------------------------------------------------------
C***	Jeff Cameron	08-AUG-1994	Initially written
C***	Jeff Cameron	30-SEP-1998	Added optional output file with
C***					DCL execution option.
C*** ----------------------------------------------------------------------
C***
C******************************************************************************
C
C***	Constants
	INCLUDE		'($SSDEF)'
	INCLUDE		'($STRDEF)'
	INCLUDE		'($SYSSRVNAM)'
C
	INTEGER*1	TEMPORARY
	PARAMETER	(TEMPORARY = 0)
	INTEGER*4	NOWAIT
	PARAMETER	(NOWAIT = 1)
C
C***	Common blocks
C
C***	Local declarations
C
	INTEGER*1	COMPLETION_EVENT_FLAG
	INTEGER*4	RESERVED_EVENT_FLAG
C
	INTEGER*4	TYO /6/, OUT /9/
	CHARACTER*255	COMMANDLINE
	CHARACTER*255	OUTFILE
	CHARACTER*132	OUTSTRING
	CHARACTER*80	FMTSTR
	CHARACTER*15	PARAM (0:3)
	CHARACTER*20	MBX_NAME
	CHARACTER*4	BOLD_ON		/'E[1m'/
	CHARACTER*3	BOLD_OFF	/'E[m'/
	INTEGER*4	LCL, LFS, LOS, LOF, LP (0:3)
	INTEGER*4	I,J,K
	INTEGER*4	JSIZ
	INTEGER*4	MY_PID, HIS_PID
	INTEGER*4	MBX_CHAN
	INTEGER*4	ISTAT
	INTEGER*4	IQSTART, IQEND
	INTEGER*4	ISTART,IEND,INC,IZPAD
	INTEGER*4	IVALUE
C
	CHARACTER*10	SVALUE
	INTEGER*4	LSV
C
	LOGICAL*4	DCL
	LOGICAL*4	COMERROR
C
C***	Externals
	INTEGER*4	LENGTH,STR$ELEMENT,ISIZ
	INTEGER*4	LIB$SPAWN,LIB$GET_EF,LIB$FREE_EF
	EXTERNAL	LENGTH,STR$ELEMENT,ISIZ
	EXTERNAL	LIB$SPAWN,LIB$GET_EF,LIB$FREE_EF
C
C***	Formats
 1	FORMAT (A)
 2	FORMAT (I<JSIZ>.<IZPAD>)
 3	FORMAT (A7,Z8.8,A5)
 5	FORMAT ('WRITE SYS$OUTPUT "',A4,A,A3,'"')
C------------------------------------------------------------------------------
	BOLD_ON  (1:1) = CHAR (27)
	BOLD_OFF (1:1) = CHAR (27)
C
C***	OPEN SYS$OUTPUT
	OPEN (	UNIT=TYO,
	1	FILE='SYS$OUTPUT',
	2	CARRIAGECONTROL='LIST',
	3	TYPE='NEW',
	4	IOSTAT=ISTAT)
C
	IF (ISTAT .NE. 0) THEN
	    TYPE *,'%NUMGEN-F-OUTOPENFAIL, failed to open SYS$OUTPUT.'
	    CALL RT_ERROR (0,ISTAT)
	    CALL EXIT (1)
	ELSE
	ENDIF
C
C***	GET THE COMMAND LINE
	CALL LIB$GET_FOREIGN (COMMANDLINE,,LCL,)
	IF (LCL .LE. 0) THEN
	    CALL DOC_NUMGEN
	    CALL EXIT
	ELSE
	ENDIF
C
C***	Load the parameters
	DO I = 0,3
	    ISTAT = STR$ELEMENT (PARAM(I),I,' ',COMMANDLINE(1:LCL))
	    IF (ISTAT .EQ. SS$_NORMAL) THEN
		LP (I) = LENGTH (PARAM(I))
	    ELSE IF (ISTAT .EQ. STR$_NOELEM) THEN
		WRITE (TYO,1) '%NUMGEN-E-INSUFPAR, insufficient parameters.'
		CALL DOC_NUMGEN
		CALL EXIT
	    ELSE
		WRITE (TYO,1) '%NUMGEN-E-PARSERR, parsing error.'
		CALL SYS_SIGNAL (ISTAT)
		CALL DOC_NUMGEN
		CALL EXIT
	    ENDIF
	END DO
C
	COMERROR = .FALSE.
C
C***	Decode input integer values
	READ (PARAM(0)(1:LP(0)),*,ERR=11) ISTART
	GO TO 12
C
 11	WRITE (TYO,1) '%NUMGEN-E-INVSTART, invalid integer specification for start.'
	COMERROR = .TRUE.
C
 12	READ (PARAM(1)(1:LP(1)),*,ERR=13) IEND
	GO TO 14
C
 13	WRITE (TYO,1) '%NUMGEN-E-INVEND, invalid integer specification for end.'
	COMERROR = .TRUE.
C
 14	READ (PARAM(2)(1:LP(2)),*,ERR=15) INC
	GO TO 16
C
 15	WRITE (TYO,1) '%NUMGEN-E-INVINC, invalid integer specification for increment.'
	COMERROR = .TRUE.
C
 16	READ (PARAM(3)(1:LP(3)),*,ERR=17) IZPAD
	IF ((IZPAD .LT. 0) .OR. (IZPAD .GT. 10)) GO TO 17
	GO TO 20
C
 17	WRITE (TYO,1) '%NUMGEN-E-INVZPAD, invalid integer specification for zpad.'
	COMERROR = .TRUE.
C
 20	IF (COMERROR) THEN
	    CALL DOC_NUMGEN
	    CALL EXIT
	ELSE
	ENDIF
C
C***	Extract quoted string
	IQSTART = INDEX (COMMANDLINE(1:LCL),'"')
	IF ((IQSTART .LE. 0) .OR. (IQSTART .EQ. LCL)) THEN
	    WRITE (TYO,1) '%NUMGEN-E-MSNGSTRING, missing required quoted string.'
	    COMERROR = .TRUE.
	ELSE
	    IQEND = IQSTART + 1
	    DO WHILE ((COMMANDLINE(IQEND:IQEND) .NE. '"') .AND. (IQEND .LT. LCL))
		IQEND = IQEND + 1
	    END DO
	    IF (IQEND-IQSTART .LE. 1) THEN
		WRITE (TYO,1) '%NUMGEN-E-MSNGSTRING, missing required quoted string.'
		COMERROR = .TRUE.
	    ELSE
		FMTSTR = COMMANDLINE (IQSTART+1:IQEND-1)
		LFS = LENGTH (FMTSTR)
		IF (LFS .LE. 0) THEN
		    WRITE (TYO,1) '%NUMGEN-E-MSNGSTRING, missing required quoted string.'
		    COMERROR = .TRUE.
		ELSE
		    IF (INDEX(FMTSTR(1:LFS),'#') .LE. 0) THEN
			WRITE (TYO,1) '%NUMGEN-E-MSNGPOUND, missing at least one pound (#) in format string.'
			COMERROR = .TRUE.
		    ELSE
		    ENDIF
		ENDIF
	    ENDIF
	ENDIF
C
C***	Is there an optional output file name ! LEFT OFF HERE
	OUTFILE = ' '
	IF (IQEND .NE. LCL) THEN
	    I = IQEND + 1
	    DO WHILE ((I .LT. LCL) .AND. (COMMANDLINE(I:I) .EQ. ' '))
		I = I + 1
	    END DO
	    IF (I .LT. LCL) THEN
		OUTFILE = COMMANDLINE (I:LCL)
	    ELSE
		OUTFILE = 'SYS$OUTPUT'
	    ENDIF
	ELSE
	    OUTFILE = 'SYS$OUTPUT'
	ENDIF
	CALL UPCASE (OUTFILE)
	LOF = LENGTH (OUTFILE)
C
	DCL = (LOF .EQ. 3) .AND. (OUTFILE(1:3) .EQ. 'DCL')
C
C***	Test reliability of increment, start, and end.
	IF (INC .LT. 0) THEN
	    IF (ISTART .LT. IEND) THEN
		WRITE (TYO,1) '%NUMGEN-E-BADINC, for negative increment start must be greater than'
		WRITE (TYO,1) '                  or equal to end.'
		COMERROR = .TRUE.
	    ELSE
	    ENDIF
	ELSE IF (INC .GT. 0) THEN
	    IF (ISTART .GT. IEND) THEN
		WRITE (TYO,1) '%NUMGEN-E-BADINC, for positive increment start must be less than'
		WRITE (TYO,1) '                  or equal to end.'
		COMERROR = .TRUE.
	    ELSE
	    ENDIF
	ELSE ! (INC .EQ. 0)
	    WRITE (TYO,1) '%NUMGEN-E-INVINC, increment must be non-zero.'
	    COMERROR = .TRUE.
	ENDIF
C
	IF (COMERROR) THEN
	    CALL DOC_NUMGEN
	    CALL EXIT
	ELSE
	ENDIF
C
C***	All values are good, Open Output file
	IF (DCL) THEN
C
C***	    Create a mailbox, name then a mail box
	    CALL GET_PID (MY_PID)
	    WRITE (MBX_NAME,3) 'NUMGEN_', MY_PID, '_MBOX'
	    ISTAT = SYS$CREMBX (%VAL(TEMPORARY),MBX_CHAN,,,,,MBX_NAME,,)
	    IF (.NOT. ISTAT) THEN
		WRITE (TYO,1) ' %NUMGEN-F-MBXCRE8FAIL, failed to create DCL command mailbox.'
		CALL LIB$STOP (%VAL(ISTAT))
	    ELSE
	    ENDIF
C
C***	    Get a process completion eventflag number
	    ISTAT = LIB$GET_EF (RESERVED_EVENT_FLAG)
	    IF (.NOT. ISTAT) THEN
		WRITE (TYO,1) ' %NUMGEN-F-COMPEFALOCFAIL, failed to allocate DCL completion event flag.'
		CALL LIB$STOP (%VAL(ISTAT))
	    ELSE
	    ENDIF
C
	    ISTAT = SYS$CLREF (%VAL(RESERVED_EVENT_FLAG))
	    IF (.NOT. ISTAT) THEN
		WRITE (TYO,1) ' %NUMGEN-F-COMPEFALOCFAIL, failed to allocate DCL completion event flag.'
		CALL LIB$STOP (%VAL(ISTAT))
	    ELSE
		COMPLETION_EVENT_FLAG = RESERVED_EVENT_FLAG
	    ENDIF
C
C***	    Spawn a DCL subprocess
	    ISTAT = LIB$SPAWN (,MBX_NAME,'SYS$OUTPUT',NOWAIT,,HIS_PID,,COMPLETION_EVENT_FLAG,,,,,)
	    IF (.NOT. ISTAT) THEN
		WRITE (TYO,1) ' %NUMGEN-F-SPAWNFAIL, failed to spawn DCL subprocess.'
		CALL LIB$STOP (%VAL(ISTAT))
	    ELSE
	    ENDIF
C
	    OUTFILE = MBX_NAME
	    LOF = 20
	ELSE
	ENDIF
C
C***	Open output file
	OPEN (	UNIT=OUT,
	1	FILE=OUTFILE(1:LOF),
	2	STATUS='NEW',
	3	CARRIAGECONTROL='LIST',
	4	IOSTAT=ISTAT)
C
	IF (ISTAT .NE. 0) THEN
	    WRITE (TYO,1) ' %NUMGEN-F-OPENOUTFAIL, failed to open output file ' // OUTFILE (1:LOF)
	    CALL RT_ERROR (TYO,ISTAT)
	    IF (DCL) THEN
		ISTAT = SYS$DELMBX (MBX_CHAN)
	    ELSE
	    ENDIF
	    CALL EXIT
	ELSE
	ENDIF
C
C***	Do the Generation
	DO IVALUE = ISTART,IEND,INC
	    SVALUE = ' '
	    OUTSTRING = ' '
	    JSIZ = JMAX0 (IZPAD,ISIZ(IVALUE))
	    WRITE (SVALUE,2) IVALUE
	    LSV = LENGTH (SVALUE)
	    J = 1
	    DO I = 1,LFS
		IF (FMTSTR(I:I) .EQ. '#') THEN
		    DO K = 1,LSV
			OUTSTRING (J:J) = SVALUE (K:K)
			J = J + 1
		    END DO
		ELSE
		    OUTSTRING (J:J) = FMTSTR (I:I)
		    J = J + 1
		ENDIF
	    END DO
	    LOS = LENGTH (OUTSTRING)
C
	    IF (DCL) THEN
		IF (OUTSTRING(1:1) .NE. '$') OUTSTRING = '$' // OUTSTRING(1:LOS)
		LOS = LOS + 1
		WRITE (OUT,5) BOLD_ON,OUTSTRING (1:LOS),BOLD_OFF
	    ELSE
	    ENDIF
C
	    WRITE (OUT,1) OUTSTRING (1:LOS)
	END DO
C
	CLOSE (UNIT=OUT)
C
	IF (DCL) THEN
	    ISTAT = SYS$DELMBX (MBX_CHAN)
	    ISTAT = SYS$WAITFR (%VAL(RESERVED_EVENT_FLAG))
	    ISTAT = LIB$FREE_EF (RESERVED_EVENT_FLAG)
	ELSE
	ENDIF
C
C***	All done
 9000	CALL EXIT
	END
	SUBROUTINE DOC_NUMGEN
	IMPLICIT NONE
C******************************************************************************
C***
C***	This routine documents the NUMGEN usage
C***
C***	Author :	Jeff Cameron
C***
C***	Modification history :
C***
C***	Programmer	Date		Description
C*** ----------------------------------------------------------------------
C***	Jeff Cameron	08-AUG-1994	Initially written
C*** ----------------------------------------------------------------------
C***
C******************************************************************************
C
C***	Constants
C
C***	Common blocks
C
C***	Local declarations
	INTEGER*4	TYO /6/, TYI /5/
	CHARACTER*1	RESP
C
C***	Externals
C
C***	Formats
 1	FORMAT (A)
C------------------------------------------------------------------------------
C
C***	Begining of executable code.
	WRITE (TYO,1) ' NUMGEN usage :'
	WRITE (TYO,1) '                $NUMGEN start end inc zpad "string" [outfile|DCL]'
	WRITE (TYO,1) ' '
	WRITE (TYO,1) '  This program generates a series of strings, one per line with integer'
	WRITE (TYO,1) ' values imbedded.'
	WRITE (TYO,1) '   Parameters :'
	WRITE (TYO,1) '       start       Starting integer value.'
	WRITE (TYO,1) '       end         Ending integer value.'
	WRITE (TYO,1) '       inc         Integer increment.'
	WRITE (TYO,1) '       zpad        Number of leading zero padding.'
	WRITE (TYO,1) '       string      String format.'
	WRITE (TYO,1) '       outfile|DCL Optional output file or DCL execution. If no file'
	WRITE (TYO,1) '                   is specified, output is listed to SYS$OUTPUT.'
	WRITE (TYO,1) '  Example :'
	WRITE (TYO,1) '     The command : $NUMGEN 20 1220 300 3 "FILE # A#B.DAT"'
	WRITE (TYO,1) '  will generate :'
	WRITE (TYO,1) ' FILE 020 A020B.DAT'
	WRITE (TYO,1) ' FILE 320 A320B.DAT'
	WRITE (TYO,1) ' FILE 620 A620B.DAT'
	WRITE (TYO,1) ' FILE 920 A920B.DAT'
	WRITE (TYO,1) ' FILE 1220 A1220B.DAT'
	WRITE (TYO,1) ' <CR> for more'
	READ (TYI,1,END=1000) RESP
	WRITE (TYO,1) '  Second Example :'
	WRITE (TYO,1) '     The command : $NUMGEN 0 100 10 3 "CREATE/DIR SYS$DISK:[DATA.GROUP#]" DCL'
	WRITE (TYO,1) '  will generate 11 directories : [DATA.GROUP000], [DATA.GROUP010] through'
	WRITE (TYO,1) '  [DATA.GROUP100] by passing off each generated command to DCL.'
	WRITE (TYO,1) ' '
	WRITE (TYO,1) ' Additional information.'
	WRITE (TYO,1) ' '
	WRITE (TYO,1) '     The values for start, end, inc, and zpad must all be integers. Zpad'
	WRITE (TYO,1) ' must be a value from 0 to 10. The string specification must be enclosed'
	WRITE (TYO,1) ' in double quotes, and must contain at least one pound sign indicating'
	WRITE (TYO,1) ' where the integer numbers are to be substituted.'
	WRITE (TYO,1) ' '
C
C***	All done
 1000	RETURN
	END