'                      Eamon
'
'                    Main  Hall
'
'
'             Buy weapons and armour
'             to prepare for adventure
'
'
'
'                   By Donald Brown
'
'
'        Converted to MS-DOS machines by John Nelson
'
    DEFINT A-Z
    DECLARE SUB PrtCenter (L$)
    DECLARE SUB Sort (AN$(), NA%)
    DECLARE FUNCTION Center$ (L$, cols%)
    DECLARE SUB WINDLIST (L, P, W, H, fgc%, bgc%, hfg%, hbg%, HDR$, hdf%, hdb%, Lst$(), Maxit, Mintags, Maxtags, S, sd)
    DECLARE SUB ReadDir (Path$, DNam$(), D%)
    DECLARE SUB PrtCenter (L$)
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 MN$(1), MD%(0, 3), Lst$(50)
    DIM NC AS INTEGER
    DIM flg%(6)
    ON ERROR GOTO NoColors
    OPEN "EAMCOLOR" FOR INPUT AS #1
    INPUT #1, fgc%
    INPUT #1, bgc%
    INPUT #1, hfg%
    INPUT #1, hbg%
    INPUT #1, brt%
    FOR x = 1 TO 5
    INPUT #1, flg%(x)
    NEXT
    CLOSE
In.BW:
'    ON ERROR GOTO GET.ATTAHERE
     ON ERROR GOTO 0
INITIALIZE:
    DIM WN$(4), WR%(4), WT%(4), WC%(4), WD%(4), WS%(4), WA%(5), SA%(4)
    DIM Arm$(3), WTYP$(5)
    DIM DNam$(x)
    MPath$ = ""
    EditorSw$ = "E"
    ReadDir MPath$, DNam$(), D%
    MastPath$ = MPath$
    READ NBR.SPELL
    DIM SPL.NAM$(NBR.SPELL), SPL.PRIC%(NBR.SPELL)
    FOR x = 1 TO NBR.SPELL
    READ SPL.NAM$(x), SPL.PRIC%(x)
    NEXT
    DATA 4
    DATA "Blast",2000
    DATA "Heal",400
    DATA "Speed",5000
    DATA "Power",100
    TYPE WeaponRecord
	Nam     AS STRING * 20
	Typ     AS INTEGER
	Odds    AS INTEGER
	Dice    AS INTEGER
	Sides   AS INTEGER
	Price   AS INTEGER
    END TYPE
    OPEN "Weaponry.Dat" FOR INPUT AS #4
    INPUT #4, Nbr.Weapons
    DIM Weapon(Nbr.Weapons) AS WeaponRecord
    FOR x = 1 TO Nbr.Weapons
	INPUT #4, Nam$, Typ, Cmp, Dice, Sides, Price
	Weapon(x).Nam = Nam$
	Weapon(x).Typ = Typ
	Weapon(x).Odds = Cmp
	Weapon(x).Dice = Dice
	Weapon(x).Sides = Sides
	Weapon(x).Price = Price
    NEXT
    CLOSE 4
    OPEN "Armory.Dat" FOR INPUT AS #4
    INPUT #4, Nbr.Arm
    DIM ArmorNam$(Nbr.Arm), ArmorHit%(Nbr.Arm), ArmorAdj%(Nbr.Arm), ArmorPrice%(Nbr.Arm)
    FOR x = 1 TO Nbr.Arm
	INPUT #4, ArmorNam$(x), ArmorHit%(x), ArmorAdj%(x), ArmorPrice%(x)
    NEXT
    INPUT #4, Nbr.Shd
    DIM ShieldNam$(Nbr.Shd), ShieldHit%(Nbr.Shd), ShieldAdj%(Nbr.Shd), ShieldPrice%(Nbr.Shd)
    FOR x = 1 TO Nbr.Shd
	INPUT #4, ShieldNam$(x), ShieldHit%(x), ShieldAdj%(x), ShieldPrice%(x)
    NEXT
    CLOSE 4
    FOR x = 1 TO 5
    READ WTYP$(x)
    NEXT
    DATA Axe,Bow,Mace,Spear,Sword
    RANDOMIZE TIMER
    LOCATE , , 1
    ON ERROR GOTO get.attahere
    OPEN "ADVENT" FOR INPUT AS #1
    INPUT #1, Nam$, REC
    CLOSE
    ON ERROR GOTO 0
    GOSUB OPEN.CHARACTERS
    GOSUB READ.CHARACTER
    CLOSE
    DEF FNP (x) = INT(x * RTIO! + .5)
    COLOR fgc%, bgc%
Main.Menu:
    PRINT
    PRINT "Wandering around the hall, you discover you can do any of these things:"
    PRINT
    PRINT "  1 - Set out for adventure"
    PRINT "  2 - Visit the weapons shop for weapons and armour"
    PRINT "  3 - Hire a Wizard to teach you some spells"
    PRINT "  4 - Find the banker and deposit or withdraw gold"
    PRINT "  5 - Examine your abilities"
    PRINT "  6 - Get some weapon training"
    PRINT "  7 - Temporarily leave the Universe"
    PRINT
    PRINT "(Press the Key for your choice): ";
    VALID$ = "1234567"
    VALID$ = VALID$ + EditorSw$
    GOSUB GET.KEYSTROKE
    IF A$ = "E" THEN GOTO RUNEDITOR
    CMD = VAL(A$)
    PRINT
    ON CMD GOTO GO.ON.ADVENTURE, WEAPONS.SHOP, MAGIC.SHOP, BANKER, DISPLAY.CHARACTER, TRAINING, LEAVE.NOW
GO.ON.ADVENTURE:
    CLS
    GOSUB OPEN.CHARACTERS
    SAVE.NAM$ = Nam$
    IF flg%(5) = 0 THEN
	Nam$ = "*" + Nam$
	GOSUB WRITE.CHARACTER
    END IF
    CLOSE
    Nam$ = SAVE.NAM$
    CLS
    IF D% > 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$
    PRINT
    PRINT
    ON ERROR GOTO Aint.Adventure
    OPEN "EAMON.NAM" FOR INPUT AS #3
    INPUT #3, ADName$
    INPUT #3, Adv$
    CLOSE
    CLS
    LOCATE 5, 1
    PRINT "You are about to adventure in"
    PRINT
    COLOR hfg%, hbg%
    PRINT " "; 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
SetPath:
    CLS
    LOCATE 5, 1
    PRINT "Enter Adventure path (or press <RETURN> "
    PRINT
    PRINT "  for current drive / directory) ..."
    PRINT
    PRINT "===> ";
    INPUT "", AdvPath$
    ReadDir AdvPath$, DNam$(), D%
    IF D% > 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. Re-try..."
    PRINT
    RESUME SetPath
NoSuchPath:
    IF ERR <> 76 THEN GOTO Oops
    PRINT
    PRINT "Invalid Path or path not found. Re-try..."
    PRINT
    RESUME Get.AdvPath
Oops:
    PRINT "Error "; ERR; " found."
    STOP
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
WEAPONS.SHOP:
    PRINT
    PRINT "As you enter the weapon shop, Marcos Cavielli (the owner) comes out of"
    PRINT "the back room and says, 'Well, as I live and breathe! If it isn't my old pal"
    PRINT Nam$; "! So, you want to buy a weapon, sell a weapon, or"
    PRINT "get some better armour?"
    PRINT
    PRINT "(Press the key, B S OR A)   ";
    C2 = CH + INT(11 * RND(1) - 5)
    C2 = C2 - (C2 = 0)
    RTIO! = 10 / C2
    VALID$ = "BSA"
    GOSUB GET.KEYSTROKE
    TR = INSTR(VALID$, A$)
    PRINT
    ON TR GOTO BUY.WEAPON, SELL.WEAPON, BUY.ARMOUR
BUY.WEAPON:
    A$ = "NONE"
    GOSUB FIND.WEAPON
    IF F = 0 THEN
	PRINT "Marcos smiles at you and says, 'Thatsa good, but first you gotta sell me a"
	PRINT "weapon. You know the law--no more than four weapons per person!'"
	PRINT
	GOTO SELL.WEAPON
    END IF
    WR = F
    PRINT "Marcos smiles at you and says, 'Good. I gotta the best. Here's a list of my"
    PRINT "most popular weapons.' He hands you an old tattered paper with a list of"
    PRINT "weapons ..."
    FOR x = 1 TO Nbr.Weapons
	PRINT USING "##. "; x;
	PRINT Weapon(x).Nam
    NEXT
    PRINT
    PRINT "Input the number of the weapon you want (or N for nothing) ";
GET.WEAPON.ID:
    INPUT "", A$
    IF UCASE$(A$) = "N" THEN PRINT A$: GOTO WEAPONS.SHOO
    IF VAL(A$) > Nbr.Weapons OR VAL(A$) < 1 THEN GOTO GET.WEAPON.ID
    PRINT Weapon(VAL(A$)).Nam
    BUY = VAL(A$)
    BP = Weapon(BUY).Price
    MGC = 0
    PRINT
    PRINT "Marcos says, 'Well, I just happen to have three "; RTRIM$(Weapon(BUY).Nam); "s in, of varying"
    PRINT "quality. I've got a very good one for"; FNP(1.5 * BP); " GP, a fair one for "; FNP(BP); " GP,"
    PRINT "and a kinda shabby one for "; FNP(BP / 2)
    PRINT "Which do you want?'"
    PRINT
    PRINT "(Press the key, G F P or N for nothing)   ";
    VALID$ = "PFGN"
    GOSUB GET.KEYSTROKE
    IF A$ = "N" THEN GOTO Ask.Armor
    Q = INSTR(VALID$, A$)
    TAKE = BP * .5 * Q
    TAKE = FNP(TAKE)
    IF TAKE > GOLD& THEN PRINT : PRINT "Marcos shakes a finger at you and says, 'You shouldn't play tricks on an old": PRINT "friend!": GOTO Main.Menu
    WN$(WR) = RTRIM$(Weapon(BUY).Nam)
    WT%(WR) = Weapon(BUY).Typ
    WC%(WR) = 10 * (Q - 2) + Weapon(BUY).Odds + MGC * 25
    WD%(WR) = Weapon(BUY).Dice + MGC
    WS%(WR) = Weapon(BUY).Sides + 2 * MGC
    GOLD& = GOLD& - TAKE
    GOSUB MAGIC.NAME
    PRINT "Marcos hands you your weapon and takes the price from you."
Ask.Armor:
    PRINT
    PRINT "He now asks you, 'Now how about some armour?'"
    PRINT
    PRINT "(Press Y OR N)   ";
    VALID$ = "YN"
    GOSUB GET.KEYSTROKE
    IF A$ = "N" THEN PRINT : GOTO WEAPONS.SHOO
    GOTO BUY.ARMOUR
WEAPONS.SHOO:
    PRINT "Marcos smiles and says, 'Come back again soon!' as he shoos you out of his"
    PRINT "shop."
    PRINT
    GOTO Main.Menu
SELL.WEAPON:
    PRINT
    PRINT "Marcos says, 'Okay, what've you got?"
    PRINT
    PRINT "(Enter the weapon name)";
    INPUT "", I$
    A$ = UCASE$(I$)
    IF A$ = "NONE" THEN GOTO Main.Menu
    GOSUB FIND.WEAPON
    IF F = 0 THEN PRINT : PRINT "Marcos frowns at you and says, 'You can't sell a weapon you don't own!'": PRINT : GOTO WEAPONS.SHOO
    P = (WD%(F) * WS%(F)) ^ 2 + WC%(F) * 2
    P = FNP(P)
    IF P < 0 THEN P = 2
    PRINT "Marcos says he can only give you "; P; "gold pieces for it."
    TAKE = P
    GOSUB SELL.HAGGLE
    IF DO.SW = 0 THEN GOTO WEAPONS.SHOO
    PRINT "Marcos gives you your money and takes your weapon."
    PRINT
    GOLD& = GOLD& + TAKE
    FOR W2 = F TO 3
    WN$(W2) = WN$(W2 + 1)
    WT%(W2) = WT%(W2 + 1)
    WC%(W2) = WC%(W2 + 1)
    WD%(W2) = WD%(W2 + 1)
    WS%(W2) = WS%(W2 + 1)
    NEXT
    WN$(4) = "NONE"
    WT%(4) = 0
    WC%(4) = 0
    WD%(4) = 0
    WS%(4) = 0
    PRINT
    PRINT "Marcos asks you, 'How about buying a weapon?'"
    PRINT
    PRINT "(Press Y OR N)   ";
    VALID$ = "YN"
    GOSUB GET.KEYSTROKE
    IF A$ = "Y" THEN PRINT A$: PRINT : GOTO BUY.WEAPON
    PRINT
    GOTO WEAPONS.SHOO
BUY.ARMOUR:
    TI = 0
    IF ArmHit > 0 THEN TI = 20 * ArmHit - ArmAdj: IF TI < 10 THEN TI = 5
    PRINT "Marcos takes you to the armour section of his shop and shows you suits of"
    PRINT "armour. He tells you he has these kinds..."
SHOW.ARMOR:
    FOR x = 1 TO Nbr.Arm
    PRINT USING "##. "; x;
    PRINT ArmorNam$(x); TAB(50);
    PRINT USING "#,###"; FNP(ArmorPrice%(x))
    NEXT
    PRINT
    IF TI THEN PRINT "Also, I can give you a trade-in on your old armour of "; TI; " gold pieces.": PRINT
    PRINT "Well, what will it be?'"
    PRINT
    PRINT "(Press N for Nothing or # of Armour)  ";
    INPUT "", I$
    IF UCASE$(I$) = "N" THEN GOTO Now.Shield
    IF VAL(I$) < 1 OR VAL(I$) > Nbr.Arm THEN PRINT : PRINT "That's not on the list! - Try again!!": GOTO SHOW.ARMOR
    BUY = VAL(I$)
    TAKE = FNP(ArmorPrice%(BUY))
    PRINT
    PRINT "I want "; TAKE; " gp for that."
    GOSUB BUY.HAGGLE
    IF DO.SW = 0 THEN GOTO WEAPONS.SHOO
    IF TAKE > GOLD& THEN PRINT "Marcos frowns when he sees that you do not have enough to pay for your": PRINT "armour and says, 'I don't give credit!'": PRINT : GOTO Now.Shield
    ArmNam$ = ArmorNam$(BUY)
    ArmHit = ArmorHit%(BUY)
    ArmAdj = ArmorAdj%(BUY)
    PRINT "Marcos takes your ";
    IF TI THEN PRINT "old armour and your ";
    PRINT "gold and helps you into your new armour."
    PRINT
    GOLD& = GOLD& - TAKE
Now.Shield:
    PRINT "Marcos smiles and says, 'Now how about a shield? I can let you have any "
    PRINT "of these real cheap! "
    FOR x = 1 TO Nbr.Shd
	PRINT USING "##. "; x;
	PRINT ShieldNam$(x);
	PRINT TAB(50); ShieldPrice%(x)
    NEXT
    PRINT
    PRINT "(Press N for Nothing or # of Shield)  ";
    INPUT "", I$
    IF UCASE$(I$) = "N" THEN GOTO WEAPONS.SHOO
    IF VAL(I$) < 1 OR VAL(I$) > Nbr.Shd THEN PRINT : PRINT "That's not on the list! - Try again!!": GOTO Now.Shield
    BUY = VAL(I$)
    TAKE = FNP(ShieldPrice%(BUY))
    PRINT
    PRINT "I want "; TAKE; " gp for that."
    GOSUB BUY.HAGGLE
    IF DO.SW = 0 THEN GOTO WEAPONS.SHOO
    IF TAKE > GOLD& THEN PRINT "Marcos frowns when he sees that you do not have enough to pay for your": PRINT "armour and says, 'I don't give credit!'": PRINT : GOTO Now.Shield
    GOLD& = GOLD& - ShieldPrice%(BUY)
    ShdNam$ = ShieldNam$(BUY)
    ShdHit = ShieldHit%(BUY)
    ShdAdj = ShieldAdj%(BUY)
    PRINT "Marcos takes your gold and gives you the "; ShdNam$; " shield."
    PRINT
    PRINT
    GOTO Main.Menu
MAGIC.NAME:
    IF MGC = 0 THEN RETURN
    PRINT
    PRINT "'Since that is a magic weapon, you may name it yourself.'"
    PRINT
    PRINT "What do you want to call it? ";
GET.MAGIC.NAME:
    INPUT "", I$
    IF I$ = "" THEN PRINT "You must give it a name!!": GOTO GET.MAGIC.NAME
    FOR x = 1 TO NBR.WEAP
    IF I$ = Weapon(x).Nam THEN I$ = "MAGIC " + Weapon(x).Nam: x = NBR.WEAP
    NEXT
    WN$(WR) = I$
    RETURN
MAGIC.SHOP:
    PRINT
    PRINT "After a few minutes diligent searching, you find Hokas Tokas, the old mage."
    PRINT "He looks at you and says, 'So you want old Hokey to teach you some magic, eh?"
    PRINT "Well, it'll cost you. Today my fees are:"
    C2 = CH + INT(11 * RND(1) - 5)
    C2 = C2 + ABS(C2 = 0)
    RTIO! = 10 / C2
    FOR x = 1 TO NBR.SPELL
    PRINT x; ". "; SPL.NAM$(x); TAB(25);
    PRINT USING "##,###"; FNP(SPL.PRIC%(x));
    PRINT " GP"
    NEXT
    PRINT
    PRINT "Well, which will it be?'"
    PRINT
    PRINT "(Press the key for your spell:"
    PRINT "   N for nothing, or # of Spell)   ";
GET.SPELL:
    INPUT "", A$
    IF UCASE$(A$) = "N" THEN GOTO HOKAS.LEAVES
    IF VAL(A$) > NBR.SPELL OR VAL(A$) < 1 THEN GOTO GET.SPELL
    SP = VAL(A$)
    PRINT SPL.NAM$(SP)
    P = FNP(SPL.PRIC%(SP))
    PRINT
    IF P > GOLD& THEN PRINT "When Hokas sees that you don't have enough to pay him, he stalks to the": PRINT "bar, muttering about youngsters who should be turned into frogs.": PRINT : GOTO Main.Menu
    IF SA%(SP) THEN GOTO ALREADY.KNOW
    GOLD& = GOLD& - P
    SA%(SP) = INT(50 * RND(1) + 26)
    PRINT "Hokas teaches you your spell, takes his fee, and returns to his stool at"
    PRINT "the bar.  As you walk away you hear him order a double dragon blomb."
    PRINT
    GOTO Main.Menu
HOKAS.LEAVES:
    PRINT
    PRINT
    PRINT "As you leave, you hear Hokas muttering about cheapskate adventurers always"
    PRINT "wanting something for nothing."
    PRINT
    GOTO Main.Menu
ALREADY.KNOW:
    PRINT "Hokas says, 'I ought to take your gold anyway, but haven't you forgotten"
    PRINT "something?  I already taught you that spell!'"
    PRINT
    PRINT "Shaking his head sadly, he returns to the bar."
    PRINT
    GOTO Main.Menu
BANKER:
    PRINT
    PRINT "You have no trouble spotting Shylock McFinney, the local banker, due to his"
    PRINT "large belly."
    PRINT
    PRINT "You attract his attention, and he comes over to you and says, 'Well,"
    PRINT Nam$; ", my dear "; MID$("girlboy", -(SEX$ = "M") * 4 + 1, 4); ", what a pleasure to see you!"
    PRINT " Do you want ";
    PRINT "to make a deposit or a withdrawl?'"
    PRINT
    PRINT "(Press 'D' for deposit, 'W' for withdrawl)   ";
    VALID$ = "DW"
    GOSUB GET.KEYSTROKE
    IF A$ = "D" THEN PRINT : GOTO DEPOSIT
' ====== WITHDRAW ======
    PRINT
    PRINT "Shylock says, 'Well, you have "; BANK&; "gold pieces stored with me.  How many"
    PRINT "do you want to take back?'"
    PRINT
GET.WD:
    PRINT "(Enter the number of gold pieces to"
    PRINT "   withdraw)  ";
    INPUT "", I$
    A$ = I$
    MNY = VAL(I$)
    IF MNY < 0 OR MNY <> INT(MNY) OR MID$(STR$(MNY), 2) <> A$ THEN PRINT : PRINT "The banker scowls and says,'Come, Come, you're not making sense!  Try again.'": PRINT : GOTO GET.WD
    IF MNY > BANK& THEN GOTO WD.TOO.MUCH
    GOLD& = GOLD& + MNY
    BANK& = BANK& - MNY
    PRINT
    PRINT "The banker hands you your gold and says, 'That leaves you with "; BANK&
    PRINT "pieces in my care.'  He shakes your hand and walks away."
    PRINT
    GOTO Main.Menu
DEPOSIT:
    PRINT "Shylock gets a wide grin on his face and says, 'Good for you!  How much do"
    PRINT "you want to deposit?'"
GET.AMT.DEP:
    PRINT
    PRINT "(Enter the amount you want to deposit)"
    PRINT " ";
    INPUT "", I$
    MNY = VAL(I$)
    IF MNY < 1 OR MNY <> INT(MNY) THEN PRINT : PRINT "The banker scowls at you and says, 'Come, Come, you're not making sense!": PRINT "Try again.'": PRINT : GOTO GET.AMT.DEP
    IF MNY > GOLD& THEN GOTO DEP.TOO.MUCH
    GOLD& = GOLD& - MNY
    BANK& = BANK& + MNY
    PRINT "Shylock takes your money, puts it in his bag, listens to it jingle, then"
    PRINT "thanks you and walks away."
    PRINT
    GOTO Main.Menu
WD.TOO.MUCH:
    PRINT
    PRINT "The banker throws you a terrible glance and says, 'That's more than you've got!"
    PRINT "You know I don't make loans to your kind!'  With that he loses himself in"
    PRINT "the crowd."
    PRINT
    GOTO Main.Menu
DEP.TOO.MUCH:
    PRINT
    PRINT "The banker was very pleased when you told him the sum, but when he discovered"
    PRINT "that you didn't have that much on you, he walked away, shouting about fools"
    PRINT "who play tricks on a kindly banker."
    PRINT
    GOTO Main.Menu
DISPLAY.CHARACTER:
    CLS
    PRINT "You are the "; MID$("mighty fair ", 1 + 7 * -(SEX$ = "F"), 7); Nam$
    PRINT
    PRINT "Your attributes are:";
    PRINT "  Hardiness"; HD; "  Agility"; AG; "  Charisma"; CH
    PRINT
    PRINT "You know the following spells--"
    SM = 0
    FOR S = 1 TO 4
    IF SA%(S) THEN PRINT SPL.NAM$(S); "  "; : SM = -1
    NEXT
    IF NOT SM THEN PRINT "   None";
    PRINT
    PRINT
    PRINT "Your Weapon Abilities are --"
    FOR W = 1 TO 5
    PRINT WTYP$(W); ":";
    PRINT USING "###"; WA%(W);
    PRINT "%  ";
    NEXT
    PRINT
    PRINT
    PRINT "Armour: ";
    IF ArmHit = 0 THEN
	PRINT "(No Armor)  ";
    ELSE
	PRINT ArmNam$; " Armor  ("; ArmHit; "/"; -ArmAdj; ")  ";
    END IF
    IF ShdHit = 0 THEN
	PRINT "(No shield) ";
    ELSE
	PRINT ShdNam$; " Shield  ("; ShdHit; "/"; -ShdAdj; ")";
    END IF
    PRINT
    PRINT "Gold in Hand :"; GOLD&; ", Bank "; BANK&; "    ";
    PRINT "Armor Exp:"; AE; "%"
    PRINT
    PRINT "Weapons"; TAB(19); "Cmplx       Damage"
    FOR W = 1 TO 4
    IF W > 1 AND WN$(W) = "NONE" THEN W = 4: GOTO NEXT.WEAPON
    IF WN$(W) = "NONE" THEN PRINT : PRINT "        No Weapons": W = 4: GOTO NEXT.WEAPON
    PRINT WN$(W); TAB(20);
    PRINT USING " ### "; WC%(W);
    PRINT "%    ";
    PRINT USING "##"; WD%(W);
    PRINT " D ";
    PRINT USING "##"; WS%(W)
NEXT.WEAPON:
    NEXT W
    LOCATE 23, 1
    PRINT "============ (Press any key to continue...) ============ ";
    A$ = INPUT$(1)
    PRINT
    GOTO Main.Menu
LEAVE.NOW:
    PRINT
    PRINT "As you start to leave, the Irishman comes up to you, slaps you on the"
    PRINT "back and says 'Y'all come back now, heah?'"
    GOSUB OPEN.CHARACTERS
    GOSUB WRITE.CHARACTER
    CLOSE
    SYSTEM
    END
TRAINING:
    CLS
    PRINT "As you enter the training center, the smell of sweat greets you at the door."
    PRINT
    PRINT "An attendant comes over and asks if you would like training on the axe, bow,"
    PRINT "mace, spear or sword."
    PRINT
    PRINT " Enter 'A' 'B' 'M' 'SP' OR 'SW' ";
    GOSUB GET.ABMSPSW
    C2 = CH + INT(11 * RND(1) - 5)
    C2 = C2 + ABS(C2 = 0)
    RTIO! = 10 / C2
    PR = FNP(BP * 20)
    PRINT
    PRINT "The attendant says that will be "; PR; "gold pieces."
    PRINT
    PRINT "Do you want to take the training?"
    PRINT "Enter (Y or N) ";
    VALID$ = "YN"
    GOSUB GET.KEYSTROKE
    IF A$ = "N" THEN GOTO Main.Menu
    IF PR > GOLD& THEN PRINT : PRINT "The attendant is irritated when he sees you do not have the gold and starts to": PRINT "grumble about using you for practice dummy.": GOTO Main.Menu
    GOLD& = GOLD& - PR
    WA%(TP) = WA%(TP) + INT(RND(1) * 15)
    PRINT
    IF AE < AC * 10 THEN AE = AE + INT(RND(1) * 6) + 2
    PRINT "The training instructor drills you on the fine arts of the "; N$; "."
    GOTO Main.Menu
GET.ABMSPSW:
    VALID$ = "ABMS;"
    GOSUB GET.KEYSTROKE
    IF A$ <> "S" THEN GOTO PRT.ABMSPSW
    I$ = A$
    VALID$ = "PW;"
    GOSUB GET.KEYSTROKE
    PRINT I$; LCASE$(A$);
    A$ = I$ + A$
PRT.ABMSPSW:
    IF A$ = "A" THEN PRINT "xe": BP = 15: N$ = "axe": TP = 1: RETURN
    IF A$ = "B" THEN PRINT "ow": BP = 20: N$ = "bow": TP = 2: RETURN
    IF A$ = "M" THEN PRINT "ace": BP = 17: N$ = "mace": TP = 3: RETURN
    IF A$ = "SP" THEN PRINT "ear": BP = 18: N$ = "spear": TP = 4: RETURN
    PRINT "ord"
    BP = 35
    N$ = "sword"
    TP = 5
    RETURN
FIND.WEAPON:
    F = 0
    FOR x = 1 TO 4
    IF UCASE$(WN$(x)) = UCASE$(A$) THEN F = x: EXIT FOR
    NEXT
    RETURN
get.attahere:
    RUN "WORLD"
GET.KEYSTROKE:
    A$ = ""
    WHILE A$ = ""
    A$ = INKEY$
    WEND
    A$ = UCASE$(A$)
    IF VALID$ = "" THEN RETURN
    IF INSTR(VALID$, A$) > 0 THEN
	IF RIGHT$(VALID$, 1) <> ";" THEN PRINT A$
	RETURN
    END IF
    GOTO GET.KEYSTROKE
BUY.HAGGLE:
    PRINT
    PRINT "Will you take it? (Y/N)  ";
    VALID$ = "YN"
    GOSUB GET.KEYSTROKE
    IF A$ = "Y" THEN DO.SW = -1: RETURN
    DO.SW = 0
    RETURN
SELL.HAGGLE:
    PRINT
    PRINT "Will you take it? (Y/N)  ";
    VALID$ = "YN"
    GOSUB GET.KEYSTROKE
    IF A$ = "Y" THEN DO.SW = -1: RETURN
    DO.SW = 0
    RETURN
WRITE.MEAT:
    OPEN "Meat" FOR OUTPUT AS #2
    WRITE #2, Nbr.Party
    GOSUB WRTMEAT
    WRITE #2, MastPath$
    CLOSE 2
    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) -------    
 ' 
NoColors:
    fgc% = 7
    bgc% = 0
    hfg% = 0
    hbg% = 7
    RESUME In.BW
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) -------    
 ' 
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 < D% THEN A = A + 1
	END IF
	IF A$ = CHR$(0) + CHR$(81) THEN
	    A = A + 10
	    IF A > D% THEN A = D%
	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 = D%
	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$(D%)
    D% = D% - 1
    IF A > D% THEN A = D%
    IF A = 0 THEN RESUME Get.AdvPath
    RESUME
RUNEDITOR:
    OPEN "LASTPGM" FOR OUTPUT AS #5
    PRINT #5, "HALL"
    CLOSE 5
    ON ERROR GOTO NoCheaters
    RUN "EDITOR"
NoCheaters:
    EditorSw$ = ""
    RESUME Main.Menu

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

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

SUB ReadDir (Path$, DNam$(), D%)
	SHELL "DIR " + Path$ + " >DIRFIL"
	OPEN "DIRFIL" FOR INPUT AS #1
	MaxDir = 200
	ArenaSw = 0
	REDIM DNam$(MaxDir)
	D% = 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
		  D% = D% + 1
		  DNam$(D%) = LEFT$(DLin$, 12)
	      END IF
	  ELSE
	      V = INSTR(DLin$, "EAMON")
	      N = INSTR(DLin$, "NAM")
	      IF V = 1 AND N > V THEN
		  D% = D% + 1
		  DNam$(D%) = "."
	      END IF
	  END IF
	  A = INSTR(DLin$, "ARENA")
	  IF A > 0 THEN ArenaSw = -1
	LOOP
	CLOSE 1
	Sort DNam$(), D%
	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

