Source:LURC Maintenance
Jump to navigation
Jump to search
| This page is a verbatim reproduction of original source material and should not be edited except for maintenance. | |
| Description |
The Applesoft BASIC source code of the Knight Quest utility program L.U.R.C. Maintenance |
|---|---|
| Source | |
| Date | |
| Author | |
| License |
The use of this item is permitted on the grounds that it's free or in the public domain. |
1 REM KNIGHT QUEST
2 REM L.U.R.C. MAINTENANCE
3 REM
4 REM COPYRIGHT (C) 1983
5 REM BY JOHN NELSON
6 REM
7 REM
8 REM 10-15: 2-4-87 LINE 13330
10 GOSUB 11000: GOSUB 12000
15 PRINT D$"OPEN KNIGHT.FORMAT,L128": PRINT D$"READ KNIGHT.FORMAT,R0": INPUT FM: DIM FRMT$(30),FM$(30,4),DF%(30,4)
20 XF = FM: FOR X = 1 TO FM: PRINT D$"READ KNIGHT.FORMAT,R";X: INPUT FRMT$(X): FOR X2 = 1 TO 4: INPUT FM$(X,X2): NEXT : FOR X2 = 1 TO 4: INPUT DF%(X,X2): NEXT : NEXT : PRINT D$"CLOSE"
25 HOME : VTAB 8: PRINT "INSERT MASTER DISKETTE AND PRESS ANY KEY": PRINT SPC( 14);"TO CONTINUE ...";: GET A$: PRINT
30 ONERR GOTO 45
40 PRINT D$"OPEN KNIGHT.LANGUAGE,L32": PRINT D$"READ KNIGHT.LANGUAGE,R0": INPUT NL:XL = NL: FOR X = 1 TO NL: PRINT D$"READ KNIGHT.LANGUAGE,R";X: INPUT L$(X),LL%(X),LC$(X),LP%(X): NEXT
45 PRINT D$"CLOSE": ONERR GOTO 55
50 PRINT D$"OPEN KNIGHT.USEFUL,L16": PRINT D$"READ KNIGHT.USEFUL,R0": INPUT NU:XU = NU: PRINT D$"READ KNIGHT.USEFUL,R";X: FOR X = 1 TO NU: INPUT U$(X),U%(X),FT%(X): NEXT
55 PRINT D$"CLOSE": ONERR GOTO 65
60 PRINT D$"OPEN KNIGHT.RACE.CLASS,L64": PRINT D$"READ KNIGHT.RACE.CLASS,R0": INPUT NR,NC: FOR X = 1 TO NR: PRINT D$"READ KNIGHT.RACE.CLASS,R";X: INPUT RC$(X): FOR X2 = 0 TO 10: INPUT RA%(X,X2): NEXT : NEXT :XC = NC:XR = NR
65 PRINT D$"CLOSE": ONERR GOTO 75
70 PRINT D$"OPEN KNIGHT.RACE.CLASS,L64": FOR X = 1 TO NC: PRINT D$"READ KNIGHT.RACE.CLASS,R";X + NR: INPUT CL$(X): FOR X2 = 0 TO 10: INPUT CA%(X,X2): NEXT : NEXT
75 REM >> DONE READING FILES
80 PRINT D$"CLOSE": ONERR GOTO 95
90 PRINT D$"OPEN KNIGHT.SPELLS,L32": PRINT D$"READ KNIGHT.SPELLS,R0": INPUT NS: FOR X = 1 TO NS: PRINT D$"READ KNIGHT.SPELLS,R";X: INPUT SN$(X),SE%(X): NEXT : PRINT D$"CLOSE"
95 POKE 216,0
100 REM === MAIN MENU ===
110 HOME : PRINT SPC( 14);"KNIGHT QUEST": PRINT SPC( 10);"L.U.R.C. MAINTENANCE": PRINT SPC( 11);"COPYRIGHT (C) 1983": PRINT SPC( 13);"BY JOHN NELSON"
115 HTAB 40: VTAB 1: PRINT MID$ ("L",1,LOCK): HTAB 40: VTAB 2: PRINT MID$ ("P",1,PRT)
120 VTAB 8: CALL - 958: PRINT "SELECT TYPE OF DATA:": PRINT
130 BW = 0: FOR X2 = 1 TO 6: PRINT " ";X2;". ";TY$(X2): NEXT : PRINT " W. WRITE FILES AND QUIT": PRINT " Q. QUIT - NO UPDATE"
140 PRINT : PRINT "SELECT NUMBER (1-6) W/Q [_]";: HTAB 26
150 GET A$: IF (A$ < "1" OR A$ > "6") AND A$ < > "Q" AND A$ < > "W" AND A$ < > CHR$ (12) AND A$ < > CHR$ (16) THEN 150
153 IF A$ = CHR$ (12) THEN LOCK = NOT LOCK: GOTO 100
157 IF A$ = CHR$ (16) THEN PRT = NOT PRT: GOTO 100
160 PRINT A$:LURC = VAL (A$):VOW = 0: FOR X = 1 TO 5: IF LEFT$ (TY$(LU),1) = MID$ ("AEIOU",X,1) THEN VOW = 1
170 NEXT :AN$ = MID$ ("AN",1,VOW + 1) + " ": IF A$ = "W" THEN 5000
180 IF A$ = "Q" THEN 6000
200 REM === GET SUB-TYPE ===
210 IF LURC < > 3 AND LURC < > 4 AND BW THEN 100
215 IF LURC < > 3 AND LURC < > 4 THEN 300
220 VTAB 8: CALL - 958: PRINT "SELECT SUB-TYPE:": PRINT : PRINT " 1. ";TY$(LURC);" NAME": PRINT : PRINT " 2. ADJUSTMENT": PRINT : PRINT " 3. RETURN TO MAIN MENU": PRINT : PRINT "SELECT (1-3) [_]";: HTAB 16
230 GET A$: IF A$ < "1" OR A$ > "3" THEN 230
240 PRINT A$: IF A$ = "3" THEN 100
260 ST = VAL (A$)
300 REM === FUNCTION MENU ===
305 HOME : PRINT SPC( 14);"KNIGHT QUEST": PRINT SPC( 10);"L.U.R.C. MAINTENANCE": PRINT SPC( 11);"COPYRIGHT (C) 1983": PRINT SPC( 13);"BY JOHN NELSON"
310 VTAB 6: CALL - 958: HTAB 40: VTAB 1: PRINT MID$ ("L",1,LOCK): HTAB 40: VTAB 2: PRINT MID$ ("P",1,PRT)
320 VTAB 8: HTAB 1: PRINT "SELECT ACTION DESIRED:": PRINT : PRINT " 1. ADD ";AN$;TY$(LU): PRINT : PRINT " 2. CHANGE ";AN$;TY$(LU): PRINT : PRINT " 3. DELETE ";AN$;TY$(LU)
330 PRINT : PRINT " 4. LIST ";TY$(LU); MID$ ("E",1,( RIGHT$ (TY$(LU),1) = "S"));"S": PRINT : PRINT " 5. RETURN": PRINT : PRINT "SELECT NUMBER (1-5) [_]";: HTAB 23
340 GET A$: IF (A$ < "1" OR A$ > "5") AND A$ < > CHR$ (12) AND A$ < > CHR$ (16) THEN 340
350 IF A$ = CHR$ (12) THEN LOCK = NOT LOCK: GOTO 300
360 IF A$ = CHR$ (16) THEN PRT = NOT PRT: GOTO 300
370 PRINT A$:ACT = VAL (A$): IF ACT = 5 THEN BW = 1: GOTO 200
380 VTAB 5: HTAB ( INT (41 - LEN (TY$(LURC)) - LEN (ACT$(ACT))) / 2): PRINT ACT$(ACT);" ";TYP$(LURC)
390 ON ACT GOTO 1000,2000,3000,4000
1000 REM === ADD ===
1020 ON LURC GOTO 1100,1200,1300,1400,1500,1600
1100 REM === ADD LANGUAGE ===
1110 VTAB 8: CALL - 958: INPUT "NEW LANGUAGE:";L$
1115 IF L$ = "" THEN 300
1120 FOR X = 1 TO XL: IF LEFT$ (L$(X),1) < > LEFT$ (L$,1) THEN NEXT : GOTO 1150
1130 PRINT : PRINT "REPLACE ";L$(X);"?": PRINT : GOSUB 9100: IF A$ = "Y" THEN L$(X) = L$
1140 IF NOT LOCK THEN 300
1145 PRINT : PRINT "LANGUAGE ADDED.": GOSUB 9200: GOTO 1100
1150 REM == NO DUP ==
1160 FOR X = 1 TO XL: IF L$(X) < > "" THEN NEXT : GOTO 1180
1170 IT = X:L$(IT) = L$:NL = NL + 1: GOTO 1140
1180 NL = NL + 1:XL = XL + 1:L$(XL) = L$: GOTO 1140
1200 REM === ADD USEFUL ===
1210 VTAB 8: CALL - 958: INPUT "NEW ARTIFACT TYPE:";U$
1215 IF U$ = "" THEN 300
1220 FOR X = 1 TO XU: IF U$(X) < > U$ THEN NEXT : GOTO 1250
1230 PRINT : PRINT "THAT TYPE IS ALREADY DEFINED.": GOSUB 9200: GOTO 1240
1240 IF NOT LOCK THEN 300
1245 GOSUB 9000: GOTO 1200
1250 REM == NO DUP ==
1260 FOR X = 1 TO XU: IF U$(X) < > "" THEN NEXT :XU = XU + 1:X = XU
1270 IT = X:NU = NU + 1:U$(IT) = U$
1275 VTAB 8: CALL - 958: PRINT "CAN ADVENTURER HAVE ONE? ";: GOSUB 9100:U%(IT) = (A$ = "Y")
1280 SL = LURC:LU = 6: GOSUB 9300:LURC = SL: IF NOT FO OR XT THEN 1280
1285 FT%(IT) = X
1290 GOTO 1240
1300 REM === ADD RACE ===
1310 VTAB 8: CALL - 958: INPUT "NEW RACE:";RC$
1315 IF RC$ = "" THEN 300
1320 FOR X = 1 TO XR: IF RC$(X) < > RC$ THEN NEXT : GOTO 1350
1330 PRINT : PRINT "THAT RACE ALREADY EXISTS.": GOSUB 9200: GOTO 1340
1340 IF NOT LOCK THEN 300
1345 GOSUB 9000: GOTO 1300
1350 REM == NO DUP ==
1360 FOR X = 1 TO XR: IF RC$(X) < > "" THEN NEXT :XR = XR + 1:X = XR
1370 IT = X: GOSUB 13100: GOTO 1340
1400 REM === ADD CLASS ===
1410 VTAB 8: CALL - 958: INPUT "NEW CLASS:";CL$
1415 IF CL$ = "" THEN 300
1420 FOR X = 1 TO XC: IF CL$(X) < > CL$ THEN NEXT : GOTO 1450
1430 PRINT : PRINT "THAT CLASS IS ALREADY DEFINED.": GOSUB 9200: GOTO 1440
1440 IF LOCK THEN GOSUB 9000: GOTO 1400
1445 GOTO 300
1450 REM == NO DUP ==
1460 FOR X = 1 TO XC: IF CL$(X) < > "" THEN NEXT :CAD = CAD + 1:XC = XC + 1
1470 IT = X: GOSUB 13200: GOTO 1440
1500 REM === ADD SPELL ===
1510 VTAB 8: CALL - 958: INPUT "NEW SPELL:";SN$: IF SN$ = "" THEN 300
1520 FOR X = 1 TO XS: IF SN$(X) < > SN$ THEN NEXT : GOTO 1550
1530 PRINT : PRINT "THAT SPELL IS ALREADY DEFINED.": GOSUB 9200: GOTO 1540
1540 IF LOCK THEN GOSUB 9000: GOTO 1500
1545 GOTO 300
1550 REM === NO DUP ===
1560 FOR X = 1 TO XS: IF SN$(X) < > "" THEN NEXT :SAD = SAD + 1:XS = XS + 1:X = XS
1565 IT = X:NS = NS + 1:SN$(IT) = SN$
1570 VTAB 6: CALL - 958: INPUT "SPELL EFFECT:";A$: IF A$ < > STR$ ( VAL (A$)) THEN PRINT : PRINT "NOT A VALID EFFECT.": GOSUB 9200: GOTO 1570
1580 SE%(IT) = VAL (A$): GOTO 1540
1600 REM === ADD FORMAT ===
1610 VTAB 8: CALL - 958: INPUT "NEW FORMAT NAME:";A$: IF A$ = "" THEN 300
1620 XF = XF + 1:IT = XF:FRMT$(IT) = A$
1640 FOR X = 1 TO 4: PRINT "LABEL - FIELD ";X + 4;: INPUT ":";FM$: IF FM$ = "" AND X = 1 THEN 300
1650 IF FM$ = "" THEN 1610
1660 FM$(IT,X) = FM$: NEXT
1670 FOR X = 1 TO 4: PRINT "DEFAULT ";FM$(IT,X);: INPUT ":";A$:DF%(IT,X) = VAL (A$): NEXT
1680 FM = FM + 1: IF LOCK THEN GOSUB 9000: GOTO 1600
1690 GOTO 300
2000 REM === CHANGE ===
2020 GOSUB 9300: IF NOT FO OR XT THEN 300
2030 IT = X
2040 ON LURC GOTO 2100,2200,2300,2400,2500,2600
2100 REM === CHANGE LANG ===
2115 VTAB 8: CALL - 958: PRINT "OLD NAME IS ";L$(IT);"."
2120 INPUT "NEW LANGUAGE NAME:";A$: IF A$ = "" THEN 300
2130 IF LEFT$ (A$,1) < > LEFT$ (L$(IT),1) THEN PRINT : PRINT "THAT IS NOT ALLOWED. MUST BE SAME 1ST": PRINT "CHARACTER.": GOSUB 9200: GOTO 2100
2140 L$(IT) = A$: IF LOCK THEN GOSUB 9000: GOTO 2000
2150 GOTO 300
2200 REM === CHANGE USEFUL ===
2210 F2$ = "USEABLE BY CHAR.":F3$ = "FORMAT NUMBER": GOSUB 2900: ON X GOTO 2220,2240,2270
2220 VTAB 8: CALL - 958: INPUT "NEW ARTIFACT NAME:";U$: IF U$ = "" THEN 300
2230 U$(IT) = U$: IF LOCK THEN GOSUB 9000: GOTO 2000
2235 GOTO 300
2240 VTAB 8: CALL - 958: PRINT "CAN ADVENTURER HAVE ONE? ";
2250 GET A$: IF A$ < > "Y" AND A$ < > "N" AND A$ < > CHR$ (13) THEN 2250
2260 PRINT A$: IF A$ < > CHR$ (13) THEN U%(IT) = (A$ = "Y"): IF LOCK THEN GOSUB 9000: GOTO 2000
2269 GOTO 300
2270 SL = LURC:LU = 6: GOSUB 9300:LU = SL: IF XT THEN 300
2280 FT%(IT) = X: IF LOCK THEN GOSUB 9000: GOTO 2000
2290 GOTO 300
2300 REM === CHANGE RACE ===
2310 VTAB 8: CALL - 958
2320 ON ST GOTO 2370,2350
2350 GOSUB 13300: IF XT THEN 300
2355 IF LOCK THEN GOSUB 9000: GOTO 2000
2360 GOTO 300
2370 VTAB 8: CALL - 958: PRINT "OLD RACE IS ";RC$(IT);".": INPUT "INPUT NEW RACE:";A$: IF A$ = "" THEN 300
2380 IF LEFT$ (A$,1) < "A" OR LEFT$ (A$,1) > "Z" THEN PRINT : PRINT "INVALID RACE NAME.": GOSUB 9200: GOTO 2370
2385 RC$(IT) = A$: IF LOCK THEN GOSUB 9000: GOTO 2000
2390 GOTO 300
2400 REM === CHANGE CLASS ===
2410 VTAB 8: CALL - 958
2420 ON ST GOTO 2490,2450
2450 GOSUB 13400: IF XT THEN 300
2455 IF LOCK THEN GOSUB 9000: GOTO 2000
2460 GOTO 300
2470 VTAB 8: CALL - 958: PRINT "OLD CLASS IS ";CL$(IT);".": INPUT "NEW CLASS:";A$: IF A$ = "" THEN 300
2480 CL$(IT) = A$: IF LOCK THEN GOSUB 9000: GOTO 2000
2490 GOTO 300
2500 REM === CHANGE SPELL ===
2510 VTAB 8: CALL - 958: PRINT "OLD SPELL NAME IS ";SN$(IT);"."
2520 INPUT "NEW SPELL NAME:";A$: IF A$ = "" THEN 2530
2525 IF LEFT$ (A$,1) < "A" OR LEFT$ (A$) > "Z" THEN PRINT : PRINT "NOT A VALID SPELL NAME.": GOSUB 9200: GOTO 2500
2528 SN$(IT) = A$
2530 VTAB 8: CALL - 958: PRINT "OLD SPELL EFFECT IS ";SE%(IT);"."
2540 INPUT "NEW SPELL EFFECT:";SE$: IF SE$ = "" THEN 2580
2550 IF VAL (SE$) < - 100 OR VAL (SE$) > 100 THEN PRINT : PRINT "THAT EXCEEDS MAXIMUM OF +/-100.": GOSUB 9200: GOTO 2530
2560 SE%(IT) = VAL (SE$)
2580 IF LOCK THEN GOSUB 9000: GOTO 2000
2590 GOTO 300
2600 REM === CHANGE FORMAT ===
2610 F2$ = "FIELD LABELS":F3$ = "DEFAULT VALUES": GOSUB 2900
2630 ON X GOTO 2650,2660,2690
2650 VTAB 8: CALL - 958: PRINT "OLD NAME IS ";FRMT$(IT): INPUT "NEW FORMAT NAME:";A$: IF A$ = "" THEN 300
2655 FRMT$(IT) = A$: IF LOCK THEN GOSUB 9000: GOTO 2000
2658 GOTO 300
2660 VTAB 8: CALL - 958: PRINT "INPUT FIELD NUMBER 5-8:";
2670 GET A$: IF A$ < "5" OR A$ > "8" THEN 2670
2675 PRINT A$:X2 = VAL (A$) - 4: VTAB 8: CALL - 958: PRINT "OLD LABEL IS ";FM$(IT,X2): INPUT "NEW LABEL:";A$: IF A$ = "" THEN GOTO 2000
2680 FM$(IT,X2) = A$: IF LOCK THEN GOSUB 9000: GOTO 2000
2685 GOTO 300
2690 VTAB 8: CALL - 958: PRINT "INPUT FIELD NUMBER 5-8:";
2692 GET A$: IF A$ < "5" OR A$ > "8" THEN 2692
2695 PRINT A$:X2 = VAL (A$) - 4: VTAB 8: CALL - 958: PRINT "OLD DEFAULT IS ";DF%(IT,X2): INPUT "NEW DEFAULT:";A$: IF A$ = "" THEN 300
2698 DF%(IT,X2) = VAL (A$): IF LOCK THEN GOSUB 9000: GOTO 2000
2699 GOTO 300
2900 REM === GET CHG FLD ===
2910 VTAB 8: CALL - 958: PRINT "SELECT FIELD TO CHANGE:": PRINT " 1. ";TY$(LURC);" NAME": PRINT " 2. ";F2$: PRINT " 3. ";F3$: PRINT "INPUT NUMBER (1-3) [_]"; CHR$ (8); CHR$ (8);
2920 GET A$: IF A$ < "1" OR A$ > "3" THEN 2920
2930 PRINT A$:X = VAL (A$): RETURN
3000 REM === DELETE ===
3010 IF LURC = 6 THEN VTAB 6: CALL - 958: PRINT "FORMATS MAY NOT BE DELETED.": GOSUB 9200: GOTO 300
3020 GOSUB 9300: IF NOT FO OR XT THEN 300
3025 IT = X
3030 ON LURC GOTO 3100,3200,3300,3400,3500
3100 REM === DELETE LANG ===
3110 L$(IT) = "":NL = NL - 1: IF X = XL THEN XL = XL - 1: IF LOCK THEN GOSUB 9000: GOTO 3000
3120 GOTO 300
3200 REM === DELETE USEFUL ===
3210 U$(IT) = "":NU = NU - 1: IF X = XU THEN XU = XU - 1: IF LOCK THEN GOSUB 9000: GOTO 3000
3220 GOTO 300
3300 REM === DELETE RACE ===
3310 RC$(IT) = "":NR = NR - 1: IF X = XR THEN XR = XR - 1: IF LOCK THEN GOSUB 9000: GOTO 3000
3320 GOTO 300
3400 REM === DELETE CLASS ===
3410 CL$(IT) = "":NC = NC - 1: IF X = XC THEN XC = XC - 1:CAD = CAD - 1: IF LOCK THEN GOSUB 9000: GOTO 3000
3420 GOTO 300
3500 REM === DELETE SPELL ===
3510 SN$(IT) = "":NS = NS - 1: IF X = XS THEN XS = XS - 1: IF LOCK THEN GOSUB 9000: GOTO 3000
3520 GOTO 300
4000 REM === LIST ===
4010 HOME :LP = 0
4020 IF (LURC = 3 OR LUR = 4) AND ST = 2 THEN GOSUB 9300:RC = X: IF NOT FO OR XT THEN 300
4050 IF PRT THEN PRINT D$"PR#1": GOSUB 9600
4080 ON LURC GOTO 4100,4200,4300,4400,4500,46000
4100 REM === LIST LANG ===
4110 FOR X = 1 TO XL: PRINT SPC( 10 * PRT); SPC( 3 - LEN ( STR$ (X)));X;". ";L$(X)
4120 LP = LP + 1: IF LP > 20 + PRT * 30 THEN GOSUB 9600:LP = 0
4180 NEXT :LP = 0: PRINT D$"PR#0": GOSUB 9600: GOTO 300
4200 REM === LIST USEFUL ===
4210 FOR X = 1 TO XU: PRINT SPC( 10 * PRT + 3 - LEN ( STR$ (X)));X;". ";U$(X); TAB( 20); MID$ ("NY",U%(X) + 1,1); TAB( 37 - LEN ( STR$ (FT%(X))));FT%(X)
4220 LP = LP + 1: IF LP > 20 + 30 * PRT THEN GOSUB 9600:LP = 0
4280 NEXT :LP = 0: PRINT D$"PR#0": GOSUB 9600: GOTO 300
4300 REM === LIST RACE ===
4310 HOME : IF ST = 2 THEN 4600
4330 FOR X = 1 TO XR: PRINT SPC( 10 * PRT + 3 - LEN ( STR$ (X)));X;". ";RC$(X)
4370 LP = LP + 1: IF LP > 20 + 30 * PRT THEN GOSUB 9600:LP = 0
4380 NEXT :LP = 0: PRINT D$;"PR#0": GOSUB 9600: GOTO 300
4400 REM === LIST CLASS ===
4410 HOME : IF ST = 2 THEN 4700
4420 IF PRT THEN PRINT D$"PR#1": GOSUB 9600
4430 FOR X = 1 TO XC: PRINT SPC( 10 * PRT + 3 - LEN ( STR$ (X)));X;". ";CL$(X)
4450 LP = LP + 1: IF LP > 20 + 30 * PRT THEN GOSUB 9600:LP = 0
4480 NEXT :LP = 0: PRINT D$"PR#0": GOSUB 9600: GOTO 300
4500 REM === LIST SPELLS ===
4510 FOR X = 1 TO XS: PRINT SPC( 10 * PRT + 3 - LEN ( STR$ (X)));X;". ";SN$(X); TAB( 35 - LEN ( STR$ (SE%(X))));SE%(X)
4520 LP = LP + 1: IF LP > 20 + PRT * 30 THEN GOSUB 9600:LP = 0
4580 NEXT :LP = 0: PRINT D$"PR#0": GOSUB 9600: GOTO 300
4600 REM === LIST RACE ADJ ===
4605 IF PRT THEN PRINT D$"PR#1": GOSUB 9600
4610 PRINT SPC( 10 * PRT + (40 - (16 + LEN (RC$(RC)))) / 2);"ADJUSTMENTS FOR ";RC$(RC)
4620 FOR X = 0 TO 10: PRINT SPC( 10 * PRT + 3 - LEN ( STR$ (X + 1)));X + 1;". ";RJ$(X);: FOR Y = 1 TO 35 - LEN (RJ$(X)) - LEN ( STR$ (RA%(RC,X))): PRINT ".";: NEXT : PRINT RA%(RC,X)
4640 NEXT :LP = 0: PRINT D$;"PR#0": GOSUB 9600: GOTO 300
4700 REM === LIST CLASS ADJ ===
4705 IF PRT THEN PRINT D$"PR#1": GOSUB 9600
4710 PRINT SPC( 10 * PRT + (40 - (16 + LEN (CL$(RC)))) / 2);"ADJUSTMENTS FOR ";CL$(RC)
4720 FOR X = 0 TO 10: PRINT SPC( 10 * PRT + 3 - LEN ( STR$ (X + 1)));X + 1;". ";CJ$(X);: FOR Y = 1 TO 35 - LEN (CJ$(X)) - LEN ( STR$ (CA%(RC,X))): PRINT ".";: NEXT : PRINT CA%(RC,X)
4740 NEXT :LP = 0: PRINT D$;"PR#0": GOSUB 9600: GOTO 300
5000 REM === END - WRITE ===
5010 HOME : PRINT SPC( 14);: INVERSE : PRINT "* CONFIRM *": NORMAL : PRINT : PRINT "DO YOU WANT TO WRITE THESE FILES ONTO": PRINT : PRINT "DISKETTE - PRESS 'C' TO CONTINUE ...": PRINT
5020 PRINT " ANY OTHER KEY TO ABORT.";
5030 GET A$: PRINT : IF A$ < > "C" THEN 100
5040 HOME : PRINT SPC( 14);"KNIGHT QUEST": PRINT SPC( 14);"WRITE FILES": VTAB 8: PRINT "SELECT FILES TO WRITE:": PRINT "LANGUAGES ";: GOSUB 9100:WL = (A$ = "Y"): PRINT "ARTIFACT TYPES ";: GOSUB 9100:WU = (A$ = "Y")
5050 PRINT "RACES / CLASSES ";: GOSUB 9100:WC = (A$ = "Y")
5055 IF WC AND CAD THEN WT = 1: GOTO 5070
5060 PRINT "*** OPTIONAL ***": PRINT "TITLES FILE ";: GOSUB 9100:WT = (A$ = "Y")
5065 PRINT "SPELLS FILE ";: GOSUB 9100:WS = (A$ = "Y")
5070 PRINT "FORMAT FILE ";: GOSUB 9100:WF = (A$ = "Y")
5075 IF WL THEN GOSUB 5100
5080 IF WU THEN GOSUB 5200
5085 IF WS THEN GOSUB 5400
5090 IF WC THEN GOSUB 5300
5095 IF WT THEN GOSUB 5500
5096 IF WF THEN GOSUB 5600
5099 HOME : VTAB 6: PRINT "INSERT DISKETTE TO BOOT ON AND PRESS ANY": PRINT SPC( 12);"KEY TO CONTINUE ... ";: GET A$: PRINT : PRINT D$"PR#6"
5100 REM === WRITE LANGS ===
5110 PRINT D$"OPEN KNIGHT.LANGUAGE,L32": PRINT D$"WRITE KNIGHT.LANGUAGE,R0": PRINT NL
5120 L = 0: FOR X = 1 TO XL: IF L$(X) < > "" THEN L = L + 1: PRINT D$"WRITE KNIGHT.LANGUAGE,R";L: PRINT L$(X): PRINT LL%(X): PRINT LC$(X): PRINT LP%(X)
5190 NEXT : PRINT D$"CLOSE": RETURN
5200 REM === WRITE USEFUL ===
5210 PRINT D$"OPEN KNIGHT.USEFUL,L16": PRINT D$"WRITE KNIGHT.USEFUL,R0": PRINT NU:U = 0: FOR X = 1 TO XU: IF U$(X) < > "" THEN U = U + 1: PRINT D$"WRITE KNIGHT.USEFUL,R";U: PRINT U$(X): PRINT U%(X)
5220 NEXT : PRINT D$"CLOSE"
5290 RETURN
5300 REM === WRITE RACE.CLASS =
5310 PRINT D$"OPEN KNIGHT.RACE.CLASS,L64": PRINT D$"WRITE KNIGHT.RACE.CLASS,R0": PRINT NR: PRINT NC
5320 R = 0: FOR X = 1 TO XR: IF RC$(X) < > "" THEN R = R + 1: PRINT D$"WRITE KNIGHT.RACE.CLASS,R";R: PRINT RC$(X): FOR X2 = 0 TO 10: PRINT RA%(X,X2): NEXT
5330 NEXT
5340 R = 0: FOR X = 1 TO XC: IF CL$(X) < > "" THEN R = R + 1: PRINT D$"WRITE KNIGHT.RACE.CLASS,R";R + NR: PRINT CL$(X): FOR X2 = 0 TO 10: PRINT CA%(X,X2): NEXT : NEXT : PRINT D$"CLOSE"
5390 RETURN
5400 REM === WRITE SPELLS ===
5410 PRINT D$"OPEN KNIGHT.SPELLS,L32": PRINT D$"WRITE KNIGHT.SPELLS,R0": PRINT NS
5420 S = 0: FOR X = 1 TO XS: IF SN$(X) < > "" THEN S = S + 1: PRINT D$"WRITE KNIGHT.SPELLS,R";S: PRINT SN$(X): PRINT SE%(X)
5490 NEXT : PRINT D$"CLOSE": RETURN
5500 REM === UPDATE TITLES ===
5510 RL = NC * 15 + NC
5520 PRINT D$"OPEN TITLES": PRINT D$"READ TITLES": INPUT TL: PRINT D$"CLOSE"
5530 GOTO 7000
5600 REM === WRITE FORMATS ===
5610 PRINT D$"OPEN KNIGHT.FORMAT,L128": PRINT D$"WRITE KNIGHT.FORMAT,R0": PRINT FM
5620 FOR X = 1 TO FM: PRINT D$"WRITE KNIGHT.FORMAT,R";X: PRINT FRMT$(X): FOR X2 = 1 TO 4: PRINT FM$(X,X2): NEXT : FOR X2 = 1 TO 4: PRINT DF%(X,X2): NEXT : NEXT : PRINT D$"CLOSE"
5690 RETURN
6000 REM === END - NO UP ===
6010 HOME : PRINT SPC( 14);: INVERSE : PRINT "* CONFIRM *";: NORMAL : PRINT : PRINT "NO FILES WILL BE WRITTEN TO DISKETTE": PRINT : PRINT " PRESS 'Q' TO QUIT ...": PRINT
6020 PRINT " ANY OTHER KEY TO RETURN."
6030 GET A$: PRINT : IF A$ < > "Q" THEN 100
6040 END
7000 REM === RECREATE TITLE ===
7010 PRINT D$"OPEN NEW TITLES,L";RL: PRINT D$"OPEN TITLES,L";TL: PRINT D$"READ TITLES,R0": INPUT X,NT,LT,IT,CC
7020 FOR X = 1 TO NT: PRINT D$"READ TITLES,R";X: FOR X2 = 1 TO CC: INPUT TI$(X2): NEXT
7030 PRINT D$"WRITE NEW TITLES,R";X: FOR X2 = 1 TO CC: PRINT TI$(X2): NEXT : FOR X2 = 1 TO CAD: PRINT "NONE": NEXT
7040 NEXT
7050 PRINT D$"WRITE NEW TITLES,R0": PRINT RL: PRINT NT: PRINT LT: PRINT IT: PRINT NC: PRINT D$"CLOSE"
7090 PRINT D$"RENAME TITLES,OLD TITLES": PRINT D$"RENAME NEW TITLES,TITLES"
7099 END
9000 REM === SHOW STATUS ===
9010 PRINT : PRINT TY$(LURC);" ";ACT$(ACT); MID$ ("ED",( RIGHT$ (ACT$(ACT),1) = "E") + 1);".": GOSUB 9200: RETURN
9100 REM === GET Y/N ===
9110 PRINT "(Y/N) ";
9120 GET A$: IF A$ < > "Y" AND A$ < > "N" THEN 9120
9130 PRINT A$: RETURN
9200 REM === DELAY ===
9210 FOR X = 1 TO 1200: NEXT X: RETURN
9300 XT = 0: VTAB 8: CALL - 958: PRINT "INPUT ";TYP$(LURC);: INPUT " NAME OR NUMBER:";A$: IF VAL (A$) > 0 THEN 9350
9310 IF A$ = "" THEN XT = 1: RETURN
9340 ON LURC GOTO 11100,11200,11300,11400,11500,11600
9350 REM === GOT # ===
9360 X = VAL (A$): ON LURC GOTO 11150,11250,11350,11450,11550,11650
9490 RETURN
9500 REM === PRESS ANY KEY ===
9510 VTAB 24: PRINT "====== PRESS ANY KEY TO CONTINUE ======";: GET A$: PRINT : HOME : RETURN
9600 REM === HEADING ===
9610 IF NOT PRT THEN 9500
9620 IF LP < > 0 THEN PRINT CHR$ (12)
9630 PRINT : PRINT SPC( 10);TYP$(LURC)
9690 RETURN
11000 REM === INITIALIZE ===
11010 D$ = CHR$ (4): DIM L$(26),U$(40),RC$(16),CL$(10),RA%(16,10),CA%(10,10),LL%(26),LC$(26),LP%(26),U%(40),FT%(40)
11020 DIM SN$(25),SE%(25): FOR X = 1 TO 6: READ TYP$(X): NEXT : FOR X = 1 TO 6: READ ACT$(X): NEXT
11030 FOR X = 0 TO 10: READ RJ$(X): NEXT : FOR X = 0 TO 10: READ CJ$(X): NEXT
11040 NS = 17:XS = NS: FOR X = 1 TO NS: READ SN$(X),SE%(X): NEXT
11050 RETURN
11070 DATA LANGUAGE,ARTIFACT,RACE,CLASS,SPELL,FORMAT,ADD,CHANGE,DELETE,LIST,WRITE,QUIT
11080 DATA MAX HD,MAX AG,MALE HD ADJ,FEMALE HD ADJ,AGIL ADJ,MALE CH ADJ,FEMALE CH ADJ,INTEL ADJ,#SPELLS ADJ,CAR.ART ADJ,HEIGHT
11090 DATA HD ADJ,AGIL ADJ,CH ADJ,INTEL ADJ,#SPELLS ADJ,CAR.ART ADJ,MACE ABIL,SPEAR ABIL,BOW ABIL,AXE ABIL,SWORD ABIL
11095 DATA HEAL,8,CHARM,30,BLAST,10,FURY,2,SCARE,30,POWER,5,HARDHIT,2,LIGHT,3,TELEPORT,50,SLEEP,7,RESURRECT,9,INVISIBILITY,7,FORCEFIELD,10,DARKSEE,15,ATTALL,5,RAGE,2,PURIFY,3
11100 REM === FIND LANGUAGE ===
11110 FO = 0: FOR X = 1 TO XL: IF LEFT$ (L$(X), LEN (A$)) < > A$ THEN NEXT : PRINT : PRINT "LANGUAGE NOT FOUND.": GOSUB 9200: RETURN
11120 FO = 1: RETURN
11150 REM === CHK LANG # ===
11160 IF X < 1 OR X > XL THEN PRINT "THAT IS NOT A LEGAL LANGUAGE NO.":FO = 0: GOSUB 9200: RETURN
11170 FO = 1: RETURN
11200 REM === FIND USEFUL ===
11210 FO = 0: FOR X = 1 TO XU: IF LEFT$ (U$(X), LEN (A$)) < > A$ THEN NEXT : PRINT : PRINT "ARTIFACT TYPE NOT FOUND.": GOSUB 9200: RETURN
11220 FO = 1: RETURN
11250 REM === CHK USEFUL # ==
11260 IF X < 1 OR X > XU THEN PRINT "THAT IS NOT A LEGAL ARTIFACT NO.":FO = 0: GOSUB 9200: RETURN
11270 FO = 1: RETURN
11300 REM === FIND RACE ===
11310 FO = 0: FOR X = 1 TO XR: IF LEFT$ (RC$(X), LEN (A$)) < > A$ THEN NEXT : PRINT : PRINT "RACE NOT FOUND.": GOSUB 9200: RETURN
11320 FO = 1: RETURN
11350 REM === CHK RACE # ===
11360 IF X < 1 OR X > XR THEN PRINT "THAT IS NOT A LEGAL RACE NO.":FO = 0: GOSUB 9200: RETURN
11370 FO = 1: RETURN
11400 REM === FIND CLASS ===
11410 FO = 0: FOR X = 1 TO XC: IF LEFT$ (CL$(X), LEN (A$)) < > A$ THEN NEXT : PRINT : PRINT "CLASS NOT FOUND.": GOSUB 9200: RETURN
11420 FO = 1: RETURN
11450 REM === CHK CLASS # ===
11460 IF X < 1 OR X > XC THEN PRINT "THAT IS NOT A LEGAL CLASS NO.": GOSUB 9200:FO = 0: RETURN
11470 FO = 1: RETURN
11500 REM === FIND SPELL ===
11510 FO = 0: FOR X = 1 TO XS: IF LEFT$ (SN$(X), LEN (A$)) < > A$ THEN NEXT : PRINT : PRINT "SPELL NOT FOUND.": GOSUB 9200: RETURN
11520 FO = 1: RETURN
11550 REM === CHK SPELL # ===
11560 IF X < 1 OR X > XS THEN PRINT "THAT IS NOT A LEGAL SPELL NO.":FO = 0: GOSUB 9200: RETURN
11570 FO = 1: RETURN
11600 REM === FIND FORMAT ===
11610 FO = 0: FOR X = 1 TO XF: IF LEFT$ (FRMT$(X), LEN (A$)) < > A$ THEN NEXT : PRINT : PRINT "FORMAT NOT FOUND.": GOSUB 9200: RETURN
11620 FO = 1: RETURN
11650 REM === CHK FORMAT # ===
11660 IF X < 1 OR X > XF THEN PRINT "THAT IS NOT A LEGAL FORMAT NO.":FO = 0: GOSUB 9200: RETURN
11670 FO = 1: RETURN
12000 REM >>> LOAD DATA <<<
12010 READ NL:XL = NL: FOR X = 1 TO NL: READ L$(X),LL%(X),LC$(X),LP%(X): NEXT
12030 READ NR:XR = NR: FOR X = 1 TO NR: READ RC$(X): NEXT
12040 READ NC:XC = NC: FOR X = 1 TO NC: READ CL$(X): NEXT
12050 READ NU:XU = NU: FOR X = 1 TO NU: READ U$(X),U%(X): NEXT
12060 FOR X = 1 TO NR: FOR X2 = 0 TO 10: READ RA%(X,X2): NEXT : NEXT : FOR X = 1 TO NC: FOR X2 = 0 TO 10: READ CA%(X,X2): NEXT : NEXT
12099 RETURN
12100 DATA 26
12110 DATA ARCADIAN,2,1111,350,BARBARISH,1,1100,900,COMMON,0,1111,0,DWARFISH,1,1111,450,ELFISH,0,1111,350,FALCONESE,6,0011,4200,GERBISH,1,1110,450,HUNGRIAN,1,1111,300
12120 DATA IDIOTESE,0,1100,650,JUNGLESE,3,1111,500,KREEBISH,4,0110,1850,LATISH,4,0011,1250,MUNCHKIN,3,0110,1650
12140 DATA NERDISH,1,1111,620,ORCISH,3,1111,375,PEONESE,0,1111,290,QUARKISH,5,1001,750,RIGELLIAN,6,0011,1550,SKULLEN,5,1101,1900
12150 DATA TROLLISH,0,1111,200,UNKNOWN,999,0000,0,VILLANESE,999,0000,0,WEIRDISH,999,0000,0,XYBER,999,0000,0,YITTICK,999,0000,0,ZURBICK,999,0000,0
12160 DATA 3,HUMAN,DWARF,ELF
12170 DATA 4,FIGHTER,THIEF,CLERIC,MAGE
12700 DATA 26,TREASURE,0,WEAPON,1,ARMOUR,1,SHIELD,1,LIGHT,1,MEDICAL,1,TOOL,1,READ,0,KEY,1,FUEL,1,TELEPORT,1,SLEEP,1
12750 DATA VITAMIN,1,AGILITY,1,CHARM,1,SCARY,1,CONT.,1,PORTAL,0,EFFECT,0,WEAPON,1,FOOD,1,DRINK,1,BANK,1,INSTRUCT,0,RESURRECT,1,TRAP,0
12800 DATA 24,24,0,-4,0,-1,2,0,0,0,0: REM HUMAN ADJUST
12810 DATA 22,22,0,-3,0,-6,-7,0,0,0,-20: REM DWARF ADJUST
12820 DATA 19,26,-5,-6,4,3,5,10,1,0,-10: REM ELF ADJUST
12830 DATA 4,2,-4,-15,-2,2,0,10,-5,10,10: REM FIGHTER ADJUST
12840 DATA 1,4,-6,-10,-3,1,0,-10,5,5,5: REM THIEF ADJUST
12850 DATA -5,-3,5,19,2,-2,15,-30,-30,-40,-45: REM CLERIC ADJUST
12860 DATA -4,-3,2,20,4,-2,10,-9,5,-20,-25: REM MAGE ADJUST
12900 RETURN
13000 REM === SUBROUTINES ===
13100 REM === ADD RACE ===
13110 NR = NR + 1:RC$(IT) = RC$
13120 FOR X2 = 0 TO 10
13130 VTAB X2 + 8: CALL - 958: PRINT "INPUT ";RJ$(X2);: INPUT ":";A$: IF VAL (A$) < - 100 OR VAL (A$) > 100 OR STR$ ( VAL (A$)) < > A$ THEN PRINT "INVALID VALUE.": GOSUB 9200: GOTO 13130
13140 RA%(IT,X2) = VAL (A$)
13170 NEXT
13180 RETURN
13200 REM === ADD CLASS/ADJ ===
13210 NC = NC + 1:CL$(IT) = CL$
13220 FOR X2 = 0 TO 10
13230 VTAB X2 + 8: CALL - 958: PRINT "INPUT ";CJ$(X2);: INPUT ":";A$: IF VAL (A$) < - 100 OR VAL (A$) > 100 OR A$ < > STR$ ( VAL (A$)) THEN PRINT "INVALID VALUE.": GOSUB 9200: GOTO 13230
13240 CA%(IT,X2) = VAL (A$)
13270 NEXT
13280 RETURN
13300 REM === CHG RACE ADJ ===
13310 FOR X = 0 TO 10:ADJ$(X) = RJ$(X): NEXT : GOSUB 13500: IF XT THEN RETURN
13330 VTAB 8: CALL - 958: PRINT "OLD ";RJ$(CG);" IS ";RA%(IT,CG);".": PRINT "INPUT NEW ";RJ$(CG);: INPUT ":";RA$
13340 IF VAL (RA$) > 100 OR VAL (RA$) < - 100 OR RA$ < > STR$ ( VAL (RA$)) THEN PRINT : PRINT "INVALID VALUE.": GOSUB 9200: GOTO 13330
13350 RA%(IT,CG) = VAL (RA$): GOSUB 13500: IF XT THEN RETURN
13360 GOTO 13330
13400 REM === CHG CLASS ADJ ===
13410 FOR X = 0 TO 10:ADJ$(X) = CJ$(X): NEXT : GOSUB 13500: IF XT THEN RETURN
13420 VTAB 8: CALL - 958: PRINT "OLD ";CJ$(CJ);" IS ";CA%(IT,CG);".": PRINT "INPUT NEW ";CJ$(CG);: INPUT ":";CA%(IT,CG): RETURN
13500 REM === ADJ MENU ===
13510 VTAB 8: CALL - 958: PRINT "SELECT FIELD TO CHANGE:": FOR X = 0 TO 10: PRINT SPC( 3 - LEN ( STR$ (X + 1)));X + 1;". ";ADJ$(X): NEXT : PRINT " 12. RETURN"
13520 XT = 0:X = 12: GOSUB 20000: IF X = 12 THEN XT = 1: RETURN
13530 CG = X - 1
13590 RETURN
20000 REM === GET NUMBER 1-9 ===
20010 IF X > 9 THEN 21000
20020 PRINT "INPUT YOUR CHOICE (1-";X;") ";
20030 PRINT "[_]"; CHR$ (8); CHR$ (8);
20040 GET X$: IF VAL (X$) < 1 OR VAL (X$) > X THEN 20040
20050 PRINT VAL (X$):X = VAL (X$): RETURN
21000 REM === GET NUMBER > 9 ===
21010 ML$ = LEFT$ ( STR$ (X),1): PRINT "INPUT YOUR CHOICE (1-";X;") ";
21020 PRINT "[__]"; CHR$ (8); CHR$ (8); CHR$ (8);
21030 GET A1$: IF A1$ > ML$ AND A1$ < ":" THEN A2$ = A1$:A1$ = "0": PRINT A1$;A2$: GOTO 21120
21040 IF (A1$ < "0" OR A1$ > "9") AND A1$ < > CHR$ (21) THEN 21030
21050 IF A1$ = CHR$ (21) THEN A1$ = "0"
21060 PRINT A1$;
21070 GET A2$: IF A2$ = CHR$ (8) THEN A1$ = "": PRINT A2$;: GOTO 21030
21080 IF A2$ = CHR$ (13) THEN A2$ = A1$:A1$ = "0": PRINT CHR$ (8);A1$;A2$: GOTO 21120
21090 IF A2$ < "0" OR A2$ > "9" THEN 21070
21100 IF VAL (A1$ + A2$) < 1 OR VAL (A1$ + A2$) > X THEN 21070
21110 PRINT A2$
21120 A$ = A1$ + A2$
21130 X = VAL (A$): RETURN
46000 REM === LIST FORMATS ===
46010 FOR X = 1 TO XF:LP = LP + 1: PRINT SPC( 10 * PRT + 3 - LEN ( STR$ (X)));X;". ";: INVERSE : PRINT FRMT$(X): NORMAL : FOR X2 = 1 TO 4: PRINT SPC( 10 * PRT + 6);FM$(X,X2); TAB( 32);DF%(X,X2)
46020 LP = LP + 1
46040 NEXT : IF LP > 16 + 30 * PRT THEN GOSUB 9600:LP = 0
46080 NEXT :LP = 0: PRINT D$"PR#0": GOSUB 9600: GOTO 300