ftp.wwiv.com/ftp.wwiv.com.zip/ftp.wwiv.com/pub/MISC/DNDOOR46.ZIP/DNDS2.BAS

BASIC Source File | 2001-07-11 | 121KB | 2,672 lines

 Rem * Filename: dnds2.bas Version: v4.6 r1.0
 Rem * This subprogram contains most login routines, and parse routines.

 Rem $Include: 'dnddoor.inc'

 Rem * routine to login user.
 Rem * output variables:
 Rem *   Time.On - contains time logged in.
 Rem *   Timeon - contains time logged in past midnight.
 Rem *   Time.Left - stores time limit in seconds past midnight.
 Rem *   User.Index - number of record in user file codename will use.
 Rem * processing variables:
 Rem *   Time.Left - during logging in.
 Rem *   Two.Minutes.Left - time remaining flag.
 Rem *   Login.Try - total login attempts.
 Rem *   New.User - flag indicates new user login.
 Rem *   Logged.User - flag indicates user exists in files.

Sub Login
 On Local Error Resume Next ' local error resume
 Time.On=Time$ ' store system time logged in (string form hh:mm:ss)
 Timeon=Timer ' store system time logged in (seconds past midnight)
 Timelogged.On=Now ' store time logged in (double format)
 Time.Left=600! ' set time limit during logging in
 Two.Minutes.Left=False ' flag for two minute left display message
 Logged.In=False ' set user logged in flag
 ' format initial login display line
 Outpt="The Adventure Door v"+Version$+", Node: "+Node+", "+FNclock$
 If Local.Mode=False Then
    Outpt=Outpt+", baud"+Str$(Modem.Baud)+"00"
 Endif
 Outpt=Outpt+"."
 Call IO.O ' display initial message
 ' format prompt for login welcome
 Outpt="Press <enter> to display the welcome, or <space> to skip:"
 No.Echo=True ' supress prompt input echo
 Line.Length=1 ' get only one keypress
 Call IO.I ' input routine
 No.Echo=False ' reset echo
 If Inpt=Nul Then ' check empty return
    Call Out.File("welcome.dat") ' display welcome file
 Endif ' end display welcome
 Do ' main login processing loop
    Login.Try=False ' reset login attempts
    Do ' get codename processing loop
       New.User=False ' reset new user flag
       Call Get.Codename ' prompt user for codename
       Call Get.PassWord ' prompt user for password
       Call Find.PassWord(Logged.User) ' find codename in user file
       If Logged.User Then ' compare user has entered an existing codename
          Call Verify.PassWord(Logged.Pass) ' compare entered password
          If Logged.Pass Then ' check if password matches
             Exit Do ' exit codename processing/entry loop
          Endif ' end check password match
          If Login.Try>=3 Then ' compare login attempts
             Call Hang.Up(7) ' routine to terminate program w/ message
             Exit Sub ' exit login routine/return to main
          Endif ' end compare login attempts
          Login.Try=Login.Try+1 ' increment login attempt
          Outpt="Illegal password attempt!" ' display error message
          Call IO.O ' send output/continue codename entry loop
       Else ' user has not entered an existing codename
          Call Get.Newuser.Record ' find an empty user file record
          Call Verify.Newuser(New.User) ' verify password entered
          If New.User>False Then ' user selected disconnect
             Call Hang.Up(8) ' routine to terminate program w/ message
             Exit Sub ' exit routine
          Endif ' end compare disconect
          If New.User<False Then ' user password verified
             Call Init.Newuser ' initialize some new user variables
             Call Verify.Newlogin(New.User,True) ' verify user is new
             If New.User Then ' user selects to continue as a new user
                Exit Do ' exit codename/password entry loop
             Endif ' end new user continue
          Endif ' end password verify
       Endif ' end compare existing codename
    Loop ' codename/password entry loop
    Call Update.Login ' intialize some login variables
    If New.User=False Then ' compare user is new user
       Exit Do ' exit main login processing loop
    Endif ' end compare new user
    If New.User Then ' compare new user login is verified
       Call Roll.Character ' get user selected character statistics
       Call Verify.Newlogin(New.User,False) ' verify new user to continue
       If New.User Then ' new user is logged in
          Exit Do ' exit main login processing loop
       Endif ' end compare new user login
    Endif ' end compare new user login
 Loop ' end main login processing loop
 Call Login.User ' routine to initialize some login variables
 Outpt=Nul ' send empty output
 Call IO.O ' send output
 Outpt="Press <enter> to begin the adventure:" ' format message
 No.Echo=True ' set flag to supress echo input
 Line.Length=1 ' get one keypress
 Call IO.I ' get input
 No.Echo=False ' reset echo flag
 Next.Room=Room ' store room number
 Call Enter.Room ' display room description
 Logged.In=True ' set user logged in flag
 Func.Buffer=Nul ' reset function key flag
End Sub ' end routine to login user

 Rem * routine to find codename entered in user file.
 Rem * output variables:
 Rem *   PassWord.Found - flag if codename is in user file.

Sub Find.PassWord(PassWord.Found)
 On Local Error Resume Next ' local error resume
 PassWord.Found=False ' set flag to false
 Inpt=Rtrim$(Player.CodeName) ' store codename
 For User.Index=1 To Lof(UserFile)/Len(UserRecord) ' loop through entire user file
    Call Read.Record(UserFile,User.Index) ' get next user file record
    Outpt=UserRecord.CodeName ' store user file codename
    Call Decrypt(Outpt) ' decrypt user file codename
    Outpt=Rtrim$(Outpt) ' trim user file codename
    If Outpt=Inpt Then ' compare user file codename to codename entered
       PassWord.Found=True ' set return variable flag
       Exit For ' exit user file loop
    Endif ' end check codenames
 Next ' loop through user file
End Sub ' end routine to find user file codename

 Rem * routine to verify valid password of codename entered.
 Rem * output variables:
 Rem *   PassWord.Found - flag indicates password exists.

Sub Verify.PassWord(PassWord.Found)
 On Local Error Resume Next ' local error resume
 PassWord.Found=False ' set flag to false
 Outpt=UserRecord.PassWord ' store user file password
 Call Decrypt(Outpt) ' decrypt password
 If Len(Outpt)=False Then ' verify decrypt result
    Outpt="Password has a checksum error!" ' format message
    Call IO.O ' send message
    PassWord.Found=False ' set flag to verify password
    Exit Sub ' exit check password routine
 Endif ' end check password
 Outpt=Rtrim$(Outpt) ' store trimmed user file password
 Inpt=Rtrim$(Player.PassWord) ' store password entered
 If Outpt=Inpt Then ' compare user file password to entered password
    PassWord.Found=True ' set flag to verify password
 Endif ' end compare passwords
End Sub ' end routine to check valid password

 Rem * routine to verify new user is continuing.
 Rem * input variables:
 Rem *   Message.Type - message to select.
 Rem * output variables:
 Rem *   Response.Type - returns true to continue, false if not.

Sub Verify.Newlogin(Response.Type,Message.Type)
 On Local Error Resume Next ' local error resume
 Do ' process input loop
    Graphics.Off=False ' reset color
    If Message.Type Then ' compare prompt
       Outpt="Press <enter> to roll character, or <space> to reenter:"
    Else ' select prompt
       Outpt="Press <enter> to use character, or <space> to reroll:"
    Endif ' end compare prompt
    No.Echo=True ' supress input echo
    Line.Length=1 ' input one keypress
    Call IO.I ' get user input
    No.Echo=False ' reset input echo
    If Inpt=" " Then ' selected space
       Response.Type=False ' set return flag
       Exit Do ' exit routine
    Endif ' end compare select
    If No.Input Then ' compare empty input
       Response.Type=True ' set return flag
       Exit Do ' exit routine
    Endif ' end compare select
 Loop ' process input loop
End Sub ' end routine to prompt to continue

 Rem * routine to get codename, check illegal character in codename, verify
 Rem * user has entered correct codename.
 Rem * output variables:
 Rem *   Player.CodeName - contains lowercased, trimmed codename entered.

Sub Get.Codename
 On Local Error Resume Next ' local error resume
 Do ' main codename entry processing loop
    Do ' loop until valid codename entered
       Outpt=Nul ' empty output
       Call IO.O ' send output
       Graphics.Off=True ' reset color
       Outpt="         +---------+---------+---------+" ' make length bar
       Call IO.O ' send output
       Outpt="Codename? " ' codename prompt
       Line.Length=30 ' set line length of codename
       Upper.Case=True ' reset uppercase flag
       Call IO.I ' get codename input
       Upper.Case=False ' reset uppercase flag
       Graphics.Off=False ' reset color
       Inpt=Ltrim$(Inpt) ' trim blanks
       Inpt=Rtrim$(Inpt) ' trim blanks
       Inpt=Ucase$(Inpt) ' set input to uppercase
       Player.CodeName=Inpt ' store codename
       If Len(Player.CodeName)>False Then ' check length of codename
          Call Valid(Player.CodeName,30) ' verify valid characters
          If Len(Player.CodeName)>False Then ' check valid codename
             Exit Do ' exit codename entry loop
          Endif ' end check valid characters
          Outpt="Illegal characters in codename!" ' format message
          Call IO.O ' send output
       Endif ' end check codename length
    Loop ' continue entry loop
    Outpt=Rtrim$(Player.CodeName) ' store codename
    Outpt=Lcase$(Outpt) ' set to lowercase
    Mid$(Outpt,1,1)=Ucase$(Mid$(Outpt,1,1)) ' make first character uppercase
    Outpt="You are "+Chr$(34)+Outpt+Chr$(34)+"(y/n)? " ' format prompt
    No.Input.Out="Y" ' set default input to yes
    Line.Length=1 ' reset line length
    Call IO.I ' prompt for correct codename entered
    If Yes Then ' verify user has verified correct codename
       Exit Do ' exit main codename entery loop
    Endif ' end verify user input
 Loop ' end codename entry loop
End Sub ' end routine to get and verify codename entry

 Rem * routine to prompt user for password, check valid characters in password.
 Rem * output variables:
 Rem *   Player.PassWord - contains lowercased, trimmed password entered.

Sub Get.PassWord
 On Local Error Resume Next ' local error resume
 Do ' password entry loop
    Outpt=Nul ' empty output
    Call IO.O ' send output
    Graphics.Off=True ' reset color
    Outpt="         +---------+---------+" ' make length bar
    Call IO.O ' send output
    Outpt="Password? " ' password prompt
    Line.Length=20 ' set line length of password
    Hidden=True ' set flag to echo mask characters
    Call IO.I ' get input
    Hidden=False ' reset mask flag
    Graphics.Off=False ' reset color
    Inpt=Ltrim$(Inpt) ' trim blanks
    Inpt=Rtrim$(Inpt) ' trim blanks
    Inpt=Ucase$(Inpt) ' set input to uppercase
    Player.PassWord=Inpt ' store password
    If Len(Player.PassWord)>False Then ' check length of password
       Call Valid(Player.PassWord,20) ' verify valid characters
       If Len(Player.PassWord)>False Then ' check valid password
          Exit Do ' exit password entry loop
       Endif ' end check valid characters
       Outpt="Illegal characters in password!" ' format message
       Call IO.O ' send output
    Endif ' end check password length
 Loop ' end password entry loop
End Sub ' end routine to enter password

 Rem * routine to find empty user file record.
 Rem * output variables:
 Rem *    User.Index - unused number of record in user file.

Sub Get.Newuser.Record
 On Local Error Resume Next ' local error resume
 For User.Index=1 To Lof(UserFile)/Len(UserRecord) ' loop through users
    Call Read.Record(UserFile,User.Index) ' load the user record
    Outpt=UserRecord.CodeName ' store user file codename
    Call Decrypt(Outpt) ' routine to decrypt codename
    If Left$(Outpt,9)=Deleted$ Then ' compare to deleted record
       Exit For ' end loop through user file
    Endif ' end compare deleted record
 Next ' end loop through user file
 ' exit of loop w/o finding a deleted record will set User.Index to one
 ' record past the last in the user file, appending the next record.
 Call Read.Record(UserFile,User.Index) ' get empty user file record
 Outpt="Codename not found in files!" ' make message
 Call IO.O ' send message
End Sub ' end routine to find empty user file record

 Rem * routine to verify new user login.
 Rem * output variables:
 Rem *   Response.Type - flag set to 1 to disconnect,
 Rem *   0 if password not verified, -1 if password is verified.

Sub Verify.Newuser(Response.Type)
 On Local Error Resume Next ' local error resume
 Do ' password verify loop
    Outpt="Press <C>ontinue, <H>angup, or <R>estart:" ' make message
    No.Input.Out="C" ' default empty input to continue
    Line.Length=1 ' reset line length
    Call IO.I ' get input
    Response.Type=False ' set return flag to unverified
    Select Case Ucase$(Inpt) ' compare input selection
    Case "C" ' continue selected
       Outpt=Nul ' set empty output
       Call IO.O ' send output
       Outpt="Verify password: " ' prompt for password
       Hidden=True ' set echo characters masked
       Line.Length=20 ' line length of password
       Call IO.I ' get user input
       Hidden=False ' reset echo mask flag
       Inpt=Ltrim$(Inpt) ' trim input
       Inpt=Rtrim$(Inpt) ' trim input
       Inpt=Ucase$(Inpt) ' set input uppercase
       Outpt=Rtrim$(Player.PassWord) ' store password entered
       If Outpt<>Inpt Then ' compare password entered to verify entry
          Outpt="Passwords don't match!" ' make error message
          Call IO.O ' send output
          Response.Type=False ' set flag to unverified
          Exit Do ' exit routine
       Endif ' end compare password
       Outpt="Memorize your password!" ' make message
       Call IO.O ' send output
       Call IO.O ' send empty line
       Response.Type=True ' set flag to verified
       Exit Do ' exit routine
    Case "H" ' hangup selected
       Response.Type=1 ' set flag to hangup user
       Exit Do ' exit routine
    Case "R" ' restart selected
       Response.Type=False ' set flag to restart/unverified
       Exit Do ' exit routine
    End Select ' end compare input selection
 Loop ' end password verify loop
End Sub ' end routine to verify new password

 Rem * routine to allow user to select new character statistics.
 Rem * processing variables:
 Rem *   Display.Help - flag to display login help messages.

Sub Roll.Character
 On Local Error Resume Next ' local error resume
 Display.Help=False ' set flag to display help text
 Outpt="List help text during character logon(y/n)? " ' prompt for help
 No.Input.Out="N" ' default prompt
 Line.Length=1 ' reset line length
 Call IO.I ' get user input
 If Yes Then ' check input
    Display.Help=True ' set help text flag
 Endif ' end check input
 If Display.Help Then ' check help flag
    Call Logon.Help(1) ' display class help text
 Endif ' end check help flag
 Call Modify.Class ' routine to select class type
 If Display.Help Then ' check help flag
    Call Logon.Help(2) ' display statistics entry help text
 Endif ' end check help flag
 Call Modify.Stats ' routine to select character statistics
 If Display.Help Then ' check help flag
    Call Logon.Help(3) ' display race entry help text
 Endif ' end check help flag
 Call Modify.Race ' routine to select character race
 Call Init.Race.Stats ' routine to initialize some race statistics
 If Display.Help Then ' check help flag
    Call Logon.Help(4) ' display weapon proficiency entry help text
 Endif ' end check help flag
 Call Modify.Proficiency ' routine to select weapon proficiency
 Call Init.Proficiency.Stats ' routine to intialize proficiency statistics
 Call Init.Stats ' routine to intialize some character statistics
 If Display.Help Then ' check help flag
    Call Logon.Help(5) ' display alignment entry help text
 Endif ' end check help flag
 Call Modify.Alignment ' routine to select character alignment
 Call Display.Init.Stats ' routine to display character statistics
End Sub ' end routine to get new character statistics

 Rem * routine to display help text.
 Rem * input variables:
 Rem *   Help.Number - range of help text file records to display.
 Rem * work variables:
 Rem *   Start.Help, End.Help, Help.Count.

Sub Logon.Help(Help.Number)
 On Local Error Resume Next ' local error resume
 Close #HelpFile ' close work file number
 FileName="logon.dat" ' store logon helptext filename
 Open FileName For Random Shared As #HelpFile Len=Len(HelpRecord) ' open file
 Graphics.Off=True ' set color flag
 Outpt=Nul ' send empty line
 Call IO.O ' send output
 Select Case Help.Number ' selection for logon help record ranges
 Case 1 ' help records
    Start.Help=2
    End.Help=6
 Case 2 ' help records
    Start.Help=7
    End.Help=15
 Case 3 ' help records
    Start.Help=16
    End.Help=25
 Case 4 ' help records
    Start.Help=26
    End.Help=32
 Case 5 ' help records
    Start.Help=33
    End.Help=36
 End Select ' end select record ranges
 For Help.Count=Start.Help To End.Help ' loop through help text file range
    Call Read.Record(HelpFile,Help.Count) ' read help record
    Outpt=Rtrim$(HelpRecord.Text) ' format help text
    Call IO.O ' send help output
 Next  'end loop through help file
 Call IO.O ' send ampty output
 Call More.Prompt ' get keypress
 Graphics.Off=False ' reset color flag
 Close #HelpFile
End Sub ' end routine to display help text

 Rem * routine to allow user to modify character alignment.

Sub Modify.Alignment
 On Local Error Resume Next ' local error resume
 Do ' process modify alignment one loop
    Graphics.Off=False ' reset color
    Outpt="Player Alignment:" ' make message
    Call IO.O ' display message
    Outpt="Press "+Enter$+" for default." ' make message
    Call IO.O ' display message
    Graphics.Off=True ' reset color
    For Align.Count=1 To 3 ' display alignment choices
       Outpt=Mid$(Str$(Align.Count),2)+"> "+ _
       Rtrim$(Alignment.Name1(Align.Count))
       Call IO.O ' send output
    Next ' loop through alignment choices
    Outpt="?" ' prompt for alignment number
    No.Input.Out="2" ' default to neutral
    Line.Length=1 ' reset line length
    Call IO.I ' get input
    Player.Alignment=Int(Val(Inpt)) ' convert to number
    If Player.Alignment>=1 And Player.Alignment<=3 Then ' compare valid choice
       Exit Do ' exit first loop
    Endif ' end compare choice
 Loop ' continue alignment loop
 UserRecord.Align1=Player.Alignment-2 ' store alignment as -1/0/1
 Do ' process modify alignment two loop
    Graphics.Off=False ' reset color
    Outpt="Player Alignment:" ' make message
    Call IO.O ' display message
    Outpt="Press "+Enter$+" for default." ' make message
    Call IO.O ' display message
    Graphics.Off=True ' reset color
    For Align.Count=1 To 3 ' display alignment choices
       Outpt=Mid$(Str$(Align.Count),2)+"> "+ _
       Rtrim$(Alignment.Name2(Align.Count))
       Call IO.O ' send output
    Next ' loop through alignment chocies
    Outpt="?" ' prompt for alignment number
    No.Input.Out="2" ' default to neutral
    Line.Length=1 ' reset line length
    Call IO.I ' get input
    Player.Alignment=Int(Val(Inpt)) ' convert to number
    If Player.Alignment>=1 And Player.Alignment<=3 Then ' compare valid choice
       Exit Do ' exit second loop
    Endif ' end compare choice
 Loop ' continue alignment loop
 UserRecord.Align2=Player.Alignment-2 ' store alignment as -1/0/1
End Sub ' end routine to modify character alignment

 Rem * routine to allow user to modify character class type.

Sub Modify.Class
 On Local Error Resume Next ' local error resume
 Outpt=Nul ' make empty line
 Call IO.O ' send output
 Do ' class entry process loop
    Graphics.Off=False ' reset color
    Call IO.O ' send blank line
    Outpt="Select your character class:" ' make message
    Call IO.O ' send output
    Outpt="Press "+Enter$+" for default." ' make message
    Call IO.O ' send output
    If Local.Mode=False Then ' console mode allows DM/Asst. DM entries
       Max.Class=8 ' set number of class choices
    Else ' compare console mode
       Max.Class=10 ' set number of class choices
    Endif ' end compare console mode
    Graphics.Off=True ' reset color
    For List.Counter=1 To Max.Class ' loop through class chocies
       Outpt=Mid$(Str$(List.Counter),2) ' store class number
       If List.Counter=10 Then ' store DM class number
          Outpt="#" ' choice ten is pound sign
       Endif ' end compare DM class number
       Outpt=Outpt+"> "+Rtrim$(Class.Name(List.Counter)) ' append class name
       Call IO.O ' send output
    Next ' loop through class choices
    Outpt="?" ' set input prompt
    No.Input.Out="1" ' set default choice
    Line.Length=1 ' reset line length
    Call IO.I ' get user input
    Player.Class=Int(Val(Inpt)) ' convert to number
    If Inpt="#" Then ' compare DM selection
       Player.Class=10 ' set to ten
    Endif ' end compare DM selection
    If Player.Class>=1 And Player.Class<=Max.Class Then ' check class range
       Exit Do ' exit class type entry loop
    Endif ' end check class range
 Loop ' end class type entry loop
 UserRecord.ClassType=Player.Class ' store class number in user record
 Outpt=Class.Name(UserRecord.ClassType) ' get class name
 Call Valid(Outpt,20) ' validate class name
 If Outpt=Nul Then ' verify class name validity
    Outpt="<checksum>" ' set error message
    Call Valid(Outpt,20) ' validate error
 Endif ' end verify class name
 Call Encrypt(Outpt,True) ' encrypt class name
 UserRecord.ClassName=Outpt ' store class name in user record
End Sub ' end routine to modify character class type

 Rem * routine to allow user to modify character statistics.

Sub Modify.Stats
 On Local Error Resume Next ' local error resume
 Do ' loop until statistics selected are accepted
    Do ' loop until statistics are valid
       Graphics.Off=False ' reset color
       Outpt="Enter character statistics, range from 8 to 18." ' message
       Call IO.O ' send message
       Outpt="Average less than or equal to 12." ' message
       Call IO.O ' send message
       Outpt="Press "+Enter$+" for default." ' message
       Call IO.O ' send message
       Stat.Total!=False ' reset total of selected statistics
       For Class.Number=1 To 7 ' loop through entry of all statistics
          Do ' loop until a valid statistic entered
             Graphics.Off=True ' reset color
             Outpt=Rtrim$(Stat(Class.Number))+">" ' make message w/ stat name
             No.Input.Out="12" ' set default
             Line.Length=2 ' reset line length
             Call IO.I ' get input
             Stat=Int(Val(Inpt)) ' convert to number
             If Stat<8 Or Stat>18 Then ' check range
                Graphics.Off=False ' reset color
                Outpt="The average statistic must range from 8 to 18."
                Call IO.O ' send output message
             Else ' check range
                Stat.Total!=Stat.Total!+Stat ' increment stat total
                UserRecord.Stats(Class.Number)=Stat ' store stat in user record
                Exit Do ' exit validity loop
             Endif ' end check range
          Loop ' continue valid statistic loop
       Next ' loop through all statistics
       Stat.Total!=Stat.Total!/7! ' calculate average of total statistics
       Stats$=Str$(Stat.Total!) ' convert to string
       Stat.Delimit=Instr(Stats$,".") ' search string for decimal
       If Stat.Delimit=False Then ' compare decimal
          Inpt=Stats$ ' set output string to converted string
       Else ' check decimal, truncate to one place
          ' set string
          Inpt=Left$(Stats$,Stat.Delimit-1)+"."+Mid$(Stats$,Stat.Delimit+1,1)
       Endif ' end compare decimal
       Graphics.Off=False ' reset color
       If Stat.Total!<=12 Then ' verify average
          Exit Do ' exit validity loop
       Endif ' end verify average
       Outpt="Average"+Inpt+" to high! Try again.." ' set message
       Call IO.O ' send message
    Loop ' end statistic validity loop
    Outpt="Your average is"+Inpt+". Change anything(y/n)? " ' make message
    No.Input.Out="N" ' set default input
    Line.Length=1 ' reset line length
    Call IO.I ' get user input
    If No Then ' check no entered
       Exit Sub ' exit routine
    Endif ' end check entry
 Loop ' end loop to verify statistics accepted
End Sub ' end routine to modify character statistics

 Rem * routine to allow user to modify character race.

Sub Modify.Race
 On Local Error Resume Next ' local error resume
 Do ' loop until race entry is accepted
    Graphics.Off=False ' reset color
    Outpt="Select your character race:" ' make message
    Call IO.O ' send message
    Outpt="Press "+Enter$+" for default." ' make message
    Call IO.O ' send message
    Graphics.Off=True ' reset color
    For Race.Count=1 To 8 ' loop through all race choices
       ' choice display
       Outpt=Mid$(Str$(Race.Count),2)+">"+Rtrim$(Race(Race.Count))
       Call IO.O ' send choice
    Next ' end race display loop
    Outpt="?" ' set input prompt
    No.Input.Out="1" ' set default
    Line.Length=1 ' reset line length
    Call IO.I ' get user input
    Player.Race=Int(Val(Inpt)) ' convert to number
    If Player.Race>=1 And Player.Race<=8 Then ' check race range
       UserRecord.Race=Player.Race ' store race in user record
       Exit Sub ' exit routine
    Endif ' end compare race range
 Loop ' end loop to accept race entry
End Sub ' end routine to modify race

 Rem * routine to allow user to modify character weapon proficiency.

Sub Modify.Proficiency
 On Local Error Resume Next ' local error resume
 Do ' loop until proficiency entry accepted
    Graphics.Off=False ' reset color
    Outpt="Weapon Proficiency:" ' set message
    Call IO.O ' send output
    Outpt="Clerics may only use blunt or pole type weapons." ' message
    Call IO.O ' send output
    Outpt="Press "+Enter$+" for default." ' message
    Call IO.O ' send output
    Graphics.Off=True ' reset color
    For Prof.Count=1 To 4 ' loop through all weapon proficiencies
       Outpt=Mid$(Str$(Prof.Count),2)+"> "+ _
       Rtrim$(Weapon.Type.Name(Prof.Count))
       Call IO.O ' send choice output
    Next ' end weapon choices
    Outpt="?" ' set user prompt
    If UserRecord.ClassType=Cleric Then ' compare class to cleric
       No.Input.Out="1" ' set default
    Else ' compare class
       No.Input.Out="3" ' set default
    Endif ' end compare class
    Line.Length=1 ' reset line length
    Call IO.I ' get user input
    Player.Prof=Int(Val(Inpt)) ' convert to number
    If UserRecord.ClassType=Cleric Then ' compare class to cleric
       ' compare valid choices for cleric
       If Player.Prof=1 Or Player.Prof=2 Then
          Exit Do ' exit weapon input loop
       Endif ' end compare valid chocies
    Else ' compare to non cleric
       If Player.Prof>=1 And Player.Prof<=4 Then ' compare valid choices
          Exit Do ' exit weapon input loop
       Endif ' end compare valid choices
    Endif ' end compare class type
 Loop ' end loop to accept weapon proficiency
 UserRecord.Proficiency=Player.Prof ' store character weapon selection
 For Weapon.Number=1 To 4 ' loop through user record weapon proficiencies
    UserRecord.Weapons(Weapon.Number)=False ' reset to zero
 Next ' end loop through weapon proficiencies
 ' set user record selected weapon profciency
 UserRecord.Weapons(Player.Prof)=10
End Sub ' end routine to modify character weapon proficinecy

 Rem * routine to initialize character proficiency statistics.

Sub Init.Proficiency.Stats
 On Local Error Resume Next ' local error resume
 Graphics.Off=False ' reset color
 Select Case UserRecord.Race ' compare player character race
 Case 3 ' gnome race
    UserRecord.Weapons(UserRecord.Proficiency)=15 ' increment proficiency
    Outpt="Gnomes weapon proficiency is raised to 15%" ' make message
    Call IO.O ' send message
 Case 6 ' half-elf race
    UserRecord.Weapons(4)=UserRecord.Weapons(4)+5 ' increment proficiency
    Outpt="Half-elves thrusting weapon proficiency is raised by 5%" ' message
    Call IO.O ' send message
 Case 7 ' half-orc race
    UserRecord.Weapons(3)=UserRecord.Weapons(3)+5 ' increment proficiency
    Outpt="Half-orcs sharp weapon proficiency is raised by 5%" ' message
    Call IO.O ' send message
 End Select ' end compare race
End Sub ' end routine to initialize proficiency statistics

 Rem * routine to initialize character race statistics.

Sub Init.Race.Stats
 On Local Error Resume Next ' local error resume
 Graphics.Off=False ' reset color
 Select Case UserRecord.Race ' compare player character race
 Case 1 ' human race
    UserRecord.Stats(1)=UserRecord.Stats(1)+1 ' increment statistics
    Outpt="Humans strength is raised one point!" ' make message
    Call IO.O ' send message
 Case 2 ' elf race
    UserRecord.Stats(4)=UserRecord.Stats(4)+1 ' increment statistics
    Outpt="Elves dexterity is raised by one point!" ' make message
    Call IO.O ' send message
 Case 4 ' dwarf race
    UserRecord.Stats(2)=UserRecord.Stats(2)+1 ' increment statistics
    Outpt="Dwarves intelligence is raised by one point!" ' make message
    Call IO.O ' send message
 Case 5 ' halfling race
    UserRecord.Stats(3)=UserRecord.Stats(3)+1 ' increment statistics
    Outpt="Halflings wisdom is raised by one point!" ' make message
    Call IO.O ' send message
 Case 8 ' ogre race
    UserRecord.Stats(1)=UserRecord.Stats(1)+1 ' increment statistics
    UserRecord.Stats(4)=UserRecord.Stats(4)+1 ' increment statistics
    Outpt="Ogres strength and dexterity are raised by one point!" ' message
    Call IO.O ' send output
 End Select ' end compare race
 UserRecord.Beauty=Int(Rnd*15+5) ' reset ladies beauty
 UserRecord.Glamour=Int(Rnd*15+5) ' reset ladies glamour
End Sub ' end routine to initialize character race statistics

 Rem * routine to initialize some character statistics.

Sub Init.Stats
 On Local Error Resume Next ' local error resume
 User.Echo=False ' reset preference
 User.LineFeeds=False ' reset preference
 User.LineLength=80 ' reset preference
 User.PageLength=24 ' reset preference
 User.Wordwrap=False ' reset preference
 UserRecord.Room=1 ' reset user record room number
 UserRecord.Level=1 ' reset user record character level
 UserRecord.Experience=64 ' reset experience
 UserRecord.Gold=2048 ' reset user record gold
 UserRecord.Bank=False ' reset user record amount of gold in bank
 UserRecord.Borrow=False ' reset user record amount of gold borrowed from bank
 UserRecord.Brief=False ' reset user record brief mode
 UserRecord.Echo=False ' reset user echo mode
 UserRecord.Linefeeds=False ' reset user linefeed mode
 UserRecord.Linelength=80 ' reset user linelength
 UserRecord.Pagelength=24 ' reset pagelength
 UserRecord.Wordwrap=False ' reset user word wrap
 UserRecord.FatigueMax=Training.Stats(UserRecord.ClassType,1) ' reset user
 UserRecord.VitalityMax=Training.Stats(UserRecord.ClassType,2) ' record maximum
 UserRecord.MagicMax=Training.Stats(UserRecord.ClassType,3) ' statistic
 UserRecord.PsionicMax=Training.Stats(UserRecord.ClassType,4) ' points
 UserRecord.Fatigue=UserRecord.FatigueMax ' reset user
 UserRecord.Vitality=UserRecord.VitalityMax ' record working
 UserRecord.Magic=UserRecord.MagicMax ' statistic
 UserRecord.Psionic=UserRecord.PsionicMax ' points
 UserRecord.MaxCalls=False ' reset user record maximum calls
 UserRecord.FromHour=False ' reset user record time restrictions
 UserRecord.FromMin=False ' reset user record time restrictions
 UserRecord.ToHour=False ' reset user record time restrictions
 UserRecord.ToMin=False ' reset user record time restrictions
 UserRecord.Flags=False ' reset user record flags variable
 Call Clear.Container(0,True) ' routine to clear the container structure
 For Container.Item=1 To 3 ' loop through user record containers
    UserRecord.Container(Container.Item)=ContainerRec ' reset container record
 Next ' end loop through user record
End Sub ' end routine to initialize character statistics

 Rem * routine to display login character statistics.

Sub Display.Init.Stats
 On Local Error Resume Next ' local error resume
 Graphics.Off=False ' reset color
 Outpt="Your character statistics are:" ' message
 Call IO.O ' send output
 Graphics.Off=True ' reset color
 Outpt="Level:"+Str$(UserRecord.Level) ' message
 Outpt=Outpt+Space$(25-Len(Outpt)) ' append blanks
 Alignment.Type$=Alignment.Name1(UserRecord.Align1+2) ' message
 Alignment.Type$=Rtrim$(Alignment.Type$) ' trim blanks
 ' first character uppercase
 Mid$(Alignment.Type$,1,1)=Ucase$(Mid$(Alignment.Type$,1,1))
 Outpt=Outpt+"Align1: "+Alignment.Type$ ' combine message
 Call IO.O ' send output
 Outpt="Gold: "+Str$(UserRecord.Gold) ' message
 Outpt=Outpt+Space$(25-Len(Outpt)) ' append blanks
 Alignment.Type$=Alignment.Name2(UserRecord.Align2+2) ' message
 Alignment.Type$=Rtrim$(Alignment.Type$) ' trim blanks
 ' first character uppercase
 Mid$(Alignment.Type$,1,1)=Ucase$(Mid$(Alignment.Type$,1,1))
 Outpt=Outpt+"Align2: "+Alignment.Type$ ' combine message
 Call IO.O ' send output
 Outpt="Room: "+Str$(UserRecord.Room) ' message
 Outpt=Outpt+Space$(25-Len(Outpt)) ' append blanks
 Player.Prof=UserRecord.Proficiency ' get statistic
 Weapon.Type$=Weapon.Type.Name(Player.Prof) ' message
 Weapon.Type$=Rtrim$(Weapon.Type$) ' trim blanks
 ' first character uppercase
 Mid$(Weapon.Type$,1,1)=Ucase$(Mid$(Weapon.Type$,1,1))
 Outpt=Outpt+"Prof:   "+Weapon.Type$ ' combine message
 Weapon.Proficiency$=Str$(UserRecord.Weapons(Player.Prof)) ' message
 Outpt=Outpt+">"+Weapon.Proficiency$+"%" ' combine message
 Call IO.O ' send output
 Outpt="Exp:  "+Str$(UserRecord.Experience) ' message
 Outpt=Outpt+Space$(25-Len(Outpt)) ' append blanks
 Outpt=Outpt+Left$(Stat(1),3)+":   "+Str$(UserRecord.Stats(1)) ' combine
 Call IO.O ' send output
 Outpt="Fat:  "+Str$(UserRecord.Fatigue) ' message
 Outpt=Outpt+Space$(25-Len(Outpt)) ' append blanks
 Outpt=Outpt+Left$(Stat(2),3)+":   "+Str$(UserRecord.Stats(2)) ' combine
 Call IO.O ' send output
 Outpt="Vit:  "+Str$(UserRecord.Vitality) ' message
 Outpt=Outpt+Space$(25-Len(Outpt)) ' append blanks
 Outpt=Outpt+Left$(Stat(3),3)+":   "+Str$(UserRecord.Stats(3)) ' combine
 Call IO.O ' send output
 Outpt="Mag:  "+Str$(UserRecord.Magic) ' message
 Outpt=Outpt+Space$(25-Len(Outpt)) ' append blanks
 Outpt=Outpt+Left$(Stat(4),3)+":   "+Str$(UserRecord.Stats(4)) ' combine
 Call IO.O ' send output
 Outpt="Psi:  "+Str$(UserRecord.Psionic) ' message
 Outpt=Outpt+Space$(25-Len(Outpt)) ' append blanks
 Outpt=Outpt+Left$(Stat(5),3)+":   "+Str$(UserRecord.Stats(5)) ' combine
 Call IO.O ' send output
 Outpt="Race:  "+Race(UserRecord.Race) ' message
 Outpt=Outpt+Space$(25-Len(Outpt)) ' append blanks
 Outpt=Outpt+Left$(Stat(6),3)+":   "+Str$(UserRecord.Stats(6)) ' combine
 Call IO.O ' send output
 Class.Type$=UserRecord.ClassName ' message
 Call Decrypt(Class.Type$) ' decrypt string
 ' first character uppercase
 Mid$(Class.Type$,1,1)=Ucase$(Mid$(Class.Type$,1,1))
 Class.Type$=Left$(Class.Type$,15) ' truncate to right
 Outpt="Class: "+Class.Type$ ' message
 Outpt=Outpt+Space$(25-Len(Outpt)) ' append blanks
 Outpt=Outpt+Left$(Stat(7),3)+":   "+Str$(UserRecord.Stats(7)) ' combine
 Call IO.O ' send output
 If UserRecord.ClassType=Lady Then ' compare class to lady
    Outpt="Lady stats:" ' message
    Call IO.O ' send output
    Outpt="Beauty:"+Str$(UserRecord.Beauty) ' message
    Outpt=Outpt+Space$(25-Len(Outpt)) ' append blanks
    Outpt=Outpt+"Glamour:"+Str$(UserRecord.Glamour) ' combine
    Call IO.O ' send output
 Endif ' end compare class type
 Call More.Prompt ' pause to continue
End Sub ' end routine to display character login statistics

 Rem * routine to initialize some variables after login.
 Rem * output variables:
 Rem *   Time.Left - player time left in seconds from login time.

Sub Update.Login
 On Local Error Resume Next ' local error resume
 Outpt=UserRecord.DateOn ' get user's last login date
 Call Decrypt(Outpt) ' decrypt date
 If Outpt<>Date$ Then ' compare last login date to today
    UserRecord.NumCalls=False ' reset user's number of calls logged in per day
 Endif ' end compare last login date
 If UserRecord.ClassType<=Lady Then ' compare user to non DM status
    Calls.Exceeded=False ' set flag to maximum calls exceeded
    UserRecord.NumCalls=UserRecord.NumCalls+1 ' increment user's max calls
    If UserRecord.MaxCalls>False Then ' compare maximum calls
       If UserRecord.NumCalls>UserRecord.MaxCalls Then ' compare calls
          Calls.Exceeded=True ' set maximum call flag
       Endif ' end compare calls to maximum calls
    Else ' end compare maximum calls
       If UserRecord.NumCalls>5 Then ' compare maximum calls to default
          Calls.Exceeded=True ' set maximum call flag
       Endif ' end compare maximum default calls
    Endif ' end compare maximum calls
    If Calls.Exceeded Then ' check user has exceeded maximum calls
       Call Share.Record(UserFile,User.Index) ' put user record
       Call Hang.Up(5) ' routine to terminate program w/ message
       Exit Sub ' exit routine
    Endif ' end check maximum calls
 Endif ' end non DM status
 Call Restricted.Login ' check user is restricted to a time to login
 If UserRecord.ClassType<AsstDM Then ' compare user is non DM status
    UserRecord.Invisible=False ' reset user invisibility
 Endif ' end compare non DM status
 Select Case UserRecord.ClassType ' compare the user class type
 Case Is>=AsstDM ' user is DM/Asst. DM
    Time.Left=3600! ' user gets 60 minutes
 Case Else ' user is non DM
    Select Case UserRecord.Level ' select by user level
    Case Is<2 ' user level is less than two
       Time.Left=900! ' user gets 15 mminutes
    Case Else ' user level is two or more
       Time.Left=1800! ' user gets 30 minutes
    End Select ' end user level
 End Select ' end user DM status
 If Time.Left>Door.Time Then ' compare user's time left to door file time left
    If Door.Time>False Then ' compare door file time
       Time.Left=Door.Time ' reset time left to door time left
    Endif ' end compare door file time
 Endif ' end compare user time left
 Two.Minutes.Left=False ' reset two minutes left message flag
 User.Echo=UserRecord.Echo ' store user preference
 User.LineFeeds=UserRecord.LineFeeds ' store user preference
 User.LineLength=UserRecord.LineLength ' store user preference
 User.PageLength=UserRecord.PageLength ' store user preference
 User.Wordwrap=UserRecord.Wordwrap ' store user preference
End Sub ' end routine to initialize some login variables

 Rem * routine to check user is restricted to specific login times.
 Rem * work variables:
 Rem *   Restrict.Start! - time in seconds to restrict logon.
 Rem *   Restrict.End! - time in seconds to restrict logon.

Sub Restricted.Login
 On Local Error Resume Next ' local error resume
 ' calculate time restrictions
 Restrict.Start!=Csng(UserRecord.FromHour*3600!+UserRecord.FromMin*60!)
 Restrict.End!=Csng(UserRecord.ToHour*3600!+UserRecord.ToMin*60!)
 ' compare any time restriction
 If Restrict.Start!>False Or Restrict.End!>False Then
    If Timer<Restrict.Start! Or Timer>Restrict.End! Then ' compare time to now
       Call Hang.Up(6) ' routine to terminate program w/ message
    Endif ' end compare time
 Endif ' end compare time restriction
End Sub ' end routine to check restricted time login

 Rem * routine to intialize some new user variables in user file record.

Sub Init.Newuser
 On Local Error Resume Next ' local error resume
 UserRecord.NumCalls=False ' reset maximum calls made today
 UserRecord.ClassType=False ' reset class type
 Outpt=Player.CodeName ' store codename
 Call Valid(Outpt,30) ' validate codename
 Call Encrypt(Outpt,True) ' encrypt codename
 UserRecord.CodeName=Outpt ' restore codename
 Outpt=Player.PassWord ' store password
 Call Valid(Outpt,20) ' validate password
 Call Encrypt(Outpt,False) ' encrypt password
 UserRecord.PassWord=Outpt ' restore password
 Outpt=Deleted$ ' set deleted
 Call Valid(Outpt,20) ' validate deleted
 Call Encrypt(Outpt,True) ' encrypt deleted
 UserRecord.ClassName=Outpt ' reset classname
 Outpt=Date$ ' store current date
 Call Valid(Outpt,10) ' validate date
 Call Encrypt(Outpt,True) ' encrypt date
 UserRecord.DateOn=Outpt ' reset date
 UserRecord.MaxCalls=False ' reset maximum calls made
 UserRecord.FromHour=False ' reset time restrictions
 UserRecord.FromMin=False
 UserRecord.ToHour=False
 UserRecord.ToMin=False
End Sub ' end routine to intialize new user variables

 Rem * routine to initialize some user variables.

Sub Login.User
 On Local Error Resume Next ' local error resume
 Number.Monsters=False ' counter of monsters currently in the room
 Monsters.Killed=False ' counter of monster killed by player during session
 ' allocate room monster arrays
 Redim MonsterArray(1 To 20) As MonsterType, _
 MonsterIndex(1 To 20) As Integer
 Max.Spells=Lof(SpellFile)/Len(SpellRecord) ' compute number of spells in file
 If Max.Spells=False Then ' compare empty file
    Max.Spells=1 ' set number to at least one
    Call Share.Record(SpellFile,1) ' put default spell record
 Endif ' end compare file
 ' check bounds of spell file
 If Max.Spells>1024 Then ' check bounds
    Max.Spells=1024 ' reste maximum
 Endif ' end check bounds
 ' make string of zeros length of spell file
 Learned.Spells=String$(Max.Spells,"0")
 If UserRecord.Race<=False Then ' check user race
    UserRecord.Race=1 ' reset to one
 Endif ' end check race
 Call Share.Record(UserFile,User.Index) ' put the user record
 Room=UserRecord.Room ' store the room number
 If UserRecord.Level=False Then ' check user level
    Outpt="You are level zero. You can use the train command once free."
    Call IO.O ' send output message
 Endif ' end compare level
 Call Bank.Interest ' calculate bank interest for balance and loan
 Call Check.Mail ' routine to display number of new messages to player
 Weapon1=False ' reset working game weapon, shield, armor, and ring variables
 Weapon2=False ' reset variable
 Weapon3=False ' reset variable
 Weapon4=False ' reset variable
 Weapon5=False ' reset variable
 Weapon6=False ' reset variable
 Weapon7=False ' reset variable
 Weapon8=False ' reset variable
 Weapon9=False ' reset variable
 Weapon10=False ' reset variable
 Call Get.User.Record ' read the user record
 Call Status.Line(1) ' initialize the console status lines
 Func.Buffer=Nul ' reset function key buffer
End Sub ' end routine to initialize some user variables

 Rem * routine to display treasure item.
 Rem * input variables:
 Rem *   Index.Number - treasure record number.
 Rem *   Type.Number - room/inventory flag.

Sub Show.Treasure
 On Local Error Resume Next ' local error resume
 If Type.Number Then ' compare treasure in room
    Prefix1="It's " ' format prefix
 Else ' compare treasure in player inventory
    Prefix1="You are carrying " ' format prefix
 Endif ' end compare treasure
 Graphics.Off=True ' reset color
 If TreasureRecord.Scroll Then ' compare treasure to scroll
    If TreasureRecord.Spell Then ' check scroll spell number
       Call Read.Record(SpellFile,TreasureRecord.Spell) ' get spell record
       Inpt=SpellRecord.Chant ' store spell chant
       Inpt=Rtrim$(Inpt) ' trim chant
       Inpt=Lcase$(Inpt) ' trim chant
       Outpt="It reads: '"+Inpt+"'." ' display scroll chant
       Call IO.O ' send message
       Outpt="It disintegrated!" ' scroll vanished message
       Call IO.O ' send output
       If Type.Number=False Then ' compare treasure in room
          ' remove scroll from inventory
          Call Discard.Inventory(Array.Number,True)
       Else ' compare treasure
          Call Discard.Room.Treasure(Array.Number) ' remove scroll from room
       Endif ' end compare treasure
    Endif ' end compare scroll spell number
    Exit Sub ' exit routine
 Endif ' end compare treasure is scroll
 Outpt=Prefix1+Outpts ' format treasure name description
 If TreasureRecord.Keyed Then ' append key number to treasure name
    Outpt=Outpt+"(#"+Right$(Str$(TreasureRecord.Keyed+100000!),5)+")"
 Endif ' end compare treasure key number
 If TreasureRecord.Plus Then ' append plus number to treasure name
    Outpt=Outpt+"(+"+Mid$(Str$(Abs(TreasureRecord.Plus)),2)+")"
 Endif ' end compare treasure plus
 If TreasureRecord.Spell Then ' append spell plus to treasure name
    Call Read.Record(SpellFile,TreasureRecord.Spell) ' get spell record
    Outpt=Outpt+"(+"+Mid$(Str$(SpellRecord.Level),2)+")"
 Endif ' end compare treasure spell plus
 If TreasureRecord.LightType Then ' compare treasure to a light
    If Charges.Number<False Then ' check treasure is also lit
       Outpt=Outpt+"[lit]" ' append to treasure name
    Endif ' end check lit treasure
 Endif ' end compare treasure to light
 If TreasureRecord.Invisible Then ' compare treasure is invisible
    Outpt=Outpt+"[inv]" ' append to treasure name
 Else ' compare treasure
    If Type.Number=1 Then ' check treasure is in room
       ' verify treasure in
       If RoomRecord.Flags(Array.Number)=Hidden.Object Then
          Outpt=Outpt+"[inv]" ' room is invisible, append to name
       Endif ' end verify treasure in room was hidden
    Endif ' end check treasure in room
 Endif ' end compare treasure is invisible
 Call IO.O ' display treasure name message
 If TreasureRecord.Proficiency Then ' compare treasure proficiency
    Outpt=Weapon.Type.Name(TreasureRecord.Proficiency) ' get proficiency
    Outpt=Rtrim$(Outpt) ' name and trim
    Outpt="This is a "+Outpt+" weapon." ' make weapon type message
    Call IO.O ' display weapon type message
 Endif ' end compare treasure proficiency
 If Last.Command.Number=Identify.Command Then ' check identify command used
    Outpt="It's worth"+Str$(TreasureRecord.Gold)+" gold peices."
    Call IO.O ' display treasure item gold value
    Outpt="It weighs"+Str$(TreasureRecord.Weight)+" pounds."
    Call IO.O ' display weight of item
    If TreasureRecord.RingType Then ' compare treasure ring type
       Select Case TreasureRecord.RingType ' determine ring type
       Case 1 ' ring type
          Outpt="protection from poison." ' ring type message
       Case 2 ' ring type
          Outpt="protection from level drain." ' ring type message
       Case 3 ' ring type
          Outpt="protection from spells." ' ring type message
       End Select ' end dtermine ring type
       Outpt="Its ring spell is "+Outpt ' make ring type message
       Call IO.O ' send ring type message
    Endif ' end compare treasure to ring
    If TreasureRecord.Spell Then ' compare treasure spell type
       Call Read.Record(SpellFile,TreasureRecord.Spell) ' get treasure spell
       Outpt="Its magical spell is "+Rtrim$(SpellRecord.SpellName)+"."
       Call IO.O ' display name of treasure spell
    Endif ' end compare treasure spell type
    ' compare treasure is loaded
    If TreasureRecord.Loadable Or TreasureRecord.Launchable Then
       If Charges.Number<=False Then ' compare treasure charges
          Outpt="It's not loaded." ' display message
       Else ' compare treasure charges
          Outpt="It's loaded with"+Str$(Charges.Number)+" charges." ' message
       Endif ' end compare loaded treasure charges
       Call IO.O ' send message of charges in loaded treasure
    Else ' compare treasure item
       If TreasureRecord.LightType Then ' compare treasure is a light
          If Charges.Number<False Then ' compare light charges (is negative)
             Outpt="It's fueled with"+Str$(Abs(Charges.Number))+" charges."
             Call IO.O ' send message of charges in light
          Endif ' end compare light charges
       Else ' compare other treasure plus
          If TreasureRecord.RingType Or TreasureRecord.Spell Or _
          TreasureRecord.Plus Then ' treasure has charges
             If Charges.Number<=False Then ' compare charges
                Outpt="It's empty of charges." ' message
             Else ' compare charges
                ' message of charges
                Outpt="It has"+Str$(Charges.Number)+" charges."
             Endif ' end compare charges
             Call IO.O ' send message of charges
          Endif ' end compare treasure charges
       Endif ' end compare treasure plus
    Endif ' end compare treasure
    ' compare treasure is ammunition
    If TreasureRecord.Ammunition Or TreasureRecord.LaunchAmmo Then
       Outpt="It's ammunition." ' treasure nessage
       Call IO.O ' send message
    Endif ' end compare treasure
    If TreasureRecord.Potion Then ' compare treasure to potion
       Outpt="It's a potion." ' make message
       Call IO.O ' send message
    Endif ' end compare to potion
    If TreasureRecord.Edible Then ' compare treasure to food
       Outpt="It's edible." ' make message
       Call IO.O ' send message
    Endif ' end compare to food
 Endif ' end identify command
 Graphics.Off=False ' reset color
End Sub ' end routine to display an itemof treasure

 Rem * routine to display object information.
 Rem * input variables:
 Rem *   Index.Number - object record number.
 Rem *   Type.Number - object is in room/inventory.

Sub Show.Object
 On Local Error Resume Next ' local error resume
 If Type.Number Then ' determine object in room
    Prefix1="It's " ' make prefix
 Else ' object in inventory
    Prefix1="You are carrying " ' make prefix
 Endif ' end determine in room
 Graphics.Off=True ' reset color
 Outpt=Prefix1+Outpts ' make message with object name
 If ObjectRecord.DoorLock>1 Then ' compare object is locked
    Outpt=Outpt+"[locked]" ' append to object name
 Endif ' end compare locked object
 If ObjectRecord.DoorLock=1 Then ' compare object is unlocked
    If ObjectRecord.Closed Then ' compare object is closed
       Outpt=Outpt+"[closed]" ' append to object name
    Endif ' end compare closed object
 Endif ' end compare object lock
 If ObjectRecord.Invisible Then ' compare object is invisible
    Outpt=Outpt+"[inv]" ' append to object name
 Endif ' end compare object invisible
 If ObjectRecord.Keyed Then ' compare object key, append number to name
    Outpt=Outpt+"(#"+Right$(Str$(ObjectRecord.Keyed+100000!),5)+")"
 Endif ' end compare object key number
 Call IO.O ' display message with object name
 Outpt=ObjectRecord.LongDesc ' store object additional description
 Outpt=Rtrim$(Outpt) ' trim description
 If Outpt<>Nul Then ' compare length of description
    Call IO.O ' display additional object description
 Endif ' end compare object description length
 Graphics.Off=False ' reset color
End Sub ' end routine to display object information

 Rem * routine to display information on a monster.
 Rem * input variables:
 Rem *   Monster.Number - number of monster array.

Sub Show.Monster
 On Local Error Resume Next ' local error resume
 Graphics.Off=True ' reset color
 Call The.Or.An ' routine for monster name prefix (a, an, the)
 Level=MonsterArray(Monster.Number).Level ' store monster level
 Outpt="It's "+Prefix1+Outpts ' make message of monster name
 ' append monster level (range of player's level capable to kill monster)
 Outpt=Outpt+"(level"+Str$((Level-1)*2+1)+" to"+Str$(Level*2)+")"
 Call IO.O ' send message with monster name and level range
 If Last.Command.Number=Identify.Command Then ' compare identify command
    Gold.Points#=MonsterArray(Monster.Number).Gold ' store monster gold
    If Gold.Points#<=False Then ' compare monster gold
       Gold.Points#=10 ' set to minimum
    Endif ' end compare monster gold
    Outpt="It has"+Str$(MonsterArray(Monster.Number).Hits)+" hits,"+ _
    Str$(MonsterArray(Monster.Number).Experience)+" experience, and"+ _
    Str$(Gold.Points#)+" gold."
    Call IO.O ' display message of monster gold
    Outpt="It carries the following treasure:" ' make message
    Call IO.O ' send message of treasure carried by monster
    Inventory.Count=False ' reset number of monster inventory items displayed
    For Array.Count=1 To 5 ' loop through all monster inventory
       ' get treasure
       Treasure.Number=MonsterArray(Monster.Number).Treasure(Array.Count)
       ' number and check range in treasure file
       If Treasure.Number>False And _
          Treasure.Number<=Lof(TreasureFile)/Len(TreasureRecord) Then
          Carriage.Return=True ' flag to disable return/linefeed
          Call IO.O ' send output of previous item
          Call Read.Record(TreasureFile,Treasure.Number) 'get treasure record
          Outpts=TreasureRecord.TreasureName ' store treasure name
          Outpt=Rtrim$(Outpts)+", " ' trim name, append comma
          Inventory.Count=Inventory.Count+1 ' increment items displayed flag
          If Inventory.Count=1 Then ' compare item to first displayed
             Mid$(Outpt,1,1)=Ucase$(Mid$(Outpt,1,1)) ' uppercase first item
          Endif ' end compare first item
       Endif ' end check treasure file range
    Next ' end loop through monster inventory
    If Inventory.Count=False Then ' check if any items displayed
       Outpt="Nothing at all." ' make message for none
    Else ' check items displayed
       Outpt=Left$(Outpt,Len(Outpt)-2)+"." ' trim comma, append period
       If Inventory.Count>1 Then ' check more than one item displayed
          Outpt="and "+Outpt ' append to last item
       Endif ' end check items
    Endif ' end check item
    Call IO.O ' send output for last item
    ' compare monster spell ability
    Spell.Number=MonsterArray(Monster.Number).Spell
    ' check spell
    If Spell.Number>False And _
    Spell.Number<=Lof(SpellFile)/Len(SpellRecord) Then
       Call Read.Record(SpellFile,Spell.Number) ' range and get spell record
       Outpt="It can cast "+Rtrim$(SpellRecord.SpellName)+" spells!"
       Call IO.O ' send message of spell name monster can cast
    Endif ' end compare monster spell
    If MonsterArray(Monster.Number).Poison Then ' compare monster poisonous
       Outpt="It can poison!" ' make message
       Call IO.O ' send output message
    Endif ' end compare monster poisonous
    If MonsterArray(Monster.Number).LevelDrain Then ' compare monster undead
       Outpt="It can drain levels!" ' make message
       Call IO.O ' send output message
    Endif ' end compare monster undead
    If MonsterArray(Monster.Number).Psionic Then ' compare monster astral
       Outpt="It can cast psi spells!" ' make message
       Call IO.O ' send output message
    Endif ' end compare monster astral
 Endif ' end check identify command used
 Graphics.Off=False ' reset color
End Sub ' end routine to display monster information

 Rem * routine to determine validity of room number.
 Rem * input variables:
 Rem *   Room - contains room number to check.

Sub Check.Next.Room
 On Local Error Resume Next ' local error resume
 Do ' loop until room is valid, room is created, or nondescriptive hangup
    If Room>False And _
    Room<=Lof(RoomFile)/Len(RoomRecord) Then ' check room range
       Call Read.Room.Record(Room) ' valid range, get room record
       Exit Sub ' exit routine
    Endif ' end check valid range
    If Room>Lof(RoomFile)/Len(RoomRecord) Then ' compare room number range
       If Not Normal.User Then ' check non DM status
          Call Add.Room(False,Room.Created) ' routine to create new room
          If Room.Created Then ' return variable indicates new room created
             Exit Sub ' exit routine
          Endif ' end create new room
       Endif ' end check normal user
    Endif ' end compare room number range
    ' otherwise, any room number out of range will be changed to room 1, or
    ' changed to the resurrection room number.
    If Lof(RoomFile)/Len(RoomRecord)>=1 Then ' check for room
       Graphics.Off=False ' reset color
       Outpt="Nondescriptive room number"+Str$(Room)+"!" ' make error message
       Call IO.O ' display room number error message
       Room=1 ' reset room number to resurrection room, continue loop
    Else ' room file is invalid, room file length is zero
       Graphics.Off=False ' reset color
       Room=1 ' reset room number
       Call Clear.Room(1) ' add first room
       Exit Sub ' exit routine
    Endif ' end check room file length
 Loop ' end loop until valid room number
End Sub ' end routine to check room number validity

 Rem * routine to initialize some room variables, check next room number, and
 Rem * display next room description.
 Rem * input variables:
 Rem *   Room - room number to move to.
 Rem * output variables:
 Rem *   Room.Rust.Rate - number of prompts to check weapon rusting.
 Rem *   Room.Steal.Rate - number of prompts to check monster stealing.
 Rem *   Room.Monster.Rate - number of prompts to check monster encounter.
 Rem *   Room.Health.Rate - number of prompts to check health increases.

Sub Display.Room
 On Local Error Resume Next ' local error resume
 Call Check.Next.Room ' routine to verify next room number
 Room.Rust.Rate=False ' store room rust rate
 Room.Steal.Rate=False ' store room steal rate
 Room.Monster.Rate=6 ' store default room encounter rate
 Room.Health.Rate=6 ' store default room health rate
 Room.Action=RoomRecord.Action
 If Room.Action>False And Room.Action<=Lof(ActionFile)/Len(ActionRecord) Then
    Call Read.Record(ActionFile,Room.Action)
    If ActionRecord.RustRate>False Then ' check room record action rust rate
       Room.Rust.Rate=ActionRecord.RustRate ' store room rust rate
    Endif ' end check action
    If ActionRecord.StealRate>False Then ' check room record action steal rate
       Room.Steal.Rate=ActionRecord.StealRate ' store room steal rate
    Endif ' end check action
    ' check room record action encounter rate
    If ActionRecord.EncounterRate Then
       ' store action encounter rate
       Room.Monster.Rate=ActionRecord.EncounterRate
    Endif ' end check action
    If ActionRecord.HealthRate Then ' check room record action health rate
       Room.Health.Rate=ActionRecord.HealthRate ' store action health rate
    Endif ' end check action
 Endif
 Call Show.Room ' routine to display room
End Sub ' end routine to process next room

 Rem * routine to determine if a room is unlit.
 Rem * return variables:
 Rem *   Lit.Room - true if room is unlit.

Sub Check.Lit.Room(Lit.Room)
 On Local Error Resume Next ' local error resume
 Lit.Room=False ' room is lit by default
 Call Read.Room.Record(Room) ' get room record
 Action.Number=RoomRecord.Action ' store action number
 ' check action number
 If Action.Number<1 Or Action.Number>Lof(ActionFile)/Len(ActionRecord) Then
    Lit.Room=False ' room is lit
    Exit Sub ' exit lit check routine
 Endif ' end check action number
 Call Read.Record(ActionFile,Action.Number) ' get action record number
 If ActionRecord.Attribute1=LitRoom Then ' compare lit flag
    Lit.Room=False ' room is lit
    Exit Sub ' exit check lit routine
 Endif ' end check lit flag
 Lit.Room=True ' flag for unlit room
 For Array.Index=1 To 20 ' loop through all user inventory
    Treasure.Number=UserRecord.Inv(Array.Index) ' get inventory number
    If Treasure.Number Then ' compare user treasure number
       Call Read.Record(TreasureFile,Treasure.Number) ' get treasure record
       If TreasureRecord.LightType Then ' check treasure item is a light
          ' check light is charged/lit
          If UserRecord.Charges(Array.Index)<False Then
             Lit.Room=False ' set flag for lit room
             Exit Sub ' exit routine
          Endif ' end check charged light
       Endif ' end check treasure is a light
    Endif ' end compare treasure number
 Next ' end loop through user inventory
 For Array.Index=1 To 20 ' loop through all treasure in room
    ' get room treasure number
    Treasure.Number=RoomRecord.Treasure(Array.Index)
    If Treasure.Number Then ' compare treasure number
       Call Read.Record(TreasureFile,Treasure.Number) ' get treasure record
       If TreasureRecord.LightType Then ' compare treasure is a light
          ' compare light is charged
          If RoomRecord.TreCharges(Array.Index)<False Then
             Lit.Room=False ' set flag for lit room
             Exit Sub ' exit routine
          Endif ' end compare charged light
       Endif ' end compare treasure is a light
    Endif ' end compare treasure number
 Next ' end loop through room treasure
 For Array.Index=1 To 20 ' loop through all room objects
    If RoomRecord.Object(Array.Index) Then ' compare room object number
       Call Read.Record(ObjectFile,RoomRecord.Object(Array.Index)) 'get record
       If ObjectRecord.LightRoom Then ' check object is a light
          If ObjectRecord.LightTime=False Then ' object lights at any time
             Lit.Room=False ' set flag for lit room
             Exit Sub ' exit routine
          Else ' light has light time restriction
             ' calculate seconds light from/to
             Start.Time!=Csng(ObjectRecord.FromHour*3600!+ _
             ObjectRecord.FromMin*60!)
             End.Time!=Csng(ObjectRecord.ToHour*3600!+ObjectRecord.ToMin*60!)
             ' check valid light time
             If Start.Time!>False Or End.Time!>False Then
                ' compare times
                If Timer>=Start.Time! And Timer<=End.Time! Then
                   Lit.Room=False ' set room lit flag
                   Exit Sub ' exit routine
                Endif ' end compare times
             Endif ' end check valid light time
          Endif ' end check object light type
       Endif ' end check object is a light
    Endif ' end compare object number
 Next ' end loop through room objects
 For Array.Index=1 To 5 ' loop through all user object inventory
    If UserRecord.Object(Array.Index) Then ' compare user object number
       Call Read.Record(ObjectFile,UserRecord.Object(Array.Index)) 'get object
       If ObjectRecord.LightRoom Then ' compare object is a light
          If ObjectRecord.LightTime=False Then ' check object lights any time
             Lit.Room=False ' set flag for lit room
             Exit Sub ' exit routine
          Else ' compare object light time restriction
             ' calculate seconds light from/to
             Start.Time!=Csng(ObjectRecord.FromHour*3600!+ _
             ObjectRecord.FromMin*60!)
             End.Time!=Csng(ObjectRecord.ToHour*3600!+ObjectRecord.ToMin*60!)
             ' check valid light time
             If Start.Time!>False Or End.Time!>False Then
                ' compare times
                If Timer>=Start.Time! And Timer<=End.Time! Then
                   Lit.Room=False ' set lit room flag
                   Exit Sub ' exit routine
                Endif ' end compare times
             Endif ' end check valid light times
          Endif ' end compare object light type
       Endif ' end compare object is a light
    Endif ' end compare object number
 Next ' end loop through user objects
End Sub ' end routine to determine lit room

 Rem * routine to display all the player character statistics.

Sub Display.Stats
 On Local Error Resume Next ' local error resume
 Graphics.Off=True ' reset color
 Outpt=UserRecord.CodeName ' get user codename
 Call Decrypt(Outpt) ' decrypt codename
 Outpt=Rtrim$(Outpt) ' trim codename
 Outpt=Lcase$(Outpt) ' set codename to lowercase
 Mid$(Outpt,1,1)=Ucase$(Mid$(Outpt,1,1)) ' uppercase first letter
 Outpt="Information: "+Outpt+". "+FNclock$+"." ' make information message
 Call IO.O ' send message
 Call Show.Align ' routine to display player alignment
 Call More.Prompt ' pause display
 If No Then ' check more prompt response
    Exit Sub ' exit info display
 Endif ' end check more prompt
 Call Show.Health ' routine to display player statistics
 Call More.Prompt ' pause display
 If No Then ' check more prompt response
    Exit Sub ' exit info display
 Endif ' end check more prompt
 Call Display.Info ' routine to display additional player information
 Call More.Prompt ' pause display
 If No Then ' check more prompt response
    Exit Sub ' exit info display
 Endif ' end check more prompt
 Call Display.Inventory ' routine to display player inventory
 Call More.Prompt ' pause display
 If No Then ' check more prompt response
    Exit Sub ' exit info display
 Endif ' end check more prompt
 Call Display.Experience ' routine to display player experience and gold
 Call More.Prompt ' pause display
 If No Then ' check more prompt response
    Exit Sub ' exit info display
 Endif ' end check more prompt
End Sub ' end routine to display all player character statistics

 Rem * routine to display player character experience, and gold.
 Rem * routine notes:
 Rem *    although gold and experience required to reach the next level double
 Rem *    each player level, the experience and gold required for players over
 Rem *    level 10 only increase by 10,000 points per level over 10.

Sub Display.Experience
 On Local Error Resume Next ' local error resume
 Graphics.Off=True ' reset color
 Outpt="You have "+FNform$(UserRecord.Gold)+" gold and "+ _
 FNform$(UserRecord.Experience)+" experience." ' make gold/experience message
 Call IO.O ' send output message
 Level=UserRecord.Level ' store player level
 If Level>False And Level<MaxInt Then ' compare level maximum
    Level=Level+1 ' increment next level needed
    ' routine to calculate gold required for next level
    Call Gold(Gold.Required#)
    Call Experience(Exp.Required#) ' routine to calculate experience needed
    Outpt="You need "+FNform$(Gold.Required#)+" gold and "+ _
    FNform$(Exp.Required#)+" experience to reach level"+Str$(Level)+"."
    Call IO.O ' send output message
 Else ' compare level
    Outpt="There is no experience or gold at your level."
    Call IO.O
 Endif ' end compare level
End Sub

 Rem * routine to display player characteristics, and weapons, shields, armor,
 Rem * and rings being held/worn.

Sub Display.Info
 On Local Error Resume Next ' local error resume
 Graphics.Off=True ' reset color
 If Sysop Then ' verify user is a sysop
    Outpt="You are a Sysop!" ' make message
    Call IO.O ' send message
 Endif ' end verify sysop
 If Dungeon.Master Then ' verify user is a DM
    Outpt="You are a Dungeon Master!" ' make message
    Call IO.O ' send message
 Endif ' end verify DM
 If Dungeon.Master.Assistant Then ' verify user is an Asst. DM
    Outpt="You are an Assistant Dungeon Master!" ' make message
    Call IO.O ' send message
 Endif ' end verify Asst. DM
 If Town.Mayor Then ' verify user is the mayor
    Outpt="You are the Town Mayor!" ' make message
    Call IO.O ' send message
 Endif ' end verify mayor
 If Governor Then ' verify user is governor
    Outpt="You are the Governor!" ' make message
    Call IO.O ' send message
 Endif ' end verify governor
 If Guild.Master Then ' verify user is guild master
    Outpt="You are the Guild Master!" ' make message
    Call IO.O ' send message
 Endif ' end verify guild master
 If UserRecord.Invisible Or Invisible Then ' check invisibility
    Outpt="You are invisible!" ' make message
    Call IO.O ' send message
 Endif ' end check invisibility
 If UserRecord.Poison Then ' check poisoned
    Outpt="You are poisoned!" ' make message
    Call IO.O ' send message
 Endif ' end check poisoned
 If Weapon1=False Then ' check wearing armor
    If Weapon7=False Then ' check wearing ring
       Outpt="You are wearing nothing." ' make message
       Call IO.O ' send message
    Endif ' end check ring
 Endif ' end check armor
 If Weapon2=False Then ' check holding weapon
    If Weapon3=False Then ' check holding shield
       Outpt="You are holding nothing." ' make message
       Call IO.O ' send message
    Endif ' end check shield
 Endif ' end check weapon
 Outpt=Nul ' clear display string
 If Weapon1 Or Weapon7 Then ' check either armor or ring being worn
    Outpt="You are wearing " ' initialize display string
    If Weapon1 Then ' check armor being worn
       Call Read.Record(TreasureFile,Abs(UserRecord.Inv(Weapon4))) ' get armor
       Outpt=Outpt+Rtrim$(TreasureRecord.TreasureName) ' record, append name
    Endif ' end check armor worn
 Endif ' end check either being worn
 If Weapon7 Then ' check ring being worn
    Call Read.Record(TreasureFile,Abs(UserRecord.Inv(Weapon7))) 'ring treasure
    If Weapon1 Then ' check armor worn again
       Outpt=Outpt+" and "+Rtrim$(TreasureRecord.TreasureName)+"." ' append
       Call IO.O ' both items being worn
    Else ' armor not worn
       Outpt="You are wearing "+Rtrim$(TreasureRecord.TreasureName)+"."
       Call IO.O ' display only ring being worn
    Endif ' end check armor worn
 Else ' end check ring worn
    If Weapon1 Then ' check armor worn, ring not
       Outpt=Outpt+"." ' append period
       Call IO.O ' display only armor worn
    Endif ' end check armor, ring
 Endif ' end check ring worn
 Outpt=Nul ' clear display string
 If Weapon2 Or Weapon3 Then ' check either weapon or shield being held
    Outpt="You are holding " ' initialize display string
    If Weapon2 Then ' check weapon being held
       Call Read.Record(TreasureFile,Abs(UserRecord.Inv(Weapon6))) 'get weapon
       Outpt=Outpt+Rtrim$(TreasureRecord.TreasureName) ' record, append name
    Endif ' end check weapon held
 Endif ' end check either being held
 If Weapon3 Then ' check shield being held
    Call Read.Record(TreasureFile,Abs(UserRecord.Inv(Weapon5))) 'shield record
    If Weapon2 Then ' check weapon held again
       Outpt=Outpt+" and "+Rtrim$(TreasureRecord.TreasureName)+"." ' append
       Call IO.O ' both items being held
    Else ' weapon not held
       Outpt="You are holding "+Rtrim$(TreasureRecord.TreasureName)+"."
       Call IO.O ' display only shield being held
    Endif ' end check weapon held
 Else ' end check shield held
    If Weapon2 Then ' check weapon held, not shield
       Outpt=Outpt+"." ' append period
       Call IO.O ' display only weapon held
    Endif ' end check weapon, shield
 Endif ' end check shield held
End Sub ' end routine to display player characteristics

 Rem * routine to display player character alignment and health statistics.

Sub Display.Health
 On Local Error Resume Next ' local error resume
 Graphics.Off=True ' reset color
 Call Show.Align ' routine to display alignment
 Call Show.Health ' routine to display health statistics
End Sub ' end routine to display alignment/health

 Rem * routine to display health statistics, and weapon, shield, armor plus.

Sub Show.Health
 On Local Error Resume Next ' local error resume
 Graphics.Off=True ' reset color
 ' display vital health statistics in percentage form
 Outpt="Vitals: " ' make output message
 Var1#=Cdbl(UserRecord.FatigueMax) ' calculate total hits
 Var1#=Var1#+Cdbl(+UserRecord.VitalityMax) ' calculate total hits
 Var2#=Cdbl(UserRecord.Fatigue) ' calculate hits remaining
 Var2#=Var2#+Cdbl(+UserRecord.Vitality) ' calculate hits remaining
 Outpt=Outpt+"Body" ' append health message
 If Var1#=0# Then ' check divide by zero
    Temp#=0# ' reset health hits
 Else ' check divide
    Temp#=((Var2#/Var1#)*.40#)*100# ' compute health percentage
    Temp#=Int(Temp#) ' compute health integer
    If Temp#<1.0# Then ' check percentage
       Temp#=1.0# ' reset percentage
    Endif ' end check percentage
 Endif ' end check divide by zero
 If Temp#<0# Then ' check overflow
    Temp#=0# ' reset percentage
 Endif ' end ceck overflow
 Outpt=Outpt+Str$(Temp#)+"%" ' append health percentage
 Outpt=Outpt+" Arms" ' append health message
 If Var1#=0# Then ' check divide by zero
    Temp#=0# ' reset health hits
 Else ' check divide
    Temp#=((Var2#/Var1#)*.25#)*100# ' compute health percentage
    Temp#=Int(Temp#)
    If Temp#<1.0# Then ' check percentage
       Temp#=1.0# ' reset percentage
    Endif ' end check percentage
 Endif ' end check divide by zero
 If Temp#<0# Then ' check overflow
    Temp#=0# ' reset percentage
 Endif ' end ceck overflow
 Outpt=Outpt+Str$(Temp#)+"%" ' append health percentage
 Outpt=Outpt+" Legs" ' append health message
 If Var1#=0# Then ' check divide by zero
    Temp#=0# ' reset health hits
 Else ' check divide
    Temp#=((Var2#/Var1#)*.25#)*100# ' compute health percentage
    Temp#=Int(Temp#)
    If Temp#<1.0# Then ' check percentage
       Temp#=1.0# ' reset percentage
    Endif ' end check percentage
 Endif ' end check divide by zero
 If Temp#<0# Then ' check overflow
    Temp#=0# ' reset percentage
 Endif ' end ceck overflow
 Outpt=Outpt+Str$(Temp#)+"%" ' append health percentage
 Outpt=Outpt+" Head" ' append health message
 If Var1#=0# Then ' check divide by zero
    Temp#=0# ' reset health hits
 Else ' check divide
    Temp#=((Var2#/Var1#)*.10#)*100# ' cmpute health percentage
    Temp#=Int(Temp#)
    If Temp#<1.0# Then ' check percentage
       Temp#=1.0# ' reset percentage
    Endif ' end check percentage
 Endif ' end check divide by zero
 If Temp#<0# Then ' check overflow
    Temp#=0# ' reset percentage
 Endif ' end ceck overflow
 Outpt=Outpt+Str$(Temp#)+"%" ' append health percentage
 Call IO.O ' send output
 ' health statistics line one contains vitals in form:
 ' Vitals: Fat 10/10(+10) Vit 10/10 Mag 10/10 Psi 10/10
 If Weapon1 Or Weapon3 Then ' check armor, shield
    ' add pluses to message
    Weapon.Plus$="(+"+Mid$(Str$(Weapon1+Weapon3),2)+")"
 Else ' neither armor, shield
    Weapon.Plus$=Nul ' clear plusses message
 Endif ' end check armor, shield
 Outpt="Vital hits:" ' initialize health one line
 ' append current fatigue and maximum fatigue
 Outpt=Outpt+" Fat" ' append stat name
 Outpt=Outpt+Str$(UserRecord.Fatigue)+"/"+Mid$(Str$(UserRecord.FatigueMax),2)
 Outpt=Outpt+Weapon.Plus$ ' append plusses message
 ' append current vitality and maximum vitality
 Outpt=Outpt+" Vit" ' append stat name
 Outpt=Outpt+Str$(UserRecord.Vitality)+"/"+Mid$(Str$(UserRecord.VitalityMax),2)
 ' append current magic points and maximum magic points
 Outpt=Outpt+" Mag" ' append stat name
 Outpt=Outpt+Str$(UserRecord.Magic)+"/"+Mid$(Str$(UserRecord.MagicMax),2)
 ' append current psionic points and maximum psionic points
 Outpt=Outpt+" Psi" ' append stat name
 Outpt=Outpt+Str$(UserRecord.Psionic)+"/"+Mid$(Str$(UserRecord.PsionicMax),2)
 Call IO.O ' display vitals message line
 ' health statistics line two contains vitals in form:
 ' Stats: Str 10(+10) Int 10 Wis 10 Dex 10 Con 10 Pie 10 Cha 10
 Outpt="Stats: " ' initialize vitals message
 For Array.Index=1 To 7 ' loop through all health statistics
    ' append first three letters of statistics name and player statistic value
    Outpt=Outpt+Left$(Stat(Array.Index),3)+Str$(UserRecord.Stats(Array.Index))
    If Array.Index=1 Then ' check strength selected
       If Weapon2 Then ' verify weapon being held
          Outpt=Outpt+"(+"+Mid$(Str$(Weapon2),2)+")" ' append weapon plus
       Endif ' end check weapon
    Endif ' end check strength
    Outpt=Outpt+" " ' append one space
 Next ' end loop through health statistics
 Call IO.O ' display vitals message line
 ' health statistics line three contains vitals in form:
 ' Weapons: Blunt> 0% Pole> 0% Sharp> 10% Thrusting> 0%
 Outpt="Weapons: " ' initialize vitals message
 For Weapon.Number=1 To 4 ' loop through all weapon classes
    Weapon$=Rtrim$(Weapon.Type.Name(Weapon.Number)) ' make weapon name
    Mid$(Weapon$,1,1)=Ucase$(Mid$(Weapon$,1,1)) ' make weapon name
    Outpt=Outpt+Weapon$ ' append weapon class name
    ' append player weapon class percentage value
    Outpt=Outpt+Str$(UserRecord.Weapons(Weapon.Number))+"% "
 Next ' loop through weapon classes
 Call IO.O ' display vitals message line
 ' display lady statistics
 If UserRecord.ClassType=Lady Then ' compare user class type to lady
    ' make message for lady statistics
    Outpt="Lady stats: Beauty "+Str$(UserRecord.Beauty) ' append beauty value
    Outpt=Outpt+" Glamour "+Str$(UserRecord.Glamour) ' append glamour value
    Call IO.O ' send lady statistics message
 Endif ' end compare user class type
End Sub ' end routine to display health statistics

 Rem * routine to display player character alignment.

Sub Show.Align
 On Local Error Resume Next ' local error resume
 Graphics.Off=True ' reset color
 If UserRecord.Level<=False Then ' check user level
    Outpt="You are dead!" ' make user level message
    Call IO.O ' send output message
    Exit Sub ' exit routine
 Endif ' end check user level
 Outpt="You are a level"+Str$(UserRecord.Level) ' make user level message
 If UserRecord.Race<=False Then ' check valid user race
    UserRecord.Race=1 ' reset user race
 Endif ' end check valid user race
 Outpt=Outpt+" "+Rtrim$(Race(UserRecord.Race))+" " ' append user race name
 Inpt=UserRecord.ClassName ' store user class name
 Call Decrypt(Inpt) ' decrypt class name
 Outpt=Outpt+Inpt ' append classname
 Call IO.O ' send user type message
 Outpt="You are aligned " ' make aligned message
 ' append player alignment type name 1 through 3 (-1,0,1 plus 2) number 1
 Outpt=Outpt+Rtrim$(Alignment.Name1(UserRecord.Align1+2))+" "
 ' append player alignment type name 1 through 3 (-1,0,1 plus 2) number 2
 Outpt=Outpt+Rtrim$(Alignment.Name2(UserRecord.Align2+2))+"."
 Call IO.O ' send player alignment message
End Sub ' end routine to display player character alignment

 Rem * DM routine to display status of system.

Sub Display.Memory
 On Local Error Resume Next ' local error resume
 Graphics.Off=False ' reset color
 Outpt="Dnddoor Author: "+Author$ ' get author name
 Call IO.O ' display author name string
 Call System.Type ' get system type
 Graphics.Off=True ' reset color
 Outpt="This System: "+Outpt
 Call IO.O ' display system status message
 Call Free.Disk.Space ' get free disk space
 Outpt="Free disk space: "+Outpt+"."
 Call IO.O ' display system status message
 ' make message with stack memory
 Outpt="Free Stack Space: "
 Outpt=Outpt+Format$(Fre(-2),"#,##0;;")+" B."
 Call IO.O ' display message
 ' make message with far memory
 Outpt="Free String Space: "
 Outpt=Outpt+Format$(Fre("a"),"#,##0;;")+" B."
 Call IO.O ' display message
 If Share.Installed Then
    Outpt="Share installed."
    Call IO.O
 Endif
End Sub ' end DM routine to display system memory

 Rem * routine returns operating system type in Outpt.

'--------D-2130-------------------------------
'INT 21 - DOS 2+ - GET DOS VERSION
'        AH = 30h
'---DOS 5+ ---
'        AL = what to return in BH
'            00h OEM number (as for DOS 2.0-4.0x)
'            01h version flag
'Return: AL = major version number (00h if DOS 1.x)
'        AH = minor version number
'        BL:CX = 24-bit user serial number (most versions do not use this)
'Notes:  the OS/2 v1.x Compatibility Box returns major version 0Ah (10)
'        the OS/2 v2.x Compatibility Box returns major version 14h (20)
'        the Windows/NT DOS box returns version 5.00, subject to SETVER

'--------W-2F160A-----------------------------
'INT 2F - MS Windows 3.1 - IDENTIFY WINDOWS VERSION AND TYPE
'        AX = 160Ah
'Return: AX = 0000h if call supported
'            BX = version (BH=major, BL=minor)
'            CX = mode (0002h = standard, 0003h = enhanced)

Sub System.Type
 On Local Error Resume Next ' local error resume
 Inregs.AX=&H2B01 ' setup for dos function call
 Inregs.CX=&H4445 ' desqview operating
 Inregs.DX=&H5351 '  parameters
 Call Interrupt(&H21,Inregs,Outregs) ' call dos function
 If (Outregs.AX And &HFF)<>&HFF Then ' check system type
    Outpt="Desqview." ' make display message
    Exit Sub ' exit from routine
 Endif ' end check system type
 Inregs.AX=&HE400 ' setup for dos function call
 Call Interrupt(&H21,Inregs,Outregs) ' call dos function
 If (Outregs.AX And &HFF)>&H00 Then ' check system type
    Outpt="DoubleDos." ' make display message
    Exit Sub ' exit from routine
 Endif ' end check system type
 Inregs.AX=&H3001 ' setup for dos function call
 Call Interrupt(&H21,Inregs,Outregs) ' call dos function
 DOS.Major=Outregs.AX And &HFF ' store low order bytes
 DOS.Minor=(Outregs.AX And &HFF00)/256 ' store high order bytes
 Inregs.AX=&H160A ' setup for dos function call
 Call Interrupt(&H2F,Inregs,Outregs) ' call dos function
 If Outregs.AX=False Then ' check windows installed
    Win.Minor=Outregs.BX And &HFF ' get windows version low byte
    Win.Major=(Outregs.BX And &HFF00)/256 ' get windows version high byte
    If Win.Major=4 Then ' verify windows
       If Win.Minor=10 Then ' verify windows type
          Outpt="Windows 98." ' make display message
       Else ' check type
          Outpt="Windows 95." ' make display message
       Endif ' end check windows type
    Else ' check windows version
       ' store windows 3.x version
       Outpt="Windows"+Str$(Win.Major)+"."+Ltrim$(Str$(Win.Minor))
    Endif ' end check windows type
 Else ' check other versions
    Select Case DOS.Major ' check os/2 version
    Case 10 ' check os/2
       Outpt="OS/2 v1.0" ' store os/2 version
    Case 20 ' check os/2
       If DOS.Minor=30 Then ' check os/2 minor
          Outpt="OS/2 v3.0" ' store os/2 version
       Else ' check os/2 minor
          Outpt="OS/2 v2.0" ' store os/2 version
       Endif ' end check os/2 minor
    Case Else ' remaining version must be dos
       ' store dos version
       Outpt="DOS"+Str$(DOS.Major)+"."+Mid$(Str$(DOS.Minor),2)
    End Select ' end check version
 Endif ' end check any version
End Sub ' end routine

 Rem * routine returns free disk space in Outpt.
 Rem * processing variables:
 Rem *   Struc - returns FAT32 free disk space information.
 Rem *   ASCIZ - stores current drive letter.
 Rem *   Fat32.Flag - true if fat32 disk space calculated.

'INT 2F - MS Windows 3.1 - IDENTIFY WINDOWS VERSION AND TYPE
'        AX = 160Ah
'Return: AX = 0000h if call supported
'            BX = version (BH=major, BL=minor)
'            CX = mode (0002h = standard, 0003h = enhanced)

'INT 21 - DOS 2+ - GET FREE DISK SPACE
'        AH = 36h
'        DL = drive number (00h = default, 01h = A:, etc)
'Return: AX = FFFFh if invalid drive
'        else
'            AX = sectors per cluster
'            BX = number of free clusters
'            CX = bytes per sector
'            DX = total clusters on drive
'Notes:  free space on drive in bytes is AX * BX * CX
'        total space on drive in bytes is AX * CX * DX

'INT 21 - Windows95 - FAT32 - GET EXTENDED FREE SPACE ON DRIVE
'        AX = 7303h
'        DS:DX -> ASCIZ string for drive ("C:\" or "\\SERVER\Share")
'        ES:DI -> buffer for extended free space structure (see #01789)
'        CX = length of buffer for extended free space
'Return: CF clear if successful
'            ES:DI buffer filled
'        CF set on error
'            AX = error code
'        on DOS versions which do not support the FAT32 calls, this function
'          returns CF clear/AL=00h (which is the DOS v1+ method for reporting
'          unimplemented functions)
'Format of extended free space structure: (returned in Struc):
'Offset  Size    Description     (Table 01789)
' 00h    WORD    (ret) size of returned structure
' 02h    WORD    (call) structure version (0000h)
'                (ret) actual structure version (0000h)
' 04h    DWORD   number of sectors per cluster (with adjustment for compression)
' 08h    DWORD   number of bytes per sector
' 0Ch    DWORD   number of available clusters
' 10h    DWORD   total number of clusters on the drive
' 14h    DWORD   number of physical sectors available on the drive, without
'                  adjustment for compression
' 18h    DWORD   total number of physical sectors on the drive, without
'                  adjustment for compression
' 1Ch    DWORD   number of available allocation units, without adjustment
'                  for compression
' 20h    DWORD   total allocation units, without adjustment for compression
' 24h  8 BYTEs   reserved

Sub Free.Disk.Space
 On Local Error Resume Next ' local error resume
 Dim Struc As String*44, ASCIZ As String*4 ' fat32 structure strings
 Inregs.AX=&H3600 ' setup for dos function call
 Inregs.DX=&H0000 ' setup for dos function call
 Call Interrupt(&H21,Inregs,Outregs) ' call dos function
 If Outregs.AX=&HFFFF Then ' check error status
    Outpt="<n/a>" ' make unknown message
    Exit Sub ' exit routine
 Endif ' end check error status
 ' check windows
 Inregs.AX=&H160A ' store function data
 Call Interrupt(&H2F,Inregs,Outregs) ' call dos function
 Fat32.Flag=False ' reset disk space flag
 If Outregs.AX=False Then ' check return error status
    TempD$=Left$(Curdir$,1) ' get default drive letter
    ASCIZ=TempD$+":\"+CHR$(0) ' store drive letter
    Inregs.AX=&H7303 ' dos function for fat32
    Inregs.DS=VARSEG(ASCIZ) ' pointer to drive variable
    Inregs.DX=VARPTR(ASCIZ) ' pointer to drive variable
    Inregs.ES=VARSEG(Struc) ' pointer to fat32 structure string
    Inregs.DI=VARPTR(Struc) ' pointer to fat32 structure string
    Inregs.CX=44 ' length of string
    Call Interrupt(&H21,Inregs,Outregs) ' dos functino call
    ' check for fat32
    If (Outregs.Flags And &H1)=&H0 THEN ' test error status
       If (Outregs.AX And &HFF)>0 THEN ' test error status
          ' get disk space beyond 2 GB.
          Bytes#=Clng(Asc(Mid$(Struc,9,1)))
          Bytes#=Bytes#+Clng(Asc(Mid$(Struc,10,1)))*256#
          Bytes#=Bytes#+Clng(Asc(Mid$(Struc,11,1)))*65536#
          Bytes#=Bytes#+Clng(Asc(Mid$(Struc,12,1)))*16777216#
          Sectors#=ClnG(Asc(Mid$(Struc,21,1)))
          Sectors#=Sectors#+Clng(Asc(Mid$(Struc,22,1)))*256#
          Sectors#=Sectors#+Clng(Asc(Mid$(Struc,23,1)))*65536#
          Sectors#=Sectors#+Clng(Asc(Mid$(Struc,24,1)))*16777216#
          Disk.Space#=Bytes#*Sectors# ' store fat32 free disk space
          Fat32.Flag=True ' set disk space flag
       Endif
    Endif
 Endif
 If Fat32.Flag=False Then ' check fat32 flag
    Inregs.AX=&H3600 ' setup for dos function call
    Inregs.DX=&H0000 ' setup for dos function call
    Call Interrupt(&H21,Inregs,Outregs) ' call dos function
    If Outregs.AX<False Then ' check high bit integer wrap
       Sectors#=Cdbl(Outregs.AX+65536) ' increment off twos-complement bit
    Else ' check high bit
       Sectors#=Cdbl(Outregs.AX) ' store sectors
    Endif ' end check high bit
    If Outregs.BX<False Then ' check high bit integer wrap
       Clusters#=Cdbl(Outregs.BX+65536) ' increment off twos-complement bit
    Else ' check high bit
       Clusters#=Cdbl(Outregs.BX) ' store clusters
    Endif ' end check high bit
    If Outregs.CX<False Then ' check high bit integer wrap
       Bytes#=Cdbl(Outregs.CX+65536) ' increment off twos-complement bit
    Else ' check high bit
       Bytes#=Cdbl(Outregs.CX) ' stores bytes
    Endif ' end check high bit
    Disk.Space#=Sectors#*Clusters#*Bytes# ' calculate actual free disk space
 Endif ' end check fat32 flag
 Byte.Counter=False ' reset kilo counter
 ' loop until disk space is an even kilo type
 Do ' start division loop
    If Disk.Space#>=1024 Then ' compare disk space to one kilobyte
       Disk.Space#=Disk.Space#/1024 ' integer divide disk space
       Byte.Counter=Byte.Counter+1 ' increment kilo type counter
       If Byte.Counter=4 Then ' check kilos greater than a terabyte
          Exit Do ' exit if too large
       Endif ' end check terabyte
    Else ' check smallest division
       Exit Do ' exit if division is smallest
    Endif ' end check kilobyte
 Loop ' end division loop
 Outpt=Format$(Disk.Space#,"#,##0.00;;") ' format the disk space
 Select Case Byte.Counter ' determine the kilo type
 Case 0 ' byte case
    Outpt=Outpt+" B" ' append size
 Case 1 ' kilobyte case
    Outpt=Outpt+" KB" ' append size
 Case 2 ' megabyte case
    Outpt=Outpt+" MB" ' append size
 Case 3 ' gigabyte case
    Outpt=Outpt+" GB" ' append size
 Case 4 ' terabyte case
    Outpt=Outpt+" TB" ' append size
 End Select ' end determine the kilo type
End Sub ' end routine

 Rem * routine to display extended information on an object, treasure,
 Rem * monster, or container using the identify command.

Sub Identify.Object
 On Local Error Resume Next ' local error resume
 If Normal.User Then ' check non DM status
    If UserRecord.Level<=4 Then ' check player level
       Outpt="You are not high enough level!" ' make message
       Call IO.O ' send message
       Exit Sub ' exit routine
    Endif ' end check level
 Endif ' end check DM status
 Call Display.Information ' routine to display information on an item
End Sub ' end identify routine

 Rem * routine to display current time, user's time on, and user's time left.
 Rem * input variables:
 Rem *   Time.On - containing the user time on in system time format hh:mm:ss.
 Rem *   Time.Left - containing the user's time limit in seconds from login.
 Rem * processing variables:
 Rem *   OnTime# - contains serial number format of time calculations.
 Rem *   Hours - contains hours since login.
 Rem *   Minutes - contains minutes since login.
 Rem *   Seconds - contains seconds since login.

Sub Time.Online
 On Local Error Resume Next ' local error resume
 Graphics.Off=True ' reset color
 Outpt="It is now "+FNclock$+"." ' make display message
 Call IO.O ' send output message
 OnTime#=TimeValue(Time$)-TimeValue(Time.On) ' calculate time online
 If OnTime#<False Then ' check past midnight
    OnTime#=OnTime#+TimeValue("12:00:00")*2 ' add 24 hours (86,400 seconds)
 Endif ' end check past midnight
 Outpt="You have been on for" ' format time display message
 Time.DIsplay$=Nul ' time display message
 Gosub Time.Display ' subroutine to display message
 Hours=Int(Time.Left/3600!) ' calculate hours of time limit
 Time.Calc=Time.Left-Hours*3600! ' calculate time minus hours
 Minutes=Int(Time.Calc/60!) ' calculate minutes of time limit
 Seconds=Time.Calc-Minutes*60! ' calculate seconds of time limit
 OnTime#=TimeSerial(Hours,Minutes,Seconds)-OnTime# ' calculate time remaining
 Outpt="You have" ' format time display message
 Time.Display$=" remaining" ' time display message
 Gosub Time.Display ' subroutine to display message
 Exit Sub ' exit routine

 ' subroutine to display time message
Time.Display:
 If Hour(OnTime#)>0 Then ' compare hours of serial time variable
    Outpt=Outpt+Str$(Hour(OnTime#))+" hours," ' append hours to string
 Endif ' end compare hours
 If Minute(OnTime#)>0 Then ' compare minutes of serial time variable
    Outpt=Outpt+Str$(Minute(OnTime#))+" minutes," ' append minutes to string
 Endif ' end compare minutes
 If Second(OnTime#)>0 Then ' compare seconds of serial time variable
    Outpt=Outpt+Str$(Second(OnTime#))+" seconds," ' append seconds to string
 Endif ' end compare seconds
 Outpt=Left$(Outpt,Len(Outpt)-1) ' trim trailing comma
 Outpt=Outpt+Time.DIsplay$+"." ' combine message
 Call IO.O ' send output message
 Return ' exit time display subroutine
End Sub ' end routine to display time on

 Rem * routine to display list of weapons for sale, the first 15 items in the
 Rem * treasure file.

Sub Weapon.List
 On Local Error Resume Next ' local error resume
 Graphics.Off=False ' reset color
 Outpt="The Blacksmith says: Here's a list of my inventory." ' message
 Call IO.O ' send output message
 Graphics.Off=True ' reset color
 Outpt="To purchase, enter number to buy, for example: Buy 15." ' make message
 Call IO.O ' send output message
 Graphics.Off=False ' reset color
 Outpt="Number Weapon                        Weight Plus   Gold" ' make output
 Call IO.O ' send output message
 Allow.Break=True ' allow control-k breaking
 Break=False ' reset control-k flag
 Graphics.Off=True ' reset color
 For List.Count=1 To 20 ' loop through the first 20 treasure items
    Call Read.Record(TreasureFile,List.Count) ' get the next treasure record
    Item.Weight=TreasureRecord.Weight ' store the treasure item weight
    Gold.Value#=TreasureRecord.Gold ' store the treasure item gold value
    ' store the treasure name
    WeaponList.Output$=TreasureRecord.TreasureName
    ' set first character uppercase
    Mid$(WeaponList.Output$,1,1)=Ucase$(Mid$(WeaponList.Output$,1,1))
    Weapon.Plus=False ' reset plus
    If TreasureRecord.Spell Then ' compare item to spell
       Call Read.Record(SpellFile,TreasureRecord.Spell) ' get spell record
       Weapon.Plus=SpellRecord.Level ' store spell level of item
    Else ' end compare spell item
       If TreasureRecord.Plus Then ' compare treasure item plus
          Weapon.Plus=Abs(TreasureRecord.Plus) ' store item plus
       Endif ' end compare treasure item plus
    Endif ' end compare item spell plus
    ' combine the treasure weight, gold value, and name with blanks imbedded
    Outpt=Mid$(Str$(List.Count),2) ' append item value
    Outpt=Outpt+Space$(8-Len(Str$(List.Count))) ' pad blanks
    Outpt=Outpt+WeaponList.Output$ ' append item value
    Outpt=Outpt+Space$(21-Len(WeaponList.Output$)) ' pad blanks
    Outpt=Outpt+Mid$(Str$(Item.Weight),2) ' append item value
    Outpt=Outpt+Space$(8-Len(Str$(Item.Weight))) ' pad blanks
    Outpt=Outpt+Mid$(Str$(Weapon.Plus),2) ' append item value
    Outpt=Outpt+Space$(8-Len(Str$(Weapon.Plus))) ' pad blanks
    Outpt=Outpt+Mid$(Str$(Gold.Value#),2) ' append item value
    Call IO.O ' send message output
    If Break Then ' check break
       Exit For ' exit treasure file loop
    Endif ' end compare break
 Next ' end treasure file item display loop
 Allow.Break=False ' reset control-k breaking
 If Break Then ' check control-k flag
    Break=False ' reset control-k flag
    Outpt=Nul ' set output to null
    Call IO.O ' send empty return
 Endif ' end check control-k flag
End Sub ' end routine to list treasure items for sale

 Rem * routine to allow user to change password.

Sub Change.PassWord
 On Local Error Resume Next ' local error resume
 Graphics.Off=True ' reset color
 Outpt="Change your password(y/n)? " ' input prompt
 No.Input.Out="N" ' default input
 Call IO.I ' get user input
 If Yes Then ' compare input
    Outpt="Type in old password for verification:" ' input prompt
    Line.Length=20 ' line length for password
    Hidden=True ' echo mask characters
    Call IO.I ' get user input
    Hidden=False ' reset echo mask flag
    Inpt=Ltrim$(Inpt) ' trim entry password
    Inpt=Rtrim$(Inpt) ' trim entry password
    Inpt=Ucase$(Inpt) ' set entry password to uppercase
    Outpt=UserRecord.PassWord ' get user's current password
    Call Decrypt(Outpt) ' decrypt user password
    If Outpt=Nul Then ' verify password validity
       Outpt="This password has a checksum error!" ' make error message
       Call IO.O ' send output message
       Exit Sub ' exit routine
    Endif ' end compare password validity
    Outpt=Rtrim$(Outpt) ' trim password
    If Outpt<>Inpt Then ' compare entered password to user password
       Outpt="Passwords don't match!" ' make error message
       Call IO.O ' send output message
       Exit Sub ' exit routine
    Endif ' end compare passwords
    Outpt="Type in new password(20 char. max.)" ' format input message
    Call IO.O ' send output message
    Line.Length=20 ' set line length of new password
    Outpt="?" ' set input prompt
    Hidden=True ' set echo mask character flag
    Call IO.I ' get user input
    Hidden=False ' reset echo mask flag
    If No.Input Then ' check length of input
       Outpt="Password not changed." ' make error message
       Call IO.O ' send output message
       Exit Sub ' exit routine
    Endif ' end compare length of input
    Inpt=Ltrim$(Inpt) ' trim new password
    Inpt=Rtrim$(Inpt) ' trim new password
    Inpt=Ucase$(Inpt) ' convert to uppercase
    Call Valid(Inpt,20) ' check validity of new password
    If Inpt=Nul Then ' compare validity of new password
       Outpt="Illegal characters in password!" ' make error message
       Call IO.O ' send output message
       Exit Sub ' exit routine
    Endif ' end compare password validity
    Call Encrypt(Inpt,False) ' encrypt new password
    UserRecord.PassWord=Inpt ' store new password in user record
    Outpt="Password changed." ' make message
    Call IO.O ' send output message
    Exit Sub ' exit routine
 Endif ' end compare input
 Outpt="Password not changed." ' make message
 Call IO.O ' send output message
End Sub ' end routine to change password

 Rem * routine to change alignment once per player character.

Sub Align
 On Local Error Resume Next ' local error resume
 If Normal.User Then ' compare to non DM
    If UserRecord.Flags And Alignmented Then ' compare user record flag
       Outpt="You've already changed alignment once!" ' message
       Call IO.O ' send output
       Exit Sub ' exit routine
    Endif ' end compare user record flag
 Endif ' end compare normal user
 Outpt="Change alignment(y/n)? " ' input prompt
 No.Input.Out="Y" ' default input
 Call IO.I ' get user input
 If Yes Then ' compare yes entered
    UserRecord.Flags=UserRecord.Flags Or Alignmented ' set user record flag
    Call Modify.Alignment ' routine to change alignment
    Outpt="Alignment is now " ' message with new alignment
    Outpt=Outpt+Rtrim$(Alignment.Name1(UserRecord.Align1+2))+" " ' message
    Outpt=Outpt+Rtrim$(Alignment.Name2(UserRecord.Align2+2)) ' message
    Call IO.O ' send message
    Exit Sub ' exit routine
 Endif ' end compare input
 Outpt="Alignment not changed!" ' make output message
 Call IO.O ' send output message
End Sub ' end routine to change alignment

 Rem * routine to allow user to change all statistics once per character.

Sub Reroll.Character
 On Local Error Resume Next ' local error resume
 If Normal.User Then ' compare to non DM
    If UserRecord.Flags And Rerolled Then ' check user record flag
       Outpt="You've already rerolled your character!" ' message
       Call IO.O ' send output
       Exit Sub ' exit routine
    Endif ' end compare user flag
 Endif ' end compare normal user
 Outpt="Reroll character(y/n)? " ' prompt user to reroll
 No.Input.Out="Y" ' set default input
 Call IO.I ' get user input
 If Yes Then ' compare yes entered
    UserRecord.Flags=UserRecord.Flags Or Rerolled ' set user record flag
    Do ' loop until changes completed
       Outpt="Character reroll:" ' message
       Call IO.O ' send output
       Outpt="Change class type/name(y/n)? " ' input prompt
       No.Input.Out="Y" ' set default input
       Call IO.I ' get user input
       If Yes Then ' compare yes entered
          Call Modify.Class ' routine to modify class type
       Endif ' end compare yes entered
       Outpt="Character reroll:" ' message
       Call IO.O ' send output
       Outpt="Change vital statistics(y/n)? " ' input prompt
       No.Input.Out="Y" ' set default input
       Call IO.I ' get user input
       If Yes Then ' compare yes entered
          Call Modify.Stats ' routine to modify statistics
       Endif ' end compare yes entered
       Outpt="Character reroll:" ' message
       Call IO.O ' send output
       Outpt="Change character race type/name(y/n)? " ' input prompt
       No.Input.Out="Y" ' set default input
       Call IO.I ' get user input
       If Yes Then ' compare yes entered
          Call Modify.Race ' routine to modify race
       Endif ' end compare yes entered
       Outpt="Character reroll:" ' message
       Call IO.O ' send output
       Outpt="Change weapon proficiency(y/n)? " ' input prompt
       No.Input.Out="Y" ' set default input
       Call IO.I ' get user input
       If Yes Then ' compare yes entered
          Call Modify.Proficiency ' routine to modify weapon proficiency
       Endif ' end compare yes entered
       Outpt="Character reroll:" ' message
       Call IO.O ' send output
       Outpt="Change character alignment(y/n)? " ' input prompt
       No.Input.Out="Y" ' set default input
       Call IO.I ' get user input
       If Yes Then ' compare yes entered
          Call Modify.Alignment ' routine to modify alignment
       Endif ' end compare yes entered
       Do ' loop until changes finished prompt
          Outpt="All changes finished(y/n)? " ' input prompt
          No.Input.Out="Y" ' set default input
          Call IO.I ' get user input
          If Yes Then ' compare yes entered
             Exit Sub ' exit routine
          Endif ' end compare
          If No Then ' compare no entered
             Exit Do ' exit changes loop
          Endif ' end compare
       Loop ' loop until yes or no entered
    Loop ' end loop until changes completed
    Exit Sub ' exit routine
 Endif ' end compare yes entered
 Outpt="Your character has not been rerolled!" ' make output message
 Call IO.O ' send output message
End Sub ' end routine to modify all statistics

 Rem * routine returns a prefix for monster name.
 Rem * output variables:
 Rem *   Prefix1 - monster name prefix.

Sub The.Or.An
 On Local Error Resume Next ' local error resume
 If MonsterArray(Monster.Number).Permanent<True Then ' check for nonplayer
    Prefix1="the " ' make prefix
 Else ' check monster type
    Prefix$=MonsterArray(Monster.Number).MonsterName ' get monster name
    Prefix$=Left$(Prefix$,1) ' get first letter of monster name
    If Instr("aeiou",Prefix$) Then ' check monster name vowel
       Prefix1="an " ' set prefix
    Else ' check vowel
       Prefix1="a " ' set prefix
    Endif ' end check monster name vowel
 Endif ' end check nonplayer
End Sub ' end routine to get monster name prefix

 Rem * routine for parsing numeric value from parameter.
 Rem * input variables:
 Rem *   Parsed.Command1 - string with imbedded pound sign to check.
 Rem * output variables:
 Rem *   Parse.Number - value of number after pound sign.
 Rem * work variables:
 Rem *   Delimit - position of # sign.

Sub Numeric
 On Local Error Resume Next ' local error resume
 Parse.Number=False ' reset numeric value
 Parse.Delimit=Instr(Parsed.Command1,"#") ' search parameter for # sign
 If Parse.Delimit Then ' check # sign in string
    ' store numeric value after #
    Parse.Number=Int(Val(Mid$(Parsed.Command1,Parse.Delimit+1)))
    ' trim # from string
    Parsed.Command1=Left$(Parsed.Command1,Parse.Delimit-1)
 Endif ' end check for # sign in string
End Sub ' end routine to parse part of parameter

 Rem * routine decrements parameter # value after calls to search routines.
 Rem * input variables:
 Rem *   Parse.Count - counter for search routines.
 Rem * output variables:
 Rem *   Parse.Number - decremented # sign value counter.

Sub Num
 On Local Error Resume Next ' local error resume
 If Parse.Number>False Then ' check counter
    ' decrement search routine value from counter
    Parse.Number=Parse.Number-Parse.Count
    If Parse.Number<False Then ' check counter
       Parse.Number=False ' reset counter
    Endif ' end check counter
 Endif ' end check counter
End Sub ' end routine to decrement # sign value counter

 Rem * routine to separate two parameters after command input.
 Rem * input variables:
 Rem *   Parsed.Command2 - first/second parameters combined.
 Rem * output variables:
 Rem *   Parsed.Command1 - first parsed parameter.
 Rem *   Parsed.Command2 - second parsed parameter.
 Rem * work variables:
 Rem *   Delimit - position of # sign.

Sub Parse
 On Local Error Resume Next ' local error resume
 ' find imbedded space in command parameter
 Parse.Delimit=Instr(Parsed.Command2," ")
 Parser=False ' reset position of space
 If Parse.Delimit Then ' check imbedded space
    ' store first parameter
    Parsed.Command1=Left$(Parsed.Command2,Parse.Delimit-1)
    ' store second parameter
    Parsed.Command2=Mid$(Parsed.Command2,Parse.Delimit+1)
    Parser=Parse.Delimit ' store parsed space position
 Endif ' end check for space
End Sub ' end routine to separate parameters

 Rem * routine to separate two parameters after command input in reverse order.
 Rem * input variables:
 Rem *   Parsed.Command2 - first/second parameters combined.
 Rem * output variables:
 Rem *   Parsed.Command1 - second parsed parameter.
 Rem *   Parsed.Command2 - first parsed parameter.
 Rem * work variables:
 Rem *   Delimit - position of # sign.

Sub ParseX
 On Local Error Resume Next ' local error resume
 ' find imbedded space in command parameter
 Parse.Delimit=Instr(Parsed.Command2," ")
 Parser=False ' reset position of space
 If Parse.Delimit Then ' check imbedded space
    ' store second parameter
    Parsed.Command1=Mid$(Parsed.Command2,Parse.Delimit+1)
    ' store first parameter
    Parsed.Command2=Left$(Parsed.Command2,Parse.Delimit-1)
    Parser=Parse.Delimit ' storeparsed space position
 Endif ' end check for space
End Sub ' end routine to separate parameters in reverse order

 Rem * routine computes gold player needs for next training level.
 Rem * output variables:
 Rem *   Gold.Required# - gold points.

Sub Gold(Gold.Required#)
 On Local Error Resume Next ' local error resume
 If UserRecord.Level<=10 Then ' check player level
    Gold.Required#=2^(UserRecord.Level+5) ' calculate gold
 Else ' player level over ten
    Gold.Required#=2^15+(UserRecord.Level-10)*10000! ' calculate gold
 Endif ' end check player level
End Sub ' end routine to calculate gold

 Rem * routine computes experience player needs for next training level.
 Rem * output variables:
 Rem *   Exp.Required# - experience points.

Sub Experience(Exp.Required#)
 On Local Error Resume Next ' local error resume
 If UserRecord.Level<=10 Then ' check player level
    Exp.Required#=2^(UserRecord.Level+6) ' calculate experience
 Else ' player level over ten
    Exp.Required#=2^16+(UserRecord.Level-10)*10000! ' calculate experience
 Endif ' end check player level
End Sub ' end routine to calculate experience

 Rem * routine returns range of numbers.
 Rem * input variables:
 Rem *   Upper.Range - contains upper range.
 Rem * output variables:
 Rem *   Start.Range - start of range.
 Rem *   End.Range - end of range.

Sub Get.Range(Upper.Range,Start.Range,End.Range)
 On Local Error Resume Next ' local error resume
 Range.Type$=Mid$(Str$(Upper.Range),2) ' convert upper range to string
 Outpt="From(1-"+Range.Type$+")? " ' make input prompt
 No.Input.Out="1" ' default input
 Call IO.I ' get input
 Start.Range=Int(Val(Inpt)) ' convert input to integer
 If Start.Range<1 Then ' check bounds of input
    Start.Range=1 ' reset input
 Endif ' end check bounds
 If Start.Range>Upper.Range Then ' check bounds of input
    Start.Range=Upper.Range ' reset input
 Endif ' end check bounds
 Outpt="To("+Mid$(Str$(Start.Range),2)+"-"+Range.Type$+")? " ' input prompt
 No.Input.Out=Range.Type$ ' default input
 Call IO.I ' get input
 End.Range=Int(Val(Inpt)) ' convert input to integer
 If End.Range<Start.Range Then ' check bounds
    End.Range=Start.Range ' reset input
 Endif ' end check bounds
 If End.Range>Upper.Range Then ' check bounds
    End.Range=Upper.Range ' reset input
 Endif ' end check bounds
End Sub ' end routine to get range of numbers

 Rem * routine returns range of numbers.
 Rem * input variables:
 Rem *   Start.Range - starting of range.
 Rem *   End.Range - end of range.
 Rem * output variables:
 Rem *   Upper.Range - contains upper range.

Sub Get.Range2(Start.Range,End.Range,Upper.Range)
 On Local Error Resume Next ' local error resume
 Start.Range$=Mid$(Str$(Start.Range),2) ' convert starting range to string
 End.Range$=Mid$(Str$(End.Range),2) ' convert upper range to string
 Outpt=Outpt+"("+Start.Range$+"-"+End.Range$+")? " ' make input prompt
 No.Input.Out=Start.Range$ ' default input
 Call IO.I ' get input
 Upper.Range=Int(Val(Inpt)) ' convert input to integer
 If Upper.Range<Start.Range Then ' check bounds of input
    Upper.Range=Start.Range ' reset input
 Endif ' end check bounds
 If Upper.Range>End.Range Then ' check bounds of input
    Upper.Range=End.Range ' reset input
 Endif ' end check bounds
End Sub ' end routine to get range of numbers

 Rem * routine returns range of single precision numbers.
 Rem * input variables:
 Rem *   Upper.Range! - contains upper range.
 Rem * output variables:
 Rem *   Start.Range! - start of range.
 Rem *   End.Range! - end of range.

Sub Get.Room.Range(Upper.Range!,Start.Range!,End.Range!)
 On Local Error Resume Next ' local error resume
 Range.Type$=Mid$(Str$(Upper.Range!),2) ' convert upper range to string
 Outpt="From(1-"+Range.Type$+")? " ' make input prompt
 No.Input.Out="1" ' default input
 Call IO.I ' get input
 Start.Range!=Int(Val(Inpt)) ' convert input to integer
 If Start.Range!<1! Then ' check bounds of input
    Start.Range!=1! ' reset input
 Endif ' end check bounds
 If Start.Range!>Upper.Range! Then ' check bounds of input
    Start.Range!=Upper.Range! ' reset input
 Endif ' end check bounds
 Outpt="To("+Mid$(Str$(Start.Range!),2)+"-"+Range.Type$+")? " ' input prompt
 No.Input.Out=Range.Type$ ' default input
 Call IO.I ' get input
 End.Range!=Int(Val(Inpt)) ' convert input to integer
 If End.Range!<Start.Range! Then ' check bounds
    End.Range!=Start.Range! ' reset input
 Endif ' end check bounds
 If End.Range!>Upper.Range! Then ' check bounds
    End.Range!=Upper.Range! ' reset input
 Endif ' end check bounds
End Sub ' end routine to get range of numbers

 Rem * routine returns range of single precision numbers.
 Rem * input variables:
 Rem *   Start.Range - starting of range.
 Rem *   End.Range - end of range.
 Rem * output variables:
 Rem *   Upper.Range - contains upper range.

Sub Get.Room.Range2(Start.Range!,End.Range!,Upper.Range!)
 On Local Error Resume Next ' local error resume
 Start.Range$=Mid$(Str$(Start.Range!),2) ' convert starting range to string
 End.Range$=Mid$(Str$(End.Range!),2) ' convert upper range to string
 Outpt=Outpt+"("+Start.Range$+"-"+End.Range$+")? " ' make input prompt
 No.Input.Out=Start.Range$ ' default input
 Call IO.I ' get input
 Upper.Range!=Int(Val(Inpt)) ' convert input to integer
 If Upper.Range!<Start.Range! Then ' check bounds of input
    Upper.Range!=Start.Range! ' reset input
 Endif ' end check bounds
 If Upper.Range!>End.Range! Then ' check bounds of input
    Upper.Range!=End.Range! ' reset input
 Endif ' end check bounds
End Sub ' end routine to get range of numbers

 Rem * routine returns the charges of an item of treasure.
 Rem * output variables:
 Rem *   Charges.Amount - stores treasure type charges.

Sub TreasureCharges(Charges.Amount)
 On Local Error Resume Next ' local error resume
 Charges.Amount=TreasureRecord.Charges ' store treasure charges
 If TreasureRecord.FuelType Then ' compare treasure to fuel
    Charges.Amount=TreasureRecord.FuelCharges ' reset treasure charges
 Endif ' end compare fuel charges
 If TreasureRecord.LightType Then ' compare vehicle to light
    Charges.Amount=False ' reset treasure charges
 Endif ' compare charges
 If TreasureRecord.Vehicle Then ' compare treasure to vehicle
    Charges.Amount=TreasureRecord.VehicleHits ' reset treasure charges
 Endif ' compare charges
End Sub ' end routine to return charges

 Rem * routine to wish for an item
 Rem * input variables:
 Rem *   Inpt - stores name of item

Sub Wish.Item
 On Local Error Resume Next ' local error resume
 Outpt="The Ghods Thunder.." ' make output message
 Call IO.O ' send message
 Outpt="   What Do You Wish For?" ' make input prompt
 Call IO.I ' get input
 Stored.Parsed.Command2=Inpt ' store input
 Parsed.Command1=Stored.Parsed.Command2 ' store input
 Call Numeric ' parse number
 Inpt=Parsed.Command1 ' restore input
 Inpt=Lcase$(Inpt) ' convert to lowercase
 Call Drop(False) ' call routine to get item
End Sub

 Rem * routine to wish for points or an item, or get an object or treasure.
 Rem * input variables:
 Rem *   Drop.Type - false to use normal drop routine, true for extended drop.

Sub Drop(Drop.Type)
 On Local Error Resume Next ' local error resume
 Wish.Points=1 ' store points number to wish for
 If Right$(Inpt,7)=" points" Then ' compare wish for two points
    Inpt=Left$(Inpt,Len(Inpt)-7) ' truncate wish parameter
    Wish.Points=2 ' store points number to wish for
 Endif ' end compare points wish
 For Stat.Number=1 To 7 ' loop through statistic names
    Outpts=Stat(Stat.Number) ' get statistic name
    Outpts=Rtrim$(Outpts) ' trim name
    Outpts=Lcase$(Outpts) ' lowercase name
    If Inpt=Outpts Then ' compare wish item to statistic name
       If Normal.User Then ' check non DM
          ' check point already wished for
          If (UserRecord.Flags And 2^Stat.Number) Then
             Goto Wish.Denied ' jump to wish denied subroutine
          Endif ' end check point wished for
       Endif ' end check normal player
       ' add player wish bitflag
       UserRecord.Flags=(UserRecord.Flags Or 2^Stat.Number)
       Wish.Points=Wish.Points*Int(Rnd*3+1) ' calculate points to add
       ' calculate new statistic
       New.Stat#=UserRecord.Stats(Stat.Number)+Wish.Points
       If New.Stat#>MaxInt Then ' compare maximum integer
          New.Stat#=MaxInt ' reset to maximum integer
       Endif ' end check maximum integer
       New.Stat=Cint(New.Stat#) ' store in integer
       If Normal.User Then ' check non DM
          If New.Stat>MaxStat Then ' check maximum statistic allowed
             Goto Wish.Denied ' jump to wish denied subroutine
          Endif ' end check maximum stat
       Endif ' end check normal player
       UserRecord.Stats(Stat.Number)=New.Stat ' increment point wished for
       Graphics.Off=True ' reset color
       Outpt="The Ghods Thunder..." ' make ghod message
       Call IO.O ' send message
       Outpt="   Your "+Outpts+" Has Been Raised!" ' make stat message
       Call IO.O ' send update stat message
       Graphics.Off=False ' reset color
       Exit Sub ' exit routine
    Endif ' end compare point wish
 Next ' end loop through statistic names
 If Drop.Type=False Then ' check drop type
    If Normal.User Then ' check normal player
       If UserRecord.Flags And Wished Then ' check player has already wished
          Goto Wish.Denied ' jump to wish denied subroutine
       Endif ' end check already wished
    Endif ' end check normal user
 Endif ' end check drop type
 UserRecord.Flags=UserRecord.Flags Or Wished ' set player wish bitflag
 Parse.Value=False ' item counter
 Wish.Charges=False ' item charges
 Wish.Index=False ' item index
 ' loop through treasure file
 For Treasure.Number=1 To Lof(TreasureFile)/Len(TreasureRecord)
    Call Read.Record(TreasureFile,Treasure.Number) ' get next record
    Outpts=TreasureRecord.TreasureName ' store treasure name
    Outpts=Left$(Outpts,Len(Inpt)) ' truncate name
    If Inpt=Outpts Then ' compare treasure name to wish item name
       Parse.Value=Parse.Value+1 ' increment item counter
       ' compare counters
       If Parse.Number=False Or Parse.Value=Parse.Number Then
          Wish.Index=Treasure.Number ' store treasure file number
          Call TreasureCharges(Wish.Charges) ' routine to get treasure charges
          Exit For ' exit loop through treasure file
       Endif ' end compare counters
    Endif ' end compare names
 Next ' end loop through treasure file
 If Wish.Index=False Then ' check no treasure match found
    If Normal.User=False Or Drop.Type Then ' compare DM/Sysop or drop type
       ' loop through object file
       For Object.Number=1 To Lof(ObjectFile)/Len(ObjectRecord)
          Call Read.Record(ObjectFile,Object.Number) ' get object record
          Outpts=ObjectRecord.ObjectName ' store object name
          Outpts=Left$(Outpts,Len(Inpt)) ' truncate object name
          If Inpt=Outpts Then ' compare object name to wish name
             Parse.Value=Parse.Value+1 ' increment counter
             ' compare counters
             If Parse.Number=False Or Parse.Value=Parse.Number Then
                ' store negation of object file index
                Wish.Index=-Object.Number
                Wish.Charges=False ' clear charges
                Exit For ' exit loop through object file
             Endif ' end compare counters
          Endif ' end compare names
       Next ' end loop through object file
    Endif ' end compare drop type/DM, Sysop
 Endif ' end check treasure found
 If Drop.Type=False Then ' check drop type
    If Wish.Index>False Then ' check treasure found
       If Normal.User Then ' check normal player/not DM
          If TreasureRecord.Container Then ' check treasure container
             Wish.Index=False ' clear treasure found
          Else ' check treasure
             If TreasureRecord.Vehicle Then ' check treasure vehicle
                Wish.Index=False ' clear treasure found
             Else ' check treasure
                Spell.Number=TreasureRecord.Spell ' get treasure spell
                ' check spell file bounds
                If Spell.Number>False And _
                Spell.Number<=Lof(SpellFile)/Len(SpellRecord) Then
                   Call Read.Record(SpellFile,Spell.Number) ' get spell record
                   If SpellRecord.SpellType=4 Then ' check spell type wish
                      Wish.Index=False ' clear treasure found
                   Endif ' end check wish spell
                Endif ' end check spell file bounds
             Endif ' end check treasure
          Endif ' end check treasure
       Endif ' end check normal player
    Endif ' and check treasure found to drop
 Endif ' end check drop type
 Drop.Type=False ' clear drop flag
 Select Case Wish.Index ' selection of item type to drop
 Case Is<False ' check object being dropped
    ' add object to room
    Call Add.Room.Object(Abs(Wish.Index),Wish.Charges,Drop.Type)
 Case Is>False ' check treasure being dropped
    Select Case TreasureRecord.Container ' selection of container dropped
    Case False ' check treasure container
       ' add treasure to room
       Call Add.Room.Treasure(Wish.Index,Wish.Charges,False,Drop.Type)
    Case True ' check container
       ' check container name
       If Rtrim$(RoomRecord.Container.ShortName)=Nul Then
          Drop.Type=True ' set drop flag
          ' store container variables
          ContainerRec.Closed=TreasureRecord.Closed
          ContainerRec.ContainerName=TreasureRecord.TreasureName
          ContainerRec.Locked=TreasureRecord.Locked
          ContainerRec.Keyed=TreasureRecord.Keyed
          ContainerRec.ShortName=TreasureRecord.ShortName
          ContainerRec.Permanent=TreasureRecord.Permanent
          For Container.Count=1 To 5 ' loop through container contents
             ' clear container contents
             Call Clear.Container(Container.Count,False)
          Next ' end loop through container
          RoomRecord.Container=ContainerRec ' add container record to room
          Call Share.Room.Record(Room) ' write room record
       Endif ' end check container
    End Select ' end select container
 End Select ' end select treasure
 If Drop.Type=False Then ' check drop flag
    Goto Wish.Denied ' jump to wish denied subroutine
 Endif ' end check drop flag
 Graphics.Off=True ' reset color
 Outpt="A Dark Cloud Passes Overhead..." ' make ghod message
 Call IO.O ' send message
 Outpt="   Some Treasure Falls From The Sky..." ' make ghod message
 Call IO.O ' send message
 Outpt="The Cloud Disappears..." ' make ghod message
 Call IO.O ' send message
 Graphics.Off=False ' reset color
 Exit Sub ' exit routine

Wish.Denied:
 Graphics.Off=True ' reset color
 Outpt="The Ghods Thunder..." ' make ghod message
 Call IO.O ' send message
 Outpt="   Your Wish Is Denied!" ' make ghod message
 Call IO.O ' send message
 Graphics.Off=False ' reset color
End Sub ' end routine to drop item to ground