#COMMND		Generate Command File from Directory
#
#
DEFINE (PROMPT="CMD" )	# 3 CHARACTER PROMPT STRING (E.G. "PMP")
DEFINE (INPUTEXT=".LST" )	# DEFAULT EXTENSION FOR INPUT FILE (E.G. ".IN")
DEFINE (OUTPUTEXT=".CMD" )	# DEFAULT EXTENSION FOR OUTPUT FILE (E.G. ".OUT")
DEFINE (PROGNAME=COMMND )	# NAME OF YOUR PROGRAM TO BE CALLED AS A SUBROUTINE
			# (E.G. SUBROU)
#
INCLUDE DEFN/NL		# STANDARD DEFINITIONS
#
INTEGER SETFLT
#
    WHILE( SETFLT(STDLUNTI, PROMPT,INPUTEXT,OUTPUTEXT,STDLUNIND) == YES)
    	CALL PROGNAME
    CALL EXIT
    END
#
    SUBROUTINE COMMND
#
    DEFINE(ENTIRELINE=0)
    DEFINE(ENTIRENAME=1)	
    DEFINE(NOVERSION=2)
    DEFINE(NOEXTENSION=3)
    DEFINE (FUNNYCOMMA=-20)
    DEFINE (FUNNYEQUAL=-21)
    DEFINE (FUNNYSLASH=-22)
#
    CHARACTER FILNAM(20),	# INPUT FILE NAME
	CMD(MAXLINE),		# COMMAND WITH SUBSTITUTIONS
	TEMCOM(MAXLINE)		# TEMPLATE COMMAND
    INTEGER GETNAM,		# FUNCTION TO GET NEXT FILE NAME FROM INPUT
    	SUBFOR,			# SUBSTITUTION FUNCTION
	APPEND,			# RATLIB APPEND FUNCTION
    	MODE			# CONTROL MODE ( ENTIRENAME | NOEXTENSION |
    				#			NOVERSION)    
#
    CALL INIT(MODE,TEMCOM)		# GET MODE AND TEMPLATE FROM COMMAND LINE
    IF ( TEMCOM(1) == EOS)	{	# PROMPT FOR COMMAND LINE IF NOT GIVEN
	CALL PUTL(" TYPE COMMAND LINE, '?' IS REPLACED BY FILE NAME",STDLUNTI)
	CALL GETL(TEMCOM,MAXLINE,STDLUNTI)
	}
    WHILE( GETNAM(MODE,FILNAM)~=EOF){	# GET THE NEXT NAME
	CMD(1)=EOS
	JUNK = APPEND (CMD,TEMCOM,1)
    	JUNK = SUBFOR(CMD,"?",FILNAM)	# DO THE SUBS
    	CALL PUTL( CMD, STDLUNOUT)	
    	}
    RETURN
    END
#
#INIT 		INITIALIZATION FOR COMMND ROUTINE
#
#   		PROCESS MCR COMMAND LINE SWITCHES TO RETURN
#
#   			MODE -- PROCESSING MODE
#   			TEMCOM --	THE TEMPLATE COMMAND
#
#
    SUBROUTINE INIT(MODE,TEMCOM)
#
    DEFINE(SWITCHLENGTH=80)
#
    INTEGER MODE,
	    GETARG,		# RATLIB GET ARGUEMENT ROUTINE
	    NUMSWI,		# SWITCH NUMBER
	    SHIFT,		# RATLIB SHIFT FUNCTION
	    NEGATE,		# SWITCH NEGATION FLAG
	    LOC			# LOCATION OF ":" IN SWITCH ARGUEMENT
    CHAR TEMCOM(ARB),
    	 WRKSWI(SWITCHLENGTH)	# WORK SWITCH STRING
#
    MODE = ENTIRENAME			# INITIALIZE MODE
    TEMCOM(1) = EOS		# AND EMPTY COMMAND STRING
#
    FOR ( NUMSWI = 1; GETARG(NUMSWI,WRKSWI,SWITCHLENGTH)~=EOF;
    	    INCREMENT(NUMSWI) ){
	NEGATE = NO		# INITIALIZE TO NO NEGATION
	IF ( WRKSWI(1) == '-'){	# SWITCH NEGATED BY "-" ?
	    NEGATE = YES
	    JUNK = SHIFT(WRKSWI,1)	# SHIFT OUT NEGATION
	    }
	IF ( WRKSWI(1)=='N' & WRKSWI(2)=='O'){  # SWITCH NEGATED BY "NO" ?	
	    NEGATE = YES
	    JUNK = SHIFT(WRKSWI,2)	# SHIFT OUT NEGATION
	    }
# FIRST LETTER WILL IDENTIFY THE SWITCH
	IF( WRKSWI(1) == "V")		# NO VERSION SWITCH
	    MODE = NOVERSION
	ELSE IF ( WRKSWI(1) == "E")	# NO EXTENSION SWITCH
	    MODE = NOEXTENSION
	ELSE IF ( WRKSWI(1) == "L")	# ENTIRE LINE SWITCH
	    MODE = ENTIRELINE
	ELSE IF ( WRKSWI(1) == "C"){	# COMMAND TEMPLATE
	    LOC = INDEX(WRKSWI,":") + 1	# FIND THE COLIN
	    IF ( LOC >> 1)
	       CALL SCOPY(WRKSWI,LOC,TEMCOM,1,SWITCHLENGTH)# AND COPY ARGUEMENT
	    FOR( I = 1; TEMCOM(I) ~= EOS; INCREMENT(I) )	# CHANGE FUNNYCOMMA
		IF ( TEMCOM(I)==FUNNYCOMMA)		# TO COMMA
		    TEMCOM(I) = ','
		ELSE IF ( TEMCOM(I)==FUNNYEQUAL)		# AND FUNNY EQUAL
		    TEMCOM(I) = '='			# TO EQUAL
		ELSE IF ( TEMCOM(I)==FUNNYSLASH)		# AND FUNNYSLASH
		    TEMCOM(I)= '/'				#  TO SLASH
	    }
	ELSE 				# BAD SWITCH
	   CALL MCRERR(STDLUNTI,PROMPT,'BAD SWITCH, IGNORED')
	}
	END

#
#GETNAM		Get next file name
#
    INTEGER FUNCTION GETNAM(MODE,FILNAM)
#
#INPUT
#
    INTEGER MODE		# MODE CONTROL:
    				#    NONE -- ACCEPT ENTIRE LINE
    				#    ENTIRENAME -- ACCEPT ENTIRE FILE NAME
    				#    NOVERSION --  NO VERSION NUMBER
    				#    NOEXTENSION -- NO EXTENSION
#
#OUTPUT
#
    CHARACTER FILNAM(ARB)	# THE FILE NAME IN PROPER FORM
#
#   FUNCTION RETURNS EOF IF NO NAME FOUND, LENGTH OF NAME IF NAME FOUND
#
#
#INTERNAL DECLARATIONS
#
    CHARACTER BUF(80),		# INPUT BUFFER
    	BRKCHR			# BREAK CHARACTER FOR FILE NAME
    INTEGER I
    INTEGER LEN,		# LENGTH COUNTER 
    	GETL,			# GET LINE FUNCTION
    	PLACE,			# PLACE MARKER FOR BRKCHR
    	INDEX,			# RATLIB INDEX FUNCTION
	SUBFOR,			# RATLIB SUBSTITUTION FUNCTION
	SHIFT,			# RATLIB SHIFT FUNCTION
    	APPEND			# RATLIB APPEND FUNCTION
#
    REPEAT{			# LOOP UNTIL PROPER LINE IS FOUND
    	LEN = GETL(BUF, 80, STDLUNIN)
    	IF ( LEN==EOF){
    	    FILNAM(1)=EOS
	    RETURN(EOF)		    		    		
	    }
 	FOR ( I=1; BUF(I)~= EOS; INCREMENT(I) ){   # REMOVE NON-PRINTING CHARS
	    IF ( BUF(I) >= BLANK & BUF(I) <= "~")  # PRINTING CHARACTER?
		NEXT			# YES, DO NOTHING
	    ELSE {
		JUNK = SHIFT(BUF(I),1)	# NO, SHIFT IT OUT
		DECREMENT(I)
		}	    		
	    }
   	IF ( MODE==ENTIRELINE)		# DONE SEARCH IF ACCEPTING ENTIRE LINE
    		BREAK
	IF ( INDEX(BUF,";") ~= 0)	# SEARCH FOR SEMICOLIN IN FILE NAME
	    BREAK
	}
    IF ( MODE == NOVERSION)
    	BRKCHR = ";"			# BREAK OFF NAME BEFORE VERSION NUMBER
    ELSE IF ( MODE == NOEXTENSION)
    	BRKCHR = "."			# BREAK OFF NAME BEFORE EXTENSION
    ELSE IF ( MODE == ENTIRENAME | MODE == ENTIRELINE)
    	BRKCHR = EOS
    IF ( BRKCHR ~= EOS) {
	PLACE =  INDEX(BUF,BRKCHR) 	# TRUNCATE THE FILE NAME AT BRKCHR
	BUF(PLACE) = EOS
	}
    JUNK = SUBFOR(BUF,' ',EOS)	# REMOVE ALL BLANKS
    FILNAM(1)=EOS		# ZERO THE FILENAME
    LEN = APPEND(FILNAM, BUF, 1)	# APPEND THE STRING TO FILE NAME
    RETURN(LEN)
    END
INTEGER FUNCTION NXTMCR(LUNPMT,PROMP,LUNIND,NUMOUT)
CHAR PROMP(3),MCR(82),CJUNK,FN(41),TYPE
INTEGER NUMOUT,DONE,I,N,POS,LUNIND,FIRST,NBRCK,ININD,GETL,MATCH
COMMON /MCRNFO/ MCR,POS
DATA DONE/NO/, FIRST/YES/, ININD/NO/
 
IF (LUNPMT<0) {
   CLOSE (UNIT=LUNIND)
   ININD=NO
   RETURN (YES)
   }
#%^
REPEAT {          # UNTIL NON-BLANK MCR LINE OR END OF MCR INPUT
   IF (DONE==YES & ININD==NO) RETURN (NO)
   IF (FIRST==YES) {
      CALL GETMCR(MCR,N)
      FOR (POS=1; POS<=N & MCR(POS)~=BLANK & MCR(POS)~=TAB; POS=POS+1) {}
      WHILE (POS<=N & MCR(POS)==BLANK | MCR(POS)==TAB) POS=POS+1
      IF (POS<=N) DONE=YES
      FIRST = NO
      }
   ELSE {
      IF (ININD==YES & LUNIND>0) {
         N = GETL(MCR,80,LUNIND)
         IF (N==EOF) {
            ININD = NO
            CLOSE (UNIT=LUNIND)
            }
         }
      ELSE {
         WRITE(LUNPMT,10) PROMP
         10 FORMAT ("$",3A1,">")
         READ (LUNPMT,20,END=1000) N,MCR
         20 FORMAT(Q,82A1)
         }
      FOR (POS=1; POS<=N & MCR(POS)==BLANK | MCR(POS)==TAB; POS=POS+1) {}
      }
   IF (POS<N & MCR(POS)=="@") {
      MCR(N+1) = EOS
      N = -1            # FORCE N<POS TO GET ANOTHER READ
      IF (ININD==YES | LUNIND <=0)
         CALL MCRERR(LUNPMT,PROMP,"COMMAND FILE INVALID HERE")
      ELSE {
         POS = POS+1
         JUNK = NXTFIL(".CMD",FN,41,CJUNK,1)
	 OPEN(UNIT=LUNIND,NAME=FN,TYPE='OLD',ERR=30,READONLY)
         ININD = YES
         GO TO 31	# BRANCH AROUND ERROR MESSAGE
         30 CALL MCRERR(LUNPMT,PROMP,"CAN'T OPEN INDIRECT COMMAND FILE")
	 31 CONTINUE 
         }
      }
} UNTIL (POS<=N)
#  CHANGE COMMAS IN COMMAND ARGUEMENT TO FUNNYCOMMA ,"=" TO FUNNYEQUAL
#	AND AND "/" TO FUNNYSLASH 
#
I = MATCH(MCR,"/C")
IF ( I > 0) {
   REPEAT {
     INCREMENT(I)
     IF ( MCR(I) == ",")
       MCR(I) = FUNNYCOMMA
     IF ( MCR(I)== "=")
       MCR(I) = FUNNYEQUAL
     IF ( MCR(I)== "/")
	MCR(I) = FUNNYSLASH
     } UNTIL ( MCR(I)==EOS)
   }
NUMOUT = 1
NBRCK = 0
MCR(N+1) = EOS
 
FOR (I=1; MCR(I)~=EOS; I=I+1)
   IF (MCR(I)=="[")                 NBRCK = NBRCK+1
   ELSE IF (MCR(I)=="]")            NBRCK = NBRCK-1
   ELSE IF (MCR(I)=="," & NBRCK==0) NUMOUT = NUMOUT+1
   ELSE IF (MCR(I)=="=")            BREAK
IF (MCR(I) ~= "=")
   NUMOUT = 0                           # NO = ON MCR LINE
RETURN (YES)     
 
1000 DONE=YES
RETURN (NO)
END