Source:Character Editor

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

The Applesoft BASIC source code of the Eamon utility program Character Editor.

Source

Eamon Utilities IV

Date

c. 1984

Author

John Nelson

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