C
C	common area for VECTOR
C
	COMMON /VECTOR/ LUNGRP,XSCALE,YSCALE,IDEV,TRNFRM(6),
	1	XOFF,YOFF,NIBS,LINPAT
C
C	SUBROUTINE INPUT
C
	BYTE      STRING(84),TEMP(80),QHELP(12),DEXT(5)
	BYTE      IDSDEV(8),PTXDEV(8),VERDEV(8)
	INTEGER*2 ICMD,IDS(2),ICMDS(48),NCMDS
	REAL*4    HELP(3)
	REAL*8    RDEVCE(2,3)
	DATA      DEXT/'.','C','M','D',0/
	DATA      RDEVCE/'IDS pris','m 132   ',
	1		 'Printron','ix 300  ',
	2		 'Versatec',' 1200A  '/
	DATA      HELP  /'HELP',' RAS','TER '/
	DATA      IDSDEV/'L','P','1',':',4*0/
	DATA      PTXDEV/'L','P','0',':',4*0/
	DATA      VERDEV/'V','S','0',':',4*0/
	DATA     NCMDS,ICMDS/48,
	1	'EX','HA','AG','??','GO','G?','LI','CO','OP','OU',
	2	'RA','VE','V0','V1','V2','V3','V4','V5','V6','V7',
	3	'V8','V9','OF','SC','O0','O1','O2','O3','O4','O5',
	4	'O6','O7','O8','O9','S0','S1','S2','S3','S4','S5',
	5	'S6','S7','S8','S9','ID','PT','VS','WA'/
	EQUIVALENCE (ICMD,STRING(1)),(QHELP,HELP)
C
C	first, see if this is the first time we've come here
C
	IF (QINPUT .OR. QIND) GOTO 110		! we've been here before ...
C
C----------------------------------------------------------------------
C 
C	First time here, check for a command line given by MCR
C 
C----------------------------------------------------------------------
C
	CALL GETMCR(STRING,IDS)
	LSTRNG = MIN0(IDS(1),80)
C
C	look for the first space ...
C
	IFIRST = LSTRNG + 1			! make us think there was no input
	DO 105 I=1,LSTRNG
	 IF (STRING(I) .NE. "40) GOTO 105
	 IFIRST = I + 1				! we've found some input
	 IF (IFIRST .GE. LSTRNG) GOTO 105	! but it's not worth looking at
	 K = 1
	 DO 103 J=IFIRST,LSTRNG
	  STRING(K) = STRING(J)			! make the string look typed
	  K = K + 1
103	 CONTINUE
	 LSTRNG = K - 1
	 GOTO 200				! and go parse it
C	and continue looking for a space in the string ...
105	CONTINUE
C
C	We've no input, but it's the first time thru.  Tell us to come
C	back for more input later ...
C
	QINPUT = .TRUE.
C
C--------------------------------------------------------------------
C 
C	Time to get a line of input
C 
C--------------------------------------------------------------------
C 
110	IF (QIND) GOTO 140
	IF (.NOT. QINPUT) RETURN		! not to input - return
	WRITE (LOONTI,120)			! prompt us
120	FORMAT('$RAS> ')
	READ (LOONTI,130,END=1000) LSTRNG,STRING	! and get our answer
130	FORMAT(Q,84A1)
	GOTO 200
C
C	for indirect command files
C
140	READ (LOONAT,130,END=150,ERR=150) LSTRNG,STRING ! get command from file
	GOTO 200
C
C	end of the indirect - do we go for more or quit?
C
150	CLOSE (UNIT=LOONAT)
	QIND = .FALSE.
	IF (QINPUT) GOTO 110
	GOTO 1000
C
C--------------------------------------------------------------------
C
C	We've got the input - lets look at it
C
C--------------------------------------------------------------------
C
200	IF (LSTRNG .LE. 0) GOTO 110		! too short - get more input
	STRING(LSTRNG+1) = 0			! tail the input line
	IF (STRING(1) .NE. '@') GOTO 250
C
C	indirect command file - try to open it
C
	IF (QIND) GOTO 210			! can't indirect from indirect
	DO 203 I=2,LSTRNG			! check for an extension
	 IF (STRING(I) .EQ. '.') GOTO 209	! have extension - use it
203	CONTINUE
	DO 205 I=1,5
	 STRING(LSTRNG+I) = DEXT(I)		! add the extension (and null)
205	CONTINUE
209	OPEN (UNIT=LOONAT,NAME=STRING(2),CARRIAGECONTROL='LIST',
	1	TYPE='OLD',READONLY,ERR=230)
	QIND = .TRUE.
	GOTO 140
C
C	errors associated with command files
C
210	WRITE (LOONTI,220) (STRING(I),I=1,LSTRNG)
220	FORMAT('0RASTER error - cannot open indirect file from indirect ',
	1	'file:'/' -->',84A1)
	GOTO 110
230	WRITE (LOONTI,240) (STRING(I),I=2,LSTRNG)
240	FORMAT('0RASTER error - bad indirect file name:'/' -->',84A1)
	GOTO 110
C
C--------------------------------------------------------------------
C
C	now find any data thats after the tag (variable length tags are OK)
C
C--------------------------------------------------------------------
C
250	LSTRN0 = 0				! assume there's nothing else
	IF (LSTRNG .LE. 2) GOTO 300		! there is nothing else
	DO 270 I=3,LSTRNG
	 IF (STRING(I) .NE. "40) GOTO 270
C
C	we've found a space.  calculate the first start and length of the rest
C
	 IFIRST = I + 1
	 IF (IFIRST .GT. LSTRNG) GOTO 300	! nothing here ...
	 LSTRN0 = LSTRNG - IFIRST + 1
	 GOTO 300				! now we're set - got the length
270	CONTINUE
C
C--------------------------------------------------------------------
C
C	regular command - look it up and go do it
C
C--------------------------------------------------------------------
C
300	CALL GETCMD(ICMD,ICMDS,NCMDS,NCMD)	! NCMD is number of the command
	IF (NCMD .GT. 0) GOTO 320
	WRITE (LOONTI,310) ICMD
310	FORMAT('0RASTER error - unknown command: ',A2)
	GOTO 110
C
C	now dispatch and do the command
C
320	GOTO   (1000,1000,1350,1100,1200,1300,1400,1500,1600,1700,
	1	1800,1900,1910,1910,1910,1910,1910,1910,1910,1910,
	2	1910,1910,2000,2100,2200,2200,2200,2200,2200,2200,
	3	2200,2200,2200,2200,2300,2300,2300,2300,2300,2300,
	4	2300,2300,2300,2300,2400,2500,2600,2700		  ),NCMD
C
C====================================================================
C
C------
C	EXit, HAlt commands
C------
C
1000	IF (QIND) CLOSE (UNIT=LOONAT)
	IF (QINPUT) STOP 'RASTER'		! if interactive, tell us
	CALL EXIT				! otherwise, go quietly
C
C------
C	HElp, ?? commands
C------
C
1100	IF (LSTRN0 .GT. 68) LSTRN0 = 68
	DO 1110 I=1,12
	 TEMP(I) = QHELP(I)			! 'HELP RASTER '
1110	CONTINUE
	IF (LSTRN0 .LE. 0) GOTO 1130		! no HELP subtopic specified
	DO 1120 I=0,LSTRN0
	 TEMP(13+I) = STRING(IFIRST+I)		! 'HELP RASTER string ...'
1120	CONTINUE
1130	CALL FORMCR(TEMP,IERR,1,LSTRN0+12)	! send the string to MCR
	IF (IERR .GT. 0) GOTO 110		! all's fine
	WRITE (LOONTI,1140) (TEMP(I),I=1,LSTRN0+12)
1140	FORMAT('0RASTER error spawning MCR for the following:',/X,80A1)
	GOTO 110
C
C------
C
C	GO command - do a plot
C
C------
C
1200	IF (LSTRN0 .LE. 0) GOTO 1220		! no device specified - use old
	DECODE (LSTRN0,1205,STRING(IFIRST),ERR=1210) IDEV
1205	FORMAT(I7)
	IDEVCE = IDEV
	GOTO 1220
1210	WRITE (LOONTI,1215)
1215	FORMAT('0RASTER - error decoding the GO device:')
	GOTO 3000
C
C	 check for valid device
C
1220	IF (IDEVCE .GE. -3) GOTO 1230
	WRITE (LOONTI,1225) IDEVCE
1225	FORMAT('0RASTER error - invalid GO device:',I6)
	IDEVCE = -1
	GOTO 3000
1230	IF (IDEVCE .LT. 0) RETURN		! go raster it
C
C	we must go to VECTOR - one loop thru all the files
C
	LUNGRP = LOONOU				! output device logical unit
	IDEV = IDEVCE				! plotting device
	CALL VECTOR(X,Y,-5)			! does this device exist?
	IF (X .LE. 0) GOTO 1300			! it doesn't exist - G?
	IF (IDEV .GT. 0) CALL ASSIGN(LUNGRP,GDDEVN(1,IDEV)) ! assign the dev.
	TRNFRM(1) = GBLSCL			! the global scaling/offset
	TRNFRM(2) = 0.0				!  factors can be used here
	TRNFRM(3) = GBLXOF
	TRNFRM(4) = 0.0
	TRNFRM(5) = GBLSCL
	TRNFRM(6) = GBLYOF
C
C	initialize the device and clear the screen
C
	CALL VECTOR(0.,0.,-4)			! init call
	CALL VECTOR(0.,0.,0)			! clear screen
C
	DO 1260 IFIL = 1,NVFILE
	IFILE = IFIL
	OPEN (UNIT=LOONVC,NAME=VECFIL(1,IFILE),ACCESS='SEQUENTIAL',
	1	FORM='UNFORMATTED',TYPE='OLD',READONLY,ERR=1270)
	XSCALE = 1.0/VECSCL(IFILE)		! VECTOR divides by scale
	YSCALE = 1.0/VECSCL(IFILE)		!  while RASTER multiplies
	XOFF = VECXOF(IFILE)
	YOFF = VECYOF(IFILE)
C
C	now VECTOR can do all the scalling and offsetting.
C	except - mode 0 on vector resets XOFF and YOFF - trap it. (mode 0)
C		also, must trap the clear screen commands - (mode 0)
C		initialize commands aren't needed more than once (mode -4)
C		return parameter modes aren't needed (modes -1,-2,-3)
C
C	so, modes 1,2,3,5,7 go straight thru.
C	    modes -3,-2,-1,6 are ignored.
C	    modes -4,0 and 4 are each done once only
C
1240	READ (LOONVC,ERR=1250,END=1250) IMODE,X,Y
	IF ((IMODE .LE. 0) .OR. (IMODE .EQ. 6)) GOTO 1240
	IF (IMODE .EQ. 4) GOTO 1250
	CALL VECTOR(X,Y,IMODE)
	GOTO 1240
C
C	all done with that file
C
1250	CLOSE(UNIT=LOONVC)
1260	CONTINUE
C
C	done with all files - finish the device and be done
C
	CALL VECTOR(0.,0.,4)
	GOTO 110
C
C	problem opening a file
C
1270	WRITE (LOONTI,1280) IFILE,(VECFIL(I,IFILE),I=1,32)
1280	FORMAT('0RASTER error opening vector file number',I3,':'/
	1	' -->',32A1)
	CALL VECTOR(0.,0.,4)		! finish with the device
	GOTO 110
C
C------
C
C	G? command - list the known devices
C
C------
C
1300	CALL RASAG(STRING(IFIRST),0)
	GOTO 110
C
C------
C
C	AG command - assign graphics device
C
C------
C
1350	CALL RASAG(STRING(IFIRST),LSTRN0)
	GOTO 110
C
C------
C
C	LIst the current values
C
C------
C
C	first, list the device
1400	IF (IDEVCE) 1410,1420,1430
1410	WRITE (LOONTI,1412) (RDEVCE(I,-IDEVCE),I=1,2)
1412	FORMAT('0	Output is to raster device: ',2A8)
	IF (IDEVCE .EQ. -3) WRITE (LOONTI,1414) IWTIME
1414	FORMAT(' 	Output delay time is',I5,' msec between lines')
	GOTO 1440
1420	WRITE (LOONTI,1422) (RASFIL(I),I=1,32)
1422	FORMAT('0	Output is to a binary vector file: ',32A1)
	GOTO 1440
1430	WRITE (LOONTI,1432) IDEVCE
1432	FORMAT('0	Output is to vector device number',I3)
C
C	now list copies, output files
C
1440	WRITE (LOONTI,1442) NCOPY,(OUTDEV(I),I=1,8),(RASFIL(I),I=1,32)
1442	FORMAT(4X,I6,' copies to output device:  ',8A1/
	1	X,'	Raster file: ',32A1)
C	now list the options
	WRITE (LOONTI,1450) IOPTNS
1450	FORMAT(X,'	Options:',O6)
	IF ( IOPTNS            .EQ. 0) WRITE (LOONTI,1452)
	IF ((IOPTNS .AND.  "1) .NE. 0) WRITE (LOONTI,1454)
	IF ((IOPTNS .AND.  "2) .NE. 0) WRITE (LOONTI,1456)
	IF ((IOPTNS .AND.  "4) .NE. 0) WRITE (LOONTI,1458)
	IF ((IOPTNS .AND. "10) .NE. 0) WRITE (LOONTI,1460)
1452	FORMAT(X,'		     0 ==> plot vectors directly')
1454	FORMAT(X,'		     1 ==> make a raster file')
1456	FORMAT(X,'		     2 ==> plot a raster file')
1458	FORMAT(X,'		     4 ==> delete the raster file when done')
1460	FORMAT(X,'		    10 ==> plot raster file via QUEUE manager')
C
C	now list the global scale factors and offsets
C
	WRITE (LOONTI,1462) GBLSCL,GBLXOF,GBLYOF
1462	FORMAT('0	Scale factor   X offset   Y offset    applied to:'/
	1	X,'	',F10.2, ' ',F10.2,' ',F10.2,'      all files')
C	now list scale and offset and vector files
	DO 1480 I=1,NVFILE
	WRITE (LOONTI,1470) VECSCL(I),VECXOF(I),VECYOF(I),
	1	I-1,(VECFIL(J,I),J=1,32)
1470	FORMAT(X,'	',F10.2,' ',F10.2,' ',F10.2,'      ',I1,': ',32A1)
1480	CONTINUE
	GOTO 110
C
C------
C
C	COpies command
C
C------
C
1500	DECODE (LSTRN0,1510,STRING(IFIRST),ERR=1520) NCOPY
1510	FORMAT(I10)
	IF (NCOPY .GT. 0) GOTO 110
1520	WRITE (LOONTI,1530)
1530	FORMAT('0RASTER error - illegal value for number of copies:')
	NCOPY = 1
	GOTO 3000
C
C------
C
C	Options command
C
C------
C
1600	DECODE (LSTRN0,1610,STRING(IFIRST),ERR=1620) IOPTNS
1610	FORMAT(O7)
	IF ((IOPTNS .GE. 0) .AND. (IOPTNS .LE. "17)) GOTO 110
1620	WRITE (LOONTI,1630)
1630	FORMAT('0RASTER error - illegal value for options:')
	IOPTNS = 0
	GOTO 3000
C
C------
C
C	OUtput device command
C
C------
C
1700	IF (LSTRN0 .GT. 7) GOTO 1730
	DO 1705 I=1,8
	 OUTDEV(I) = "40
1705	CONTINUE
	DO 1710 I=1,LSTRN0
	 OUTDEV(I) = STRING(IFIRST+I-1)
1710	CONTINUE
	OUTDEV(LSTRN0+1) = 0
	GOTO 110
1730	WRITE (LOONTI,1740)
1740	FORMAT('0RASTER error - bad output device specification:')
	GOTO 3000
C
C------
C
C	RAster output file specification
C
C------
C
1800	IF (LSTRN0 .GT. 31) GOTO 1830
	DO 1805 I=1,32
	 RASFIL(I) = "40
1805	CONTINUE
	DO 1810 I=1,LSTRN0
	 RASFIL(I) = STRING(IFIRST+I-1)
1810	CONTINUE
	RASFIL(LSTRN0+1) = 0
	GOTO 110
1830	WRITE (LOONTI,1840)
1840	FORMAT('0RASTER error - bad raster file specification:')
	GOTO 3000
C
C------
C
C	VEctor file specifications (also V0, V1, ..., V9)
C
C------
C
1900	STRING(2) = '0'				! make VE command a V0 command
1910	IFILE = STRING(2) - "60			! get the file number (0-9)
	IF (LSTRN0 .GT. 0) GOTO 1950
C	delete this file ... 
	IF (IFILE .LT. NVFILE) GOTO 1920	! valid file to delete
	WRITE (LOONTI,1915) IFILE
1915	FORMAT('0RASTER error - cannot delete file '
	1	'that does not exist:',I2)
	GOTO 110
1920	IF (NVFILE .GT. 1) GOTO 1930
	WRITE (LOONTI,1925)
1925	FORMAT('0RASTER error - cannot delete the only raster file')
	GOTO 110
1930	IFILE = IFILE + 1			! now 1-10, like NVFILE
	IF (IFILE .EQ. NVFILE) GOTO 1940
C	must squish all files down one place
	DO 1935 I=IFILE+1,NVFILE
	 DO 1934 J=1,32
	  VECFIL(J,I-1) = VECFIL(J,I)		! move the file name
1934	 CONTINUE
	 VECSCL(I-1) = VECSCL(I)		! move scale and offsets
	 VECXOF(I-1) = VECXOF(I)
	 VECYOF(I-1) = VECYOF(I)
	 QVECSC(I-1) = QVECSC(I)
1935	CONTINUE
1940	NVFILE = NVFILE - 1
	GOTO 110
C
C	file specified - put it in place
C
1950	IF (LSTRN0 .LE. 31) GOTO 1960
	WRITE (LOONTI,1955)
1955	FORMAT('0RASTER error - raster file spec. too long:')
	GOTO 3000
1960	DO 1965 I=1,32
	 VECFIL(I,IFILE+1) = "40
1965	CONTINUE
	DO 1970 I=1,LSTRN0
	 VECFIL(I,IFILE+1) = STRING(IFIRST+I-1)
1970	CONTINUE
	VECFIL(LSTRN0+1,IFILE+1) = 0
	NVFILE = MAX0(NVFILE,IFILE+1)		! update the number of vector file
	GOTO 110
C
C------
C
C	global OFfset command
C
C------
C
2000	DECODE (LSTRN0,2010,STRING(IFIRST),ERR=2020) GBLXOF,GBLYOF
2010	FORMAT(2G16.0)
	QGBLSC = .TRUE.
	GOTO 110
2020	WRITE (LOONTI,2030)
2030	FORMAT('0RASTER error decoding global offsets:')
	GBLXOF = 0.0
	GBLYOF = 0.0
	GOTO 3000
C
C------
C
C	global SCale factor
C
C------
C
2100	DECODE (LSTRN0,2010,STRING(IFIRST),ERR=2120) GBLSCL
	QGBLSC = .TRUE.
	GOTO 110
2120	WRITE (LOONTI,2130)
2130	FORMAT('0RASTER error decoding global scale factor:')
	GBLSCL = 1.0
	GOTO 3000
C
C------
C
C	Ox - offset factors for each file
C
C------
C
2200	IFILE = STRING(2) - "60 + 1		! 1-10
	DECODE (LSTRN0,2010,STRING(IFIRST),ERR=2220)
	1				VECXOF(IFILE),VECYOF(IFILE)
	QVECSC(IFILE) = .TRUE.
	GOTO 110
2220	WRITE (LOONTI,2230)
2230	FORMAT('0RASTER error decoding vector file offsets:')
	VECXOF(IFILE) = 0.0
	VECYOF(IFILE) = 0.0
	GOTO 3000
C
C------
C
C	Sx - scale factors for each file
C
C------
C
2300	IFILE = STRING(2) - "60 + 1		! 1-10
	DECODE (LSTRN0,2010,STRING(IFIRST),ERR=2320) VECSCL(IFILE)
	QVECSC(IFILE) = .TRUE.
	GOTO 110
2320	WRITE (LOONTI,2330)
2330	FORMAT('0RASTER error decoding vector file scale factor:')
	VECSCL(IFILE) = 1.0
	GOTO 3000
C
C------
C
C	IDs printer - sets defaults for.
C
C------
C
2400	IDEVCE = -1
	IOPTNS = 0			! plot directly
	NCOPY = 1			! one's enough
	DO 2410 I=1,8
	 OUTDEV(I) = IDSDEV(I)		! set up for LP1: or TTn: or something
2410	CONTINUE
	GOTO 110
C
C------
C
C	PT - printronix printer
C
C------
C
2500	IDEVCE = -2
	IOPTNS = "17			! make, plot (via QMG) & del raster file
	NCOPY = 1
	DO 2510 I=1,8			! set up the device name
	 OUTDEV(I) = PTXDEV(I)
2510	CONTINUE
	GOTO 110
C
C------
C
C	VErsatek printer
C
C------
C
2600	IDEVCE = -3
	IOPTNS = "7			! make, plot & delete raster file
	NCOPY = 1
	DO 2610 I=1,8
	 OUTDEV(I) = VERDEV(I)
2610	CONTINUE
	GOTO 110
C
C------
C
C	WAit command - set delay time for Versetec plotter
C
C-----
C
2700	DECODE (LSTRN0,2710,STRING(IFIRST),ERR=2720) IWTIME
2710	FORMAT(I10)
	IF (IWTIME .GE. 0) GOTO 110
2720	WRITE (LOONTI,2730)
2730	FORMAT('0RASTER error - illegal value for wait time:')
	IWTIME = 0
	GOTO 3000
C
C
C====================================================================
C
C
C	Write out the part of the string that caused an error
C
3000	WRITE (LOONTI,3010) (STRING(IFIRST+I),I=0,LSTRN0-1)
3010	FORMAT(' -->',82A1)
	GOTO 110
C
C	Thats all folks ...
C
	END