SUBROUTINE CLI
	 
C 
C FUNCTIONAL DESCRIPTION:	
C 
C    Uses Niel Kempson's routines to extract the command line information
C 
C DUMMY ARGUMENTS:
C 
C    none
C 
C IMPLICIT INPUTS:
C 
C    none
C 
C IMPLICIT OUTPUTS:
C 
C    All values in COMMON/GINOTOSIX/ initialized
C 
C 
C SIDE EFFECTS:
C 
C    none
C 
C 
	IMPLICIT NONE

	INCLUDE '($SSDEF)'
	INCLUDE '($NAMDEF)'
	
	INTEGER*4	SEGMENT		!Segment number in saved drawing
	REAL*4		WIDTH		!Desired width
	REAL*4		HEIGHT		!Desired height
	REAL*4		SCALE		!Desired scale factor
	CHARACTER*255	INPUT		!Name of input file
	CHARACTER*255	OUTPUT		!Name of output file
	LOGICAL		FORMFEED	!Do we want a formfeed at the end of the
					!file?

	COMMON/GINOTOSIX/INPUT,OUTPUT,WIDTH,HEIGHT,SCALE,SEGMENT,FORMFEED

	INTEGER*4	CLI_STATUS
	INTEGER*4	CLI_STRING_LENGTH
	INTEGER*4	FILE_NAME_STATUS_BITS
	INTEGER*4	INPUT_LENGTH
	INTEGER*4	OUTPUT_LENGTH
	INTEGER*4	OUTPUT__LENGTH
	INTEGER*4	PARSE_STATUS
	INTEGER*4	F_DOLLAR_PARSE
	CHARACTER*255	CLI_STRING
	CHARACTER*255	OUTPUT_
	CHARACTER*255	DEFAULT_FILESPEC
	CHARACTER*255	DEFAULT_NAME
	INTEGER*4	DEFAULT_NAME_LENGTH
	INTEGER*4	DEFAULT_TYPE_LENGTH
	INTEGER*4	DEFAULT_FILESPEC_LENGTH
	 
	PARAMETER	PARSE_CONCEAL = 0
	PARAMETER	PARSE_NOCONCEAL = 1
	PARAMETER	PARSE_SYNTAX_ONLY = 2
	PARAMETER	PARSE_CHECK_EXISTS = 0

	EXTERNAL	CLI$PRESENT
	EXTERNAL	CLI$GET_VALUE
 
	INTEGER*4	CLI$PRESENT
	INTEGER*4	CLI$GET_VALUE

	EXTERNAL	CLI$_PRESENT
	EXTERNAL	CLI$_ABSENT
	EXTERNAL	CLI$_NEGATED
	EXTERNAL	CLI$_COMMA

	SEGMENT = 0
	CLI_STATUS = CLI$PRESENT ('SEGMENT')
	IF (CLI_STATUS .EQ. %LOC (CLI$_PRESENT)) THEN
	    CLI_STATUS = CLI$GET_VALUE ('SEGMENT', 
	1				CLI_STRING, 
	1				CLI_STRING_LENGTH)
	    
	    IF (CLI_STATUS .EQ. SS$_NORMAL) THEN 
		READ (CLI_STRING(1:CLI_STRING_LENGTH), 110) SEGMENT
	    ELSE
		TYPE *,'GINOTOSIX Error - Invalid segment'
		STOP
	    END IF
	    IF (SEGMENT.LT.0) THEN
		TYPE *,'GINOTOSIX Error - Invalid segment'
		STOP
	    END IF

	END IF       

	SCALE = 0
	CLI_STATUS = CLI$PRESENT ('SCALE')
	IF (CLI_STATUS .EQ. %LOC (CLI$_PRESENT)) THEN
	    CLI_STATUS = CLI$GET_VALUE ('SCALE', 
	1				CLI_STRING, 
	1				CLI_STRING_LENGTH)
	    
	    IF (CLI_STATUS .EQ. SS$_NORMAL) THEN 
		READ (CLI_STRING(1:CLI_STRING_LENGTH), 100, ERR=200) SCALE
	    ELSE
200		TYPE *,'GINOTOSIX Error - Invalid scale'
		STOP
	    END IF

	END IF       

	WIDTH = 0
	HEIGHT = 0
	CLI_STATUS = CLI$PRESENT ('SIZE')
	
	IF (CLI_STATUS .EQ. %LOC (CLI$_PRESENT)) THEN
	
	    CLI_STATUS = CLI$GET_VALUE ('SIZE.WIDTH', 
	1				CLI_STRING, 
	1				CLI_STRING_LENGTH)

	    IF (CLI_STATUS .EQ. SS$_NORMAL) THEN
		READ (CLI_STRING(1:CLI_STRING_LENGTH), 100) WIDTH
	    ELSE
		TYPE *,'GINOTOSIX Error - Invalid width'
		STOP
	    END IF
	
	    CLI_STATUS = CLI$GET_VALUE ('SIZE.HEIGHT', 
	1				CLI_STRING, 
	1				CLI_STRING_LENGTH)

	    IF (CLI_STATUS .EQ. SS$_NORMAL) THEN 
		READ (CLI_STRING(1:CLI_STRING_LENGTH), 100) HEIGHT
	    ELSE
		TYPE *,'GINOTOSIX Error - Invalid height'
		STOP
	    END IF

	END IF       

	CLI_STATUS = CLI$PRESENT ('OUTPUT')
	IF (CLI_STATUS .EQ. %LOC (CLI$_PRESENT)) THEN
	    CLI_STATUS = CLI$GET_VALUE (
	1		'OUTPUT', 
	1		OUTPUT_, 
	1		OUTPUT__LENGTH)

	    PARSE_STATUS = F_DOLLAR_PARSE(
	1		OUTPUT_(1:OUTPUT__LENGTH),
	1		'*.*;*',
	1		'FULL',
	1		PARSE_CONCEAL+PARSE_SYNTAX_ONLY,
	1		OUTPUT,
	1		OUTPUT_LENGTH,
	1		FILE_NAME_STATUS_BITS)

	    IF (IAND(FILE_NAME_STATUS_BITS, NAM$M_WILD_DIR) .NE. 0) THEN
		TYPE *,'GINOTOSIX Error - Illegal output filespec'
		STOP
	    END IF

	ELSE

	    OUTPUT(1:7) = '[]*.*;*'
	    OUTPUT(8:) = ' '
	    OUTPUT_LENGTH = 7

	END IF

	CALL REMOVE_WILDCARDS (OUTPUT, OUTPUT_LENGTH)

	CLI_STATUS = CLI$GET_VALUE('INPUT_FILESPEC',
	1			   INPUT,
	1			   INPUT_LENGTH)

	IF (CLI_STATUS .NE. SS$_NORMAL) THEN
	    TYPE *,'GINOTOSIX Error - Illegal input filespec'
	    STOP
	END IF

	PARSE_STATUS = F_DOLLAR_PARSE (
	1			INPUT(1:INPUT_LENGTH),
	1		        '.PIC',
	1		        'FULL',
	1			PARSE_CONCEAL+PARSE_SYNTAX_ONLY,
	1			INPUT,
	1			INPUT_LENGTH,
	1			FILE_NAME_STATUS_BITS)

	PARSE_STATUS = F_DOLLAR_PARSE (INPUT,
	1			' ',
	1			'NAME', 
	1			PARSE_CONCEAL+PARSE_SYNTAX_ONLY,
	1			DEFAULT_NAME,
	1			DEFAULT_NAME_LENGTH,
	1			FILE_NAME_STATUS_BITS)

	DEFAULT_FILESPEC = DEFAULT_NAME(1:DEFAULT_NAME_LENGTH) // '.SIX'
	DEFAULT_FILESPEC_LENGTH = DEFAULT_NAME_LENGTH + 4

	PARSE_STATUS = F_DOLLAR_PARSE (
	1			OUTPUT(1:OUTPUT_LENGTH),
	1		        DEFAULT_FILESPEC(1:DEFAULT_FILESPEC_LENGTH),
	1		        'FULL',
	1			PARSE_CONCEAL+PARSE_SYNTAX_ONLY,
	1			OUTPUT,
	1			OUTPUT_LENGTH,
	1			FILE_NAME_STATUS_BITS)

	IF (IAND (FILE_NAME_STATUS_BITS, NAM$M_WILDCARD) .NE. 0) THEN
	    CALL REMOVE_WILDCARDS (OUTPUT, OUTPUT_LENGTH)
	END IF

	FORMFEED=.FALSE.
	CLI_STATUS = CLI$PRESENT ('FORMFEED')
	IF (CLI_STATUS .EQ. %LOC (CLI$_PRESENT)) FORMFEED=.TRUE.

	RETURN
	
100	FORMAT (F5.0)
110	FORMAT (I5)
	
	END
	 
	SUBROUTINE REMOVE_WILDCARDS (FILE_SPEC, FILE_SPEC_LENGTH)
	INCLUDE '($NAMDEF)'
	PARAMETER	PARSE_CONCEAL = 0,
	1		PARSE_NOCONCEAL = 1,
	1		PARSE_SYNTAX_ONLY = 2,
	1		PARSE_CHECK_EXISTS = 0
	CHARACTER*(*)	file_spec
	INTEGER*4	file_spec_length
	CHARACTER*255
	1		new_file_spec,
	1		node,
	1		device,
	1		directory
	CHARACTER*255
	1		default_name,
	1		default_type,
	1		name,
	1		type,
	1		version
	INTEGER*4	new_file_spec_length,
	1		node_length,
	1		device_length,
	1		directory_length,
	1		name_length, 
	1		type_length,
	1		version_length,
	1		f_dollar_parse,
	1		parse_status,
	1		file_name_status_bits,
	1		string_length

	
	file_spec_length = string_length (file_spec)

	parse_status = f_dollar_parse (
	1			file_spec(1:file_spec_length),
	1		        ' ',
	1		        'NODE',
	1			PARSE_CONCEAL+PARSE_SYNTAX_ONLY,
	1			node,
	1			node_length,
	1			file_name_status_bits)
	IF (node_length .GT. 0) THEN
	    new_file_spec(1:) = node(1:node_length)
	END IF
	new_file_spec_length = node_length

	parse_status = f_dollar_parse (
	1			file_spec(1:file_spec_length),
	1		        ' ',
	1		        'DEVICE',
	1			PARSE_CONCEAL+PARSE_SYNTAX_ONLY,
	1			device,
	1			device_length,
	1			file_name_status_bits	)
	IF (device_length .GT. 0) THEN
	    new_file_spec(new_file_spec_length+1:) = device(1:device_length)
	END IF
	new_file_spec_length = new_file_spec_length + device_length

	parse_status = f_dollar_parse (
	1			file_spec(1:file_spec_length),
	1		        ' ',
	1		        'DIRECTORY',
	1			PARSE_CONCEAL+PARSE_SYNTAX_ONLY,
	1			directory,
	1			directory_length,
	1			file_name_status_bits)

	IF (IAND (file_name_status_bits, NAM$M_WILD_DIR) .EQ. 0) THEN
	    IF (directory_length .GT. 0) THEN
		new_file_spec(new_file_spec_length+1:) = 
	1				    directory(1:directory_length)
	    END IF
	    new_file_spec_length = new_file_spec_length + directory_length
	END IF

	parse_status = f_dollar_parse (
	1			file_spec(1:file_spec_length),
	1		        ' ',
	1		        'NAME',
	1			PARSE_CONCEAL+PARSE_SYNTAX_ONLY,
	1			name,
	1			name_length,
	1			file_name_status_bits	)

	IF (IAND (file_name_status_bits, NAM$M_WILD_NAME) .EQ. 0) THEN
	    IF (name_length .GT. 0) THEN
		new_file_spec(new_file_spec_length+1:) = name(1:name_length)
	    END IF
	    new_file_spec_length = new_file_spec_length + name_length
	END IF

	parse_status = f_dollar_parse (
	1			file_spec(1:file_spec_length),
	1		        ' ',
	1		        'TYPE',
	1			PARSE_CONCEAL+PARSE_SYNTAX_ONLY,
	1			type,
	1			type_length,
	1			file_name_status_bits	)

	IF (IAND (file_name_status_bits, NAM$M_WILD_TYPE) .EQ. 0) THEN
	    IF (type_length .GT. 0) THEN
		new_file_spec(new_file_spec_length+1:) = type(1:type_length)
	    END IF
	    new_file_spec_length = new_file_spec_length + type_length
	END IF

	parse_status = f_dollar_parse (
	1			file_spec(1:file_spec_length),
	1		        ' ',
	1		        'VERSION',
	1			PARSE_CONCEAL+PARSE_SYNTAX_ONLY,
	1			version,
	1			version_length,
	1			file_name_status_bits)

	IF (IAND (file_name_status_bits, NAM$M_WILD_VER) .EQ. 0) THEN
	    IF (version_length .GT. 0) THEN
		new_file_spec(new_file_spec_length+1:) = 
	1				    version(1:version_length)
	    END IF
	    new_file_spec_length = new_file_spec_length + version_length
	END IF

	IF (new_file_spec_length .GT. 0) THEN
	    file_spec(1:) = new_file_spec(1:new_file_spec_length)
	END IF
	file_spec_length = new_file_spec_length

	RETURN
	END

	INTEGER*4 FUNCTION f_dollar_parse (file_spec, 
	1				default_file_spec,
	1				parse_type,
	1				parse_flags,
	1				return_buffer, 
	1				return_string_length,
	1				file_name_status_bits)
	INCLUDE '($FABDEF)'
	INCLUDE '($NAMDEF)'
	PARAMETER	PARSE_CONCEAL = 0,
	1		PARSE_NOCONCEAL = 1,
	1		PARSE_SYNTAX_ONLY = 2,
	1		PARSE_CHECK_EXISTS = 0
	CHARACTER*(*)	file_spec,
	1		default_file_spec,
	1		return_buffer,
	1		parse_type
	INTEGER*4	return_string_length,
	1		parse_flags,
	1		file_name_status_bits
	RECORD /FABDEF/ fab
	RECORD /NAMDEF/ nam
	CHARACTER*16	local_parse_type
	CHARACTER*255
	1		full_filespec	
	INTEGER*4	SYS$PARSE,
	1		start_char, 
	1		stop_char, 
	1		return_buffer_size,
	1		parsed_string_length
	BYTE		int_to_byte

	fab.FAB$B_BID = FAB$C_BID
	fab.FAB$B_BLN = FAB$C_BLN

	fab.FAB$L_FNA = %LOC (file_spec)
	fab.FAB$B_FNS = int_to_byte (LEN (file_spec))

	fab.FAB$L_DNA = %LOC (default_file_spec)
	fab.FAB$B_DNS = int_to_byte (LEN (default_file_spec))

	fab.FAB$L_NAM = %LOC (nam)

	nam.NAM$B_BID = NAM$C_BID
	nam.NAM$B_BLN = NAM$C_BLN

	nam.NAM$L_ESA = %LOC (full_filespec)
	nam.NAM$B_ESS = int_to_byte (MIN (LEN (full_filespec), 255))

	nam.NAM$B_NOP = 0

	IF (IAND (parse_flags, PARSE_NOCONCEAL) .NE. 0) THEN
	    nam.NAM$B_NOP = NAM$M_NOCONCEAL
	END IF 

	IF (IAND (parse_flags, PARSE_SYNTAX_ONLY) .NE. 0) THEN
	    nam.NAM$B_NOP = nam.NAM$B_NOP + NAM$M_SYNCHK
	END IF

	f_dollar_parse = SYS$PARSE (fab)
	file_name_status_bits = nam.NAM$L_FNB	

	CALL STR$UPCASE (local_parse_type, parse_type)

	IF (local_parse_type .EQ. 'NODE') THEN
	    start_char = nam.NAM$L_NODE - nam.NAM$L_ESA + 1
	    stop_char = start_char + ZEXT (nam.NAM$B_NODE) - 1

	ELSE IF (local_parse_type .EQ. 'DEVICE') THEN
	    start_char = nam.NAM$L_DEV - nam.NAM$L_ESA + 1
	    stop_char = start_char + ZEXT (nam.NAM$B_DEV) - 1

	ELSE IF (local_parse_type .EQ. 'DIRECTORY') THEN
	    start_char = nam.NAM$L_DIR - nam.NAM$L_ESA + 1
	    stop_char = start_char + ZEXT (nam.NAM$B_DIR) - 1

	ELSE IF (local_parse_type .EQ. 'NAME') THEN
	    start_char = nam.NAM$L_NAME - nam.NAM$L_ESA + 1
	    stop_char = start_char + ZEXT (nam.NAM$B_NAME) - 1

	ELSE IF (local_parse_type .EQ. 'TYPE') THEN
	    start_char = nam.NAM$L_TYPE - nam.NAM$L_ESA + 1
	    stop_char = start_char + ZEXT (nam.NAM$B_TYPE) - 1

	ELSE IF (local_parse_type .EQ. 'VERSION') THEN
	    start_char = nam.NAM$L_VER - nam.NAM$L_ESA + 1
	    stop_char = start_char + ZEXT (nam.NAM$B_VER) - 1

	ELSE IF (local_parse_type .EQ. 'FULL') THEN
	    start_char = 1
	    stop_char = ZEXT (nam.NAM$B_ESL)

	ELSE
	    TYPE *, 'Invalid parse string: (',local_parse_type,').'
	    CALL LIB$SIGNAL (MODIFY$INVPARTYP, 1, local_parse_type)
	    CALL EXIT
	END IF	    
	
	parsed_string_length = stop_char - start_char + 1
	return_buffer_size = LEN (return_buffer)
	return_string_length = MIN (return_buffer_size, parsed_string_length)

	IF (return_string_length .GT. 0) THEN
	    return_buffer(1:) = full_filespec(
	1	start_char:start_char + return_string_length - 1)
	END IF

	RETURN
	END

	INTEGER*4 FUNCTION string_length (string)
	IMPLICIT NONE
	CHARACTER*(*)	string
	CHARACTER	this_char
	string_length = LEN (string)

	DO WHILE (string_length .GT. 0)
	    this_char = string(string_length:string_length)
	    IF ((this_char .NE. ' ') .AND. (this_char .NE. CHAR(9))) THEN
		RETURN
	    END IF
	    string_length = string_length - 1
	END DO
	RETURN
	END

	BYTE FUNCTION int_to_byte (number)
	IMPLICIT NONE
	INTEGER*4 number

	IF ( IAND (number, '00000080'X) .NE. 0) THEN
	    int_to_byte = IOR (number, 'FFFFFF00'X)
	ELSE
	    int_to_byte = IAND (number, '000000FF'X)
	END IF
	
	RETURN
	END