Source:Dungeon List 7.1
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 7.1, 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
DUNGEON LIST 7.1
BY TOM ZUCHOWSKI
2 REM
DEVELOPED FROM VERSION 6.0
BY JOHN NELSON
5 REM DL9
6 REM 1/31/95
10 PRINT CHR$ (4);"MAXFILES 3"
20 TEXT :D$ = CHR$ (4): HOME : VTAB 5: HTAB 12: PRINT "DUNGEON LIST 7.1": VTAB 9: PRINT " INSERT EAMON ADVENTURE DISKETTE": PRINT : PRINT " PRESS ANY KEY TO CONTINUE": 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"
32 IF DV < 7 THEN PRINT : PRINT "THIS ADVENTURE IS NOT VERSION 7.X.": PRINT : PRINT "USE THE PROGRAM NAMED 'DUNGEON LIST' FOR THIS ADVENTURE": END
35 POKE 216,0
40 ND = VAL (DR$)
50 PRINT D$"OPEN EAMON.DESC,L242": PRINT D$;"READ EAMON.DESC,R0": INPUT NR,NA,NE,NM,LR,LM,LA: PRINT D$
60 GOSUB 35000
70 DIM R$(NR),AN$(NA),MN$(NM)
90 PRINT D$"OPEN EAMON.ROOMS,L"LR: FOR R = 1 TO NR: PRINT D$;"READ EAMON.ROOMS,R";R: INPUT R$(R): NEXT : PRINT D$"CLOSE EAMON.ROOMS"
95 PRINT D$"OPEN EAMON.ARTIFACTS,L"LA: 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,L"LM: 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 7.1": PRINT : 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-7):";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 32
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 # (1): ";BE$: IF BE$ = "" THEN BE$ = "1": VTAB 6: HTAB 23: PRINT BE$
2020 VTAB 8: PRINT "ENDING WITH # ("NR;: INPUT "): ";EN$: IF EN$ = "" THEN EN$ = STR$ (NR): VTAB 8: HTAB 21: PRINT EN$
2030 IF VAL (BE$) > NR OR VAL (BE$) < 1 THEN BE$ = "1"
2040 IF VAL (EN$) > NR OR VAL (EN$) < VAL (BE$) THEN EN$ = STR$ (NR)
2050 BE = VAL (BE$):EN = VAL (EN$)
2060 PRINT D$"OPEN EAMON.ROOMS,L"LR
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 = BE 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: INPUT X$: 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)));"]";
2155 IF DR%(D) > 500 THEN PRINT "[";AN$(DR%(D) - 500);"]";
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 (1): ";BE$: IF BE$ = "" THEN BE$ = "1": VTAB 6: HTAB 30: PRINT BE$
3020 VTAB 8: CALL - 958: PRINT "ENDING WITH ARTIFACT ("NA;: INPUT "): ";EN$: IF EN$ = "" THEN EN$ = STR$ (NA): HTAB 28: VTAB 8: PRINT EN$
3030 IF VAL (BE$) > NA OR VAL (BE$) < 1 THEN BE$ = "1"
3040 IF VAL (EN$) > NA OR VAL (EN$) < VAL (BE$) THEN EN$ = STR$ (NA)
3050 BE = VAL (BE$):EN = VAL (EN$)
3060 PRINT D$"OPEN EAMON.ARTIFACTS,L"LA
3080 IF PRT THEN PRINT D$"PR#";PS: PRINT CHR$ (9);"80N"
3090 PRINT SPC( (SIZ - LEN (ADV$)) / 2);ADV$: PRINT : PRINT : FOR R = BE 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 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";200 + 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) > 11 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) > 500 AND A%(4) < NA + 500 THEN PRINT " [INSIDE ";AN$(A%(4) - 500);"]";
3600 IF A2 = 4 AND A%(4) = - 999 THEN PRINT " [WORN BY ";MN$( ABS (A%(4)) - 1);"]";
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 LEFT$ (A$(A2),5) = "USER#" AND VAL (A$(A2)) = 0 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 # (1): ";BE$: IF BE$ = "" THEN BE$ = "1": HTAB 23: VTAB 6: PRINT BE$
4020 VTAB 8: CALL - 958: PRINT "ENDING WITH # ("NE;: INPUT "): ";EN$: IF EN$ = "" THEN EN$ = STR$ (NE): HTAB 21: VTAB 8: PRINT EN$
4030 IF VAL (BE$) > NE OR VAL (BE$) < 1 THEN BE$ = "1"
4040 IF VAL (EN$) > NE OR VAL (EN$) < VAL (BE$) THEN EN$ = STR$ (NE)
4050 BE = VAL (BE$):EN = VAL (EN$)
4080 IF PRT THEN PRINT D$"PR#";PS
4090 HOME :LP = 500: FOR R = BE 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 + 400: 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 # (1): ";BE$: IF BE$ = "" THEN BE$ = "1": HTAB 23: VTAB 6: PRINT BE$
5020 VTAB 8: CALL - 958: PRINT "ENDING WITH # ("NM;: INPUT "): ";EN$: IF EN$ = "" THEN EN$ = STR$ (NM): VTAB 8: HTAB 21: PRINT EN$
5030 IF VAL (BE$) > NM OR VAL (BE$) < 1 THEN BE$ = "1"
5040 IF VAL (EN$) > NM OR VAL (EN$) < VAL (BE$) THEN EN$ = STR$ (NM)
5050 BE = VAL (BE$):EN = VAL (EN$)
5060 PRINT D$"OPEN EAMON.MONSTERS,L"LM
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 = BE 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 11: INPUT M%(M2): NEXT : PRINT D$;"READ EAMON.DESC,R";R + 600: INPUT A$
5520 PRINT "MONSTER # ";R;" [";MN$;"]": PRINT "DESC:": GOSUB 8000:LP = LP + 4
5530 FOR M2 = 1 TO 11: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 = 11 AND M%(11) > 99 THEN PRINT " [";M%(11) - 100;"%]";
5545 IF M2 = 11 AND M%(11) < 4 THEN PRINT " ";FR$(M%(11));
5550 IF M2 = 5 AND M%(5) > 0 AND M%(5) < = NR THEN PRINT " [";R$(M%(5));"]";
5560 IF M2 = 8 AND M%(8) = - 1 THEN PRINT " [ NO WEAPONS ]"
5570 IF M2 = 8 AND M%(8) = 0 THEN PRINT " [ NATURAL WEAPONS ]";
5580 IF M2 = 8 AND M%(8) > 0 AND M%(8) < = (NA) THEN PRINT " [";AN$(M%(8));"]";
5590 IF M2 = 8 AND M%(8) > 0 AND M%(8) < N%(2) THEN PRINT " [";AN$(M%(8));"]";
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,11: 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,# IN GROUP,COUR,ROOM,WGHT,ARMOR,WEAPON #,# DICE,# SIDES,FRIEND?
35200 READ DT: DIM TYP$(DT): FOR X = 0 TO DT: READ TYP$(X): NEXT
35210 DATA 11
35220 DATA GOLD,TREASURE,WEAPON,MAGIC WEAPON,CONTAINER,LIGHT,HEAL,READABLE,DOOR/GATE,KEY,BOUND MON.,WEARABLE
35250 FOR A = 1 TO 8: READ A$(A): NEXT
35270 DATA VALUE,TYPE,WEIGHT,ROOM,USER#5,USER#6,USER#7,USER#8
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$ = "...................."
35485 FR$(1) = "[ENEMY]":FR$(2) = "[NEUTRAL]":FR$(3) = "[FRIEND]"
35490 RETURN
35500 DATA 9
35550 DATA 0,0,1,1,2,3,4,5,6,7,8,9
35600 DATA ODDS,W.TYPE,DICE,SIDES
35610 DATA KEY#,STRENGTH,OPEN?,USER#8
35620 DATA COUNTER,USER#6,USER#7,USER#8
35630 DATA HEAL AMT,NBR USES,OPEN?,USER#8
35640 DATA 1ST EFFECT,# EFFECTS,OPEN?,USER#8
35650 DATA NEXT ROOM,KEY#,STRENGTH,HIDDEN?
35660 DATA USER#5,USER#6,USER#7,USER#8
35670 DATA MONSTER#,KEY#,GUARD#,USER#8
35680 DATA ARMOR CLASS,TYPE,USER#7,USER#8
35900 RETURN