DECLARE SUB frame (left%, right%, top%, bottom%) DECLARE SUB oldfile () DECLARE SUB mark () DECLARE SUB scan () DECLARE SUB traverse () DECLARE SUB pointers () DECLARE SUB rotate () DECLARE SUB intake () DECLARE SUB bldfile () DECLARE SUB newfile () REM BINARY TREE TYPE kwicRec lf AS INTEGER hl AS STRING * 60 pg AS STRING * 3 dt AS STRING * 14 rt AS INTEGER END TYPE DIM SHARED kwic AS kwicRec COMMON SHARED hl$, pg$, dt$, q$ COMMON SHARED pt%, ef%, n% CLEAR , , 2000 CLS LOCATE 5 PRINT TAB(29); "WELCOME TO TREEPROG": PRINT PRINT TAB(28); "Please specify a file" PRINT TAB(23); "(Example==> C:\TEMP.DAT)" PRINT TAB(27); "and press ENTER to begin" PRINT : PRINT TAB(27); "use "; COLOR 0, 7 PRINT "C"; COLOR 7, 0 PRINT "aps for entry "; COLOR 0, 7 PRINT "T"; COLOR 7, 0 PRINT "erms" frame 18, 58, 2, 14 PRINT : PRINT : PRINT DO LINE INPUT "File specification==> "; z$ LOOP UNTIL LEFT$(RIGHT$(z$, 4), 1) = "." OPEN z$ FOR RANDOM AS #1 LEN = LEN(kwic) y$ = LEFT$(z$, LEN(z$) - 3) + "TXT" OPEN y$ FOR OUTPUT AS #2 DO CLS BEEP LINE INPUT "(B)uild or (M)anip or (X)Stop==> "; q$ PRINT SELECT CASE UCASE$(q$) CASE "B" LINE INPUT "(N)ew file or (A)ppend to old==> "; q$ SELECT CASE UCASE$(q$) CASE "N" newfile bldfile CASE "A" oldfile bldfile END SELECT CASE "M" LINE INPUT "(S)earch (D)elete (L)ist (X)==> "; q$ q$ = UCASE$(q$) PRINT SELECT CASE q$ CASE "S" CLOSE #2 OPEN y$ FOR OUTPUT AS #2 oldfile scan traverse IF hl$ <> "@" THEN LINE INPUT z$ END IF CASE "D" oldfile scan mark CASE "L" CLOSE #2 OPEN y$ FOR OUTPUT AS #2 oldfile traverse LINE INPUT z$ CASE "X" END SELECT CASE "X" CLOSE CLS END END SELECT LOOP SUB bldfile ef% = VAL(kwic.dt) DO ef% = ef% + 1 intake rotate LOOP UNTIL hl$ = "" GET #1, 1, kwic kwic.dt = STR$(ef%) PUT #1, 1, kwic END SUB SUB frame (left%, right%, top%, bottom%) LOCATE top%, left%: PRINT CHR$(201) LOCATE top%, right%: PRINT CHR$(187) LOCATE bottom%, left%: PRINT CHR$(200) LOCATE bottom%, right%: PRINT CHR$(188) FOR vert% = top% + 1 TO bottom% - 1 LOCATE vert%, left%: PRINT CHR$(186); LOCATE vert%, right%: PRINT CHR$(186); NEXT vert% horiz% = right% - left% - 1 hline$ = STRING$(horiz%, 205) LOCATE top%, left% + 1: PRINT hline$ LOCATE bottom%, left% + 1: PRINT hline$ END SUB SUB intake PRINT LINE INPUT "HEADLINE==> "; hl$ IF hl$ = "" THEN EXIT SUB LINE INPUT "PAGE==> "; pg$ IF LEN(pg$) = 1 THEN pg$ = " " + pg$ END IF PRINT "DATE==> "; kwic.dt; LINE INPUT " OK? "; q$ IF UCASE$(q$) = "N" THEN LINE INPUT "DATE==> "; dt$ dt$ = UCASE$(dt$) pt% = 1 END SUB SUB mark IF hl$ <> "@" THEN PRINT kwic.hl; kwic.dt; "P."; kwic.pg IF RIGHT$(kwic.hl, 1) = "@" THEN PRINT : PRINT "DELETED" LINE INPUT z$ ELSE PRINT LINE INPUT "DELETE? "; q$ END IF IF UCASE$(q$) = "Y" THEN kwic.hl = LEFT$(kwic.hl, 59) + "@" PUT #1, pt%, kwic END IF END IF END SUB SUB newfile LINE INPUT "Are you sure? "; q$ IF UCASE$(q$) <> "Y" THEN EXIT SUB kwic.lf = 0 kwic.hl = "*ROOT*" + SPACE$(53) + "@" kwic.pg = "" kwic.dt = "1" kwic.rt = 0 ef% = 1 PUT #1, ef%, kwic END SUB SUB oldfile GET #1, 1, kwic hl$ = "" pg$ = "" dt$ = "" n% = 0 END SUB SUB pointers hl$ = UCASE$(hl$) GET #1, pt%, kwic IF hl$ <= kwic.hl THEN IF kwic.lf = 0 THEN kwic.lf = ef% PUT #1, pt%, kwic kwic.lf = 0 kwic.hl = hl$ kwic.pg = pg$ kwic.dt = dt$ kwic.rt = 0 PUT #1, ef%, kwic EXIT SUB ELSE pt% = kwic.lf END IF ELSE IF kwic.rt = 0 THEN kwic.rt = ef% PUT #1, pt%, kwic kwic.lf = 0 kwic.hl = hl$ kwic.pg = pg$ kwic.dt = dt$ kwic.rt = 0 PUT #1, ef%, kwic EXIT SUB ELSE pt% = kwic.rt END IF END IF pointers END SUB SUB rotate IF hl$ = "" THEN EXIT SUB FOR i = 1 TO LEN(hl$) t$ = hl$ p = ASC(MID$(hl$, i, 1)) IF p > 64 AND p < 91 THEN IF i = 1 THEN pointers ELSE pt% = 1 ef% = ef% + 1 hl$ = MID$(hl$, i) + "/ " + LEFT$(hl$, i - 1) pointers END IF END IF hl$ = t$ NEXT i END SUB SUB scan CLS LINE INPUT "TARGET KEY==> "; hl$ hl$ = UCASE$(hl$) PRINT IF q$ = "S" THEN LINE INPUT "OUTPUT TO PRINTER? "; q$ q$ = UCASE$(q$) PRINT END IF DO IF hl$ > LEFT$(kwic.hl, LEN(hl$)) THEN IF kwic.rt = 0 THEN PRINT "STEM NOT FOUND" hl$ = "@" LINE INPUT z$ EXIT SUB ELSE pt% = kwic.rt GET #1, pt%, kwic END IF ELSE IF hl$ < LEFT$(kwic.hl, LEN(hl$)) THEN IF kwic.lf = 0 THEN PRINT "STEM NOT FOUND" hl$ = "@" LINE INPUT z$ EXIT SUB ELSE pt% = kwic.lf GET #1, pt%, kwic END IF ELSE EXIT SUB END IF END IF LOOP END SUB SUB traverse IF RIGHT$(kwic.hl, 1) <> "@" THEN kwic.hl = LEFT$(kwic.hl, LEN(kwic.hl) - 2) + " " END IF IF kwic.lf = 0 AND kwic.rt = 0 THEN IF RIGHT$(kwic.hl, 1) <> "@" AND LEFT$(kwic.hl, LEN(hl$)) = hl$ THEN PRINT kwic.hl; kwic.dt; "P."; kwic.pg IF q$ = "Y" THEN LPRINT kwic.hl; kwic.dt; "P."; kwic.pg END IF w$ = kwic.hl + kwic.dt + "P." + kwic.pg WRITE #2, w$ n% = n% + 1 IF n% = 23 THEN n% = 0 LINE INPUT z$ END IF END IF END IF IF kwic.lf <> 0 AND kwic.rt <> 0 THEN lh$ = kwic.hl gp$ = kwic.pg td$ = kwic.dt rt% = kwic.rt GET #1, kwic.lf, kwic traverse IF RIGHT$(lh$, 1) <> "@" AND LEFT$(lh$, LEN(hl$)) = hl$ THEN PRINT lh$; td$; "P."; gp$ IF q$ = "Y" THEN LPRINT lh$; td$; "P."; gp$ END IF w$ = lh$ + td$ + "P." + gp$ WRITE #2, w$ n% = n% + 1 IF n% = 23 THEN n% = 0 LINE INPUT z$ END IF END IF GET #1, rt%, kwic traverse END IF IF kwic.lf <> 0 AND kwic.rt = 0 THEN lh$ = kwic.hl gp$ = kwic.pg td$ = kwic.dt GET #1, kwic.lf, kwic traverse IF RIGHT$(lh$, 1) <> "@" AND LEFT$(lh$, LEN(hl$)) = hl$ THEN PRINT lh$; td$; "P."; gp$ IF q$ = "Y" THEN LPRINT lh$; td$; "P."; gp$ END IF w$ = lh$ + td$ + "P." + gp$ WRITE #2, w$ n% = n% + 1 IF n% = 23 THEN n% = 0 LINE INPUT z$ END IF END IF END IF IF kwic.lf = 0 AND kwic.rt <> 0 THEN IF RIGHT$(kwic.hl, 1) <> "@" AND LEFT$(kwic.hl, LEN(hl$)) = hl$ THEN PRINT kwic.hl; kwic.dt; "P."; kwic.pg IF q$ = "Y" THEN LPRINT kwic.hl; kwic.dt; "P."; kwic.pg END IF w$ = kwic.hl + kwic.dt + "P." + kwic.pg WRITE #2, w$ n% = n% + 1 IF n% = 23 THEN n% = 0 LINE INPUT z$ END IF END IF GET #1, kwic.rt, kwic traverse END IF END SUB |