Source:Dungeon List
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 Dungeon List, part of the Eamon Dungeon Designer. |
---|---|
Source |
Eamon Dungeon Designer version 7.1 |
Date |
31 January 1995 |
Author | |
License |
The use of this item is permitted on the grounds that it's free or in the public domain. |
Other versions |
1 REM LIST DUNGEON
2 REM VERSION 6.0
3 REM BY JOHN NELSON
4 REM MYLIST G BY TOM Z
5 TEXT
6 REM
9 REM 1/31/95
10 PRINT CHR$ (4);"MAXFILES 5"
20 D$ = CHR$ (4): HOME : VTAB 5: PRINT " LISTING A DUNGEON DESIGN FOR EAMON": PRINT : PRINT " INSERT DISKETTE WITH DUNGEON, THEN": PRINT : PRINT " PRESS ANY KEY ...";: POKE - 16368,0: GET A$: PRINT
25 ONERR GOTO 200
30 PRINT : PRINT D$;"OPEN EAMON.NAME": PRINT D$;"READ EAMON.NAME": INPUT ADV$: INPUT DR$,DV: PRINT D$;"CLOSE"
35 POKE 216,0: IF DV > 6.9 THEN PRINT CHR$ (7): PRINT "THIS EAMON ADVENTURE IS VERSION 7.X. USE 'DUNGEON LIST 7.1' TO LIST THIS ADVENTURE.": PRINT D$"CLOSE": END
40 ND = VAL (DR$)
50 PRINT D$"OPEN EAMON.DESC,L256": PRINT D$;"READ EAMON.DESC,R0": INPUT NR,NA,NE,NM: PRINT D$
60 GOSUB 35000
70 DIM R$(NR),AN$(NA),MN$(NM)
88 PRINT D$"OPEN EAMON.ROOM NAMES,L64"
90 FOR R = 1 TO NR: PRINT D$;"READ EAMON.ROOM NAMES,R";R: INPUT R$(R): NEXT
92 PRINT D$"CLOSE EAMON.ROOM NAMES"
95 PRINT D$"OPEN EAMON.ARTIFACTS,L128": FOR R = 1 TO NA: PRINT D$"READ EAMON.ARTIFACTS,R";R: INPUT AN$(R): NEXT : PRINT D$"CLOSE EAMON.ARTIFACTS": PRINT D$
98 PRINT D$"OPEN EAMON.MONSTERS,L128": FOR R = 1 TO NM: PRINT D$"READ EAMON.MONSTERS,R";R: INPUT MN$(R): NEXT : PRINT D$"CLOSE EAMON.MONSTERS"
99 SIZ = 40
100 REM /// MAIN ROUTINE
110 HOME : PRINT SPC( 12);"EAMON DUNGEON LIST": PRINT SPC( 14);"BY JOHN NELSON": PRINT SPC( (40 - LEN (ADV$)) / 2 + 1);: INVERSE : PRINT ADV$: NORMAL
130 VTAB 8: PRINT "SELECT ACTION DESIRED:": PRINT " 1. SET UP PRINTER": PRINT " 2. LIST ROOMS": PRINT " 3. LIST ARTIFACTS": PRINT " 4. LIST EFFECTS"
140 PRINT " 5. LIST MONSTERS": PRINT " 6. TOGGLE PRINTER (NOW "; MID$ ("OFFON",PRT * 3 + 1,3 - PRT);")": PRINT " 7. QUIT": INPUT "INPUT YOUR CHOICE (1-6):";CH
150 ON CH GOTO 1000,2000,3000,4000,5000,6000,7000
160 GOTO 130
200 IF DR$ = "" THEN DV = 4:DR$ = "6": POKE 216,0: PRINT D$;"CLOSE": GOTO 35
210 DV = 5: PRINT D$;"CLOSE": GOTO 35
1000 REM /// SET UP PRINTER
1010 VTAB 6: CALL - 958: PRINT "WHAT SLOT IS PRINTER IN?";
1020 GET A$: IF A$ < "1" OR A$ > "7" THEN 1020
1030 PRINT A$:PS = VAL (A$): GOTO 100
2000 REM /// LIST ROOMS
2010 VTAB 6: CALL - 958: INPUT "BEGINNING WITH #:";BEG$: IF BEG$ = "" THEN BEG$ = "1": VTAB 6: HTAB 18: PRINT BEG$
2020 VTAB 8: INPUT "ENDING WITH #:";EN$: IF EN$ = "" THEN EN$ = STR$ (NR): VTAB 8: HTAB 15: PRINT EN$
2030 IF VAL (BEG$) > NR OR VAL (BEG$) < 1 THEN BEG$ = "1"
2040 IF VAL (EN$) > NR OR VAL (EN$) < VAL (BEG$) THEN EN$ = STR$ (NR)
2050 BEG = VAL (BEG$):EN = VAL (EN$)
2060 PRINT D$"OPEN EAMON.ROOMS,L64"
2080 IF PRT THEN PRINT D$"PR#";PS: PRINT CHR$ (9);"80N"
2090 HOME : PRINT SPC( (SIZ - LEN (ADV$)) / 2);ADV$: PRINT : PRINT :LP = 3: FOR R = BEG TO EN: GOSUB 2100: NEXT
2095 PRINT D$"CLOSE EAMON.ROOMS": PRINT D$: PRINT D$"PR#0": GOTO 100
2100 PRINT : PRINT "ROOM # ";R;" [";R$(R);"]": PRINT "DESC:": PRINT D$;"READ EAMON.DESC,R";R: INPUT A$: GOSUB 8000
2120 PRINT "DIRECTIONS MOVED IN--": PRINT D$;"READ EAMON.ROOMS,R";R: FOR D = 1 TO ND: INPUT DR%(D): NEXT
2125 INPUT LT
2130 FOR D = 1 TO ND: PRINT " ";DD$(D);": "; SPC( (DR%(D) > = 0) + ( ABS (DR%(D)) < 10));DR%(D); SPC( 5)
2140 IF DR%(D) = - 99 THEN PRINT "[EXIT]";: GOTO 2160
2150 IF DR%(D) < > 0 AND ABS (DR%(D)) < = NR THEN PRINT "[";R$( ABS (DR%(D)));"]";
2160 PRINT : NEXT D: PRINT "LIGHT: ";LT: PRINT D$
2170 IF NOT PRT THEN PRINT : INVERSE : PRINT " PRESS ANY KEY TO CONTINUE ";: NORMAL : GET A$: HOME : PRINT
2180 IF A$ = CHR$ (27) THEN POP : GOTO 100
2190 RETURN
3000 REM /// LIST ARTIF.
3010 VTAB 6: CALL - 958: INPUT "BEGINNING WITH ARTIFACT:";BEG$: IF BEG$ = "" THEN BEG$ = "1": VTAB 6: HTAB 25: PRINT BEG$
3020 VTAB 8: CALL - 958: INPUT "ENDING WITH ARTIFACT:";EN$: IF EN$ = "" THEN EN$ = STR$ (NA): HTAB 22: VTAB 8: PRINT EN$
3030 IF VAL (BEG$) > NA OR VAL (BEG$) < 1 THEN BEG$ = "1"
3040 IF VAL (EN$) > NA OR VAL (EN$) < VAL (BEG$) THEN EN$ = STR$ (NA)
3050 BEG = VAL (BEG$):EN = VAL (EN$)
3060 PRINT D$"OPEN EAMON.ARTIFACTS,L128"
3080 IF PRT THEN PRINT D$"PR#";PS: PRINT CHR$ (9);"80N"
3090 PRINT SPC( (SIZ - LEN (ADV$)) / 2);ADV$: PRINT : PRINT : FOR R = BEG TO EN: GOSUB 3500: NEXT
3095 PRINT D$"CLOSE EAMON.ARTIFACTS": PRINT D$: PRINT D$"PR#0": GOTO 100
3500 PRINT D$;"READ EAMON.ARTIFACTS,R";R: INPUT X$: FOR A = 1 TO 4: INPUT A%(A): NEXT : IF DV > 5 OR A%(2) > 1 THEN FOR A = 5 TO 8: INPUT A%(A): NEXT
3505 IF A%(2) > DT THEN FOR X = 1 TO 4:A$(AF + X) = "FIELD " + STR$ (AF + X): NEXT : GOTO 3520
3510 IF FMP%(A%(2)) > 0 THEN FOR X = 1 TO 4:A$(AF + X) = FL$(FMP%(A%(2)),X): NEXT
3520 PRINT "ARTIFACT # ";R;" [";AN$(R);"]":LP = LP + 2: PRINT D$;"READ EAMON.DESC,R";100 + R: INPUT A$: PRINT "DESC: ": GOSUB 8000
3540 FOR A2 = 1 TO 4:LP = LP + 1: PRINT " ";A$(A2); MID$ (PR$,1,10 - LEN (A$(A2))); MID$ (PR$,1,6 - LEN ( STR$ (A%(A2))));A%(A2);
3550 IF A2 = 2 AND A%(2) > 10 THEN PRINT " [SPECIAL CATEGORY]";: GOTO 3580
3560 IF A2 = 2 THEN PRINT " [";TYP$(A%(2));"]";: GOTO 3580
3570 IF A2 = 4 AND A%(4) > 0 AND A%(4) < = NR THEN PRINT " [";R$(A%(4));"]";
3575 IF A2 = 4 AND A%(4) < 0 AND A%(4) = > - NM - 1 THEN PRINT " [CARRIED BY ";MN$( ABS (A%(4)) - 1);"]";
3580 IF A2 = 4 AND A%(4) > 200 AND A%(4) < = 200 + NR THEN PRINT " [";R$(A%(4) - 200);"]";
3590 IF A2 = 4 AND A%(4) > 100 AND A%(4) < 100 + NAR THEN PRINT " [INSIDE ";AN$(A%(4) - 100);"]";
3600 IF A2 = 4 AND A%(4) > 300 AND A%(4) < = 300 + NR THEN PRINT " [HIDDEN ";R$(A%(4) - 300);"]";
3610 PRINT : NEXT A2: IF A%(2) > 10 THEN 3740
3620 IF FMP%(A%(2)) = 0 THEN 3740
3630 FOR A2 = 5 TO 8: IF A$(A2) = "(NOT USED)" THEN 3740
3650 LP = LP + 1: PRINT " ";A$(A2); MID$ (PR$,1,10 - LEN (A$(A2))); MID$ (PR$,1,6 - LEN ( STR$ (A%(A2))));A%(A2);
3700 IF A2 = 6 AND (A%(2) = 2 OR A%(2) = 3) THEN IF A%(A2) = > 1 AND A%(A2) < = 5 THEN PRINT " ["; MID$ (" AXE BOW CLUB SPEARSWORD",(A%(6) - 1) * 5 + 1,5);"]";
3720 PRINT : NEXT A2
3740 REM
3750 PRINT D$: PRINT : IF NOT PRT THEN INVERSE : PRINT SPC( 7);"PRESS ANY KEY TO CONTINUE"; SPC( 7);: NORMAL : GET A$: PRINT : HOME
3760 IF A$ = CHR$ (27) THEN POP : GOTO 100
3770 RETURN
4000 REM /// LIST EFFECTS
4010 VTAB 6: CALL - 958: INPUT "BEGINNING WITH #:";BEG$: IF BEG$ = "" THEN BEG$ = "1": HTAB 18: VTAB 6: PRINT BEG$
4020 VTAB 8: CALL - 958: INPUT "ENDING WITH #:";EN$: IF EN$ = "" THEN EN$ = STR$ (NE): HTAB 15: VTAB 8: PRINT EN$
4030 IF VAL (BEG$) > NE OR VAL (BEG$) < 1 THEN BEG$ = "1"
4040 IF VAL (EN$) > NE OR VAL (EN$) < VAL (BEG$) THEN EN$ = STR$ (NE)
4050 BEG = VAL (BEG$):EN = VAL (EN$)
4080 IF PRT THEN PRINT D$"PR#";PS
4090 HOME :LP = 500: FOR R = BEG TO EN: GOSUB 4500: NEXT : PRINT D$
4095 PRINT D$"PR#0": GOTO 100
4500 REM
4510 PRINT SPC( MRG);"EFFECT #";R;":": PRINT :LP = LP + 2
4520 PRINT D$;"READ EAMON.DESC,R";R + 200: INPUT A$: GOSUB 8000
4527 IF LP = 500 THEN RETURN
4530 PRINT D$: PRINT : IF NOT PRT THEN INVERSE : PRINT SPC( 7);"PRESS ANY KEY TO CONTINUE"; SPC( 7);: GET A$: NORMAL : PRINT : HOME : IF A$ = CHR$ (27) THEN POP : GOTO 100
4540 RETURN
5000 REM /// LIST MONSTERS
5010 VTAB 6: CALL - 958: INPUT "BEGINNING WITH #:";BEG$: IF BEG$ = "" THEN BEG$ = "1": HTAB 18: VTAB 6: PRINT BEG$
5020 VTAB 8: CALL - 958: INPUT "ENDING WITH #:";EN$: IF EN$ = "" THEN EN$ = STR$ (NM): VTAB 8: HTAB 15: PRINT EN$
5030 IF VAL (BEG$) > NM OR VAL (BEG$) < 1 THEN BEG$ = "1"
5040 IF VAL (EN$) > NM OR VAL (EN$) < VAL (BEG$) THEN EN$ = STR$ (NM)
5050 BEG = VAL (BEG$):EN = VAL (EN$)
5060 PRINT D$"OPEN EAMON.MONSTERS,L128"
5080 IF PRT THEN PRINT D$"PR#";PS
5090 HOME : PRINT CHR$ (12); SPC( (SIZ - LEN (ADV$)) / 2);ADV$: PRINT : PRINT :LP = 3: FOR R = BEG TO EN: GOSUB 5500: NEXT
5095 PRINT D$"CLOSE EAMON.MONSTERS": PRINT D$: PRINT D$"PR#0": GOTO 100
5500 REM
5510 PRINT D$;"READ EAMON.MONSTERS,R";R: INPUT MN$: FOR M2 = 1 TO 12: INPUT M%(M2): NEXT : PRINT D$;"READ EAMON.DESC,R";R + 300: INPUT A$
5520 PRINT "MONSTER # ";R;" [";MN$;"]": PRINT "DESC:": GOSUB 8000:LP = LP + 4
5530 FOR M2 = 1 TO 12:LP = LP + 1: PRINT " ";M$(M2); MID$ (PR$,1,10 - LEN (M$(M2))); MID$ (PR$,1,6 - LEN ( STR$ (M%(M2))));M%(M2);
5540 IF M2 = 3 OR M2 = 4 OR M2 = 7 OR M2 = 10 THEN PRINT " %";
5550 IF M2 = 5 AND M%(5) > 0 AND M%(5) < = NR THEN PRINT " [";R$(M%(5));"]";
5560 IF M2 = 9 AND M%(9) = - 1 THEN PRINT " [ NO WEAPONS ]"
5570 IF M2 = 9 AND M%(9) = 0 THEN PRINT " [ NATURAL WEAPONS ]";
5580 IF M2 = 9 AND M%(9) > 0 AND M%(9) < = NAR THEN PRINT " [";AN$(M%(9));"]";
5590 IF M2 = 9 AND M%(9) > 0 AND M%(9) < N%(2) THEN PRINT " [";AN$(M%(9));"]";
5600 PRINT : NEXT M2: PRINT D$
5610 IF LP > 45 AND PRT THEN LP = 0: PRINT CHR$ (12); SPC( (SIZ - LEN (ADV$)) / 2 + 1);ADV$
5620 PRINT : IF NOT PRT THEN INVERSE : PRINT SPC( 7);"PRESS ANY KEY TO CONTINUE"; SPC( 6);: GET A$: NORMAL : HOME : PRINT
5650 IF A$ = CHR$ (27) THEN POP : GOTO 100
5690 RETURN
6000 REM /// TOGGLE PRINTER
6010 PRT = NOT PRT
6020 IF PRT THEN SIZ = 80
6040 IF NOT PRT THEN SIZ = 40
6050 IF NOT PS THEN 1000
6090 GOTO 100
7000 REM /// QUIT
7010 PRINT D$"CLOSE": PRINT D$"PR#0": END
8000 PRINT A$:LP = LP + INT ( LEN (A$) / 80) + 1: RETURN
35000 REM >>> READ DATA
35020 READ AF: READ MF
35050 DATA 4,12: REM AF = # ARTIF FIELDS, MF = # MONST FIELDS
35060 DIM M$(MF),M%(MF):M$(0) = "ADVENTURER": FOR M = 1 TO MF: READ M$(M): NEXT
35100 DATA HARD,AGIL,FRIEND,COUR,ROOM,WGHT,D.ODDS,ARMOUR,WEAPON#,O.ODDS,W.DICE,W.SIDES
35200 READ DT: DIM TYP$(DT): FOR X = 0 TO DT: READ TYP$(X): NEXT
35210 DATA 10
35220 DATA GOLD,TREASURE,WEAPON,SP.WEAPON,CONTAINER,LIGHT,HEAL,READABLE,DOOR,KEY,BOUND MON.
35250 FOR A = 1 TO AF: READ A$(A): NEXT
35270 DATA VALUE,TYPE,WEIGHT,ROOM
35300 DATA NORTH ,SOUTH ,EAST ,WEST ,UP ,DOWN ,NORTHEAST,NORTHWEST,SOUTHEAST,SOUTHWEST
35400 FOR D = 1 TO 10: READ DD$(D): NEXT
35450 READ NF: DIM FMP%(DT),FL$(DT,4): FOR X = 0 TO DT: READ FMP%(X): NEXT : FOR X = 1 TO NF: FOR F = 1 TO 4: READ FL$(X,F): NEXT
35480 NEXT :PR$ = "...................."
35490 RETURN
35500 DATA 8
35550 DATA 0,0,1,1,2,3,4,5,6,7,8
35600 DATA ODDS,W.TYPE,DICE,SIDES
35610 DATA KEY#,STRENGTH,(NOT USED),(NOT USED)
35620 DATA COUNTER,(NOT USED),(NOT USED),(NOT USED)
35630 DATA CHANCES,HEAL AMT,NBR USES,(NOT USED)
35640 DATA 1ST EFFECT,# EFFECTS,READABLE,(NOT USED)
35650 DATA ROOM INTO,KEY#,STRENGTH,(NOT USED)
35660 DATA (NOT USED),(NOT USED),(NOT USED),(NOT USED)
35670 DATA MONSTER#,KEY#,GUARD#,ATTACHED
35900 RETURN