'               EAMON-QB
'               "CREATE"
'          CHARACTER GENERATOR
'           AND INSTRUCTIONS
'
'            BY DONALD BROWN
'
'     converted to the IBM-PC by John Nelson
'
    DEFINT A-Z
    RANDOMIZE TIMER
    DEF FNR (X) = INT(X * RND(1) + 1)
    DEF FNA (X) = FNR(X) + FNR(X) + FNR(X)
    DIM WN$(4), WR%(4), WT%(4), WC%(4), WD%(4), WS%(4), WA%(5), SA%(4)
    ON ERROR GOTO NoColors
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) -------    
 ' 
    Bas = 8
    OPEN "EAMCOLOR" FOR INPUT AS #1
    INPUT #1, fgc%
    INPUT #1, bgc%
    INPUT #1, hfg%
    INPUT #1, hbg%
    INPUT #1, brt%
    CLOSE
In.BW:
    ON ERROR GOTO 0
    COLOR fgc%, bgc%
    OPEN "ADVENT" FOR INPUT AS #2
    INPUT #2, Nam$
    CLOSE
    PRINT
    PRINT "The Irishman says, 'First I must know whether ye be male or female. Which are"
    PRINT "ye  (Press 'M' for Male, 'F' for Female)?";
    VALID$ = "MF"
    GOSUB GET.KEYSTROKE
    SEX$ = A$
    PRINT SEX$
    PRINT
    PRINT
    PRINT "The Irishman walks away and in walks a tall man of possibly Elvish descent."
    PRINT
    PRINT "He studies you for a moment and says, 'Here is a booklet of instruction for"
    PRINT "you to read, and your prime attributes are--"
    PRINT
Show.Attrib:
    HD = FNA(Bas)
    AG = FNA(Bas)
    CH = FNA(Bas)
    PRINT "   Hardiness--"; HD
    PRINT "   Agility  --"; AG
    PRINT "   Charisma --"; CH; "'"
    IF HD + AG + CH < 39 THEN GOTO SUICIDE.RTN
READ.OR.NOT:
    PRINT "(Press 'R' to read instructions, 'T' to give them back)";
    VALID$ = "RAT+"
    GOSUB GET.KEYSTROKE
    PRINT A$
    IF A$ = "A" THEN GOTO Show.Attrib
    IF A$ = "R" THEN GOSUB Read.the.instructions
    IF A$ = "+" THEN Bas = Bas + 2: GOTO Show.Attrib
Create.Character:
    PRINT
    CLS
    PRINT "The man behind the desk takes back the instructions and says, 'It is now time"
    PRINT "for you to start your career.' He makes an odd sign with his hand and says,"
    PRINT "'Live long and prosper.'"
    PRINT
    PRINT "You now wander into the main hall."
    GOSUB OPEN.CHARACTERS
    GOSUB READ.NBR.CHARS
    R = 0
    FOR X = 1 TO NC
	REC = X + 1
	GET #1, REC, Char
	A$ = RTRIM$(Char.Nam$)
	IF LEFT$(A$, 1) = "*" THEN R = X: X = NC
    NEXT
    IF R = 0 THEN
	NC = NC + 1
	R = NC
	GOSUB WRITE.NBR.CHARS
	REC = NC + 1
    ELSE
	REC = R + 1
    END IF
    WA%(1) = 5
    WA%(2) = -10
    WA%(3) = 20
    WA%(4) = 10
    WA%(5) = 0
    GOLD& = 200
    BANK& = 0
    FOR X = 1 TO 4
	WN$(X) = "NONE"
	WT%(X) = 0
	WC%(X) = 0
	WD%(X) = 0
	WS%(X) = 0
    NEXT
    ArmNam$ = "NONE"
    ShdNam$ = "NONE"
    GOSUB WRITE.CHARACTER
    CLOSE
    OPEN "ADVENT" FOR OUTPUT AS #2
    WRITE #2, Nam$, REC
    CLOSE
    RUN "HALL"
SUICIDE.RTN:
    PRINT
    PRINT "Your character is such a poor excuse for an adventurer that we will allow"
    PRINT "you to commit suicide. Press 'Y' to commit suicide, else 'N'";
    VALID$ = "YNA"
    GOSUB GET.KEYSTROKE
    PRINT
    PRINT
    IF A$ = "N" OR A$ = "n" THEN GOTO READ.OR.NOT
    PRINT "We resurrect  you again and your prime attributes are --"
    PRINT
    GOTO Show.Attrib
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
NoColors:
    fgc% = 7
    bgc% = 0
    hfg% = 0
    hbg% = 7
    brt% = 15
    RESUME In.BW
Pressanykey:
    PRINT " (Press any key to coninue)   ";
    A$ = INPUT$(1)
    RETURN
Read.the.instructions:
    CLS
    OPEN "Instruct.Dat" FOR INPUT AS #3
    WHILE NOT EOF(3)
	LINE INPUT #3, Instruct$
	IF Instruct$ = "***" THEN
	    GOSUB Pressanykey
	    CLS
	ELSE
	    PRINT Instruct$
	END IF
    WEND
    RETURN

