Source:Character File 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 |
Character File Maintenance, a BASIC Eamon utility program for managing adventurer records. |
|---|---|
| Source |
|
| Date | |
| Author | |
| License |
The use of this item is permitted on the grounds that it's free or in the public domain. |
10 REM CHARACTER FILE 12 REM MAINTENANCE 14 REM - BY - 16 REM THOMAS J. ZUCHOWSKI 18 REM WINSTON-SALEM, NC 20 REM DEC 1983 25 REM PRODOS UPDATE 1/23/90 26 REM REV.5/22/91 30 REM EAMON ADVENTURER'S GUILD 7625 HAWKHAVEN DR. CLEMMONS, NC 27012 100 FOR I = 768 TO 777: READ N: POKE I,N: NEXT 110 DATA 104,168,104,166,223,154,72,152,72,96 120 D$ = CHR$ (4): TEXT 130 S$ = " ": REM 7 SPACES 140 HOME : VTAB 10 150 PRINT D$"PREFIX": INPUT PX$ 200 REM /// INPUT DATA FROM DISK 205 ONERR GOTO 215 210 PRINT D$"OPEN CHARACTERS,L150": PRINT D$"READ CHARACTERS,R0": INPUT NC: PRINT D$: POKE 216,0: GOTO 220 215 POKE 216,0: PRINT D$: PRINT CHR$ (7): INVERSE : PRINT "UNABLE TO LOAD CHARACTERS FILE": NORMAL : PRINT : GOTO 440 220 N = NC + 10:FULL = N 230 DIM NA$(N),SEX$(N),GOLD(N),BANK(N),HD(N),AG(N),CH(N),SA%(4,N),WA%(5,N),AC(N),AE(N),WN$(4,N),WT%(4,N),WO%(4,N),WD%(4,N),WS%(4,N),UP(N),DD$(N) 235 IF NC = 0 THEN 420 240 FOR I = 1 TO NC 250 PRINT 260 PRINT D$;"READ CHARACTERS,R";I: INPUT NA$(I) 270 IF NA$(I) < > "" THEN 320 280 ONERR GOTO 10000 290 INPUT DD$(I): IF DD$(I) = "" THEN NA$(I) = "(BAD DATA IN FILE)": GOTO 400 300 DD = VAL (DD$(I)): IF DD$(I) < > "" AND DD = 0 THEN NA$(I) = "(DEAD)" 310 IF DD < > 0 THEN HD(I) = DD: GOTO 330 320 INPUT HD(I) 330 INPUT AG(I): INPUT CH(I) 340 FOR J = 1 TO 4: INPUT SA%(J,I): NEXT : FOR J = 1 TO 5: INPUT WA%(J,I): NEXT 350 INPUT AE(I): INPUT SEX$(I): IF SEX$(I) = "M" OR SEX$(I) = "F" OR SEX$(I) = "" THEN 380 360 PRINT D$: PRINT D$;"READ CHARACTERS,R";I: INPUT NA$(I): INPUT DD$(I) 370 NA$(I) = "(DEAD)": GOTO 320 380 INPUT GOLD(I): INPUT BANK(I): INPUT AC(I) 390 FOR J = 1 TO 4: INPUT WN$(J,I): INPUT WT%(J,I): INPUT WO%(J,I): INPUT WD%(J,I): INPUT WS%(J,I): NEXT 400 NEXT I: PRINT D$ 410 POKE 216,0: IF NC > 0 THEN 510 420 PRINT D$: HOME : VTAB 10 430 PRINT " THE CHARACTERS FILE IS EMPTY." 440 PRINT : PRINT S$;" YOUR ONLY OPTION IS TO": PRINT S$;" GENERATE A NEW CHARACTER. 450 PRINT : PRINT : PRINT S$;: INPUT " DO YOU WISH TO DO THIS?";A$: IF LEFT$ (A$,1) = "Y" THEN 8000 455 IF LEFT$ (A$,1) < > "N" THEN 450 460 GOTO 9050 500 REM /// MAIN MENU 510 TX$ = "":UP = 0: HOME : IF FULL = 0 THEN VTAB 8: PRINT " THE DIMENSIONED ARRAYS ARE FULL; THE CHARACTER ARRAYS ARE BEING SAVED TO DISK. RERUN THE PROGRAM TO CONTINUE.": GOTO 9000 520 HOME : PRINT SPC( 17);"EAMON": PRINT : PRINT " CHARACTER FILE MAINTENANCE": VTAB 6: PRINT S$;" CHARACTER: NONE";: IF C > 0 THEN HTAB 21: PRINT NA$(C);" "; 530 VTAB 8: PRINT : PRINT " SELECT ACTION:": PRINT 540 PRINT S$;"1. SELECT A RECORD": PRINT S$;"2. MANIPULATE THIS RECORD": PRINT S$;"3. FILE MAINTENANCE" 550 PRINT S$;"4. TRANSFER THIS RECORD": PRINT S$;"5. GENERATE A NEW CHARACTER" 560 PRINT S$;"6. UPDATE RECORD AND QUIT":X = 6: GOSUB 600 570 ON S GOTO 1000,2000,6000,7000,8000,9000 600 REM /// GET NUMBER 610 PRINT : PRINT " INPUT (1-";X;"):"; 620 GET A$:S = VAL (A$): IF S < 1 OR S > X THEN 620 630 PRINT A$: RETURN 700 REM /// CONTINUE PROMPT 710 PRINT : PRINT " (PRESS ANY KEY TO CONTINUE)";: GET A$: PRINT : GOTO 510 720 PRINT : PRINT " (PRESS ANY KEY TO CONTINUE)";: GET A$: PRINT : RETURN 1000 REM /// SELECT RECORD 1010 HOME : VTAB 6: PRINT " SELECT RECORD BY:": PRINT : PRINT S$;"1. NAME": PRINT S$;"2. RECORD NUMBER": PRINT S$;"3. NEXT RECORD": PRINT S$;"4. RETURN TO MAIN MENU":X = 4: GOSUB 600: PRINT 1020 ON S GOTO 1100,1210,1300,510 1100 REM /// BY NAME 1110 INPUT "CHARACTER NAME:";NA$(0) 1120 FOR I = 1 TO NC: IF NA$(I) < > NA$(0) THEN NEXT : PRINT CHR$ (7): PRINT "NO SUCH CHARACTER IN THIS FILE.": GOSUB 720: GOTO 1000 1130 C = I:C1 = C: GOTO 5000 1200 REM /// BY RECORD # 1210 INPUT "RECORD NUMBER:";C 1220 IF C > NC THEN PRINT CHR$ (7): PRINT "ONLY ";NC;" RECORDS IN FILE.": GOSUB 720: GOTO 1000 1230 C1 = C: GOTO 5000 1300 REM /// NEXT RECORD 1310 IF C = NC THEN PRINT : PRINT SPC( 14);"END OF FILE.":C = 0: GOTO 710 1320 C = C + 1: GOTO 5000 2000 REM /// MODIFY RECORD 2010 IF C = 0 THEN SUB = 1: GOSUB 1000 2020 NA$(0) = NA$(C):SEX$(0) = SEX$(C):GOLD(0) = GOLD(C):BANK(0) = BANK(C):HD(0) = HD(C):AG(0) = AG(C):CH(0) = CH(C) 2030 FOR I = 1 TO 4:SA%(I,0) = SA%(I,C): NEXT : FOR I = 1 TO 5:WA%(I,0) = WA%(I,C): NEXT 2040 AE(0) = AE(C):AC(0) = AC(C): FOR I = 1 TO 4:WN$(I,0) = WN$(I,C):WT%(I,0) = WT%(I,C):WO%(I,0) = WO%(I,C):WD%(I,0) = WD%(I,C):WS%(I,0) = WS%(I,C): NEXT 2050 DD$(0) = DD$(C) 2060 HOME : HTAB (40 - LEN (NA$(0))) / 2: PRINT NA$(0): PRINT 2070 PRINT " INPUT FIELD TO CHANGE:": PRINT : PRINT S$;" 1. NAME": PRINT S$;" 2. HARDINESS": PRINT S$;" 3. AGILITY": PRINT S$;" 4. CHARISMA" 2080 PRINT S$;" 5. SPELL ABILITIES": PRINT S$;" 6. WEAPON ABILITIES": PRINT S$;" 7. ARMOR" 2090 PRINT S$;" 8. SEX": PRINT S$;" 9. GOLD": PRINT S$;"10. ARMOR EXPERTISE": PRINT S$;"11. WEAPON" 2100 PRINT S$;"--------------------": PRINT S$;"12. DISPLAY RECORD": PRINT S$;"13. RETURN TO MAIN MENU" 2110 PRINT S$;"14. ADD AS A NEW RECORD": PRINT S$;"15. CANCEL CHANGES": PRINT : INPUT " INPUT (1-15) ";S 2120 ON S GOSUB 2200,2400,2600,2800,3000,3200,3400,3600,3800,4000,4200,4400,4600,4800,510 2130 GOTO 2060 2200 IF DD$(0) < > "" THEN PRINT : PRINT "THIS CHARACTER IS DEAD. THE PREVIOUS NAME OF THIS CHARACTER WAS:": PRINT : HTAB 15: PRINT "(?)";DD$(0): PRINT : GOTO 2220 2210 PRINT : PRINT "OLD NAME: "NA$(0) 2220 INPUT "NEW NAME: ";X$: IF LEN (X$) = 0 OR LEFT$ (X$,1) < "A" OR LEFT$ (X$,1) > "Z" OR LEN (X$) > 20 THEN PRINT : PRINT "INVALID NAME.": GOTO 2200 2230 FOR I = 1 TO NC: IF NA$(I) < > X$ THEN NEXT 2240 IF NA$(I) = X$ AND C < > I THEN PRINT : PRINT "THAT NAME IS ALREADY BEING USED.": GOTO 2200 2250 DD$(0) = "":UP = 1:NA$(0) = X$: RETURN 2400 PRINT : PRINT "OLD HARDINESS:";HD(0): INPUT "NEW HARDINESS:";X: IF X < 3 OR X > 300 OR X < > INT (X) THEN PRINT : PRINT "INVALID HARDINESS.": GOTO 2400 2410 UP = 1:HD(0) = X: RETURN 2600 PRINT : PRINT "OLD AGILITY:";AG(0): INPUT "NEW AGILITY:";X: IF X < 3 OR X > 300 OR X < > INT (X) THEN PRINT : PRINT "INVALID AGILITY.": GOTO 2600 2610 UP = 1:AG(0) = X: RETURN 2800 PRINT : PRINT "OLD CHARISMA:";CH(0): INPUT "NEW CHARISMA:";X: IF X < 3 OR X > 300 OR X < > INT (X) THEN PRINT : PRINT "INVALID CHARISMA.": GOTO 2800 2810 UP = 1:CH(0) = X: RETURN 3000 HOME : VTAB 8: PRINT " SELECT SPELL:": PRINT S$;"1. BLAST",SA%(1,0): PRINT S$;"2. HEAL",SA%(2,0): PRINT S$;"3. SPEED",SA%(3,0) 3010 PRINT S$;"4. POWER",SA%(4,0): PRINT S$;"----------": PRINT S$;"5. RETURN TO MENU":X = 5: GOSUB 600: PRINT : ON S GOTO 3020,3030,3040,3050,3060 3020 UP = 1: INPUT "NEW BLAST RATING:";SA%(1,0): GOTO 3000 3030 UP = 1: INPUT "NEW HEAL RATING:";SA%(2,0): GOTO 3000 3040 UP = 1: INPUT "NEW SPEED RATING:";SA%(3,0): GOTO 3000 3050 UP = 1: INPUT "NEW POWER RATING:";SA%(4,0): GOTO 3000 3060 RETURN 3200 HOME : VTAB 8: PRINT " SELECT WEAPON ABILITY:": PRINT S$;"1. AXE",WA%(1,0): PRINT S$;"2. BOW",WA%(2,0): PRINT S$;"3. CLUB",WA%(3,0) 3210 PRINT S$;"4. SPEAR",WA%(4,0): PRINT S$;"5. SWORD",WA%(5,0): PRINT S$;"----------": PRINT S$;"6. RETURN TO MENU":X = 6: GOSUB 600 3220 PRINT : ON S GOTO 3230,3240,3250,3260,3270,3280 3230 UP = 1: INPUT "NEW AXE EXPERTISE:";WA%(1,0): GOTO 3200 3240 UP = 1: INPUT "NEW BOW EXPERTISE:";WA%(2,0): GOTO 3200 3250 UP = 1: INPUT "NEW CLUB EXPERTISE:";WA%(3,0): GOTO 3200 3260 UP = 1: INPUT "NEW SPEAR EXPERTISE:";WA%(4,0): GOTO 3200 3270 UP = 1: INPUT "NEW SWORD EXPERTISE:";WA%(5,0): GOTO 3200 3280 RETURN 3400 UP = 1: HOME : PRINT " ARMOR CLASS:": PRINT : PRINT S$;"1. SHIELD ONLY": PRINT S$;"2. LEATHER ARMOR": PRINT S$;"3. LEATHER ARMOR & SHIELD": PRINT S$;"4. CHAIN ARMOR" 3410 PRINT S$;"5. CHAIN ARMOR & SHIELD": PRINT S$;"6. PLATE ARMOR": PRINT S$;"7. PLATE ARMOR & SHIELD" 3420 PRINT : PRINT S$;"(CURRENTLY ";AC(0);")":X = 7: GOSUB 600:AC(0) = S: RETURN 3600 PRINT : PRINT "OLD SEX: ";SEX$(0) 3610 INPUT "NEW SEX: ";X$: IF X$ < > "M" AND X$ < > "F" THEN PRINT : PRINT "INVALID SEX": GOTO 3600 3620 UP = 1:SEX$(0) = X$: RETURN 3800 UP = 1: HOME : VTAB 8: PRINT "SELECT ONE:": PRINT : PRINT S$;"1. GOLD IN HAND",GOLD(0): PRINT S$;"2. GOLD IN BANK",BANK(0):X = 2: GOSUB 600: PRINT : ON S GOTO 3810,3830 3810 INPUT "HOW MUCH GOLD IN HAND:";X: IF X < 0 OR X > 50000 OR X < > INT (X) THEN PRINT : PRINT "INVALID AMOUNT.": GOTO 3810 3820 GOLD(0) = X: RETURN 3830 INPUT "HOW MUCH IN BANK:";X: IF X < 0 OR X > 50000 OR X < > INT (X) THEN PRINT : PRINT : PRINT "INVALID AMOUNT.": GOTO 3830 3840 BANK(0) = X: RETURN 4000 PRINT : PRINT "OLD ARMOR EXPERTISE:";AE(0): INPUT "NEW ARMOR EXPERTISE:";X: IF X < 0 OR X > 99 THEN PRINT : PRINT "INVALID EXPERTISE.":X = 0: GOTO 4000 4010 UP = 1:AE(0) = X: RETURN 4200 HOME : VTAB 8: PRINT "SELECT WEAPON TO CHANGE:": PRINT : PRINT " NAME TYPE CMPLX DMG ODDS";: PRINT : FOR I = 1 TO 4 4210 PRINT I;".";WN$(I,0); SPC( 16 - LEN (WN$(I,0)));WT%(I,0); SPC( 6 - LEN ( STR$ (WO%(I,0))));WO%(I,0);"%"; 4220 PRINT SPC( 7 - LEN ( STR$ (WD%(I,0)) + "D" + STR$ (WS%(I,0))));WD%(I,0);"D";WS%(I,0); SPC( 5 - LEN ( STR$ (2 * AG(0) + WA%(WT%(I,0),0) + WO%(I,0))));2 * AG(0) + WA%(WT%(I,0),0) + WO%(I,0);"%" 4230 NEXT 4240 PRINT "-----------------": PRINT "5. RETURN TO MENU":X = 5: GOSUB 600 4250 W = S: PRINT : IF S = 5 THEN RETURN 4260 PRINT " SELECT FIELD TO CHANGE:": PRINT : PRINT S$;"1. NAME",WN$(W,0): PRINT S$;"2. TYPE",WT%(W,0): PRINT S$;"3. COMP.",WO%(W,0): PRINT S$;"4. DICE",WD%(W,0): PRINT S$;"5. SIDES",WS%(W,0) 4270 PRINT S$;"6. NEXT WEAPON": PRINT S$;"7. RETURN TO WEAPON MENU":X = 7: GOSUB 600 4280 PRINT : ON S GOTO 4290,4300,4340,4350,4360,4370,4200 4290 UP = 1: INPUT "NEW NAME:";WN$(W,0): GOTO 4260 4300 UP = 1: PRINT "NEW TYPE:" 4310 PRINT : PRINT S$;"1. AXE": PRINT S$;"2. BOW": PRINT S$;"3. CLUB": PRINT S$;"4. SPEAR": PRINT S$;"5. SWORD" 4320 PRINT : INPUT WT%(W,0): GOTO 4260 4330 UP = 1: INPUT "NEW TYPE:";WT%(W,0): GOTO 4260 4340 UP = 1: INPUT "NEW ODDS:";WO%(W,0): GOTO 4260 4350 UP = 1: INPUT "NEW DICE:";WD%(W,0): GOTO 4260 4360 UP = 1: INPUT "NEW SIDES:";WS%(W,0): GOTO 4260 4370 W = W + 1: ON W GOTO 4260,4260,4260,4260,4380 4380 RETURN 4400 C1 = C:C = 0:SUB = 1: GOSUB 5000:C = C1: RETURN 4600 REM /// CHANGE ARRAY 4610 NA$(C) = NA$(0):SEX$(C) = SEX$(0):GOLD(C) = GOLD(0):BANK(C) = BANK(0):HD(C) = HD(0):AG(C) = AG(0):CH(C) = CH(0) 4620 FOR I = 1 TO 4:SA%(I,C) = SA%(I,0): NEXT : FOR I = 1 TO 5:WA%(I,C) = WA%(I,0): NEXT 4630 AE(C) = AE(0):AC(C) = AC(0): FOR I = 1 TO 4:WN$(I,C) = WN$(I,0):WT%(I,C) = WT%(I,0):WO%(I,C) = WO%(I,0):WD%(I,C) = WD%(I,0):WS%(I,C) = WS%(I,0): NEXT 4640 DD$(C) = DD$(0) 4650 IF UP = 1 THEN UP(C) = 1:UP = 0 4660 POP : GOTO 510 4800 IF FULL = 0 THEN PRINT : PRINT "THE DIMENSIONED ARRAYS ARE FULL. YOU MAY NOT ADD A CHARACTER TO THIS FILE UNTIL THE PROGRAM IS RERUN.": GOSUB 720: RETURN 4810 FOR I = 1 TO NC: IF NA$(I) < > NA$(0) THEN NEXT 4820 IF NA$(I) = NA$(0) THEN PRINT : PRINT " THAT NAME IS ALREADY BEING USED.": GOSUB 720: RETURN 4830 NC = NC + 1:C = NC:ADD = 1:UP(C) = 1: IF NC = FULL THEN FULL = 0 4840 GOTO 4610 5000 REM /// DISPLAY CHARACTER 5010 HOME : PRINT "RECORD #: ";: IF SUB = 1 THEN PRINT C1; 5020 IF SUB = 0 THEN PRINT C; 5030 HTAB 15: PRINT "NAME: ";NA$(C) 5040 PRINT : IF SEX$(C) = "M" THEN PRINT "MALE"; 5050 IF SEX$(C) = "F" THEN PRINT "FEMALE"; 5060 HTAB 20: PRINT "GOLD:" 5070 PRINT "HARDINESS:";: HTAB 12: PRINT HD(C);: HTAB 21: PRINT "IN HAND: ";GOLD(C) 5080 PRINT "AGILITY:";: HTAB 12: PRINT AG(C);: HTAB 21: PRINT "IN BANK: ";BANK(C) 5090 PRINT "CHARM:";: HTAB 12: PRINT CH(C) 5100 HTAB 20: PRINT "WEAPON ABILITY:" 5110 PRINT "SPELL ABILITY:";: HTAB 21: PRINT "1.AXE:";: HTAB 30: PRINT WA%(1,C) 5120 PRINT " BLAST:";: HTAB 12: PRINT SA%(1,C);: HTAB 21: PRINT "2.BOW:";: HTAB 30: PRINT WA%(2,C) 5130 PRINT " HEAL:";: HTAB 12: PRINT SA%(2,C);: HTAB 21: PRINT "3.CLUB:";: HTAB 30: PRINT WA%(3,C) 5140 PRINT " SPEED:";: HTAB 12: PRINT SA%(3,C);: HTAB 21: PRINT "4.SPEAR:";: HTAB 30: PRINT WA%(4,C) 5150 PRINT " POWER:";: HTAB 12: PRINT SA%(4,C);: HTAB 21: PRINT "5.SWORD:";: HTAB 30: PRINT WA%(5,C) 5160 A$ = "NONE" 5170 IF AC(C) = 1 THEN A$ = "SHIELD ONLY": GOTO 5220 5180 IF AC(C) > 1 THEN A$ = "LEATHER ARMOR" 5190 IF AC(C) > 3 THEN A$ = "CHAIN ARMOR" 5200 IF AC(C) > 5 THEN A$ = "PLATE ARMOR" 5210 IF INT (AC(C) / 2) < > AC(C) / 2 THEN A$ = A$ + " & SHIELD" 5220 PRINT : PRINT "ARMOR: ";A$ 5230 PRINT " EXPERTISE: ";AE(C);"%" 5240 PRINT : PRINT "WEAPON INFORMATION:" 5250 PRINT " NAME TYPE CMPLX DMG ODDS"; 5260 FOR I = 1 TO 4 5270 PRINT WN$(I,C); SPC( 18 - LEN (WN$(I,C)));WT%(I,C); SPC( 6 - LEN ( STR$ (WO%(I,C))));WO%(I,C);"%"; 5280 PRINT SPC( 7 - LEN ( STR$ (WD%(I,C)) + "D" + STR$ (WS%(I,C))));WD%(I,C);"D";WS%(I,C); SPC( 5 - LEN ( STR$ (2 * AG(C) + WA%(WT%(I,C),C) + WO%(I,C))));2 * AG(C) + WA%(WT%(I,C),C) + WO%(I,C);"%" 5290 NEXT : IF SUB = 2 THEN SUB = 0: RETURN 5300 GOSUB 720 5310 IF AU = 1 AND C = NC THEN AU = 0:C = 0 5320 IF AU = 1 THEN 1300 5330 IF SUB = 1 THEN SUB = 0: RETURN 5340 GOTO 510 6000 REM /// FILE MAINTENANCE 6010 HOME : VTAB 8: PRINT " SELECT ACTION:": PRINT 6020 PRINT S$;"1. LIST FILE": PRINT S$;"2. SHORT LIST": PRINT S$;"3. CONDENSE FILE": PRINT S$;"4. INIT FILE": PRINT S$;"5. LIST/DELETE CHARACTERS" 6030 PRINT S$;"6. RETURN TO MAIN MENU":X = 6: GOSUB 600 6040 ON S GOTO 6100,6800,6200,6400,6600,510 6100 REM ///LIST FILE 6110 AU = 1:C = 0: GOTO 1300 6200 REM /// CONDENSE FILE 6210 FOR I = 1 TO NC 6220 IF NA$(I) < > "" THEN 6300 6230 FOR J = I TO NC - 1:NA$(J) = NA$(J + 1):SEX$(J) = SEX$(J + 1):GOLD(J) = GOLD(J + 1):BANK(J) = BANK(J + 1):HD(J) = HD(J + 1):AG(J) = AG(J + 1):CH(J) = CH(J + 1) 6240 FOR K = 1 TO 4:SA%(K,J) = SA%(K,J + 1): NEXT 6250 FOR K = 1 TO 5:WA%(K,J) = WA%(K,J + 1): NEXT 6260 AC(J) = AC(J + 1):AE(J) = AE(J + 1) 6270 FOR K = 1 TO 4:WN$(K,J) = WN$(K,J + 1):WT%(K,J) = WT%(K,J + 1):WO%(K,J) = WO%(K,J + 1):WD%(K,J) = WD%(K,J + 1):WS%(K,J) = WS%(K,J + 1): NEXT 6280 UP(J) = 1: NEXT J 6290 NC = NC - 1:ADD = 1 6300 NEXT I: PRINT : PRINT : PRINT SPC( 16)"DONE": FOR I = 1 TO 500: NEXT I: GOTO 6000 6400 REM /// INIT FILE 6410 HOME : VTAB 6: HTAB 16: INVERSE : PRINT "WARNING": NORMAL 6420 FOR I = 1 TO 3: PRINT CHR$ (7);: NEXT 6430 PRINT : PRINT : PRINT " THIS SUBROUTINE WILL DELETE EVERY CHARACTER ON THIS DISK!!!" 6440 PRINT : PRINT : PRINT " DO YOU WANT TO DELETE ALL THE": INPUT " CHARACTERS ON THIS DISK? ";A$ 6450 IF A$ = "Y" THEN PRINT : PRINT : HTAB 13: INPUT "ARE YOU SURE? ";A$ 6460 IF A$ < > "Y" THEN 6000 6470 PRINT D$"CLOSE": PRINT D$;"DELETE CHARACTERS" 6480 NC = 1: PRINT D$;"OPEN CHARACTERS,L150": PRINT D$;"WRITE CHARACTERS,R0": PRINT NC 6490 PRINT D$;"WRITE CHARACTERS,R1": PRINT : PRINT D$:NC = 0: GOTO 410 6600 REM /// CHAR LIST/DELETE 6610 HOME : FOR I = 1 TO NC 6620 PRINT : PRINT "RECORD #";I;": ";NA$(I) 6630 PRINT " KEEP THIS RECORD?";: GET A$: PRINT A$: IF A$ = "N" THEN NA$(I) = "":UP(I) = 1 6640 NEXT 6650 GOTO 6000 6800 REM /// SHORT LIST 6810 FOR I = 1 TO NC: IF DD$(I) < > "" THEN S$ = "" 6820 NEXT 6830 HOME : VTAB 8: PRINT "SHORT LIST:": PRINT : PRINT S$;"REC # NAME";: IF S$ = "" THEN HTAB 20: PRINT "OLD NAME"; 6840 PRINT : PRINT : FOR I = 1 TO NC: PRINT S$;" ";I;".";: HTAB 8 + LEN (S$): PRINT NA$(I);: IF DD$(I) < > "" THEN HTAB 21: PRINT "(?)";DD$(I); 6850 PRINT : NEXT 6860 S$ = " ": GOSUB 720: GOTO 6000 7000 REM /// MOVE CHARACTER 7010 IF C = 0 THEN SUB = 1: GOSUB 1000 7020 HOME : PRINT "THIS ROUTINE WILL MOVE AN ADVENTURER FROM ONE DISKETTE/FILE TO ANOTHER. THE CHARACTER MUST BE LOADED WHEN THIS FUNCTION IS EXECUTED." 7030 PRINT : PRINT "THE CHARACTER NOW LOADED IS:": PRINT : HTAB (40 - LEN (NA$(C))) / 2: PRINT NA$(C) 7040 PRINT : PRINT "IF THE CHARACTER IS ALREADY LOADED, INSERT THE DISK IT IS TO BE TRANSFERRED TO, AND PRESS 'C'." 7050 PRINT : PRINT "HIT ANY OTHER KEY TO RETURN TO THE MAIN MENU.": PRINT 7060 GET A$: PRINT : IF A$ < > "C" THEN 510 7062 INPUT "PREFIX OF TRANSFER DISK: ";TX$: IF TX$ = "" THEN 510 7064 ONERR GOTO 11000 7066 PRINT D$"PREFIX"TX$ 7067 ONERR GOTO 7080 7070 PRINT D$"CLOSE": PRINT D$"OPEN CHARACTERS,L150": PRINT D$"READ CHARACTERS,R0": INPUT C2: PRINT D$: GOTO 7080 7080 POKE 216,0: PRINT : PRINT " SELECT ACTION:": PRINT S$;"1. ADD CHARACTER AS NEW": PRINT S$;"2. REPLACE EXISTING CHARACTER": PRINT S$;"3. LIST CHARACTERS IN THIS FILE": PRINT S$;"4. RETURN TO MAIN MENU":X = 4: GOSUB 600 7090 ON S GOTO 7200,7300,7800,7600 7200 REM /// ADD NEW CHARACTER 7210 I = C2 + 1: GOSUB 7700 7220 PRINT D$"WRITE CHARACTERS,R0": PRINT I: GOTO 7530 7300 REM /// REPLACE CHARACTER 7305 IF C2 = 0 AND S < > 1 THEN PRINT : PRINT "***NEW FILE***": GOTO 7080 7310 PRINT : PRINT " SELECT METHOD:": PRINT S$;"1. REPLACE BY NAME": PRINT S$;"2. REPLACE BY RECORD #": PRINT S$;"3. RETURN TO FIRST MENU":X = 3: GOSUB 600 7320 ON S GOTO 7400,7500,7080 7400 PRINT : HTAB 10: INPUT "NAME:";N1$ 7410 FOR I = 1 TO C2: PRINT D$"READ CHARACTERS,R";I: INPUT N2$: IF N2$ < > N1$ THEN NEXT : PRINT D$: PRINT : PRINT "I DON'T FIND THAT NAME.": GOTO 7080 7420 PRINT D$: GOSUB 7700: GOTO 7530 7500 REM /// REPLACE BY REC# 7510 PRINT D$: PRINT : HTAB 10: INPUT "RECORD #:";I: IF I < > INT (I) OR I > C2 OR I < 1 THEN PRINT D$: PRINT : PRINT "THE HIGHEST RECORD IN THIS FILE IS ";C2: GOTO 7080 7520 GOSUB 7700 7530 PRINT D$"WRITE CHARACTERS,R"I:I = C: GOSUB 9140 7540 PRINT : HTAB 18: PRINT "DONE.": PRINT : GOSUB 720 7600 REM /// RETURN 7610 PRINT D$"CLOSE": HOME : VTAB 5: PRINT " INSERT ORIGINAL DISKETTE AND PRESS": HTAB 16: PRINT "ANY KEY": GET A$: PRINT 7615 PRINT D$"PREFIX"PX$ 7620 PRINT D$"OPEN CHARACTERS,L150": GOTO 510 7700 IF C2 = 0 THEN PRINT : PRINT "***NEW FILE***": RETURN 7705 FOR J = 1 TO C2: PRINT D$;"READ CHARACTERS,R";J: INPUT N$ 7710 IF NA$(C) = N$ AND I < > J THEN PRINT D$: PRINT CHR$ (7): PRINT "THE CHARACTER NAME ";NA$(C): PRINT "ALREADY EXISTS IN THIS FILE IN RECORD ";J: POP : GOTO 7080 7720 NEXT : RETURN 7800 IF C2 = 0 THEN PRINT : PRINT "***NEW FILE***": GOTO 7080 7810 PRINT : FOR J = 1 TO C2: PRINT D$;"READ CHARACTERS,R";J: INPUT N$: PRINT S$;J;". ";N$: NEXT : PRINT D$: GOTO 7080 8000 REM // GENERATE NEW RECORD 8010 PRINT : INPUT "NAME OF NEW CHARACTER: ";NA$(0) 8020 HD(0) = 0:AG(0) = 0:CH(0) = 0: FOR I = 1 TO 5:WA%(I,0) = 0: NEXT 8030 FOR I = 1 TO 4:SA%(I,0) = 0: NEXT :GOLD(0) = 0:BANK(0) = 0: FOR I = 1 TO 4:WN$(I,0) = "NONE":WT%(I,0) = 0:WD%(I,0) = 0:WO%(I,0) = 0:WS%(I,0) = 0: NEXT 8040 AE = 0:AC = 0 8050 ADD = 1:NC = NC + 1:C = NC:UP(C) = 1: IF NC = FULL THEN FULL = 0 8060 NA$(C) = NA$(0): GOTO 2000 9000 REM /// QUIT ROUTINE 9010 PRINT D$;"CLOSE" 9020 FOR I = 1 TO NC: IF UP(I) = 1 THEN GOSUB 9110 9030 NEXT 9040 IF ADD THEN PRINT D$"OPEN CHARACTERS,L150": PRINT D$"WRITE CHARACTERS,R0": PRINT NC: PRINT D$: 9050 PRINT D$;"CLOSE": VTAB 20: HTAB 8: PRINT "*** END OF PROGRAM ***": PRINT : PRINT D$"-EAMON.MASTER" 9100 REM /// WRITE RECORD 9110 PRINT D$;"OPEN CHARACTERS,L150" 9120 IF DD$(I) < > "" THEN NA$(I) = "" 9130 PRINT D$"WRITE CHARACTERS,R";I 9140 PRINT NA$(I): PRINT HD(I): PRINT AG(I): PRINT CH(I): FOR J = 1 TO 4: PRINT SA%(J,I): NEXT : FOR J = 1 TO 5: PRINT WA%(J,I): NEXT 9150 PRINT AE(I): PRINT SEX$(I): PRINT GOLD(I): PRINT BANK(I): PRINT AC(I) 9160 FOR J = 1 TO 4: PRINT WN$(J,I): PRINT WT%(J,I): PRINT WO%(J,I): PRINT WD%(J,I): PRINT WS%(J,I): NEXT : PRINT D$ 9165 PRINT D$"CLOSE" 9170 RETURN 10000 REM ///ONERR ROUTINE 10010 CALL 768 10020 IF NC = 1 AND PEEK (222) = 5 THEN NC = 0: GOTO 410 10030 PRINT D$;"CLOSE" 10040 PRINT D$;"OPEN CHARACTERS,L150" 10050 GOTO 410 11000 IF PEEK (222) = 6 THEN PRINT : PRINT : PRINT CHR$ (7); CHR$ (7); CHR$ (7);"PATH NOT FOUND": PRINT : PRINT : POKE 216,0: FOR I = 1 TO 1000: NEXT : GOTO 7000