1000 !-----------------------------------------------!
1010 !  PROGRAM TO MAINTAIN THE WORDS FOR HANG5.BAS  !
1020 !-----------------------------------------------!
1030
2000 REM ...... MAP DEFINITIONS
2020   MAP1 RECSIZ,F,6,16    ! RECORD SIZE IN WORDS.DAT FILE
2021   MAP1 FWORD$,S,16
2025   MAP1 NWORD$,S,16
2027   MAP1 LWORD$,S,16
2028   MAP1 CODE$ ,S,16
2030   MAP1 RECNUM,F,6       ! RECORD NUMBER COUNTER
2040   MAP1 LOCK$ ,S,1,"Y"   ! "Y" IF LOCKS ARE TO BE USED (LOAD XLOCK.SBR)
2050   MAP1 COMD$ ,S,25
2060   MAP1 BS$   ,S,50
2070   MAP1 FNAME$ ,S,10
2080   MAP1 BUFWORD$,S,50
2090
2300 REM ...... XLOCK MAPS
2320   MAP1 MODE,B,2
2330   MAP1 L1  ,B,2,100
2340   MAP1 L2  ,B,2,1
2390
2400 REM ...... PARAMETER RECORDS
2420   MAP1 RECORD'ZERO
2430     MAP2 URECS,B,2
2440     MAP2 TBLOX,B,2
2450     MAP2 BPREC,B,2
2460     MAP2 INDEX,B,2
2490
2500 REM ...... ONE-TIME INITIALIZATION
2520   FOR I=1 TO 50 : BS$=BS$+CHR(8) : NEXT I
2530   MODE=2 : XCALL XLOCK,MODE,L1,L2
2540   PRINT TAB(-1,0);
2590
3000 MAIN:
3020   PRINT
3025   COMD$="HELP"
3030   INPUT "ENTER NEXT COMMAND (OR 'HELP' FOR AID) : ", COMD$
3040   IF(LEN(COMD$) < 2) THEN ? "ERROR---COMMAND < 2 LETTERS" : GO TO MAIN
3090
3100 REM ...... COMMANDS
3120   IF(INSTR(1,"INITIALIZE",COMD$)=1) THEN GO TO INITIALIZE'COMMAND
3130   IF(INSTR(1,"ADD"       ,COMD$)=1) THEN GO TO ADD'COMMAND
3140   IF(INSTR(1,"DELETE"    ,COMD$)=1) THEN GO TO DELETE'COMMAND
3150   IF(INSTR(1,"DISPLAY"   ,COMD$)=1) THEN GO TO DISPLAY'COMMAND
3160   IF(INSTR(1,"DUMP"      ,COMD$)=1) THEN GO TO DUMP'COMMAND
3170   IF(INSTR(1,"BUILD"     ,COMD$)=1) THEN GO TO BUILD'COMMAND
3180   IF(INSTR(1,"HELP"      ,COMD$)=1) THEN GO TO HELP'COMMAND
3190
3200 REM ...... OTHER ENTRIES
3220   IF(INSTR(1,"END"       ,COMD$)=1) THEN GO TO END'PROG
3250   PRINT "ERROR---ILLEGAL COMMAND"
3260   GO TO MAIN
3290
3470
3480
3490
3500 INITIALIZE'COMMAND:
3520   LOOKUP "WORDS.DAT", THERE
3530   IF(THERE <> 0) THEN ? "ERROR---WORDS FILE ALREADY EXISTS" : GO TO MAIN
3590
3600 ENTER'MAX:
3620   INPUT "ENTER MAXIMUM NUMBER OF WORDS ALLOWED IN WORDS FILE : ", MWORDS
3630   IF(MWORDS < 5) THEN ? "HEY --- ARE YOU SERIOUS, MAN ?":GO TO END'COMMANDS
3640   IF(MWORDS > 10000) THEN ? "ERROR--- > 10000 WORDS" : GO TO END'COMMANDS
3650   RPB=INT(512/RECSIZ)
3660   TBLOX=INT(MWORDS/RPB + .99999)
3690
3700 REM ...... ALLOCATE FILE
3720   ALLOCATE "WORDS.DAT", TBLOX
3730   OPEN #1, "WORDS.DAT", RANDOM, RECSIZ, RECNUM
3740   RECNUM=0
3742   URECS=1  :  BPREC=RECSIZ  :  INDEX=0
3750   WRITE #1, RECORD'ZERO
3790
3900 REM ...... FINISH
3950   GO TO END'CLOSE
3970
3980
3990
4000 ADD'COMMAND:
4020   ACTION$="L" : GOSUB FILE : IF(NERR > 0) THEN GO TO END'COMMANDS
4021   PRINT "   KEEP ENTERING WORDS --- TO FINISH, ENTER A CARRIAGE RETURN"
4023 ADD'LOOP:
4025   IF(FRECS=0) THEN ? "   [WARNING---WORD FILE FULL]" : GO TO END'CLOSE
4030   PRINT "   ENTER NEW WORD : <"; SPACE$(RECSIZ); ">"; BS$[1,RECSIZ+1];
4035   BUFWORD$=""
4040   INPUT "" BUFWORD$
4041   IF(BUFWORD$="") THEN GO TO END'CLOSE
4042   IF(LEN(BUFWORD$) > RECSIZ) THEN ? "ERROR---TOO LARGE" : GO TO END'CLOSE
4043   NWORD$=BUFWORD$
4045   IF(NWORD$="*") THEN ? "[NOT ADDED]" : GO TO ADD'LOOP
4050   CODE$=NWORD$
4060   GOSUB FIND'WORD
4070   IF(FOUND > 0) THEN PRINT "ERROR---ALREADY IN FILE" : GO TO END'CLOSE
4090
4100 REM ...... MOVE FOLLOWING WORDS IN
4120   IF(-FOUND=URECS) THEN GO TO ADD'WORD
4130   FOR REC=URECS-1 TO -FOUND   STEP -1
4140     RECNUM=REC
4150     READ #1, FWORD$
4160     RECNUM=REC+1
4170     WRITE #1, FWORD$
4180   NEXT REC
4190
4200 ADD'WORD:
4220   RECNUM=-FOUND
4230   WRITE #1, NWORD$
4290
4400 REM ...... UPDATE FILE PARAMETERS
4420   RECNUM=0
4425   URECS=URECS+1
4430   WRITE #1, URECS
4440   GO TO ADD'LOOP
4470
4480
4490
5000 DELETE'COMMAND:
5020   ACTION$="L" : GOSUB FILE : IF(NERR > 0) THEN GO TO END'COMMANDS
5030   ? "   ENTER WORD TO DELETE : <"; SPACE$(RECSIZ); ">"; BS$[1,RECSIZ+1];
5040   INPUT "" NWORD$
5042   FILLER=RECSIZ-LEN(NWORD$)
5045   IF(FILLER < 0) THEN PRINT "ERROR---WORD TOO LONG" : GO TO END'COMMANDS
5050   CODE$=NWORD$
5060   GOSUB FIND'WORD
5070   IF(FOUND < 0) THEN PRINT "ERROR---WORD NOT FOUND" : GO TO END'CLOSE
5090
5100 REM ...... MOVE FOLLOWING WORDS IN
5110   PRINT TAB(-1,7); "DELETING WORD .... ";
5120   IF(FOUND=URECS) THEN GO TO END'DELETE
5130   FOR REC=FOUND TO URECS-1
5140     RECNUM=REC+1
5150     READ #1, FWORD$
5160     RECNUM=REC
5170     WRITE #1, FWORD$
5180   NEXT REC
5190
5400 END'DELETE:
5420   RECNUM=0
5425   URECS=URECS-1
5430   WRITE #1, URECS
5440   GO TO END'UPDATE
5470
5480
5490
6000 DISPLAY'COMMAND:
6050   ACTION$="O" : GOSUB FILE : IF(NERR > 0) THEN GO TO END'COMMANDS
6090
6100 REM ...... DETERMINE DISPLAY RANGE
6120   FREC=1
6130   LREC=URECS-1
6140   P=0
6190
6200 REM ...... PRINT TITLES
6290
6300 REM ...... DO OUTPUT
6310   IF(FREC > LREC) THEN ? "   [WORD FILE EMPTY]" : GO TO FINISH'DISPLAY
6315   PRINT "   ";
6320   FOR RECNUM=FREC TO LREC
6330     READ #1, FWORD$
6340     PRINT #P, FWORD$; SPACE$(RECSIZ+1-LEN(FWORD$));
6350   IF(RECNUM/4=INT(RECNUM/4) AND RECNUM<>LREC) THEN PRINT : PRINT "   ";
6360   NEXT RECNUM
6370   PRINT #P
6375 FINISH'DISPLAY:
6380   PRINT #P, "WORDS DISPLAYED :"; LREC-FREC+1;
6385   PRINT #P, "     WORDS IN FILE :"; URECS-1;
6387   PRINT #P, "     VACANCIES :"; FRECS
6390
6400 END'DISPLAY:
6450   GO TO END'CLOSE
6470
6480
6490
6500 DUMP'COMMAND:
6520   ACTION$="L" : GOSUB FILE : IF(NERR > 0) THEN GO TO END'COMMANDS
6530   FNAME$="WORDS.SEQ"
6540   INPUT "ENTER NAME OF SEQUENTIAL FILE (DEFAULT IS 'WORDS.SEQ') : ", FNAME$
6550   LOOKUP FNAME$, THERE
6560   IF(THERE <> 0) THEN ? "ERROR---FILE ALREADY EXISTS" : GO TO END'CLOSE
6590
6600 REM ...... OPEN FILE & DO DUMP
6610   PRINT "   DUMPING .... ";
6620   OPEN #2, FNAME$, OUTPUT
6630   FOR RECNUM=1 TO URECS-1
6640     READ #1, NWORD$
6650     PRINT #2, NWORD$; ","; SPACE$(RECSIZ-LEN(NWORD$));
6660     IF(RECNUM/4=INT(RECNUM/4) AND RECNUM<>URECS-1) THEN PRINT #2
6680   NEXT RECNUM
6685   PRINT #2
6690
6900 END'DUMP:
6910   PRINT "FINISHED"
6920   CLOSE #2
6950   GO TO END'CLOSE
6970
6980
6990
7000 BUILD'COMMAND:
7020   ACTION$="L" : GOSUB FILE : IF(NERR > 0) THEN GO TO END'COMMANDS
7030   IF(URECS > 1) THEN ? "WARNING---ALREADY"; URECS-1; "WORDS IN WORD FILE"
7040   FNAME$="WORDS.SEQ"
7050   INPUT "ENTER NAME OF INPUT WORD FILE (DEFAULT IS 'WORDS.SEQ') : ", FNAME$
7060   LOOKUP FNAME$, THERE
7070   IF(THERE=0) THEN ? "ERROR---FILE NOT FOUND" : GO TO END'CLOSE
7080   OPEN #2, FNAME$, INPUT
7090
7100 REM ...... SET UP LOOP
7120   RECNUM=URECS-1
7130   IF(URECS=1) THEN LWORD$=""   ELSE READ #1, LWORD$
7140   PRINT "   NOW INSERTING WORD : ";
7190
7200 BUILD'LOOP:
7210   PRINT : PRINT "                        "; TAB(-1,3); TAB(-1,9);
7220   INPUT #2, BUFWORD$
7230   IF(EOF(2)=1) THEN GO TO END'BUILD
7235   PRINT BUFWORD$; " ";
7237   IF(LEN(BUFWORD$) > RECSIZ) THEN ? "ERROR---TOO BIG" : GO TO BUILD'LOOP
7238   NWORD$=BUFWORD$
7240   IF(NWORD$="*") THEN PRINT "[NOT ADDED]" : GO TO BUILD'LOOP
7245   IF(FRECS=0) THEN PRINT "ERROR---WORD FILE FULL" : GO TO END'BUILD
7247   IF(NWORD$>LWORD$) THEN FOUND=-URECS : LWORD$=NWORD$ : GO TO BUILD'INSERT
7250   CODE$=NWORD$
7260   GOSUB FIND'WORD
7270   IF(FOUND > 0) THEN ? "ERROR---WORD ALREADY IN FILE" : GO TO BUILD'LOOP
7290
7300 REM ...... MOVE FOLLOWING WORDS "OUT"
7320   FOR REC=URECS-1 TO -FOUND   STEP -1
7330     RECNUM=REC
7340     READ #1, FWORD$
7350     RECNUM=REC+1
7360     WRITE #1, FWORD$
7380   NEXT REC
7390
7400 BUILD'INSERT:
7420   RECNUM=-FOUND
7430   WRITE #1, NWORD$
7440   RECNUM=0
7450   URECS=URECS+1
7455   FRECS=FRECS-1
7460   WRITE #1, RECORD'ZERO
7480   GO TO BUILD'LOOP
7490
7900 END'BUILD:
7940   CLOSE #2
7950   PRINT "[FINISHED BUILDING]"
7960   GO TO END'CLOSE
7970
7980
7990
9000 HELP'COMMAND:
9020   PRINT
9030   PRINT "FOLLOWING COMMANDS ARE AVAILABLE :"
9090
9100 REM ......
9120   PRINT "   'INitialize'   START A BRAND NEW WORDS.DAT FILE"
9130   PRINT "   'ADd'          ADD A NEW WORD TO THE WORDS FILE"
9140   PRINT "   'DElete'       DELETE AN OLD WORD FROM THE WORDS FILE"
9150   PRINT "   'DIsplay'      DISPLAY THE WORDS ON THE CRT"
9160   PRINT "   'DUmp'         DUMP THE WORDS INTO A SEQUENTIAL FILE"
9170   PRINT "   'BUild'        RE-BUILD THE WORDS FILE FROMA SEQUENTIAL FILE"
9180   PRINT "   'help'         DISPLAY THIS EXPLANATION AGAIN"
9190   PRINT "   'ENd'          EXIT FROM THIS PROGRAM"
9195
9200 REM ...... STATUS OF FILE
9230   PRINT "WORD DATA FILE (WORDS.DAT)";
9240   LOOKUP "WORDS.DAT", THERE
9250   IF(THERE=0) THEN ? " HAS NOT BEEN INITIALIZED YET." : GO TO END'COMMANDS
9260   ACTION$="O" : GOSUB FILE : IF(NERR > 0) THEN GO TO END'COMMANDS
9270   PRINT " HAS"; URECS-1; "WORDS";
9280   PRINT ", & ROOM FOR"; FRECS; "MORE WORDS."
9290
9400 REM ...... FINISH
9450   GO TO END'CLOSE
9470
9480
9490
9500 END'UPDATE:
9520   ACTION$="C" : GOSUB FILE
9530   PRINT "FINISHED"; TAB(-1,8); " "
9540   GO TO END'COMMANDS
9590
9600 END'CLOSE:
9650   ACTION$="C" : GOSUB FILE
9690
9700 END'COMMANDS:
9750   GO TO MAIN
9970
9980
9990
21000 !--------------------------!
21010 !  WORD LOOKUP SUBROUTINE  !
21020 !--------------------------!
21030
21040   REM   INPUT  : CODE$ = WORD TO LOOK UP IN WORDS FILE
21050   REM   OUTPUT : FOUND = +N IF WORD FOUND AT RECORD # N
21060   REM                  = -N IF WORD PRECEEDS RECORD # N
21090
21100 FIND'WORD:
21120
21130   LOREC=0
21140   HIREC=URECS
21190
21200 FW'LOOP:
21210   IF(LOREC+1=HIREC) THEN FOUND=-HIREC : LOREC=-HIREC : GO TO END'FW
21220
21230   REM ...... SPLIT SEARCH RANGE IN HALF
21240   RECNUM=INT( (HIREC+LOREC)/2 )
21250   READ #1, FWORD$
21260   IF(CODE$ <= FWORD$) THEN HIREC=RECNUM
21265   IF(CODE$ >= FWORD$) THEN LOREC=RECNUM
21270   FOUND=HIREC
21275   IF(LOREC <> HIREC) THEN GO TO FW'LOOP
21290
21400 END'FW:
21450   RETURN
21470
21480
21490
28000 !------------------------------------!
28010 !  FILES OPEN/CLOSE/LOCK SUBROUTINE  !
28020 !------------------------------------!
28030
28040   REM   INPUT  : ACTION$ = O(PEN),L(OCK),C(LOSE)
28045   REM            LOCKS$  = "Y" IF LOCKS USED , "N" IF NOT USED
28050   REM   OUTPUT : NERR    = +N IF N ERRORS FOUND
28090
28200 FILE:
28220   NERR=1
28230   IF(ACTION$="L") THEN GO TO LOCK'FILE
28240   IF(ACTION$="O") THEN GO TO OPEN'FILE
28250   IF(ACTION$="C") THEN GO TO CLOSE'FILE
28280   PRINT "ERROR---ILLEGAL ACTION CODE" : GO TO END'FILE
28290
28300 LOCK'FILE:
28320   IF(LOCK$="N") THEN GO TO OPEN'FILE
28330   IF(LOCK$<>"Y") THEN PRINT "ERROR---ILLEGAL LOCK CODE" : GO TO END'FILE
28340   MODE=0
28350   XCALL XLOCK,MODE,L1,L2
28360   IF(MODE=0) THEN GO TO OPEN'FILE
28370   PRINT "ERROR---JOB #"; MODE; "USING FILE" : GO TO END'FILE
28390
28400 OPEN'FILE:
28420   LOOKUP "WORDS.DAT", THERE
28430   IF(THERE=0) THEN PRINT "ERROR---WORDS.DAT NOT FOUND" : GO TO UNLOCK
28440   IF(THERE>0) THEN ? "ERROR---WORDS.DAT IS SEQUENTIAL" : GO TO UNLOCK
28450   OPEN #1, "WORDS.DAT", RANDOM, RECSIZ, RECNUM
28490
28500 REM ...... READ IN PARAMETERS & CHECK
28520   RECNUM=0
28530   READ #1, RECORD'ZERO
28540   IF(TBLOX<>-THERE) THEN ? "ERROR---BAD TBLOX VALUE" : GO TO CLOSE'FILE
28550   IF(BPREC<>RECSIZ) THEN ? "ERROR---BAD BPREC VALUE" : GO TO CLOSE'FILE
28560   FRECS=INT(512/BPREC)*TBLOX-URECS
28570   IF(FRECS<0) THEN PRINT "ERROR---BAD URECS VALUE" : GO TO CLOSE'FILE
28580   NERR=0 : GO TO END'FILE
28590
28700 CLOSE'FILE:
28710   CLOSE #1
28770   NERR=0
28790
28800 UNLOCK:
28820   MODE=2
28830   IF(LOCK$="Y") THEN XCALL XLOCK,MODE,L1,L2
28890
28900 END'FILE:
28950   RETURN
28970
28980
28990
29000 END'PROG:
29020   PRINT
29030   PRINT "[EXIT FROM WORDS MAINTENANCE PROGRAM]"
29050   END

You are viewing proxied material from gopher.floodgap.com. The copyright of proxied material belongs to its original authors. Any comments or complaints in relation to proxied material should be directed to the original authors of the content concerned. Please see the disclaimer for more details.