'
'                EAMON-QB
'               Version 2.92
'                WONDERFL
'                   by
'
'               John Nelson
'
'     DEVELOPER EDITION / CHAMPION EDITION
'
' =============================================================================
'     Log of Changes:
'  Ver.     Date       By    Description of Change(s)
'  ----   ----------   --    --------------------------------------------------
'  2.89   03/18/2000   JN    Fixed a bug in DungEdit where special rooms were
'                            getting messed up.
'  2.89   03/17/2000   JN    Fixed a bug where nbr of adventures getting changed
'                            by the resurrect routine - changed D% to NbrAdv
'  2.86   01/15/2000   JN    Display character displays first (partial) match
'                            changed to do exact matches. Also display no weap.
'                            Re-wrote Move character routine - was not working.
'                            Fixed timer Waitasec routine - was not pausing.
' -----------------------------------------------------------------------------
	DEFINT A-Z
	DECLARE SUB Normalize (Nam$)
	DECLARE SUB WaitaSec (Waitsecs%)
	DECLARE SUB GetColor (fgc%, bgc%, hfg%, hbg%, brt%)
	DECLARE SUB ReadDir (Path$, DNam$(), NbrAdvs)
	DECLARE SUB CenterArea (L$, L%)
	DECLARE SUB PrtCenter (L$)
	DECLARE SUB Sort (AN$(), NA%)
	DECLARE FUNCTION Center$ (X$, L%)
	DIM Nam$(100)
REM $$INCL:'\EAMON\COPY\CHARDEF.BAS'
	' %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
	'
	'   Module:  CHARDEF.BAS
	'   Eamon Version:  Eamon-QB (or Eamon-PC)
	' ------------------------------------------------------------
	'  Character Definition for Eamon QB/PC
	'        Basic version:  QuickBASIC 4.0, GW-BASIC, QBasic *
	'                        or BASIC 7.0 PDS
	'       uses Field statements for record description
	'       This module will work for QBasic, but QBasic cannot
REM $$INCL:statements, so module must be copied
	'       into programs manually or merged using a utility
	' %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
	'
TYPE WeaponRec
	Nam             AS STRING * 20
	Wpntyp          AS INTEGER
	Odds            AS INTEGER
	Dice            AS INTEGER
	Sides           AS INTEGER
END TYPE

TYPE CharacterRecord
	Nam             AS STRING * 30
	HD              AS INTEGER
	AG              AS INTEGER
	CH              AS INTEGER
	SA1             AS INTEGER
	SA2             AS INTEGER
	SA3             AS INTEGER
	SA4             AS INTEGER
	WA1             AS INTEGER
	WA2             AS INTEGER
	WA3             AS INTEGER
	WA4             AS INTEGER
	WA5             AS INTEGER
	SEX             AS STRING * 1
	GOLD            AS LONG
	BANK            AS LONG
	AE              AS INTEGER
	ArmNam          AS STRING * 20
	ArmHit          AS INTEGER
	ArmAdj          AS INTEGER
	ShdNam          AS STRING * 20
	ShdHit          AS INTEGER
	ShdAdj          AS INTEGER
	Wpn1Nam         AS STRING * 20
	Wpn1Typ         AS INTEGER
	Wpn1WpnTyp      AS INTEGER
	Wpn1Odds        AS INTEGER
	Wpn1Dice        AS INTEGER
	Wpn1Sides       AS INTEGER
	Wpn2Nam         AS STRING * 20
	Wpn2Typ         AS INTEGER
	Wpn2WpnTyp      AS INTEGER
	Wpn2Odds        AS INTEGER
	Wpn2Dice        AS INTEGER
	Wpn2Sides       AS INTEGER
	Wpn3Nam         AS STRING * 20
	Wpn3Typ         AS INTEGER
	Wpn3WpnTyp      AS INTEGER
	Wpn3Odds        AS INTEGER
	Wpn3Dice        AS INTEGER
	Wpn3Sides       AS INTEGER
	Wpn4Nam         AS STRING * 20
	Wpn4Typ         AS INTEGER
	Wpn4WpnTyp      AS INTEGER
	Wpn4Odds        AS INTEGER
	Wpn4Dice        AS INTEGER
	Wpn4Sides       AS INTEGER
	Filler          AS STRING * 23
END TYPE
DIM CHAR AS CharacterRecord
TYPE CharControl
	NbrChar         AS INTEGER
	Filler          AS STRING * 254
END TYPE
DIM CharCtl AS CharControl

    '------- (end of include file) -------
 '
	DIM Red AS CharacterRecord
	KEY OFF
	RANDOMIZE TIMER
	DIM flg%(6)
	DIM WN$(4), WR%(4), WT%(4), WC%(4), WD%(4), WS%(4), SA%(4), WA%(5)
	DIM SPL.NAM$(4), WTyp$(5), DW%(5), DS%(4)
	DIM Msg$(6)
	CHDIR "\Eamon"
REM $$INCL:'\Eamon\Copy\colorrtn.bas'
     ON ERROR GOTO NoColors
     OPEN "EAMCOLOR" FOR INPUT AS #1
     INPUT #1, fgc%
     INPUT #1, bgc%
     INPUT #1, hfg%
     INPUT #1, hbg%
     CLOSE
In.BW:
     ON ERROR GOTO 0
     COLOR fgc%, bgc%
     GOTO Colorset
NoColors:
      fgc% = 7
      bgc% = 0
      hfg% = 0
      hbg% = 7
      RESUME In.BW
Colorset:

    '------- (end of include file) -------
 '
	ON ERROR GOTO No.Version
	OPEN "Version.Txt" FOR INPUT AS #1
	INPUT #1, Lin1$
	INPUT #1, Lin2$
	INPUT #1, Lin3$
	INPUT #1, Lin4$
	INPUT #1, Lin5$
	CLOSE 1
	ON ERROR GOTO 0
GoVer:
	LOCATE , , 0
	COLOR fgc%, bgc%
	Msg$(1) = " For additional information and adventures "
	Msg$(2) = " contact:"
	Msg$(3) = " "
	Msg$(4) = "    biggraybeard@hotmail.com"
	Msg$(5) = "                    "
	Msg$(6) = "                        "
	DIM DNam$(X)
	MastPath$ = ""
	ReadDir MastPath$, DNam$(), NbrAdvs
	CLS
	FOR X = 1 TO 6
	LOCATE 5 + X, 10
	PRINT Msg$(X)
	NEXT
	Waitsecs = 10
	SavTim! = TIMER + Waitsecs
	WaitaSec Waitsecs
	GOSUB TABLE.CHARS
	DEF FNR (X) = INT(RND(1) * X + 1)
	DEF FNA (X) = FNR(X) + FNR(X) + FNR(X)
	FOR X = 1 TO 4
	READ SPL.NAM$(X)
	NEXT
	FOR X = 1 TO 5
	READ WTyp$(X)
	NEXT
	FOR X = 1 TO 5
	READ DW%(X)
	NEXT
	DATA Blast,Heal,Speed,Power
	DATA Axe,Bow,Mace,Spear,Sword
	DATA 10,-5,20,0,5
Main.Menu:
	COLOR fgc%, bgc%
	CLS
	COLOR hfg%, hbg%
	LOCATE 1, 25
	A$ = Center$(Lin1$, 42)
	PRINT A$
	LOCATE 2, 25
	A$ = Center$(Lin2$, 42)
	PRINT A$
	LOCATE 3, 25
	A$ = Center$(Lin3$, 42)
	PRINT A$
	LOCATE 4, 25
	A$ = Center$(Lin4$, 42)
	PRINT A$
	LOCATE 5, 25
	A$ = Center$(Lin5$, 42)
	PRINT A$
	COLOR fgc%, bgc%
	PRINT
	PRINT SPC(28); "<1> Play the Game"
	PRINT SPC(28); "<2> Show Names of characters"
	PRINT SPC(28); "<3> Display a Character"
	PRINT SPC(28); "<4> Kill a Character"
	PRINT SPC(28); "<5> Move a Character"
	PRINT SPC(28); "<6> Add a Character"
	PRINT SPC(28); "<7> Initialize Characters File"
	PRINT SPC(28); "<8> Go directly to an Adventure"
	PRINT SPC(28); "<9> Resurrect a Character"
	PRINT SPC(28); "<C> Declare a Champion"
	PRINT SPC(28); "<D> Design or Edit an Adventure"
	PRINT SPC(28); "<V> View all Characters "
	PRINT SPC(28); "<S> Set Colors"
	PRINT SPC(28); "<Q> Quit"
	LOCATE 24, 1
	PrtCenter "Press Key for your choice..."
	VALID$ = "123456789CDSQEV"
	GOSUB GET.KEYSTROKE
	IF A$ = "C" THEN GOTO Champion
	IF A$ = "D" THEN GOTO DDD.Disk
	IF A$ = "Q" THEN GOTO QUIT.RTN
	IF A$ = "S" THEN GOTO SetColor
	IF A$ = "E" THEN GOTO EDIT.CHAR
	IF A$ = "V" THEN GOTO View.All
	C = VAL(A$)
	ON C GOTO PLAY.GAME, DISPLAY.NAMES, DISPLAY.CHARACTER, KILL.CHARACTER, MOVE.CHARACTER, ADD.A.CHARACTER, INITIALIZE.FILE, Go.on.Adventure, RESURRECT
PLAY.GAME:
	CLS
	LOCATE 6, 37
	PrtCenter "CONFIRM"
	LOCATE 10, 10
	PrtCenter "Entering the game ... Press 'C' to continue"
	VALID$ = ""
	GOSUB GET.KEYSTROKE
	IF A$ <> "C" THEN GOTO Main.Menu
	RUN "WORLD"
DISPLAY.NAMES:
	CLS
	COLOR hfg%, hbg%
	PRINT SPC(30); "Character Names"; SPC(30); " "
	COLOR fgc%, bgc%
	IF NC = 0 THEN
	LOCATE 12, 20
	PrtCenter "** No Characters on File ** "
	ELSE
	FOR N = 1 TO NC
		IF LEFT$(Nam$(N), 1) = "*" THEN
		N$ = "(Dead " + MID$(Nam$(N), 2) + ")"
		ELSE
		N$ = Nam$(N)
		END IF
		PRINT USING "###. "; N;
		PRINT N$
		IF CSRLIN > 22 THEN GOSUB PRESS.ANY.KEY: PRINT : CLS
	NEXT
	END IF
	GOSUB PRESS.ANY.KEY
	GOTO Main.Menu
PRESS.ANY.KEY:
	LOCATE 25, 1
	COLOR hfg%, hbg%
	PRINT "                        Press Any Key to Continue ...                        ";
	COLOR fgc%, bgc%
	DO
	A$ = INKEY$
	LOOP WHILE A$ = ""
	CtlKey$ = ""
	IF A$ = CHR$(27) THEN CtlKey$ = "E"
	IF LEFT$(A$, 1) = CHR$(0) THEN
	IF ASC(MID$(A$, 2)) = 75 THEN CtlKey$ = "L"
	IF ASC(MID$(A$, 2)) = 77 THEN CtlKey$ = "R"
	END IF
	RETURN
View.All:
	GOSUB OPEN.CHARACTERS
	FOR X = 1 TO NC
	REC = X + 1
	GOSUB READ.CHARACTER
	IF LEFT$(Nam$, 1) <> "*" THEN GOSUB Display.Someone
	IF CtlKey$ = "L" THEN
	IF X > 1 THEN X = X - 2 ELSE X = 0: BEEP
	END IF
	IF CtlKey$ = "E" THEN EXIT FOR
	NEXT
	CLOSE
	GOTO Main.Menu
DISPLAY.CHARACTER:
	CLS
	COLOR hfg%, hbg%
	PRINT SPC(78);
	PrtCenter "Character Display"
	COLOR fgc%, bgc%
	LOCATE 10, 1
	XM$ = "X"
	GOSUB FIND.CHARACTER
	IF Esc THEN GOTO Main.Menu
	IF FOUND = 0 THEN GOSUB CHAR.NOT.FOUND: GOTO Main.Menu
	GOSUB OPEN.CHARACTERS
	GOSUB READ.CHARACTER
	CLOSE
	GOSUB Display.Someone
	GOTO Main.Menu
Display.Someone:
REM === DISPLAY FORMATTED RECORD ===
	CLS
	LOCATE 1, 1
	PRINT "The ";
	IF SEX$ = "M" THEN PRINT "Mighty ";  ELSE PRINT "Fair ";
	PRINT Nam$;
	LOCATE 3, 1
	PRINT "Attributes ---"
	LOCATE 4, 3
	PRINT "Hardiness: ";
	PRINT USING "#,###"; HD;
	LOCATE 4, 21
	PRINT "Agility: ";
	PRINT USING "#,###"; AG;
	LOCATE 4, 37
	PRINT "Charisma: ";
	PRINT USING "#,###"; CH
	PRINT
	PRINT "Spells ---"
	SP.CNT = 0
	FOR S = 1 TO 4
	IF SA%(S) > 0 THEN PRINT SPL.NAM$(S); "   "; : SP.CNT = SP.CNT + 1
	NEXT
	IF SP.CNT = 0 THEN PRINT "    No Spells"
	PRINT
	PRINT
	PRINT "Weapon abilities ---"
	FOR W = 1 TO 5
	PRINT WTyp$(W); ":";
	PRINT USING "###"; WA%(W);
	PRINT "%   ";
	NEXT
	LOCATE 13, 1
	IF ArmHit > 0 THEN
	PRINT RTRIM$(ArmNam$); " Armor ("; ArmHit; "/"; -ArmAdj; ")   ";
	ELSE
	PRINT "(No Armor)    ";
	END IF
	IF ShdHit > 0 THEN
	PRINT RTRIM$(ShdNam$); " Shield ("; ShdHit; "/"; -ShdAdj; ")";
	ELSE
	PRINT " (No Shield)"
	END IF
	LOCATE 15, 3
	PRINT "Gold: ";
	PRINT USING "#,###,###"; GOLD&;
	LOCATE 15, 20
	PRINT "Bank: ";
	PRINT USING "#,###,###"; BANK&;
	LOCATE 15, 40
	PRINT "Armor Exp:";
	PRINT USING "###"; AE;
	PRINT "%"
	LOCATE 17, 1
	PRINT "Carrying: "; SPC(25); "Type  Comp  Dice  Sides"
	IF RTRIM$(WN$(1)) = "NONE" THEN
	PRINT "    (No Weapons carried)"
	ELSE
	FOR W = 1 TO 4
		IF RTRIM$(WN$(W)) = "" THEN WN$(W) = "NONE"
		IF LEFT$(WN$(W), 4) <> "NONE" THEN
		GOSUB Display.Weapon
		END IF
		PRINT
	NEXT
	END IF
	GOSUB PRESS.ANY.KEY
	RETURN
Display.Weapon:
	LOCATE 17 + W, 6
	PRINT WN$(W);
	LOCATE 17 + W, 36
	PRINT WTyp$(WT%(W));
	LOCATE 17 + W, 43
	PRINT USING "###"; WC%(W);
	LOCATE 17 + W, 49
	PRINT USING "###"; WD%(W);
	LOCATE 17 + W, 55
	PRINT USING "###"; WS%(W);
	EA = ArmAdj + ShdAdj - AE
	IF EA < 0 THEN EA = 0
	OddsHit = AG * 2 + WA%(WT%(W)) + WC%(W) - EA
	PRINT USING "  (###%)"; OddsHit;
	RETURN
KILL.CHARACTER:
	CLS
	COLOR hfg%, hbg%
	PRINT SPC(78);
	PrtCenter "Character Assissination"
	COLOR fgc%, bgc%
	XM$ = "X"
	GOSUB FIND.CHARACTER
	IF Esc THEN GOTO Main.Menu
	IF FOUND = 0 THEN GOSUB CHAR.NOT.FOUND: GOTO Main.Menu
	CLS
	LOCATE 6, 10
	PRINT "DELETE "; Nam$(R); " --- CONFIRM ---"
	LOCATE 8, 10
	PRINT "Press 'D' to Delete, 'K' to Kill..."
	LOCATE 10, 10
	PRINT "(or press any other key to cancel)"
	VALID$ = ""
	GOSUB GET.KEYSTROKE
	IF A$ = "K" THEN KD$ = A$: GOTO Kill.Im
	IF A$ = "D" THEN KD$ = A$: GOTO Kill.Im
	GOTO Main.Menu
Kill.Im:
	GOSUB OPEN.CHARACTERS
	IF KD$ = "D" THEN
	SAVREC = REC
	REC = NC + 1
	GOSUB READ.CHARACTER
	REC = SAVREC
	Nam$(REC - 1) = RTRIM$(Nam$)
	GOSUB WRITE.CHARACTER
	NC = NC - 1
	CLOSE
	GOTO Main.Menu
	END IF
	GOSUB KILL.A.GUY
	CLOSE
	Nam$(R) = Nam$
	GOTO Main.Menu
KILL.A.GUY:
	Nam$ = "*" + Nam$(R)
	GOSUB WRITE.CHARACTER
	RETURN
MOVE.CHARACTER:
	CLS
	COLOR hfg%, hbg%
	PRINT SPC(78);
	PrtCenter "Move a Character"
	COLOR fgc%, bgc%
	LOCATE 6, 10
	INPUT "Character Name:", N$
	OPEN "CHARACT.DAT" FOR RANDOM AS #1 LEN = LEN(CHAR)
	GET #1, 1, CharCtl
	NC = CharCtl.NbrChar
	FOR R = 1 TO NC
	GET #1, R + 1, CHAR
	IF RTRIM$(CHAR.Nam$) = N$ THEN GOSUB Move.Im: EXIT FOR
	NEXT
	CLOSE
	GOTO Main.Menu
Move.Im:
	LOCATE 8, 10
	PRINT "Insert diskette to receive character and/or enter path ..."
	INPUT "=> ", Path$
	IF LEN(Path$) > 0 AND RIGHT$(Path$, 1) <> "\" THEN Path$ = Path$ + "\"
	OPEN Path$ + "CHARACT.DAT" FOR RANDOM AS #2 LEN = LEN(CHAR)
	MX = LOF(2) \ LEN(CHAR)
	FOR R = 1 TO MX
	GET #2, R + 1, Red
	IF RTRIM$(Red.Nam$) = Nam$ THEN PRINT Nam$ + " is already here.": R = -1: EXIT FOR
	NEXT
	IF R < 1 THEN RETURN
	PUT #2, MX + 2, CHAR
	CharCtl.NbrChar = MX + 1
	PUT #2, 1, CharCtl
	CLOSE
	RETURN
ADD.A.CHARACTER:
	CLS
	COLOR hfg%, hbg%
	PRINT SPC(30); "Add a Character"; SPC(30); " "
	COLOR fgc%, bgc%
	XM$ = "X"
GET.NEW.CHAR:
	GOSUB FIND.CHARACTER
	IF Esc THEN GOTO Main.Menu
	XM$ = " "
	IF FOUND OR Nam$ = "" THEN
	PRINT
	PRINT "Invalid name or already on file."
	GOTO GET.NEW.CHAR
	END IF
	LOCATE 10, 1
	PRINT "    Male or Female (M/F): ";
	VALID$ = "MF"
	GOSUB GET.KEYSTROKE
	SEX$ = A$
	PRINT SEX$
	HD = FNA(8)
	AG = FNA(8)
	CH = FNA(8)
	FOR X = 1 TO 5
	WA%(X) = DW%(X)
	NEXT
	FOR X = 1 TO 4
	SA%(X) = DS%(X)
	NEXT
	AE = 20
	GOLD& = 500
	BANK& = 300
	ArmNam$ = "Chain Mail"
	ArmHit = 4
	ArmAdj = 20
	ShdNam$ = "NONE"
	ShdHit = 0
	ShdAdj = 0
	FOR X = 1 TO 4
	WN$(X) = "NONE"
	WT%(X) = 0
	WC%(X) = 0
	WD%(X) = 0
	WS%(X) = 0
	NEXT
	GOSUB OPEN.CHARACTERS
	GOSUB READ.NBR.CHARS
	NC = NC + 1
	REC = NC + 1
	GOSUB WRITE.CHARACTER
	GOSUB WRITE.NBR.CHARS
	CLOSE
	Nam$(NC) = Nam$
	GOTO Main.Menu
INITIALIZE.FILE:
	RUN "INIT"
EDIT.CHAR:
	OPEN "LASTPGM" FOR OUTPUT AS #5
	PRINT #5, "WONDERFL"
	CLOSE 5
	ON ERROR GOTO NO.EDITOR
	RUN "EDITOR"
NO.EDITOR:
	RESUME Main.Menu
Go.on.Adventure:
	CLS
	RUN "CONTINUE"
	COLOR hfg%, hbg%
	PRINT SPC(25); "Go Adventuring... "; SPC(25); " "
	COLOR fgc%, bgc%
	GOSUB FIND.CHARACTER
	IF Esc THEN GOTO Main.Menu
	IF FOUND = 0 THEN GOSUB CHAR.NOT.FOUND: GOTO Main.Menu
	GOSUB OPEN.CHARACTERS
	GOSUB READ.CHARACTER
	IF flg%(5) = 0 THEN
	SAVE.NAME$ = Nam$
	GOSUB KILL.A.GUY
	Nam$ = SAVE.NAME$
	END IF
	CLOSE
	'===========
	IF NbrAdvs > 0 THEN GOTO PickfromList
Get.AdvPath:
	LOCATE 5, 1
	PRINT "   Insert Adventure Disk and Press any key  ";
	A$ = INPUT$(1)
	ON ERROR GOTO NoSuchPath
GONOW:
	IF INSTR(AdvPath$, ":") = 2 THEN DR$ = LEFT$(AdvPath$, 2): AdvPath$ = MID$(AdvPath$, 3): SHELL DR$
	IF AdvPath$ <> "" THEN CHDIR AdvPath$
	ON ERROR GOTO 0
	PRINT
	PRINT
	ON ERROR GOTO Not.Advent
	OPEN "EAMON.NAM" FOR INPUT AS #3
	INPUT #3, ADNAME$
	INPUT #3, Adv$
	CLOSE
	CLS
	LOCATE 5, 1
	PrtCenter "You are about to adventure in"
	PRINT
	COLOR hfg%, hbg%
	PrtCenter " " + Adv$ + " "
	COLOR fgc%, bgc%
	PRINT
	PRINT
	PRINT
	OPEN "EAMCOLOR" FOR OUTPUT AS #1
	PRINT #1, fgc%
	PRINT #1, bgc%
	PRINT #1, hfg%
	PRINT #1, hbg%
	PRINT #1, brt%
	CLOSE 1
	GOSUB Write.Meat
	ON ERROR GOTO NotValidAdv
	RUN ADNAME$
NotValidAdv:
	CHDIR MastPath$
	AdvPath$ = ""
	CLS
	LOCATE 12, 1
	PrtCenter "Adventure Program not found."
	LOCATE 24, 1
	PrtCenter "Press any key to continue..."
	A$ = INPUT$(1)
	CLS
	RESUME LoopAdv
Write.Meat:
	OPEN "MEAT" FOR OUTPUT AS #2
	WRITE #2, Nbr.Party
	GOSUB WRTMEAT
	WRITE #2, MastPath$
	CLOSE 2
	RETURN
SETPATH:
	CLS
	LOCATE 5, 1
	PRINT "   Enter Adventure Path (or press <RETURN>  "
	PRINT
	PRINT "   for the current drive/directory) ...     "
	PRINT
	PRINT "       ===> ";
	INPUT "", AdvPath$
	ReadDir AdvPath$, DNam$(), NbrAdvs
	IF NbrAdvs > 0 THEN GOTO Main.Menu
	PRINT
	PRINT
	ON ERROR GOTO Aint.Adventure
	OPEN "EAMON.NAM" FOR INPUT AS #3
	INPUT #3, ADNAME$
	INPUT #3, Adv$
	CLOSE
	ON ERROR GOTO 0
	GOTO Main.Menu
PathNotset:
	IF ERR <> 76 THEN GOTO Oops
	PRINT
	PRINT "Invalid path or path not found... Try again."
	PRINT
	RESUME SETPATH
Aint.Adventure:
	PRINT
	PRINT "Invalid Path, or adventure not found. Please Re-try..."
	PRINT
	PRINT "(Press any key to continue) ...";
	A$ = INPUT$(1)
	RESUME Get.AdvPath
NoSuchPath:
	IF ERR <> 76 THEN GOTO Oops
	PRINT
	PRINT "Invalid path or path not found... Try again."
	PRINT
	RESUME Get.AdvPath
Oops:
	PRINT "Error encountered ...  Error code "; ERR
	STOP
Not.Advent:
	PRINT
	PRINT "Invalid Path, or adventure not found. Please Re-try..."
	PRINT
	PRINT "(Press any key to continue) ...";
	A$ = INPUT$(1)
	RESUME Get.AdvPath
PickfromList:
	CLS
	Esc = 0
	A = 1
LoopAdv:
	LOCATE 4, 20
	PRINT "Press <RETURN> to adventure in ..."
	LOCATE 23, 1
	PRINT "Use Up/Down Arrows to change adventures"
	ON ERROR GOTO NoNameFile
	DO
	OPEN AdvPath$ + DNam$(A) + "\EAMON.NAM" FOR INPUT AS #1
	INPUT #1, X$, Adv$
	CLOSE 1
	LOCATE 6, 20, 0
	COLOR hfg%, hbg%
	PRINT Center$(Adv$, 40)
	COLOR fgc%, bgc%
	DO
		A$ = INKEY$
	LOOP UNTIL A$ <> ""
	IF A$ = CHR$(0) + CHR$(80) THEN
		IF A < NbrAdvs THEN A = A + 1
	END IF
	IF A$ = CHR$(0) + CHR$(81) THEN
		A = A + 10
		IF A > NbrAdvs THEN A = NbrAdvs
	END IF
	IF A$ = CHR$(0) + CHR$(73) THEN
		A = A - 10
		IF A < 1 THEN A = 1
	END IF
	IF A$ = CHR$(0) + CHR$(72) THEN
		IF A > 1 THEN A = A - 1
	END IF
	IF A$ = CHR$(0) + CHR$(71) THEN A = 1
	IF A$ = CHR$(0) + CHR$(79) THEN A = NbrAdvs
	IF A$ = CHR$(27) THEN Esc = -1: EXIT DO
	LOOP UNTIL A$ = CHR$(13)
	IF Esc THEN CLS : LOCATE 10, 1: GOTO Main.Menu
	IF AdvPath$ <> "" THEN
	AdvPath$ = AdvPath$ + DNam$(A)
	ELSE
	AdvPath$ = DNam$(A)
	END IF
	ON ERROR GOTO 0
	GOTO GONOW
NoNameFile:
	DNam$(A) = DNam$(NbrAdvs)
	NbrAdvs = NbrAdvs - 1
	IF A > NbrAdvs THEN A = NbrAdvs
	IF A = 0 THEN RESUME Get.AdvPath
	RESUME
	'===========
RESURRECT:
	CLS
	COLOR hfg%, hbg%
	PRINT SPC(78);
	PrtCenter "Character Resurrection"
	COLOR fgc%, bgc%
	PrtCenter "Say " + CHR$(34) + "Halleluiah!!" + CHR$(34)
	LOCATE 6, 10
	PRINT "Character to be resurrected:";
	GOSUB GET.ADVEN.NAME
	IF Esc THEN GOTO Main.Menu
	RNAM$ = I$
	REC = 0
	FOR R = 1 TO NC
	A$ = RTRIM$(UCASE$(Nam$(R)))
	IF LEFT$(A$, 1) = "*" THEN GOSUB MAYBE.RESURR
	NEXT
	IF REC > 0 THEN GOTO Main.Menu
	LOCATE 10, 10
	PRINT Nam$; " isn't dead or doesn't exist."
	CLOSE
	GOSUB PRESS.ANY.KEY
	GOTO Main.Menu
MAYBE.RESURR:
	IF MID$(A$, 2) <> UCASE$(RNAM$) THEN RETURN
	GOSUB Check.for.Dups
	Nam$(R) = MID$(Nam$(R), 2)
	GOSUB OPEN.CHARACTERS
	REC = R + 1
	GOSUB READ.CHARACTER
	Nam$ = RNAM$
	GOSUB WRITE.CHARACTER
	CLOSE
	LOCATE 10, 10
	PRINT "Very well, "; RNAM$; " has been resurrected."
	GOSUB PRESS.ANY.KEY
	RETURN
Check.for.Dups:
	FOR D = 1 TO NC
	IF UCASE$(Nam$(D)) = UCASE$(RNAM$) AND D <> R THEN RNAM$ = RNAM$ + " I"
	NEXT
	WHILE INSTR(RNAM$, " I ") > 0
	RNAM$ = LEFT$(RNAM$, INSTR(RNAM$, " I ") - 1) + " I"
	WEND
	RETURN
Champion:
	CLS
	PrtCenter "Declare a Champion"
	LOCATE 3, 1
	PRINT "Declaring a Champion gives you a way to play with the same character all"
	PRINT "the time without having to give your name each time you start the game."
	LOCATE 6, 10
	PRINT "Character to be declared:";
	GOSUB GET.ADVEN.NAME
	IF Esc THEN GOTO Main.Menu
	RNAM$ = I$
	REC = 0
	FOR R = 1 TO NC
	A$ = RTRIM$(UCASE$(Nam$(R)))
	IF A$ = UCASE$(I$) THEN REC = R + 1: EXIT FOR
	NEXT
	IF REC > 0 THEN GOTO Make.Champion
	GOTO Main.Menu
Make.Champion:
	OPEN "Champion" FOR OUTPUT AS #1
	PRINT #1, Nam$(R)
	PRINT #1, REC
	CLOSE 1
	GOTO Main.Menu
QUIT.RTN:
	CLOSE : CHDIR "..": RUN "MUSEUM"
	SYSTEM
	END
DDD.Disk:
	OPEN "EAMONCTL" FOR OUTPUT AS #1
	PRINT #1, "WONDERFL"
	CLOSE 1
	CLS : PRINT "Contact John Nelson or use the Eamon CD source files for DDD access."
	PRINT : PRINT "Hit any key..."
	DO
	LOOP UNTIL INKEY$ <> ""
	CLS : RUN
	RUN "DDD\DUNGMENU"
GET.ADVEN.NAME:
	V% = CSRLIN
	H% = POS(1)
	Esc = 0
GET.NM:
	LOCATE V%, H%
	INPUT "", I$
	Normalize I$
	IF I$ = "" THEN FOUND = 0: Esc = -1: RETURN
	IF LEFT$(UCASE$(I$), 1) < "A" OR LEFT$(UCASE$(I$), 1) > "Z" THEN GOTO GET.NM
	IF LEN(I$) > 20 THEN GOTO GET.NM
	RETURN
TABLE.CHARS:
	GOSUB OPEN.CHARACTERS
	GOSUB READ.NBR.CHARS
	FOR X = 1 TO NC
	GET #1, X + 1, CHAR
	Nam$(X) = RTRIM$(CHAR.Nam)
	NEXT
	CLOSE
	RETURN
FIND.CHARACTER:
	LOCATE 8, 12
	PRINT "Name of Adventurer:";
	GOSUB GET.ADVEN.NAME
	IF Esc THEN FOUND = 0: RETURN
	Nam$ = I$
	IF Nam$ = "" THEN FOUND = 0: RETURN
	FOUND = 0
	FOR X1 = 1 TO NC
	IF XM$ <> "X" THEN
	IF LEFT$(UCASE$(Nam$(X1)), LEN(Nam$)) = UCASE$(Nam$) THEN
		R = X1
		REC = X1 + 1
		X1 = NC
		FOUND = -1
	END IF
	END IF
	IF XM$ = "X" THEN IF UCASE$(Nam$(X1)) = UCASE$(Nam$) THEN R = X1: REC = X1 + 1: X1 = NC: FOUND = -1
	NEXT
	RETURN
CHAR.NOT.FOUND:
	LOCATE CSRLIN + 2, 30
	COLOR hfg%, hbg%
	PRINT "Character not Found";
	COLOR fgc%, bgc%
	CLOSE
	WaitaSec 5
	RETURN
REM $$INCL:'\EAMON\COPY\WRTMEAT.BAS'
WRTMEAT:
    WRITE #2, REC
    WRITE #2, Nam$
    WRITE #2, HD
    WRITE #2, AG
    WRITE #2, CH
    FOR X = 1 TO 4
    WRITE #2, SA%(X)
    NEXT
    FOR X = 1 TO 5
    WRITE #2, WA%(X)
    NEXT
    WRITE #2, SEX$
    WRITE #2, GOLD&
    WRITE #2, BANK&
    WRITE #2, AE
    WRITE #2, ArmNam$
    WRITE #2, ArmHit
    WRITE #2, ArmAdj
    WRITE #2, ShdNam$
    WRITE #2, ShdHit
    WRITE #2, ShdAdj
    FOR X = 1 TO 4
    WRITE #2, WN$(X)
    WRITE #2, WT%(X)
    WRITE #2, WC%(X)
    WRITE #2, WD%(X)
    WRITE #2, WS%(X)
    NEXT
    RETURN

    '------- (end of include file) -------
 '
REM $$INCL:'\Eamon\Copy\Chario.bas'
	' %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
	'
	'   Module:  CHARIO.BAS
	'   Eamon Version:  Eamon-QB (or Eamon-PC)
	' ------------------------------------------------------------
	'  Character File I/O Routines for Eamon QB/PC
	'        Basic version:  QuickBASIC 4.0, GW-BASIC, QBasic *
	'                        or BASIC 7.0 PDS
	'       uses User defined types for record definition
	'       This module will work for QBasic, but QBasic cannot
REM $$INCL:statements, so module must be built
	'       manually or merged using a utility
	' %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
	'
OPEN.CHARACTERS:
      OPEN "CHARACT.DAT" FOR RANDOM AS #1 LEN = LEN(CHAR)
      RETURN
READ.NBR.CHARS:
      GET #1, 1, CharCtl
      NC = CharCtl.NbrChar
      IF NC > LOF(1) \ LEN(CHAR) THEN NC = LOF(1) \ LEN(CHAR) - 1
      RETURN
READ.CHARACTER:
      GET #1, REC, CHAR
      Nam$ = RTRIM$(CHAR.Nam$)
      HD = CHAR.HD
      AG = CHAR.AG
      CH = CHAR.CH
      SA%(1) = CHAR.SA1
      SA%(2) = CHAR.SA2
      SA%(3) = CHAR.SA3
      SA%(4) = CHAR.SA4
      WA%(1) = CHAR.WA1
      WA%(2) = CHAR.WA2
      WA%(3) = CHAR.WA3
      WA%(4) = CHAR.WA4
      WA%(5) = CHAR.WA5
      SEX$ = CHAR.SEX
      GOLD& = CHAR.GOLD
      BANK& = CHAR.BANK
      AE = CHAR.AE
      ArmNam$ = RTRIM$(CHAR.ArmNam)
      ArmHit = CHAR.ArmHit
      ArmAdj = CHAR.ArmAdj
      ShdNam$ = RTRIM$(CHAR.ShdNam)
      ShdHit = CHAR.ShdHit
      ShdAdj = CHAR.ShdAdj
      WN$(1) = RTRIM$(CHAR.Wpn1Nam)
      WR%(1) = CHAR.Wpn1Typ
      WT%(1) = CHAR.Wpn1WpnTyp
      WC%(1) = CHAR.Wpn1Odds
      WD%(1) = CHAR.Wpn1Dice
      WS%(1) = CHAR.Wpn1Sides
      WN$(2) = RTRIM$(CHAR.Wpn2Nam)
      WR%(2) = CHAR.Wpn2Typ
      WT%(2) = CHAR.Wpn2WpnTyp
      WC%(2) = CHAR.Wpn2Odds
      WD%(2) = CHAR.Wpn2Dice
      WS%(2) = CHAR.Wpn2Sides
      WN$(3) = RTRIM$(CHAR.Wpn3Nam)
      WR%(3) = CHAR.Wpn3Typ
      WT%(3) = CHAR.Wpn3WpnTyp
      WC%(3) = CHAR.Wpn3Odds
      WD%(3) = CHAR.Wpn3Dice
      WS%(3) = CHAR.Wpn3Sides
      WN$(4) = RTRIM$(CHAR.Wpn4Nam)
      WR%(4) = CHAR.Wpn4Typ
      WT%(4) = CHAR.Wpn4WpnTyp
      WC%(4) = CHAR.Wpn4Odds
      WD%(4) = CHAR.Wpn4Dice
      WS%(4) = CHAR.Wpn4Sides
      RETURN
WRITE.CHARACTER:
      CHAR.Nam = Nam$
      CHAR.HD = HD
      CHAR.AG = AG
      CHAR.CH = CH
      CHAR.SA1 = SA%(1)
      CHAR.SA2 = SA%(2)
      CHAR.SA3 = SA%(3)
      CHAR.SA4 = SA%(4)
      CHAR.WA1 = WA%(1)
      CHAR.WA2 = WA%(2)
      CHAR.WA3 = WA%(3)
      CHAR.WA4 = WA%(4)
      CHAR.WA5 = WA%(5)
      CHAR.SEX = SEX$
      CHAR.GOLD = GOLD&
      CHAR.BANK = BANK&
      CHAR.AE = AE
      CHAR.ArmNam = ArmNam$
      CHAR.ArmHit = ArmHit
      CHAR.ArmAdj = ArmAdj
      CHAR.ShdNam = ShdNam$
      CHAR.ShdHit = ShdHit
      CHAR.ShdAdj = ShdAdj
      CHAR.Wpn1Nam = WN$(1)
      CHAR.Wpn1Typ = WR%(1)
      CHAR.Wpn1WpnTyp = WT%(1)
      CHAR.Wpn1Odds = WC%(1)
      CHAR.Wpn1Dice = WD%(1)
      CHAR.Wpn1Sides = WS%(1)
      CHAR.Wpn2Nam = WN$(2)
      CHAR.Wpn2Typ = WR%(2)
      CHAR.Wpn2WpnTyp = WT%(2)
      CHAR.Wpn2Odds = WC%(2)
      CHAR.Wpn2Dice = WD%(2)
      CHAR.Wpn2Sides = WS%(2)
      CHAR.Wpn3Nam = WN$(3)
      CHAR.Wpn3Typ = WR%(3)
      CHAR.Wpn3WpnTyp = WT%(3)
      CHAR.Wpn3Odds = WC%(3)
      CHAR.Wpn3Dice = WD%(3)
      CHAR.Wpn3Sides = WS%(3)
      CHAR.Wpn4Nam = WN$(4)
      CHAR.Wpn4Typ = WR%(4)
      CHAR.Wpn4WpnTyp = WT%(4)
      CHAR.Wpn4Odds = WC%(4)
      CHAR.Wpn4Dice = WD%(4)
      CHAR.Wpn4Sides = WS%(4)
      PUT #1, REC, CHAR
      RETURN
WRITE.NBR.CHARS:
      CharCtl.NbrChar = NC
      PUT #1, 1, CharCtl
      RETURN

    '------- (end of include file) -------
 '
GET.KEYSTROKE:
	A$ = ""
	WHILE A$ = ""
	  A$ = INKEY$
	WEND
	A$ = UCASE$(A$)
	IF VALID$ = "" THEN RETURN
	IF INSTR(VALID$, A$) > 0 THEN RETURN
	GOTO GET.KEYSTROKE
SetColor:
	CLS
	F = 8
	savfg% = fgc%
	savbg% = bgc%
	LOCATE 8, 10
	PRINT " Normal Text / Background ...           ";
	LOCATE 10, 10
	PRINT " Hi-Lited Text / Hi-Lite Background ... ";
	LOCATE 24, 1
	PRINT " F5 = FG Color Change    F6 = BG Color Change     Tab = Next     <Esc> - Exit";
	DO
	LOCATE 8, 52
	COLOR fgc%, bgc%
	PRINT " Sample ";
	LOCATE 10, 52
	COLOR hfg%, hbg%
	PRINT " Sample ";
	COLOR savfg%, savbg%
	LOCATE 22, 71
	PRINT MID$(" N", flg%(1) * -1 + 1, 1);
	LOCATE 22, 72
	PRINT MID$(" O", flg%(2) * -1 + 1, 1);
	LOCATE 22, 73
	PRINT MID$(" F", flg%(3) * -1 + 1, 1);
	LOCATE 22, 75
	PRINT MID$(" K", flg%(5) * -1 + 1, 1);
	LOCATE 22, 74
	PRINT MID$(" D", flg%(4) * -1 + 1, 1);
	SELECT CASE F
	CASE 8
		wkf% = fgc%
		wkb% = bgc%
	CASE 10
		wkf% = hfg%
		wkb% = hbg%
	CASE 12
		wkf% = brt%
		wkb% = bgc%
	CASE 14
		wkf% = hdf%
		wkb% = hdb%
	CASE 16
		wkf% = brt%
		wkb% = brb%
	CASE ELSE
	END SELECT
	LOCATE F, 6
	COLOR savfg%, savbg%
	PRINT "==> ";
	A$ = ""
	WHILE A$ = ""
	A$ = INKEY$
	WEND
	IF A$ = CHR$(0) + CHR$(63) THEN
	wkf% = wkf% + 1
	IF wkf% > 15 THEN wkf% = 0
	END IF
	IF A$ = CHR$(0) + CHR$(64) THEN
	wkb% = wkb% + 1
	IF wkb% > 7 THEN wkb% = 0
	END IF
	SELECT CASE F
	CASE 8
		fgc% = wkf%
		bgc% = wkb%
	CASE 10
		hfg% = wkf%
		hbg% = wkb%
	CASE 12
		brt% = wkf%
		bgc% = wkb%
	CASE 14
		hdf% = wkf%
		hdb% = wkb%
	CASE 16
		brt% = wkf%
		brb% = wkb%
	CASE ELSE
	END SELECT
	IF A$ = CHR$(9) THEN
	LOCATE F, 6
	COLOR savfg%, savbg%
	PRINT "    ";
	F = F + 2
	IF F > 10 THEN F = 8
	'IF F > 16 THEN F = 8
	END IF
	IF A$ = CHR$(0) + CHR$(15) THEN
	LOCATE F, 6
	COLOR savfg%, savbg%
	PRINT "    ";
	F = F - 2
	IF F < 8 THEN F = 10
	'IF F < 8 THEN F = 16
	END IF
	IF A$ = CHR$(0) + CHR$(68) THEN
	flg%(4) = NOT flg%(4)
	LOCATE 22, 74
	COLOR savfg%, savbg%
	PRINT MID$(" D", flg%(4) * -1 + 1, 1);
	END IF
	IF A$ = CHR$(0) + CHR$(62) THEN
	flg%(3) = NOT flg%(3)
	LOCATE 22, 73
	COLOR savfg%, savbg%
	PRINT MID$(" F", flg%(3) * -1 + 1, 1);
	END IF
	IF A$ = CHR$(0) + CHR$(61) THEN
	flg%(2) = NOT flg%(2)
	LOCATE 22, 72
	COLOR savfg%, savbg%
	PRINT MID$(" O", flg%(2) * -1 + 1, 1);
	END IF
	IF A$ = CHR$(0) + CHR$(60) THEN
	flg%(5) = NOT flg%(5)
	LOCATE 22, 75
	COLOR savfg%, savbg%
	PRINT MID$(" K", flg%(5) * -1 + 1, 1);
	END IF
	LOOP UNTIL A$ = CHR$(27) OR A$ = CHR$(13)
	LOCATE 14, 10
	INPUT "Magic Word:", N$
	flg%(1) = (N$ = SecretWord$)
	OPEN Path$ + "EAMCOLOR" FOR OUTPUT AS #1
	PRINT #1, fgc%
	PRINT #1, bgc%
	PRINT #1, hfg%
	PRINT #1, hbg%
	PRINT #1, brt%
	FOR X = 1 TO 5
	PRINT #1, flg%(X)
	NEXT
	PRINT #1, SecretWord$
	CLOSE 1
	GOTO Main.Menu
No.Version:
	CLOSE
	Lin1$ = "Eamon"
	Lin2$ = "Original Game by Donald Brown"
	Lin4$ = "MS-DOS Version 2.81"
	Lin3$ = "01/03/2000"
	Lin5$ = "by John Nelson"
	OPEN "Version.Txt" FOR OUTPUT AS #1
	PRINT #1, Lin1$
	PRINT #1, Lin2$
	PRINT #1, Lin3$
	PRINT #1, Lin4$
	PRINT #1, Lin5$
	CLOSE 1
	RESUME GoVer

FUNCTION Center$ (L$, cols%)
	L = (cols% - LEN(L$)) \ 2
	Center$ = SPACE$(L) + L$ + SPACE$(cols% - LEN(L$) - L)
END FUNCTION

SUB Normalize (Nam$)
	Nam$ = UCASE$(Nam$)
	ND = 8
	REDIM N$(ND)
	WHILE INSTR(Nam$, " ") > 0
	p = INSTR(Nam$, " ")
	N$(X) = LEFT$(Nam$, p - 1)
	Nam$ = MID$(Nam$, p + 1)
	X = X + 1
	WEND
	N$(X) = Nam$
	Nam$ = ""
	FOR N = 0 TO X
	N$(N) = LTRIM$(N$(N))
	IF N$(N) <> "OF" AND N$(N) <> "THE" AND N$(N) <> "AT" AND N$(N) <> "FROM" THEN
		Nam$ = Nam$ + UCASE$(LEFT$(N$(N), 1)) + LCASE$(MID$(N$(N), 2)) + " "
	ELSE
		Nam$ = Nam$ + LCASE$(N$(N)) + " "
	END IF
	NEXT
	Nam$ = LTRIM$(RTRIM$(Nam$))

END SUB

SUB PrtCenter (L$)
	LOCATE , (80 - LEN(L$)) \ 2 + 1
	PRINT L$
END SUB

SUB ReadDir (MPath$, DNam$(), NbrAdvs)
	SHELL "DIR ADV* >DIRFIL"
	OPEN "DIRFIL" FOR INPUT AS #1
	MaxDir = 300
	ArenaSw = 0
	REDIM DNam$(MaxDir)
	NbrAdvs = 0
	DO UNTIL EOF(1)
	  LINE INPUT #1, DLin$
	  Dov = INSTR(DLin$, "Directory of ")
	  IF Dov > 0 THEN MPath$ = MID$(DLin$, Dov + 13)
	  I = INSTR(DLin$, "<DIR>")
	  IF I > 0 THEN
		  IF LEFT$(DLin$, 3) = "ADV" THEN
		  NbrAdvs = NbrAdvs + 1
		  DNam$(NbrAdvs) = LEFT$(DLin$, 12)
		  END IF
	  ELSE
		  V = INSTR(DLin$, "EAMON")
		  N = INSTR(DLin$, "NAM")
		  IF V = 1 AND N > V THEN
		  NbrAdvs = NbrAdvs + 1
		  DNam$(NbrAdvs) = "."
		  END IF
	  END IF
	  A = INSTR(DLin$, "ARENA")
	  IF A > 0 THEN ArenaSw = -1
	LOOP
	CLOSE 1
	Sort DNam$(), NbrAdvs
	Path$ = MPath$


END SUB

SUB Sort (AN$(), NA)
	IM = NA
SRT.1:
	IM = INT(IM / 2)
	IF IM = 0 THEN EXIT SUB
	K = NA - IM
	J = 1
SRT.2:
	I = J
SRT.3:
	L = I + IM
	IF AN$(I) <= AN$(L) THEN GOTO SRT.4
	SWAP AN$(I), AN$(L)
	' SWAP REC%(I), REC%(L)
	I = I - IM
	IF I >= 1 THEN GOTO SRT.3
SRT.4:
	J = J + 1
	IF J <= K THEN GOTO SRT.2
	GOTO SRT.1



END SUB

SUB WaitaSec (Waitsecs)
	
	SavTim! = TIMER + Waitsecs
	WHILE SavTim! > TIMER
		A$ = INKEY$
		IF A$ <> "" THEN SavTim! = 0
	WEND

END SUB

