REM-----FILE VOCBLD.BAS---
COMMON KEYWD$(1),LIBNAME$,RLEN%,TRUE%,AUTH.LEN%,TITL.LEN%
COMMON MAXBIB%,MAXDESC%,MAXDEF%,MAXKEYS%,MAXCON%,CONCEPT$(1)
COMMON ISS.LEN%,CLS$,ERR%,JOUR.LEN%,KWD.LEN%,CMD$(1)
COMMON LFT%(1),RGHT%(1),CON.KEY%(2),CON.RATE(2),QUERY$,L%
DIM DKEY%(MAXKEYS%),V%(MAXKEYS%),MOVE%(MAXKEYS%)
DIM L.STK%(8),R.STK%(8)
4E1 REM B/E/C/ VOCAB FILE
PRINT CLS$
PRINT
PRINT "KEYWORDS # ";MAXKEYS%
PRINT
PRINT TAB(12);"--KEYWORD VOCAB BUILD/MODIFY--"
PRINT
BLANK$="                                             "
ZEES$="ZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZ"
FOR I%=1 TO MAXKEYS% : MOVE%(I%)=0 : V%(I%)=I% : NEXT I%
DEL%=0
IF END #1 THEN 4.1E1
OPEN LIBNAME$+".VOC" AS 1
IF SIZE(LIBNAME$+".VOC")=0 THEN \
 DELETE 1 : GOTO 4.1E1
IF END #1 THEN 4.2E1
VOC.LEN%=1
WHILE TRUE%
 READ #1; LINE KEYWD$(VOC.LEN%)
 VOC.LEN%=VOC.LEN%+1
 WEND
4.2E1 CLOSE 1
VOC.LEN%=VOC.LEN%-1
NEW%=0
OLD.NUM%=VOC.LEN%
B%=RENAME(LIBNAME$+".VBK",LIBNAME$+".VOC")
CREATE LIBNAME$+".VTM" AS 1
INPUT "DO YOU WISH TO ADD OR DELETE (A/D)? ";ANS$
ANS$=UCASE$(LEFT$(ANS$,1))
IF ANS$="A" THEN 4.5E1
WHILE TRUE%
 INPUT "ENTER KEYWORD NUMBER: ";LINE TEMP$
 IF LEN(TEMP$)=0 THEN 4.4E1
 J%=VAL(TEMP$) : DEL%=DEL%+1 : DKEY%(DEL%)=J%
 KEYWD$(J%)=LEFT$(ZEES$,KWD.LEN%)
 WEND
4.5E1 REM GET A KEYWORD
WHILE TRUE%
 IF VOC.LEN%>=MAXKEYS% THEN \
  PRINT "KEYWORD VOCAB FULL":\
  GOTO 4.4E1
 4.55E1 PRINT "ENTER KEYWORD #"; VOC.LEN%+1;" : ";
 INPUT "";LINE TEMP$
 IF LEN(TEMP$)=0 THEN 4.4E1
 TEMP$=UCASE$(TEMP$)
 I%=0
 WHILE I%<LEN(TEMP$) :  I%=I%+1
  IF MID$(TEMP$,I%,1)=" " THEN \
   PRINT "KEYWORDS MAY NOT CONTAIN BLANKS- RE-ENTER":\
   GOTO 4.55E1
   WEND
 VOC.LEN%=VOC.LEN%+1 : KEYWD$(VOC.LEN%)=LEFT$(TEMP$+BLANK$,KWD.LEN%)
 WEND
4.1E1 REM BUILD FROM SCRATCH
CREATE LIBNAME$+".VOC" AS 1
VOC.LEN%=0
NEW%=-1
GOTO 4.5E1
4.4E1 REM QUICKSORT
PRINT "SORTING......"
S%=1 : L.STK%(1)=1 : R.STK%(1)=VOC.LEN%
4.41E1 L%=L.STK%(S%) : R%=R.STK%(S%) : S%=S%-1
 4.422E1 I%=L% : J%=R% : X$=KEYWD$(INT%((L%+R%)/2))
  4.43E1 WHILE KEYWD$(I%)<X$ : I%=I%+1 : WEND
  WHILE X$<KEYWD$(J%) : J%=J%-1 : WEND
  IF I%<=J% THEN \
   W$=KEYWD$(I%) : KEYWD$(I%)=KEYWD$(J%) :\
   KEYWD$(J%)=W$ : TEMP%=V%(I%) :\
   V%(I%)=V%(J%) : V%(J%)=TEMP% :\
   I%=I%+1 : J%=J%-1
  IF I%<=J% THEN 4.43E1
 IF (J%-L%)>= (R%-I%) THEN 4.44E1
 IF I%<R% THEN \
  S%=S%+1 : L.STK%(S%)=I% : R.STK%(S%)=R%
 R%=J%
 GOTO 4.45E1
 4.44E1 IF L%<J% THEN \
  S%=S%+1 : L.STK%(S%)=L% : R.STK%(S%)=J%
 L%=I%
 4.45E1 IF L%<R% THEN 4.422E1
IF S%<>0 THEN 4.41E1
IF NEW% THEN 4.42E1
 FOR I%=1 TO VOC.LEN%
  IF V%(I%)<=OLD.NUM% THEN \
   MOVE%(V%(I%))=I%-V%(I%)
  NEXT I%
IF DEL%<=0 THEN 4.42E1
FOR I%=1 TO DEL%
MOVE%(DKEY%(I%))=999
 NEXT I%
VOC.LEN%=VOC.LEN%-DEL%
4.42E1 REM WRITE TO DISC
IF END #1 THEN 4.6E1
FOR I%=1 TO VOC.LEN%
 PRINT USING "&"; #1; KEYWD$(I%)
 NEXT I%
CLOSE 1
PRINT VOC.LEN%; "KEYWORDS WRITTEN TO VOCAB"
IF NOT NEW% THEN \
 B%=RENAME (LIBNAME$+".VOC",LIBNAME$+".VTM") :\
 OPEN LIBNAME$+".VBK" AS 1:\
 DELETE 1 :\
 GOSUB 5E1
CHAIN "VOCLST"
4.6E1 PRINT "FILE WRITE ERROR"
IF NEW% THEN DELETE 1 ELSE CLOSE 1 :\
 B%=RENAME (LIBNAME$+".VOC",LIBNAME$+".VBK") :\
 OPEN LIBNAME$+".VTM" AS 1 :\
 DELETE 1
INPUT "PRESS RETURN TO GO BACK TO MENU";LINE ANS$
4.9E1 CHAIN "BIBLIO"
DEF FN.TWO.INT%(DUM$)
TEN%=ASC(MID$(DUM$,1,1))
IF TEN%>64 THEN TEN%=TEN%-55 ELSE TEN%=TEN%-48
ONE%=ASC(MID$(DUM$,2,1))
IF ONE%>64 THEN ONE%=ONE%-55 ELSE ONE%=ONE%-48
FN.TWO.INT%=16*TEN%+ONE%
RETURN
FEND
DEF FN.INT.TWO$(DUM%)
HI%=DUM%/16 : LO%=DUM%-16*HI%
IF HI%<10 THEN HI%=HI%+48 ELSE HI%=HI%+55
IF LO%<10 THEN LO%=LO%+48 ELSE LO%=LO%+55
FN.INT.TWO$=CHR$(HI%)+CHR$(LO%)
RETURN
FEND
5E1 REM ALTER KEYWORDS
IF END #2 THEN 5.5E1
OPEN LIBNAME$+".BIB" RECL RLEN% AS 2
IF SIZE(LIBNAME$+".BIB")=0 THEN \
 DELETE 2 : RETURN
PRINT "MODIFYING KEYWORD DESCRIPTORS IN BIBLIO.."
IF END #2 THEN 5.4E1
RNUM%=2
READ #2,1;LINE TEMP$
DESC.BEG%=AUTH.LEN%+TITL.LEN%+JOUR.LEN%+ISS.LEN%+1
WHILE TRUE%
 READ #2,RNUM%;LINE TEMP$
 I%=DESC.BEG% : L1%=LEN(TEMP$)
 WHILE TRUE%
  DUM$=MID$(TEMP$,I%,3)
  IF DUM$="FFF" THEN 5.3E1
  K%=FN.TWO.INT%(DUM$)
  IF MOVE%(K%)=999 THEN \
   DUM2$="" \
  ELSE \
   K%=K%+MOVE%(K%) :\
   DUM2$=FN.INT.TWO$(K%)+RIGHT$(DUM$,1)
  TEMP1$=LEFT$(TEMP$,I%-1)+DUM2$+RIGHT$(TEMP$,L1%-I%-2)
  TEMP$=LEFT$(TEMP1$+"   ",L1%)
  IF LEN(DUM2$)>0 THEN I%=I%+3
  WEND
 5.3E1 PRINT USING "&"; #2,RNUM%; TEMP$
 RNUM%=RNUM%+1
 WEND
5.4E1 CLOSE 2
5.5E1 RETURN