Source:Character Editor
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 Eamon utility program Character Editor. |
|---|---|
| Source | |
| Date |
c. 1984 |
| Author | |
| License |
The use of this item is permitted on the grounds that it's free or in the public domain. |
0 REM EAMON
1 REM CHARACTER EDITOR
2 REM
3 REM
4 REM BY JOHN NELSON
5 REM
6 REM
7 REM
50 ONERR GOTO 63000
60 FOR X = 1 TO 5: READ WT$(X): NEXT : FOR X = 0 TO 7: READ AC$(X): NEXT
100 D$ = CHR$ (4): TEXT :X1 = 999:X2 = 999:X3 = 999:XW = 100:XM = 500:XD = 50:XS = 90:XAE = 100:XG = 10000
105 REM
X1=MAX HD
X2=MAX AG
X3=MAX CH
XW=MAX WEAP ABIL
XM=MAX SPELL ABIL
XD=MAX DICE
XS=MAX SIDES
XAE=MAX AE
XG=MAX GOLD
110 HOME : VTAB 6: REM : POKE 1010,0: POKE 1011,0: POKE 1012,0: POKE 1013,0
120 PRINT " INSERT DISKETTE CONTAINING CHARACTERS ": PRINT : PRINT SPC( 3);"AND PRESS ANY KEY TO CONTINUE ...";: GET A$: PRINT
130 PRINT D$"OPEN CHARACTERS,L150": PRINT D$"READ CHARACTERS,R0": INPUT NC: PRINT D$;"CLOSE"
135 POKE 216,0
140 HOME : PRINT SPC( 17);"EAMON": PRINT SPC( 12);"CHARACTER EDITOR": PRINT SPC( 12);"BY JOHN NELSON": FOR X = 1 TO 39: PRINT "=";: NEXT
141 PRINT : PRINT "RECORD ";C;" IS IN MEMORY.... OF ";NC: PRINT " NAME = ";NA$: PRINT
142 PRINT MID$ (" ADDING",(ADD = 1) * 6 + 1,6);" "; MID$ (" UPDATED",(UP = 1) * 7 + 1,7): FOR X = 1 TO 39: PRINT "=";: NEXT : PRINT
145 VTAB 11: PRINT SPC( 8);"SELECT ACTION:"
150 PRINT SPC( 8);" 1. SELECT RECORD": PRINT SPC( 8);" 2. UPDATE RECORD": PRINT SPC( 8);" 3. DISPLAY RECORD": PRINT SPC( 8);" 4. SELECT MODE": PRINT SPC( 8);" 5. GO ON AN ADVENTURE"
160 PRINT SPC( 8);" 6. ADD A RECORD": PRINT SPC( 8);" 7. MAKE A CLONE": PRINT SPC( 8);" 8. QUIT":X = 8: GOSUB 1000
170 ON S GOTO 10000,20000,30000,40000,50000,60000,44000,62000
1000 REM /// GET NUMBER
1010 PRINT SPC( 8);"INPUT (1-";X;"):";
1020 GET S$: IF VAL (S$) < 1 OR VAL (S$) > X THEN 1020
1030 PRINT S$:S = VAL (S$): RETURN
2000 REM /// READ RECORD
2005 ONERR GOTO 2500
2010 UP = 0: PRINT D$"OPEN CHARACTERS,L150": PRINT D$"READ CHARACTERS,R";C: INPUT NAME$: REM IF NA$ = "" THEN C = 0: PRINT D$;"CLOSE": POKE 216,0: RETURN
2015 INPUT HD: INPUT AG: INPUT CH: FOR X = 1 TO 4: INPUT SA%(X): NEXT : FOR X = 1 TO 5: INPUT WA%(X): NEXT
2020 INPUT AE: INPUT SEX$: INPUT GOLD: INPUT BANK: INPUT AC
2030 FOR X = 1 TO 4: INPUT WNAME$(X): INPUT WTYPE%(X): INPUT WODDS%(X): INPUT WDICE%(X): INPUT WSIDES%(X): NEXT : PRINT D$
2040 POKE 216,0: PRINT D$"CLOSE": RETURN
2110 PRINT D$"OPEN CHARACTERS,L150": PRINT D$"READ CHARACTERS,R";C: INPUT NAME$
2120 INPUT HD: INPUT AG: INPUT CH: FOR X = 1 TO 4: INPUT SA%(X): NEXT : FOR X = 1 TO 5: INPUT WA%(X): NEXT
2130 INPUT AE: INPUT SEX$: INPUT GOLD: INPUT BANK: INPUT AC
2140 FOR X = 1 TO 4: INPUT WNAME$(X): INPUT WTYPE%(X): INPUT WODDS%(X): INPUT WDICE%(X): INPUT WSIDES%(X): NEXT : PRINT D$;"CLOSE"
2500 REM >> ERROR ON READ
2505 PRINT D$: POKE 216,0: PRINT "ERROR "; PEEK (222);" AT LINE "; PEEK (218) + PEEK (219) * 256;"."
2510 PRINT D$: PRINT : PRINT "AN ERROR WAS DETECTED READING RECORD ";C: PRINT
2520 PRINT "DO YOU WANT THIS RECORD REPLACED?";
2530 GET A$: IF A$ < > "Y" AND A$ < > "N" THEN 2530
2540 PRINT A$: IF A$ = "N" THEN 2600
2550 HD = 16:AG = 16:CH = 16:AC = 2:WA%(1) = 8:WA%(2) = 4:WA%(3) = 40:WA%(4) = 14:WA%(5) = 10
2560 FOR X = 1 TO 5:SA%(X) = 0: NEXT :GOLD = 300:BANK = 0: FOR X = 1 TO 4:WN$(X) = "NONE":WT%(X) = 0:WD%(X) = 0:WS%(X) = 0:WO%(X) = 0: NEXT
2570 NA$ = "BADREC":AE = 0:SEX$ = "M": GOSUB 5000: GOTO 140
2600 REM READ DEAD
2610 PRINT : PRINT "DO YOU WANT TO TREAT THIS AS A DEAD": PRINT " CHARACTER?";
2620 GET A$: IF A$ < > "Y" AND A$ < > "N" THEN 2620
2630 PRINT A$: IF A$ = "N" THEN C = 0: GOTO 140
2640 PRINT D$"OPEN CHARACTERS,L150": PRINT D$"READ CHARACTERS,R";C: INPUT X$: INPUT NA$
2650 GOSUB 2015: GOTO 140
5000 REM /// WRITE RECORD
5010 PRINT D$"OPEN CHARACTERS,L150": PRINT D$"WRITE CHARACTERS,R";C
5020 PRINT NAME$: PRINT HD: PRINT AG: PRINT CH: FOR X = 1 TO 4: PRINT SA%(X): NEXT : FOR X = 1 TO 5: PRINT WA%(X): NEXT
5030 PRINT AE: PRINT SEX$: PRINT GOLD: PRINT BANK: PRINT AC
5040 FOR X = 1 TO 4: PRINT WNAME$(X): PRINT WTYP%(X): PRINT WODDS%(X): PRINT WDICE%(X): PRINT WSIDES%(X): NEXT
5050 PRINT D$
5070 UP = 0:ADD = 0: PRINT D$"CLOSE": RETURN
6000 REM >>> STOP SCREEN
6010 INVERSE : PRINT SPC( 7);"PRESS ANY KEY TO CONTINUE"; SPC( 7);: NORMAL : GET A$: PRINT
6020 RETURN
6500 FOR X = 1 TO 700: NEXT X: RETURN
10000 REM /// SELECT RECORD
10010 IF UP THEN GOSUB 5000
10020 VTAB 11: CALL - 958: PRINT SPC( 8);"SELECT RECORD BY:": PRINT SPC( 8);" 1. NAME": PRINT SPC( 8);" 2. RECORD NUMBER": PRINT SPC( 8);" 3. NEXT RECORD":X = 3: GOSUB 1000
10030 ON S GOTO 10040,10090,10130
10040 REM /// FIND NAME
10050 VTAB 11: CALL - 958: PRINT SPC( 8);: INPUT "CHARACTER NAME:";NAME$
10060 PRINT D$"OPEN CHARACTERS,L150"
10065 FOR C = 1 TO NC: PRINT D$"READ CHARACTERS,R";C: INPUT FINM$: IF FINM$ < > NAME$ THEN NEXT : PRINT SPC( 8);"I CAN'T FIND THAT CHARACTER.";: PRINT D$;"CLOSE": GET A$: PRINT :C = 0: GOTO 140
10070 PRINT D$"CLOSE": GOSUB 2000: IF MO$ = "A" THEN 30000
10080 GOTO 140
10090 VTAB 11: CALL - 958: PRINT SPC( 8);: INPUT "RECORD NUMBER:";C$: IF VAL (C$) < 1 OR VAL (C$) < > INT ( VAL (C$)) THEN 10090
10100 C = VAL (C$): IF C > NC THEN PRINT "THERE AREN'T THAT MANY!": FOR X = 1 TO 500: NEXT X: GOTO 10090
10110 GOSUB 2000: IF MO$ = "A" THEN 30000
10120 GOTO 140
10130 REM /// READ NEXT RECORD
10140 C = C + 1: IF C > NC THEN PRINT "END OF FILE.":C = NC: GOSUB 6000: GOTO 140
10150 GOSUB 2000: IF MO$ = "A" THEN 30000
10160 GOTO 140
20000 REM /// UPDATE ROUTINE
20005 IF C = 0 THEN PRINT "NO CHARACTER IN MEMORY.": GOSUB 6000: GOTO 140
20010 HOME : PRINT " EAMON CHARACTER CHANGE PROGRAM": PRINT SPC( 14);"BY JOHN NELSON": VTAB 5: PRINT SPC( INT ((40 - ( LEN (NA$) + 8)) / 2));"CHANGING ";NA$
20015 VTAB 8: PRINT SPC( 8);"INPUT FIELD TO CHANGE:": PRINT SPC( 8);" 1. NAME": PRINT SPC( 8);" 2. HARDINESS": PRINT SPC( 8);" 3. AGILITY": PRINT SPC( 8);" 4. CHARISMA"
20020 PRINT SPC( 8);" 5. SPELL ABILITIES": PRINT SPC( 8);" 6. WEAPON ABILITIES": PRINT SPC( 8);" 7. ARMOUR EXPERTISE"
20030 PRINT SPC( 8);" 8. SEX CHANGE": PRINT SPC( 8);" 9. GOLD": PRINT SPC( 8);" 10. ARMOUR CLASS": PRINT SPC( 8);" 11. WEAPON CHANGE"
20040 PRINT SPC( 8);" 12. DISPLAY RECORD": PRINT SPC( 8);" 13. RETURN TO MAIN MENU": PRINT SPC( 8);" 14. CANCEL CHANGES"
20045 PRINT SPC( 8);"INPUT (1-14)";: INPUT ":";A$: IF VAL (A$) > 14 OR VAL (A$) < 1 OR VAL (A$) < > INT ( VAL (A$)) THEN VTAB PEEK (37): GOTO 20045
20050 S = VAL (A$): IF S < 12 THEN UP = 1
20060 ON S GOTO 20100,20200,20300,20400,20500,20600,20700,20800,20900,21000,22000,30000,140,21400
20100 VTAB 8: CALL - 958: PRINT SPC( 8);"NEW NAM"
59080 IF CODE = 53 THEN PRINT "ILLEGAL QUANTITY)"
59090 IF CODE = 77 THEN PRINT "(OUT OF MEMORY)"
59100 IF CODE = 90 THEN PRINT "(UNDEFINED STATEMENT)"
59110 IF CODE = 107 THEN PRINT "(BAD SUBSCR IF ON GOSUB AND NOT STR$ O ERROR ��I RECALL GOTO COLOR= POP 4 USR SGN SCRN( ^ NOT ^ GOSUB CLEAR ON POP THEN SPEED= IF SAVE SPEED= ONERR GOSUB RECALL RUN AND NOT STR$ � ERROR ��I RECALL GOTO COLOR= POP 4 FRE < < ^ NOT ^ RECALL GOSUB LOAD STORE - RECALL THEN IF LET GOSUB POP LOAD LOAD RETURN ON GOSUB THEN ONERR GOSUB GOSUB POP SPEED= ON GOSUB POP COLOR= AND NOT COS ^ NOT GOSUB GOTO D70+4D0,-7D46+#6%)HD,-0DC6!7!0CFd`$) < 3 OR VAL (A$) > X1 OR VAL (A$) < > INT ( VAL (A$)) THEN PRINT : PRINT "INVALID HARDINESS.": GOSUB 6500: GOTO 20200
20210 HD = VAL (A$): GOTO 20010
20300 VTAB 8: CALL - 958: PRINT "OLD AGILITY:";AG: PRINT SPC( 8);: INPUT "NEW AGILITY:";A$: IF VAL (A$) < 3 OR VAL (A$) > X2 OR VAL (A$) < > INT ( VAL (A$)) THEN PRINT : PRINT "INVALID AGILITY.": GOSUB 6500: GOTO 20300
20310 AG = VAL (A$): GOTO 20010
20400 VTAB 8: CALL - 958: PRINT "OLD CHARISMA:";CH: PRINT SPC( 8);: INPUT "NEW CHARISMA:";A$: IF VAL (A$) < 3 OR VAL (A$) > X3 OR VAL (A$) < > INT ( VAL (A$)) THEN PRINT : PRINT "INVALID CHARISMA.": GOSUB 6500: GOTO 20400
20410 CH = VAL (A$): GOTO 20010
20500 VTAB 8: CALL - 958: PRINT SPC( 8);"SELECT SPELL:": PRINT SPC( 8);" 1. BLAST",SA%(1): PRINT SPC( 8);" 2. HEAL",SA%(2)
20505 PRINT SPC( 8);" 3. SPEED",SA%(3): PRINT SPC( 8);" 4. POWER",SA%(4):X = 4: GOSUB 1000: ON S GOTO 20510,20520,20530,20540
20510 VTAB 8: CALL - 958: PRINT SPC( 8);: INPUT "NEW BLAST RATING:";SA$: IF VAL (SA$) < XM AND VAL (SA$) = > 0 AND VAL (SA$) = INT ( VAL (SA$)) THEN SA%(1) = VAL (SA$)
20515 GOTO 20010
20520 VTAB 8: CALL - 958: INPUT "NEW HEAL RATING:";SA$: IF VAL (SA$) < XM AND VAL (SA$) = > 0 AND VAL (SA$) = INT ( VAL (SA$)) THEN SA%(2) = VAL (SA$)
20525 GOTO 20010
20530 VTAB 8: CALL - 958: INPUT "NEW SPEED RATING:";SA$: IF VAL (SA$) < XM AND VAL (SA$) = > 0 AND VAL (SA$) = INT ( VAL (SA$)) THEN SA%(3) = VAL (SA$)
20535 GOTO 20010
20540 VTAB 8: CALL - 958: INPUT "NEW POWER RATING:";SA$: IF VAL (SA$) < XM AND VAL (SA$) = > 0 AND VAL (SA$) = INT ( VAL (SA$)) THEN SA%(4) = VAL (SA$)
20545 GOTO 20010
20600 VTAB 8: CALL - 958: PRINT SPC( 8);"SELECT WEAPON ABILITY:"
20605 FOR X = 1 TO 5: PRINT SPC( 10);X;". ";WT$(X),WA%(X): NEXT : PRINT SPC( 10);"6. RETURN":X = 6: GOSUB 1000
20608 ON S GOTO 20610,20620,20630,20640,20650,20000
20610 VTAB 8: CALL - 958: PRINT SPC( 8);: INPUT "NEW AXE EXPERTISE:";A$: IF VAL (A$) < = XW AND VAL (A$) = INT ( VAL (A$)) THEN WA%(1) = VAL (A$)
20615 GOTO 20010
20620 VTAB 8: CALL - 958: PRINT SPC( 8);: INPUT "NEW BOW EXPERTISE:";A$: IF VAL (A$) < = XW AND VAL (A$) = INT ( VAL (A$)) THEN WA%(2) = VAL (A$)
20625 GOTO 20010
20630 VTAB 8: CALL - 958: PRINT SPC( 8);: INPUT "NEW MACE EXPERTISE:";A$: IF VAL (A$) < = XW AND VAL (A$) = INT ( VAL (A$)) THEN WA%(3) = VAL (A$)
20635 GOTO 20010
20640 VTAB 8: CALL - 958: PRINT SPC( 8);: INPUT "NEW SPEAR EXPERTISE:";A$: IF VAL (A$) < = XW AND VAL (A$) = INT ( VAL (A$)) THEN WA%(4) = VAL (A$)
20645 GOTO 20010
20650 VTAB 8: CALL - 958: PRINT SPC( 8);: INPUT "NEW SWORD EXPERTISE:";A$: IF VAL (A$) < = XW AND VAL (A$) = INT ( VAL (A$)) THEN WA%(5) = VAL (A$)
20655 GOTO 20010
20700 VTAB 8: CALL - 958: PRINT "OLD ARMOUR EXP:";AE: INPUT "NEW ARMOR EXPERTISE:";A$: IF VAL (A$) < - 90 OR VAL (A$) > XAE THEN PRINT "INVALID EXPERTISE.": GOSUB 6500: GOTO 20700
20710 AE = VAL (A$): GOTO 20010
20800 IF SEX$ = "M" THEN SEX$ = "F": VTAB 8: CALL - 958: PRINT "SEX CHANGED TO FEMALE": GOSUB 6500: GOTO 20010
20810 SEX$ = "M": VTAB 8: CALL - 958: PRINT "SEX CHANGED TO MALE.": GOSUB 6500: GOTO 20010
20900 VTAB 8: CALL - 958: PRINT SPC( 8);" 1. GOLD IN HAND",GOLD: PRINT SPC( 8);" 2. GOLD IN BANK",BANK:X = 2: GOSUB 1000: ON S GOTO 20910,20920
20910 VTAB 8: CALL - 958: INPUT "HOW MUCH GOLD:";A$: IF VAL (A$) < 0 OR VAL (A$) > XG OR VAL (A$) < > INT ( VAL (A$)) THEN PRINT : PRINT "INVALID GOLD.": GOSUB 6500: GOTO 20910
20915 GOLD = VAL (A$): GOTO 20010
20920 VTAB 8: CALL - 958: PRINT SPC( 8);: INPUT "HOW MUCH IN BANK:";A$: IF VAL (A$) < 0 OR VAL (A$) > XG OR VAL (A$) < > INT ( VAL (A$)) THEN PRINT : PRINT "INVALID AMOUNT.": GOSUB 6500: GOTO 20920
20930 BANK = VAL (A$): GOTO 20010
21000 VTAB 8: CALL - 958: PRINT SPC( 8);"CURRENT ARMOUR CLASS": PRINT SPC( 8);: INVERSE : PRINT AC$(AC): NORMAL : PRINT SPC( 8);"SELECT NEW ARMOUR CLASS:"
21010 FOR X = 1 TO 7: PRINT SPC( 10);X;". "AC$(X): NEXT
21020 X = 7: GOSUB 1000:AC = S: GOTO 20010
21400 REM >>> CANCEL CHANGES
21410 IF ADD THEN ADD = 0:UP = 0:C = 0: GOTO 140
21430 UP = 0: GOSUB 2000: GOTO 140
22000 REM >>> WEAPON CHANGE
22010 VTAB 8: CALL - 958: PRINT SPC( 8);"SELECT WEAPON TO CHANGE:": FOR X = 1 TO 4: PRINT SPC( 8);" ";X;". ";WN$(X): NEXT : PRINT SPC( 8);" 5. RETURN":X = 5: GOSUB 1000
22015 IF S = 5 THEN 20000
22020 W = S: PRINT : IF WN$(W) = "NONE" THEN 22600
22030 VTAB 8: CALL - 958: PRINT SPC( 8);"SELECT FIELD TO CHANGE:": PRINT SPC( 8);" 1. NAME"; TAB( 38 - LEN (WN$(W)));WN$(W)
22040 PRINT SPC( 8);" 2. TYPE"; TAB( 38 - LEN (WT$(WT%(W))));WT$(WT%(W)): PRINT SPC( 8);" 3. COMP."; TAB( 38 - LEN ( STR$ (WO%(W))));WO%(W)
22045 PRINT SPC( 8);" 4. DICE"; TAB( 38 - LEN ( STR$ (WD%(W))));WD%(W): PRINT SPC( 8);" 5. SIDES"; TAB( 38 - LEN ( STR$ (WS%(W))));WS%(W)
22050 PRINT SPC( 8);" 6. NEXT WEAPON": PRINT SPC( 8);" 7. END OF WEAPON CHANGE":X = 7: GOSUB 1000
22060 ON S GOTO 22100,22200,22300,22400,22500,22600,20000
22100 REM >> WEAP NAME
22110 VTAB 8: CALL - 958: PRINT SPC( 8);: INPUT "NEW NAME:";A$: IF LEN (A$) < 2 OR LEN (A$) > 20 OR LEFT$ (A$,1) < "A" OR LEFT$ (A$,1) > "Z" THEN PRINT "INVALID WEAPON NAME.": GOSUB 6500: GOTO 22110
22120 WN$(W) = A$: GOTO 22000
22200 REM >> WEAP TYPE
22210 VTAB 8: CALL - 958: PRINT SPC( 8);"SELECT TYPE:": FOR X = 1 TO 5: PRINT SPC( 8);" ";X;". ";WT$(X): NEXT : PRINT SPC( 8);"INPUT # OF NEW TYPE:";
22220 GET A$: IF A$ < "1" OR A$ > "5" THEN 22220
22230 PRINT A$:WT%(W) = VAL (A$): GOTO 22000
22300 REM >> WEAP ODDS
22310 VTAB 8: CALL - 958: PRINT SPC( 8);: INPUT "NEW ODDS:";A$: IF VAL (A$) < 100 AND VAL (A$) = INT ( VAL (A$)) THEN WO%(W) = VAL (A$): GOTO 22000
22320 PRINT "INVALID ODDS.": GOTO 22300
22400 REM >> WEAP DICE
22410 VTAB 8: CALL - 958: PRINT SPC( 8);: INPUT "NEW DICE:";A$: IF VAL (A$) < = XD AND VAL (A$) = INT ( VAL (A$)) AND VAL (A$) > 0 THEN WD%(W) = VAL (A$): GOTO 22000
22420 PRINT SPC( 8);"INVALID DICE": GOSUB 6500: GOTO 22410
22500 REM >> WEAP SIDES
22510 VTAB 8: CALL - 958: PRINT SPC( 8);: PRINT "NEW SIDES:";A$: IF VAL (A$) < = XS AND VAL (A$) = INT ( VAL (A$)) AND VAL (A$) > 0 THEN WS%(W) = VAL (A$): GOTO 22510
22520 PRINT SPC( 8);"INVALID SIDES.": GOSUB 6500: GOTO 22510
22600 REM >> ADD WEAPON
22610 VTAB 8: CALL - 958: PRINT SPC( 8);: INPUT "WEAPON NAME:";A$: IF LEN (A$) < 2 OR LEN (A$) > 20 OR LEFT$ (A$,1) < "A" OR LEFT$ (A$,1) > "Z" THEN PRINT "INVALID WEAPON NAME.": GOSUB 6500: GOTO 22610
22620 WN$(W) = A$
22630 VTAB 9: CALL - 958: PRINT SPC( 8);"SELECT TYPE:": FOR X = 1 TO 5: PRINT SPC( 8);" ";X;". ";WT$(X): NEXT : PRINT SPC( 8);"INPUT # OF NEW TYPE:";
22640 GET A$: IF A$ < "1" OR A$ > "5" THEN 22640
22650 PRINT A$:WT%(W) = VAL (A$): VTAB 9: CALL - 868: PRINT SPC( 8);"WEAPON TYPE:";WT$(WT%(W))
22660 VTAB 10: CALL - 958: PRINT SPC( 8);: INPUT "WEAPON ODDS:";A$: IF VAL (A$) > 100 OR VAL (A$) < > INT ( VAL (A$)) THEN PRINT "INVALID ODDS.": GOSUB 6500: GOTO 22660
22665 WO%(W) = VAL (A$)
22670 VTAB 11: CALL - 958: PRINT SPC( 8);: INPUT "WEAPON DICE:";A$: IF VAL (A$) > XD OR VAL (A$) < > INT ( VAL (A$)) OR VAL (A$) < 0 THEN PRINT "INVALID DICE.": GOSUB 6500: GOTO 22670
22675 WD%(W) = VAL (A$)
22680 VTAB 12: CALL - 958: PRINT SPC( 8);: INPUT "NEW SIDES:";A$: IF VAL (A$) > XS OR VAL (A$) < > INT ( VAL (A$)) OR VAL (A$) < 0 THEN PRINT SPC( 8);"INVALID SIDES.": GOSUB 6500: GOTO 22510
22685 WS%(W) = VAL (A$): GOTO 22000
30000 REM /// DISPLAY CHARACTER
30005 IF C = 0 THEN PRINT "NO RECORD IN MEMORY.": GOSUB 6000: GOTO 140
30010 HOME : PRINT "NAME:";NAME$;" REC:";C: PRINT : PRINT "SEX:";SEX$;" GOLD:";GOLD;" ";"BANK:";BANK
30020 PRINT : PRINT "HARDINESS:";HD;" AGILITY:";AG;" CHARISMA:";CH
30030 PRINT
30040 PRINT " SPELL ABILITY": PRINT "BLAST:";SA%(1);" HEAL:";SA%(2);" SPEED:";SA%(3);" POWER:";SA%(4)
30050 PRINT : PRINT " WEAPON ABILITY": PRINT "AXE:"WA%(1);" BOW:";WA%(2);" MACE:";WA%(3)
30060 PRINT " SPEAR:";WA%(4);" SWORD:";WA%(5)
30070 A$ = AC$(AC)
30110 PRINT : PRINT "ARMOUR: ";A$;" AE=";AE;"%"
30120 PRINT : PRINT "WEAPON INFORMATION:"
30130 PRINT "NAME TYPE COMP DAM. ODDS": PRINT
30135 EA = 10 * AC - AE: IF EA < 0 THEN EA = 0
30140 HW = 0: FOR X = 1 TO 4
30150 IF WN$(X) < > "NONE" THEN PRINT WN$(X); SPC( 18 - LEN (WN$(X)));WT%(X); SPC( 6 - LEN ( STR$ (WO%(X))));WO%(X);"%";:HW = 1
30160 IF WN$(X) < > "NONE" THEN PRINT SPC( 7 - LEN ( STR$ (WD%(X)) + "D" + STR$ (WS%(X))));WD%(X);"D";WS%(X); SPC( 5 - LEN ( STR$ (2 * AG + WA%(WT%(X)) + WO%(X))));2 * AG + WA%(WT%(X)) + WO%(X) - EA;"%"
30170 NEXT X: PRINT : IF HW = 0 THEN PRINT SPC( 8);"(NONE)": PRINT : PRINT
30180 GOSUB 6000: PRINT
30190 IF A$ = "U" THEN 20010
30200 IF MO$ = "A" THEN IF UP = 1 THEN UP = 0: GOSUB 5000: GOTO 10130
30210 IF MO$ = "A" THEN 10130
30220 IF S = 3 THEN 140
30230 GOTO 20010
40000 REM /// SELECT MODE
40010 VTAB 13: CALL - 958: PRINT SPC( 8);"SELECT ACTIONS WANTED:": PRINT SPC( 8);" 1. AUTOMATIC": PRINT SPC( 8);" 2. MANUAL": PRINT SPC( 8);" 3. MOVE CHARACTER":X = 3: GOSUB 1000
40020 ON S GOTO 40100,40200,40300
40100 MO$ = "A": GOTO 140
40200 MO$ = "": GOTO 140
40300 REM >>> MOVE CHARACTER
40310 HOME : PRINT "THIS ROUTINE WILL MOVE AN ADVENTURER ": PRINT "FROM ONE DISKETTE/FILE TO ANOTHER.": PRINT "CHARACTER MUST BE IN MEMORY WHEN THIS ": PRINT "FUNCTION IS EXECUTED."
40320 PRINT : PRINT "IF CHARACTER IS NOT IN MEMORY, RETURN": PRINT "TO THE PRIMARY MENU BY PRESSING 'R'"
40330 INPUT ":";A$: IF A$ = "R" THEN 140
40335 IF UP THEN GOSUB 5000
40338 PRINT D$"CLOSE"
40340 HOME : VTAB 5: PRINT "INSERT RECEIVING DISKETTE": PRINT " AND PRESS ANY KEY": GET A$: PRINT
40350 PRINT D$"OPEN CHARACTERS,L150": PRINT D$"READ CHARACTERS,R0": INPUT C2: PRINT D$
40355 HOME : PRINT SPC( 12);"MOVING CHARACTER": VTAB 8: CALL - 958:
40360 PRINT SPC( 8);"SELECT ACTION:": PRINT SPC( 8);" 1. ADD CHARACTER AS NEW": PRINT SPC( 8);" 2. REPLACE EXISTING CHARACTER": PRINT SPC( 8);" 3. RETURN WITHOUT CHANGE":X = 3: GOSUB 1000
40370 ON S GOTO 41000,42000,43000
41000 REM >>> ADD NEW CHARACTER
41010 C2 = C2 + 1:C3 = C:C = C2: GOSUB 5000:C = C3: PRINT D$"WRITE CHARACTERS,R0": PRINT C2: PRINT D$: PRINT "DONE.": GOSUB 6000: GOTO 43000
42000 REM >>> REPLACE CHARACTER
42010 VTAB 8: CALL - 958: PRINT "SELECT METHOD": PRINT SPC( 8);" 1. REPLACE BY NAME": PRINT SPC( 8);" 2. REPLACE BY RECORD #":X = 2: GOSUB 1000
42020 ON S GOTO 42100,42200
42100 VTAB 8: CALL - 958: INPUT "NAME:";N$
42110 FOR R = 1 TO NC: PRINT D$"READ CHARACTERS,R";R: INPUT N2$: PRINT D$: IF N2$ < > N$ THEN NEXT : PRINT "I DON'T FIND THAT NAME.": GOTO 42010
42120 C3 = C:C = R: GOSUB 5000:C = C3: PRINT : PRINT "DONE.": PRINT "PRESS ANY KEY TO CONTINUE";: GET A$: PRINT : GOTO 43000
42200 REM >>> REPLACE BY REC#
42210 VTAB 8: CALL - 958: INPUT "RECORD #:";A$: IF VAL (A$) < > INT ( VAL (A$)) OR VAL (A$) > C2 OR VAL (A$) < 1 THEN 42210
42220 GOTO 42120
43000 REM >>> RETURN
43005 IF C = 0 THEN PRINT "NO CHARACTER IN MEMORY.": GOSUB 6000: GOTO 140
43010 PRINT D$"CLOSE": HOME : VTAB 5: PRINT "INSERT ORIGINAL DISKETTE AND PRESS ANY": PRINT : PRINT " KEY": GET A$: PRINT
43020 PRINT D$"OPEN CHARACTERS,L150": PRINT D$"READ CHARACTERS,R0": INPUT NC: PRINT D$: GOTO 140
44000 IF C = 0 THEN PRINT : PRINT "NO CHARACTER IN MEMORY.": GOSUB 6500: GOTO 140
44010 NC = NC + 1:C = NC: PRINT D$"OPEN CHARACTERS,L150": PRINT D$"WRITE CHARACTERS,R0": PRINT NC: PRINT D$"CLOSE": GOSUB 5000: GOTO 140
50000 REM >>> WRITE FRESH MEAT
50005 IF C = 0 THEN PRINT "NO CHARACTER IN MEMORY.": GOSUB 6500: GOTO 140
50010 IF UP THEN GOSUB 5000
50015 PRINT D$"CLOSE"
50020 GOSUB 51000: HOME : VTAB 6: PRINT " INSERT ADVENTURE TO TEST AND PRESS": PRINT " ANY KEY": GET A$: PRINT
50030 ONERR GOTO 50020
50040 PRINT D$"OPEN EAMON.NAME": PRINT D$"READ EAMON.NAME": INPUT DNG$
50050 HOME : VTAB 5: PRINT "YOU ARE ABOUT TO ADVENTURE IN": PRINT : INVERSE : PRINT DNG$: NORMAL
50060 PRINT D$"OPEN FRESH MEAT": PRINT D$"WRITE FRESH MEAT": PRINT C:
50070 GOSUB 5020: PRINT D$"RUN ";DNG$
51000 REM >>> INSTRUCTIONS
51010 HOME : PRINT "YOU ARE ABOUT TO TRANSFER ";NA$: PRINT "TO AN ADVENTURE."
51030 PRINT : PRINT "PRESS 'C' TO CONTINUE TO ADVENTURE": PRINT : PRINT "OR ANY OTHER KEY TO RETURN TO MENU.";: GET A$: PRINT
51040 IF A$ = "C" THEN RETURN
51050 POP : GOTO 130
60000 REM >>> ADD A RECORD
60005 IF UP THEN GOSUB 5000
60010 HOME : PRINT SPC( 11);"CREATE A CHARACTER": VTAB 8: CALL - 958: PRINT SPC( 8);"SELECT GENERAL POWER LEVEL:"
60030 PRINT " 1. WEAK CHARACTER": PRINT " 2. AVERAGE NORMAL": PRINT " 3. HIGH CHARACTER": PRINT " 4. SUPER CHARACTER"
60050 X = 4: GOSUB 1000
60060 PRINT : INPUT "NAME:";NA$
60080 ON S GOSUB 60100,60200,60300,60400
60099 GOTO 140
60100 HD = 10:AG = 10:CH = 10:AC = 0:WA%(1) = 5:WA%(2) = 0:WA%(3) = 20:WA%(4) = 10:WA%(5) = 0
60190 GOTO 60500
60200 HD = 16:AG = 16:CH = 16:AC = 2:WA%(1) = 8:WA%(2) = 4:WA%(3) = 40:WA%(4) = 14:WA%(5) = 10
60290 GOTO 60500
60300 HD = 22:AG = 22:CH = 22:AC = 4:WA%(1) = 20:WA%(2) = 20:WA%(3) = 50:WA%(4) = 20:WA%(5) = 40
60390 GOTO 60500
60400 HD = 24:AG = 24:CH = 24:WA%(1) = 70:WA%(2) = 70:WA%(3) = 70:WA%(4) = 60:WA%(5) = 60
60490 GOTO 60500
60500 FOR X = 1 TO 5:SA%(X) = 0: NEXT :GOLD = 300:BANK = 0: IF NOT NW THEN GOSUB 60550
60510 AE = (S - 1) * 20:C = NC + 1:NC = NC + 1:SEX$ = "M"
60520 PRINT D$"OPEN CHARACTERS,L150": PRINT D$"WRITE CHARACTERS,R0": PRINT C: PRINT D$;"CLOSE": GOSUB 5000
60550 FOR X = 1 TO 4:WN$(X) = "NONE":WT%(X) = 0:WD%(X) = 0:WS%(X) = 0:WO%(X) = 0: NEXT
60560 RETURN
60590 RETURN
62000 REM /// QUIT ROUTINE
62010 IF UP THEN GOSUB 5000
62030 PRINT D$"CLOSE": END
63000 REM ERROR ROUTINE
63005 POKE 216,0: PRINT D$
63010 PRINT : PRINT "THERE IS NO CHARACTER FILE ON THIS DISK.": PRINT "DO YOU WANT TO CREATE ONE? (Y OR N):";
63020 GET A$: IF A$ < > "Y" AND A$ < > "N" THEN 63020
63030 PRINT A$: IF A$ = "N" THEN RUN
63040 PRINT D$"OPEN CHARACTERS,L150": PRINT D$"WRITE CHARACTERS,R0": PRINT 1: PRINT D$"WRITE CHARACTERS,R1": PRINT "": PRINT "OBODY": FOR X = 1 TO 53: PRINT 0: NEXT :
63050 PRINT D$"CLOSE": GOTO 100
63100 DATA AXE,BOW,MACE,SPEAR,SWORD,NONE,SHIELD ONLY,LEATHER,LEATHER & SHIELD,CHAIN MAIL,CHAIN & SHIELD,PLATE,PLATE & SHIELD