Source:Character File Maintenance

From Eamon Wiki
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

CHAR.FILE.MAINT on the EAG's ProDOS Eamon Master

Date

December 1983; modified 22 May 1991

Author

Tom Zuchowski

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