DIMENSION IDISP(2000),ICHAR(90),IBOX(4),
	1KMOV(4),ITAL(6),
	2ICVS(200),IDIF(200),ICVD(8,8),IDL(200)

	INTEGER XOR,YOR,HGHT,WDTH,XCNT,YCNT,DEL,DEL2,DEL3
	LOGICAL ERR,FLAG,SPEC,EDIT,TAK
	COMMON /ST/ JBOX
	COMMON /SW/ ICONT(6)
	COMMON /IN/IXCD(100),IYCD(100)
	COMMON/LT/ILET(90)
	COMMON /SB/ IHL(6)
	COMMON/JN/ IDX,IDY
	COMMON/PK/INM(6),ICVA(6,200),IV(6)
	COMMON/OT/IRES(3),NOS,INOEL(10)
	DATA  ICVD/0,1,2,3,4,3,2,1,1,0,1,2,3,4,3,2,2,1,0,1,2,3,
	14,3,3,2,1,0,1,2,3,4,4,3,2,1,0,1,2,3,3,4,3,2,1,0,1,2,2,3,4,
	23,2,1,0,1,1,2,3,4,3,2,1,0/
	DATA XOR,YOR,HGHT,WDTH/512,312,400,300/,JORX,JORY,JHGHT,JWDTH/
	1542,342,85,60/,XCNT,YCNT/672,512/,DEL/30/,DEL2/60/,DEL3/45/
	2,NAME/'GRASS'/
	DO 2 I=1,6
	INM(I)=0
	IV(I)=0
2	CONTINUE
	CALL SENTER
	CALL DEFPIC(IDISP,2000)
	CALL BOARD(ICHAR)
	CALL BUTTONS
	INX=XOR
	INY=YOR
	DO 59 I=1,4
	IBOX(I)=NEWSEG(I)
	CALL MOVETO(INX,INY,.FALSE.,0,5)
	IX=WDTH*IFIX(SIND(FLOAT(I-1)*90))
	IY=HGHT*IFIX(COSD(FLOAT(I-1)*90))
	CALL LINE(IX,IY,.TRUE.)
	INX=INX+IX
	CALL MSSLP(IBOX(I))
	INY=INY+IY
59	CONTINUE
	CALL BOX(JORX,JORY,JHGHT,JWDTH,2,7,JBOX,.TRUE.)
	CALL SPOTS
	CALL DEPICT(IDISP,1)
	TAK=.FALSE.
	EDIT=.FALSE.
	FLAG=.FALSE.
	ERR=.FALSE.
100	IF(ERR) CALL QUERY(ITS,IDISP)
99	CALL ATTIC(12,KMOV)
	IF(TAK)CALL MSSLP(IBOX(2))
	TAK=.FALSE.
	IF(ERR)CALL CLEAR(ITS,IDISP)
	ERR=.FALSE.
	IF(KMOV(1).EQ.1)GOTO101
	L=KMOV(2)
	IF(L.EQ.IBOX(1))GOTO105
	DO 102 J=1,90
	IF (ICHAR(J).NE.L)GOTO102
	IASC=J+32
	GOTO103
102	CONTINUE
	DO 104 J=1,6
	IF(ICONT(J).NE.L)GOTO104
	IDO=J
	GOTO106
104	CONTINUE
	GOTO99
101	IASC=KMOV(3)
103	ISEG=NEWSEG(34)
	SPEC=.FALSE.
	CALL ACK(IASC,IDISP,ICHAR)
512	CALL TRSET(XCNT,YCNT)
C
C	THIS ACTIVATES  LIGHT BUTTONS.
C
	CALL ATTIC(2,KMOV)
	IXL=KMOV(3)
	IYL=KMOV(4)
	ICC=0
	NOS=1
	ILC=0
199	CALL MOVETO(IXL,IYL,.FALSE.,0,5)
	CALL TRSET(IXL,IYL)
278	ICC=ICC+1
	IXCD(ICC)=IXL
	IYCD(ICC)=IYL
200	CALL ATTIC(13,KMOV)
	IF(KMOV(1).EQ.1)GOTO202
	L=KMOV(3)
	M=KMOV(4)
	IDX=L-IXL
	IDY=M-IYL
	IT=NEWSEG(4)
	CALL MOVETO(IXL,IYL,.FALSE.,0,5)
	CALL LINE(IDX,IDY,.TRUE.)
	CALL MSSLP(IT)
	CALL DEPICT(IDISP,1)
	IDIST=INT(SQRT(FLOAT(IDX**2+IDY**2)))
	J=IDIST/DEL
	IF(J.EQ.0)GOTO 206
	N=IDX/J
	K=IDY/J
	DO 205  I=1,J
	ICC=ICC+1
	IXCD(ICC)=IXL+I*N
	IYCD(ICC)=IYL+I*K
205	CONTINUE
	IF(MOD(IDIST,DEL).LT.20)GOTO210
206	ICC=ICC+1
	IXCD(ICC)=L
	IYCD(ICC)=M
210	IXL=L
	IYL=M
	GOTO200
202	CALL TRKILL
	CALL ATTIC(2,KMOV)
	DO 208 J=1,4
	IF(KMOV(2).EQ.IBOX(J))GOTO300
208	CONTINUE
	INOEL(NOS)=ICC-ILC
	ILC=ICC
	NOS=NOS+1
	IXL=KMOV(3)
	IYL=KMOV(4)
	GOTO199
300	INOEL(NOS)=ICC-ILC
	IF(NOS.LE.6)GOTO301
	ERR=.TRUE.
	GOTO305
301	ITY=IPNT(DUM)
	CALL CVS
305	IF(SPEC)GOTO 311
	CALL MSSLP(ICHAR(IASC-32))
	CALL CHINTS(ICHAR(IASC-32),0,5)
311	CALL STRIP(ISEG)
	CALL DEPICT(IDISP,1)
	IF(ERR)GOTO100
	IF(.NOT.FLAG)GOTO468
	ITS=NEWSEG(12)
	CALL MOVETO(660,280,.FALSE.,0,5)
	CALL HOLSTR('CVS FOR VALUE ')
	CALL STRING(' ',1)
	CALL INDISP(IDTOCT(IASC),6)
	CALL HOLSTR(' (')
	CALL INDISP(IASC,5)
	CALL SUBTEN
	CALL HOLSTR(')')
	CALL MOVETO(660,280,.FALSE.,0,5)
	CALL HOLSTR('@000000000000000000000@')
	LM=0
	LPT=ISTBP0(IRES(1),3)
456	LM=LM+1
	IF(LM.GT.NOS)GOTO457
	CALL MOVETO(600,280-LM*30,.FALSE.,-1,-1)
	CALL INDISP(LM,1)
	CALL MOVETO(660,-1,.FALSE.,-1,-1)
	DO 458 I=1,6
	LJ=ILDB(LPT)
	CALL STRING(ILET(LJ+16),1)
458	CONTINUE
	GOTO456
457	CALL MOVETO(600,280-LM*30,.FALSE.,0,5)
	CALL HOLSTR('REGION WORD')
	CALL INDISP(IDTOCT(ITY),8)
	CALL DEPICT(IDISP,1)
468	IF(EDIT)GOTO 507
	CALL PACK(IASC,ITY,IDISP)
	ERR=.TRUE.
	GOTO99
105	CALL ATTIC(2,KMOV)
	IF(KMOV(2).EQ.IBOX(2))GOTO500
	ERR=.TRUE.
	GOTO100
500	ITS=NEWSEG(1)
	CALL MOVETO(800,100,.FALSE.,0,5)
	CALL HOLSTR(' DELETE LAST CHAR.')
	CALL DEPICT(IDISP,1)
	IV(NOS)=IV(NOS)-IHL(NOS)
	INM(NOS)=INM(NOS)-1
	TAK=.TRUE.
	ERR=.TRUE.
	CALL MSILP(IBOX(2))
	GOTO99
106	GOTO(501,502,503,504,505,506)IDO
506	CALL CHINTS(ICONT(6),1,5)
	CALL SWOFF
	GOTO 99
505	EDIT=.TRUE.
C
C	EDIT LIGHT BUTTON
C
	FLAG=.TRUE.
	CALL CHINTS(ICONT(5),1,7)
	GOTO508
507	DO 700 I=1,6
	IF(INM(I).EQ.0)GOTO 700
	ITOT=IV(I)-IHL(I)+1
	DO 700 J=1,ITOT,IHL(I)
	M=ICVA(I,J)
	L=IHLR(M)
	IF(L.EQ.IASC)GOTO 701
700	CONTINUE
	CALL MOVETO(600,900,.FALSE.,0,5)
	CALL HOLSTR('CHARACTER NOT IN DICTIONARY !!')
	CALL MOVETO(600,875,.FALSE.,0,5)
	CALL HOLSTR('CANNOT PERFORM EDIT , TRY AGAIN.')
	CALL DEPICT(IDISP,1)
	ERR=.TRUE.
	GOTO 99
701	IF(I.EQ.NOS)GOTO 702
	DO 703 K=0,IHL(I)-1
	ICVA(I,J+K)="262626262626
703	CONTINUE
	INM(I)=INM(I)-1
	CALL PACK(IASC,ITY,IDISP)
	IF(FLAG)ERR=.TRUE.
	GOTO 99
702	M=IHRL(IASC)
	M=IHRR(ITY)
	ICVA(I,J)=M
	DO 705 K=1,(NOS+1)/2
	ICVA(I,J+K)=IRES(K)
705	CONTINUE
	IF(FLAG)ERR=.TRUE.
	GOTO99
504	CALL CHINTS(ICONT(4),1,7)
C
C	UPDATE LIGHT BUTTON.
C
508	CALL SWOFF
	CALL IFILE(23,NAME)
	READ(23) INM,ITAL,ICVS
	DO 900 I=1,6
	IF(INM(I).EQ.0)GOTO 900
	ITOT=INM(I)*IHL(I)+ITAL(I)-1
	DO 901 J=ITAL(I),ITOT
	ICVA(I,J-ITAL(I)+1)=ICVS(J)
901	CONTINUE
	IV(I)=ITOT-ITAL(I)+1
900	CONTINUE
	ITS=NEWSEG(1)
	CALL MOVETO(800,100,.FALSE.,0,5)
	CALL HOLSTR('INPUT FINISHED')
	CALL DEPICT(IDISP,1)
	ERR=.TRUE.
	GOTO99
503	ITS=NEWSEG(1)
C
C	SPECIAL CHARACTER LIGHT BUTTON.
C
	CALL MOVETO(550,100,.FALSE.,0,5)
	CALL HOLSTR(' INPUT ON 7-TTY,</> TERMINATES VALUE.')
	CALL DEPICT(IDISP,1)
	IASC=0
510	CALL ATTIC(1,KMOV)
	IF(KMOV(3).EQ.47)GOTO511
	IF(KMOV(3).EQ.32)GOTO510
	IASC=IASC*10+KMOV(3)-48
	GOTO510
511	CALL CLEAR(ITS,IDISP)
	ISEG=NEWSEG(34)
	SPEC=.TRUE.
	GOTO512
502	FLAG=.NOT.FLAG
C
C	DISPLAY VALUE&CVS LIGHT BUTTON.
C
	GOTO99
501	CALL REDUCE
	CALL TRKILL
	CALL DEPICT(IDISP,1)
	ICNT=1
	DO 400 I=1,6
	IF(INM(I).GT.0)GOTO401
	ITAL(I)=0
	GOTO400
401	ITAL(I)=ICNT
	DO 400 J=1,IV(I)
	IF(ICVA(I,J).EQ."262626262626)GOTO 400
	ICVS(ICNT)=ICVA(I,J)
	ICNT=ICNT+1
	IF(ICNT.GT.200)GOTO403
400	CONTINUE
	CALL OFILE(22,NAME)
	WRITE(22) INM,ITAL,ICVS
	CALL MOVETO(12,512,.FALSE.,0,4)
	CALL HOLSTR('YOUR DICTIONARY IS NOW ON FILE "GRASS.DAT",')
	CALL HOLSTR(' TO GET AN ANALYSIS OF IT TYPE :-')
	CALL MOVETO(400,480,.FALSE.,0,4)
	CALL HOLSTR('RU CHECK @+@60,72@,@')
	CALL MOVETO(400,460,.FALSE.,0,4)
	CALL HOLSTR('PRINT TABLE.ANL')
	CALL DEPICT(IDISP,1)
	STOP
403	CALL MOVETO(300,512,.FALSE.,0,5)
	CALL HOLSTR('DICTIONARY OVERFLOW! RERUN PROGRAM,AND PUT IN')
	CALL HOLSTR( ' LESS SYMBOLS!!!!!!!!!')
	CALL DEPICT(IDISP,1)

	END