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