ftp.wwiv.com/ftp.wwiv.com.zip/ftp.wwiv.com/pub/MISC/DNDOOR45.ZIP/DNDS4.BAS

BASIC Source File | 2000-04-28 | 117KB | 2,587 lines

 Rem * Filename: dnds4.bas Version: v4.5 r1.0
 Rem * This subprogram contains room edit routines, user list routines,
 Rem * shopkeeper routines, and some main commands.

 Rem $Include: 'dnddoor.inc'

 Rem * routine to toggle player sort flag.

Sub Sort.Inventory
 On Local Error Resume Next ' local error resume
 Select Case Sorting ' toggle sort method
 Case -1 ' now sort by charges
    Sorting=0 ' change to no sort
    UserRecord.Sort=0 ' store in user record
    Outpt="Inventory sorting off."
 Case 0 ' now not sorting
    Sorting=1 ' change to sorting by plus
    UserRecord.Sort=1 ' store in user record
    Outpt="Inventory plus sorting on."
 Case 1 ' now sort by plus
    Sorting=-1 ' change to sorting by charges
    UserRecord.Sort=-1 ' store in user record
    Outpt="Inventory charges sorting on."
 Case Else ' not within range
    Sorting=0 ' default sorting off
    UserRecord.Sort=0 ' store in user record
    Outpt="Inventory sorting off."
 End Select ' end toggle sort flag
 Call IO.O ' send display message
End Sub ' end routine to toggle sort flag

 Rem * routine to sort player inventory.
 Rem * input variables:
 Rem *   Sorting - flag for sort toggle.

Sub Sorter
 On Local Error Resume Next ' local error resume
 If Sorting=False Then ' check sorting on
    Exit Sub ' exit routine
 Endif ' end check sorting on
 ' perform a simple 'bubble sort' while swapping indexes of weapons variables
 For Sort1=1 To 20 ' loop through top bubble of player inventory
    For Sort2=Sort1+1 To 20 ' loop through bottom bubble of player inventory
       If Sorting=-1 Then ' sort by charges
          '  make the comparison of charges left of two inventory items
          If UserRecord.Charges(Sort1)<UserRecord.Charges(Sort2) Then
             ' swap the two items if the second one is greater
             Swap UserRecord.Inv(Sort1),UserRecord.Inv(Sort2)
             Swap UserRecord.Charges(Sort1),UserRecord.Charges(Sort2)
             Gosub Swap.Weapons ' check weapons being held
          Endif ' end compare value of two items
       Else
          If Sorting=1 Then ' sort by plus
             Inventory1=UserRecord.Inv(Sort1) ' get treasure index
             Inventory2=UserRecord.Inv(Sort2) ' get treasure index
             If Inventory1>0 And Inventory2>0 Then ' compare index values
                Call Read.Record(TreasureFile,Inventory1) ' get record
                Inventory.Plus1=TreasureRecord.Plus ' store treasure plus
                Call Read.Record(TreasureFile,Inventory2) ' get record
                Inventory.Plus2=TreasureRecord.Plus ' store treasure plus
                If Inventory.Plus1<Inventory.Plus2 Then ' compare inventory pluses
                   ' swap the two items if the second one is greater
                   Swap UserRecord.Inv(Sort1),UserRecord.Inv(Sort2)
                   Swap UserRecord.Charges(Sort1),UserRecord.Charges(Sort2)
                   Gosub Swap.Weapons ' check weapons being held
                Endif
             Endif
          Endif
       Endif
    Next ' end loop through bubble sort
 Next ' end loop through bubble sort
 Exit Sub ' exit sort routine
Swap.Weapons:
 ' check if any of the weapons/armor/shield/rings held/worn are
 ' equal to one of the two items being swapped so their indexes
 ' still point to the correct player inventory array elements
 Select Case Weapon4 ' select an index (armor)
 Case Sort1 ' swap 1
    Weapon4=Sort2 ' switch index
 Case Sort2 ' swap 2
    Weapon4=Sort1 ' switch index
 End Select ' end index selection
 Select Case Weapon5 ' select an index (shield)
 Case Sort1 ' swap 1
    Weapon5=Sort2 ' switch index
 Case Sort2 ' swap 2
    Weapon5=Sort1 ' switch index
 End Select ' end index selection
 Select Case Weapon6 ' select an index (weapon)
 Case Sort1 ' swap 1
    Weapon6=Sort2 ' switch index
 Case Sort2 ' swap 2
    Weapon6=Sort1 ' switch index
 End Select ' end index selection
 Select Case Weapon7 ' select an index (ring)
 Case Sort1 ' swap 1
    Weapon7=Sort2 ' switch index
 Case Sort2 ' swap 2
    Weapon7=Sort1 ' switch index
 End Select ' end index selection
Return
End Sub ' end routine to sort player inventory

 Rem * routine to page sysop at console by beeping.
 Rem * processing variables:
 Rem *   Chat - contains chat mode toggle.

Sub Page.Sysop
 On Local Error Resume Next ' local error resume
 If Normal.User Then ' check non DM
    If UserRecord.Level<=1 Then ' check player level
       Outpt="The Sysop is not answering pages now." ' make message
       Call IO.O ' send message
       Exit Sub ' exit routine
    Endif ' end check player level
 Endif ' end check normal user
 Beep.Count=False ' reset beep counter
 Graphics.Off=True ' reset color
 Outpt="Hit <control-k> to return to prompt." ' make message
 Call IO.O ' send message
 Outpt="Sysop press <escape> to enter chat.." ' make message
 Call IO.O ' send message
 Outpt="Paging Sysop:" ' make paging message
 Carriage.Return=True ' disable cr/lf
 Call IO.O ' send paging message
 Chat=True ' store chat flag toggle off
 Allow.Break=True ' enable control-k checking
 Break=False ' reset control-k flag
 Beep.Time!=Timer ' store current time
 Do While Chat ' loop until chat entered, 10 beeps, or control-k break entered
    If Break Then ' check control-k entered
       Exit Do ' exit chat loop
    Endif ' end check control-k entered
    ' routine to compute time elapsed
    Call Second.Timer(Time.Elapsed,Beep.Time!,2!)
    If Time.Elapsed Then ' check two seconds elapsed
       Outpt=Chr$(7)+Mask$ ' make remote beep plus character
       Carriage.Return=True ' disable cr/lf
       Call IO.O ' send page message
       Beep.Time!=Timer ' store current time
       Beep.Count=Beep.Count+1 ' increment beep counter
       If Beep.Count=10 Then ' check 10 beeps
          Exit Do ' exit chat loop
       Endif ' end check beep exit
    Endif ' end check time elapsed
 Loop ' end chat loop
 Allow.Break=False ' reset control-k checking off
 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
 If Chat=False Then ' compare chat flag on
    Chat=True ' reset chat flag
    Call Enter.Chat ' routine to chat with player
 Endif ' end compare chat flag
 Chat=False ' clear chat flag
 Call IO.O ' send empty cr/lf
End Sub

 Rem * routine to chat with remote player.
 Rem * input variables:
 Rem *   Chat - is true, false to quit.
 Rem * processing variables:
 Rem *   Logged.On! - time player logged on (seconds from midnight).
 Rem *   Chat.Start! - time chat started (seconds from midnight).
 Rem *   Time.Remaining! - time player had remaining before chat in seconds.

Sub Enter.Chat
 On Local Error Resume Next ' local error resume
 Graphics.Off=True ' reset graphics
 Logged.On!=Timeon ' store timeon
 Chat.Start!=Timer ' store time now
 Time.Remaining!=Time.Left ' store time left
 Timeon=Timer ' reset time on to now
 Time.Left=60! ' reset time left to 60 seconds
 Allow.Break=False ' disable control-k checking
 Break=False ' reset control-k flag
 Outpt=Nul ' format empty string
 Call IO.O ' send empty cr/lf
 Outpt="Chat Mode.." ' make chat mode message
 Call IO.O ' send chat mode message
 User.Word.Wrap=User.Wordwrap ' store word wrap
 User.Wordwrap=False ' reset word wrap
 Word.Wrap=True ' enable 80 column word wrap
 Do While Chat ' chat in an input loop
    Timeon=Timer ' reset time on (disables timeout messages)
    Time.Left=600! ' reset time left (disables timeout messages)
    Call IO.I ' continually process input (from keyboard and modem)
 Loop ' loop until chat toggla flag is reset
 ' end chat, restore time variables
 Timeon=Logged.On!+Fix(Timer-Chat.Start!) ' recalculate time on
 If Timeon>86400! Then ' check chatted past midnight
    Timeon=Timeon-86400! ' decrement midnight
 Endif ' end check midnight
 Time.Left=Time.Remaining! ' restore time left
 Allow.Break=False ' disable control-k checking
 Break=False ' reset control-k flag
 Buffer=Nul ' clear buffer
 Func.Buffer=Nul ' clear buffer
 Outpt=Nul ' clear buffer
 Word.Wrap=False ' disable word wrap
 User.Wordwrap=User.Word.Wrap ' restore word wrap
 If Len(Inpt) Then ' check last input
    Call IO.O ' output last input
 Endif ' end check last input
 Inpt=Nul ' reset input buffer
End Sub ' end routine to chat with remote player

 Rem * routine to display help text for DMs.
 Rem * input variables:
 Rem *   Stored.Parsed.Command1 - command to look up help text for.

Sub DM.Help
 On Local Error Resume Next ' local error resume
 Help.Command$=Stored.Parsed.Command1 ' get command parameter
 ' compare first character to DM command prefix
 If Left$(Help.Command$,1)<>"!" Then
    Outpt="Enter DM command, form: !Help !<command>" ' make error message
    Call IO.O ' send error message
    Exit Sub ' exit routine
 Endif ' end compare DM command prefix
 ' store next part of parameter for command lookup
 Help.Command$=Mid$(Help.Command$,2)
 Stored.Parsed.Command1=Help.Command$ ' store into parsed command variable
 Call Read.Help(True) ' routine to read help text
End Sub ' end routine for DM help text

 Rem * routine displays help text for a command.
 Rem * input variables:
 Rem *   Help.Type is 1=!edit help, 0=normal command, -1=DM command lookup.

Sub Read.Help(Help.Type)
 On Local Error Resume Next ' local error resume
 Help.Command$=Stored.Parsed.Command1 ' store parameter of command to lookup
 Help.Command$=Rtrim$(Help.Command$) ' trim command
 Help.Command$=Ucase$(Help.Command$) ' uppercase command
 Close #HelpFile ' close work file
 Select Case Help.Type ' selection of help file
 Case True ' check DM command
    FileName="dmhelp.dat" ' store DM help filename
    Help.Command$=Left$(Help.Command$,8) ' truncate command
 Case False ' check normal command
    FileName="help.dat" ' store normal command help filename
    Help.Command$=Left$(Help.Command$,8) ' truncate command
 Case 1 ' check !edit help command
    FileName="edithelp.dat" ' store !edit help filename
 End Select ' end check command type
 Open FileName For Random Shared As #HelpFile Len=Len(HelpRecord) ' open file
Start.Display:
 Allow.Break=True ' enable control-k checking
 Break=False ' reset control-k flag
 Continue=False ' reset continuous flag
 Graphics.Off=True ' reset color
 Help.Displayed=False ' reset help text displayed flag
 Page.Length=False ' reset page length counter
 For Record.Count=2 To Lof(HelpFile)/Len(HelpRecord) ' loop through help records
    Call Read.Record(HelpFile,Record.Count) ' get next help record
    Command.Name$=HelpRecord.CName ' store command name of help record
    Command.Name$=Rtrim$(Command.Name$) ' trim command
    Command.Name$=Ucase$(Command.Name$) ' uppercase command
    If Help.Type<=False Then ' check help file type
       Command.Name$=Left$(Command.Name$,8) ' truncate command
    Endif ' end check command
    If Help.Displayed=True Then ' check help topic found already
       If Help.Command$<>Command.Name$ Then ' compare against topic selected
          Exit For ' exit help file display loop
       Endif ' end compare topic
    Endif ' end check help topic displayed
    If Help.Command$=Command.Name$ Then ' compare help record command
       If Help.Type=1 Then ' check displaying !edit help
          If Help.Displayed=False Then ' verify topic already being displayed
             If Help.Command$<>"CONTENTS" Then ' compare help type
                Count.Store=Record.Count ' save help file record counter
                Topic.Name$=Rtrim$(HelpRecord.CName) ' get command being displayed
                For Topic.Count=2 To Lof(HelpFile)/Len(HelpRecord) ' loop through help records
                   Call Read.Record(HelpFile,Topic.Count) ' get next help record
                   Topic.Number$=HelpRecord.Text ' store command name of help record
                   Topic.Number$=Rtrim$(Topic.Number$) ' trim command
                   Topic.Space=Instr(Topic.Number$," ") ' store imbdded topic number
                   If Topic.Space Then ' remove topic sequence from topic
                      Topic.Number$=Left$(Topic.Number$,Topic.Space-1) ' remove topic
                   Endif ' end check for topic sequence
                   If Topic.Number$=Topic.Name$ Then ' compare to topic
                      Page.Length=Page.Length+1 ' increment text displayed
                      Outpt=Rtrim$(HelpRecord.Text) ' store topic number/name
                      Call IO.O ' send command name message
                      Exit For ' exit loop search
                   Endif ' end compare topic
                Next ' end loop search
                Record.Count=Count.Store ' restore help file record counter
             Endif ' end compare help type
          Endif ' end verify topic displayed
       Endif ' end check displaying
       Call Read.Record(HelpFile,Record.Count) ' get help record
       Outpt=HelpRecord.Text ' get command help text
       Outpt=Rtrim$(Outpt) ' trim help text
       Outpt=Ltrim$(Outpt) ' trim help text
       Call IO.O ' display help text
       Help.Displayed=True ' set text displayed flag
       If Break Then ' check control-k break flag
          Goto End.Display ' exit loop through help file
       Endif ' end check control-k break
       Page.Length=Page.Length+1 ' increment page length counter
       If Page.Length=User.Pagelength Then ' compare page length
          Page.Length=False ' reset page length counter
          If Continue=False Then ' check continuous flag
             Call More.Prompt ' routine to pause for more
             If No Then ' check no more entered
                Goto End.Display ' exit loop through help file
             Endif ' end check no  entered
          Endif ' end check continuous flag
       Endif ' end check page length
    Endif ' end compare help commands
 Next ' end loop through all help file records
 If Help.Type=1 Then ' check if !edit help topics are being displayed
    If Record.Count<Lof(HelpFile)/Len(HelpRecord) Then ' verify eof
       Graphics.Off=False ' reset color
       Outpt="Continue search(y/n)? " ' prompt to continue to next topic
       No.Input.Out="y" ' default input
       Call IO.I ' get user input
       If Yes Then ' verify to continue display
          Help.Command$=Command.Name$ ' store last help topic
          Goto Start.Display ' go redisplay
       Endif ' end verify to continue
    Endif ' end verify file end
 Endif ' end check help display type
End.Display:
 Graphics.Off=False ' reset color
 Allow.Break=False ' clear control-k flag
 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
 If Page.Length Then ' check page length
    Call More.Prompt ' routine for more
 Endif ' end check page length
 If Help.Displayed=False Then ' check help text displayed flag
    Outpt="No help found on '"+Lcase$(Help.Command$)+"'." ' make error message
    Call IO.O ' send error message
 Endif ' end check help text flag
 Close #HelpFile ' close work file
End Sub ' end routine to display help text

 Rem * routine trains player for next level.

Sub Train.Stats
 On Local Error Resume Next ' local error resume
 If UserRecord.Level<False Then ' check negative player level
    UserRecord.Level=False ' set player level
 Endif ' end check negative level
 If UserRecord.Level>=MaxInt Then ' check player level to maximum integer
    Outpt="Nothing happens.." ' make error message
    Call IO.O ' send message
    Exit Sub ' exit routine
 Endif ' end check maximum integer
 If UserRecord.Level>False Then ' check player level again
    Call Gold(Required.Gold#) ' get gold required to train for next level
    UserRecord.Gold=UserRecord.Gold-Required.Gold# ' subtract gold from player
 Endif ' end check player level
 Stat=Int(Rnd*7+1) ' get random statistic to increment
 ' verify statistic below maximum statistic or player is DM type
 If UserRecord.Stats(Stat)<MaxStat Or Normal.User=False Then ' verify
    UserRecord.Stats(Stat)=UserRecord.Stats(Stat)+1 ' increment statistic
 Endif ' end verify player type
 If UserRecord.Level<=10 Then ' compare player level
    If UserRecord.Stats(6)<MaxStat Then ' check statistic below maximum stat
       UserRecord.Stats(6)=UserRecord.Stats(6)+1 ' increment piety
    Endif ' end check statistic
 Endif ' end compare level
 UserRecord.Level=UserRecord.Level+1 ' increment the player level
 Call New.Stats ' routine to update statistics based on level
 Outpt="After many hours of training and meditation..." ' make train message
 Call IO.O ' send train message
 Call Display.Health ' routine to display player statistics
 Call Display.Experience ' routine to display player requirements
End Sub ' end routine to train player for next level

 Rem * routine recalculates player statistics based on player level.

Sub New.Stats
 On Local Error Resume Next ' local error resume
 If UserRecord.Level<False Then ' check player level
    UserRecord.Level=False ' reset player level
 Endif ' end check player level
 ' compute player maximum fatigue points
 New.Stat#=Cdbl(Training.Stats(UserRecord.ClassType,1))*Cdbl(UserRecord.Level)
 If New.Stat#<0 Then ' compare fatigue points
    New.Stat#=0 ' reset fatigue points
 Endif ' end compare points
 If New.Stat#>MaxInt Then ' compare fatigue points
    New.Stat#=MaxInt ' reset fatigue points
 Endif ' end compare points
 ' store new maximum fatigue points in player record
 UserRecord.FatigueMax=Cint(New.Stat#) ' convert points to integer
 ' compute player maximum vitality points
 New.Stat#=Cdbl(Training.Stats(UserRecord.ClassType,2))*Cdbl(UserRecord.Level)
 If New.Stat#<0 Then ' compare vitality points
    New.Stat#=0 ' reset vitality points
 Endif ' end compare points
 If New.Stat#>MaxInt Then ' compare vitality points
    New.Stat#=MaxInt ' reset vitality points
 Endif ' end compare points
 ' store new maximum vitality points in player record
 UserRecord.VitalityMax=Cint(New.Stat#) ' convert points to integer
 ' compute player maximum magic points
 New.Stat#=Cdbl(Training.Stats(UserRecord.ClassType,3))*Cdbl(UserRecord.Level)
 If New.Stat#<0 Then ' compare magic points
    New.Stat#=0 ' reset magic points
 Endif ' end compare points
 If New.Stat#>MaxInt Then ' compare magic points
    New.Stat#=MaxInt ' reset magic points
 Endif ' end compare points
 ' store new maximum magic points in player record
 UserRecord.MagicMax=Cint(New.Stat#) ' convert points to integer
 ' compute player maximum psionic points
 New.Stat#=Cdbl(Training.Stats(UserRecord.ClassType,4))*Cdbl(UserRecord.Level)
 If New.Stat#<0 Then ' compare psionic points
    New.Stat#=0 ' reset psionic points
 Endif ' end compare points
 If New.Stat#>MaxInt Then ' compare psionic points
    New.Stat#=MaxInt ' reset psionic points
 Endif ' end compare points
 ' store new maximum psionic points in player record
 UserRecord.PsionicMax=Cint(New.Stat#) ' convert points to integer
 Stat=UserRecord.Fatigue ' store player fatigue points
 Stat.Max=UserRecord.FatigueMax ' store player maximum fatigue points
 If Stat<0 Or Stat>Stat.Max Then ' compare fatigue points range
    Stat=Stat.Max ' reset fatigue to maximum fatigue points
 Endif ' end compare points
 UserRecord.Fatigue=Stat ' store new fatigue points
 Stat=UserRecord.Vitality ' store player vitality points
 Stat.Max=UserRecord.VitalityMax ' store player maximum vitality points
 If Stat<0 Or Stat>Stat.Max Then ' compare vitality points range
    Stat=Stat.Max ' reset vitality to maximum vitality points
 Endif ' end compare points
 UserRecord.Vitality=Stat ' store new vitality points
 Stat=UserRecord.Magic ' store player magic points
 Stat.Max=UserRecord.MagicMax ' store player maximum magic points
 If Stat<0 Or Stat>Stat.Max Then ' compare magic points range
    Stat=Stat.Max ' reset magic points to maximum magic points
 Endif ' end compare points
 UserRecord.Magic=Stat ' store new magic points
 Stat=UserRecord.Psionic ' store player psionic points
 Stat.Max=UserRecord.PsionicMax ' store player maximum psionic points
 If Stat<0 Or Stat>Stat.Max Then ' compare spionic points range
    Stat=Stat.Max ' reset psionic points to maximum psionic points
 Endif ' end compare points
 UserRecord.Psionic=Stat ' store new psionic points
 ' routine for maximum statistic comparison
 If Normal.User Then ' check non DM
    For Stats=1 To 7 ' loop through all player statistic points
       If UserRecord.Stats(Stats)>MaxStat Then ' compare statistic to maximum
          UserRecord.Stats(Stats)=MaxStat ' reset statistic to maximum
       Endif ' end compare points
    Next ' end loop through statistics
 Endif
 ' routine for zero stats
 If Normal.User Then
    Low.Stats=False ' reset low stats flag
    For Stats1=1 To 7 ' loop through statistics again
       If UserRecord.Stats(Stats1)<=False Then ' check low statistic
          UserRecord.Stats(Stats1)=1 ' reset low statistic
          ' loop through statistics again to prevent death loop
          For Stats2=1 To 7
             If UserRecord.Stats(Stats2)<=False Then ' check low statistic
                UserRecord.Stats(Stats2)=1 ' reset statistic
             Endif ' end check low stat
          Next ' end loop through stats
          Low.Stats=True ' set low stats flag
          Exit For ' exit loop so low stats don't death loop
       Endif ' end check low stat
    Next ' end loop through stats
    If Low.Stats Then ' check low stats flag
       ' make death message
       Outpts=Lcase$(Rtrim$(Stat(Stats1)))
       Message1="Your "+Outpts+" is zero! You have died!"
       Call Player.Died ' routine for dead player
       Exit Sub ' exit low stats loop
    Endif ' end check low stats flag
 Endif ' end check normal player
 ' routine to assign upper class name to player
 If UserRecord.Level>=10 Then ' check player level
    Class.Number=UserRecord.ClassType ' get player class type
    If Class.Number<=0 Or Class.Number>10 Then ' verify bounds of class type
       Class.Number=1 ' reset class type to fighter
       UserRecord.ClassType=1 ' reset class type to fighter
    Endif ' end verify class type bounds
    Inpt=High.Class.Name(Class.Number) ' get player level 10 class name
    Call Valid(Inpt,20) ' validate name
    If Len(Inpt) Then ' compare name length
       Call Encrypt(Inpt,True) ' encrypt name
       UserRecord.ClassName=Inpt ' assign class name to player record
    Endif ' end compare name length
 Endif ' end check player level
 Call Get.User.Stats ' routine to assign more player stats
End Sub ' end routine to recalculate player stats

 Rem * routine adds and edits new room.
 Rem * input variables:
 Rem *   Next.Room - number of new room number to add.
 Rem *   Last.Direction - last direction entered.
 Rem * output variables:
 Rem *   Room.Added - true for a new room added, false if not.

Sub Add.Room(Last.Direction,Room.Added)
 On Local Error Resume Next ' local error resume
 Graphics.Off=True ' reset color
 Outpt="Add new room(y/n)? " ' make input prompt
 No.Input.Out="N" ' default input
 Call IO.I ' get input
 Room.Added=False ' set return variable
 If No Then ' check response
    Exit Sub ' exit routine
 Endif ' end check response
 Room.Added=True ' set return variable
 Next.Room=Lof(RoomFile)/Len(RoomRecord)+1 ' store last room record
 Call Clear.Room(Next.Room) ' routine to clear room record
 ' routine to edit room description and monster class
 Call Change.Room(Next.Room)
 Outpt="Add room link(y/n)? " ' input prompt
 No.Input.Out="Y" ' default input
 Call IO.I ' get input
 If Yes Then ' check response
    If Last.Direction Then ' check direction entered
       Graphics.Off=True ' reset color
       Outpt="Press <enter> for entry link:" ' make message
       Call IO.O ' send message
    Endif ' end check direction entered
    ' routine to add link to room
    Call Add.Link(Room,Next.Room,Last.Direction)
 Endif ' end check response
 Graphics.Off=False ' reset color
 Outpt="New room"+Str$(Next.Room)+" added." ' make display message
 Call IO.O ' send display message
 Room=Next.Room ' update current room number to added room number
End Sub ' end routine to add new room

 Rem * routine clears room record variables.
 Rem * input variables:
 Rem *   Room.Number! - room number.

Sub Clear.Room(Room.Number!)
 On Local Error Resume Next ' local error resume
 RoomRecord.ShortDesc=Nul ' set short description
 For Array.Index=1 To 4 ' loop through long description
    RoomRecord.LongDesc(Array.Index)=Nul ' set long description
 Next ' end loop through long description
 RoomRecord.Action=False ' clear variable
 RoomRecord.MonsterClass=False ' clear variable
 For Array.Index=1 To 12 ' loop through room directions
    RoomRecord.Direct(Array.Index)=False ' clear variable
 Next ' end loop through directions
 For Array.Index=1 To 20 ' loop through room objects and treasure
    RoomRecord.Object(Array.Index)=False ' clear variable
    RoomRecord.ObjCharges(Array.Index)=False ' clear variable
    RoomRecord.Treasure(Array.Index)=False ' clear variable
    RoomRecord.TreCharges(Array.Index)=False ' clear variable
    RoomRecord.Flags(Array.Index)=False ' clear variable
 Next ' end loop through room objects and treasure
 Call Clear.Container(0,True) ' routine to clear container record
 RoomRecord.Container=ContainerRec ' clear variable
 Call Share.Room.Record(Room.Number!) ' write room record number
End Sub ' end routine to clear room record

 Rem * routine to add, delete, and list room links.

Sub Link.Room
 On Local Error Resume Next ' local error resume
 Do ' input entry loop
    Graphics.Off=False ' reset color
    Outpt="Room link edit:" ' make option message
    Call IO.O ' send option message
    Graphics.Off=True ' reset color
    Outpt="[A]dd" ' make message
    Call IO.O ' send message
    Outpt="[D]elete" ' make message
    Call IO.O ' send message
    Outpt="[L]ist" ' make message
    Call IO.O ' send message
    Graphics.Off=False ' reset color
    Outpt="Enter room link option(q to quit)? " ' make input prompt
    No.Input.Out="Q" ' default input
    Call IO.I ' get input
    Graphics.Off=True ' reset color
    Select Case Ucase$(Inpt) ' make selection of input
    Case "A" ' add link
       Outpt="Enter room number" ' make range prompt
       Max.Rooms!=Lof(RoomFile)/Len(RoomRecord) ' make range number
       ' routine to get number from range
       Call Get.Room.Range2(0!,Max.Rooms!,Room.From!)
       If Room.From! Then ' check range
          Outpt="Enter link room number" ' make range prompt
          ' routine to get number from range
          Call Get.Room.Range2(0!,Max.Rooms!,Room.To!)
          If Room.To! Then ' check range
             ' routine to link two room numbers
             Call Add.Link(Room.From!,Room.To!,False)
          Endif ' end check range
       Endif ' end check range
    Case "D" ' delete link
       Outpts="Link not deleted." ' make default response
       Outpt="Enter room number" ' make range prompt
       Max.Rooms!=Lof(RoomFile)/Len(RoomRecord) ' make range number
       ' routine to get number from range
       Call Get.Room.Range2(0!,Max.Rooms!,Room.Delete!)
       If Room.Delete! Then ' check range
          Outpt="Enter direction(N/E/S/W/NE/SE/SW/NW/U/D/I/O)? "
          Call IO.I ' get input
          ' routine to get room link number
          Call Find.Link(Inpt,Room.Link,False)
          If Room.Link>=1 And Room.Link<=12 Then ' check link number
             Call Read.Room.Record(Room.Delete!) ' get room record
             RoomRecord.Direct(Room.Link)=False ' clear room link number
             Call Share.Room.Record(Room.Delete!) ' write room record
             Outpts="Room"+Str$(Room.Delete!)+", "+ _
             Rtrim$(Direction(Room.Link))+" link removed."
          Endif ' end check link number
       Endif ' end check range
       Outpt=Outpts ' store response
       Call IO.O ' send message
    Case "L" ' list links
       Graphics.Off=False ' reset color
       Outpt="Enter range of room numbers:" ' make display message
       Call IO.O ' send message
       Graphics.Off=True ' reset color
       Max.Rooms!=Lof(RoomFile)/Len(RoomRecord) ' store length of room file
       ' get range of rooms to list
       Call Get.Room.Range(Max.Rooms!,Room.List1!,Room.List2!)
       Allow.Break=True ' set allow break flag
       Break=False ' reset control-k flag
       Continue=False ' set continuous flag
       Page.Length=False ' reset page length counter
       For Room.Number!=Room.List1! To Room.List2! ' loop through rooms to list
          If Page.Length+4>=User.Pagelength Then ' compare page length
             Page.Length=False ' clear page length
             If Continue=False Then ' check continuous flag
                Call More.Prompt ' routine to pause
                If No Then ' check more promtp response
                   Exit For ' exit room link display loop
                Endif ' end check response
             Endif ' end check continuouu flag
          Endif ' end compare page length
          Call Read.Room.Record(Room.Number!) ' get next room record
          Call Display.Room.Links(Room.Number!) ' display room links
          If Break Or No Then ' check break flag
             Exit For ' exit display loop
          Endif ' end check break flag
          Page.Length=Page.Length+4 ' increment page length counter
       Next ' end loop through rooms
       Allow.Break=False ' reset allow break flag
       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
       If Page.Length Then ' check page length counter
          Call More.Prompt ' pause prompt
       Endif ' end check page length
    Case "Q" ' quit
       Exit Do ' exit input loop
    End Select ' end selection of input
 Loop ' end input loop
 Call Read.Room.Record(Room) ' get current room record
End Sub ' end DM link routine

 Rem * routine adds links between two room numbers.
 Rem * input variables:
 Rem *   Room.Number1! - room to link.
 Rem *   Room.Number2! - room to link.
 Rem *   Entry.Link - default entry link.

Sub Add.Link(Room.Number1!,Room.Number2!,Entry.Link)
 On Local Error Resume Next ' local error resume
 ' make direction link prompt
 Outpt="Enter direction(N/E/S/W/NE/SE/SW/NW/U/D/I/O)? "
 Call IO.I ' get input
 ' routine converts direction to link number
 Call Find.Link(Inpt,Direction.Number,Entry.Link)
 If Direction.Number=False Or Direction.Number=13 Then ' check link number
    Outpt="Link not added." ' make error message
    Call IO.O ' send message
    Exit Sub ' exit routine
 Endif ' end check link number
 Call Read.Room.Record(Room.Number1!) ' get room number one to link
 RoomRecord.Direct(Direction.Number)=Room.Number2! ' add link to room
 Call Share.Room.Record(Room.Number1!) ' write room record
 ' make link message
 Outpt="Room"+Str$(Room.Number1!)+" link added to room"+ _
 Str$(Room.Number2!)+"."
 Call IO.O ' send message
 ' make link back prompt
 Outpt="Link room"+Str$(Room.Number2!)+ _
 " back to room"+Str$(Room.Number1!)+"(y/n)? "
 Call IO.I ' get input
 If Yes Then ' check response
    Call Find.Back.Link(Direction.Number,Return.Link) ' get return link
    If Return.Link Then ' check return link
       Call Read.Room.Record(Room.Number2!) ' get room record
       ' add return link to first room
       RoomRecord.Direct(Return.Link)=Room.Number1!
       Call Share.Room.Record(Room.Number2!) ' write room record
       ' make return link message
       Outpt="Room"+Str$(Room.Number2!)+ _
       " link added back to room"+Str$(Room.Number1!)+"."
       Call IO.O ' send message
    Endif ' end check return link
 Endif ' end check response
End Sub ' end routine to link two rooms

 Rem * routine converts direction string to number.
 Rem * input variables:
 Rem *   Direction.Name$ - string of direction name.
 Rem *   Entry.Link - default entry link number.
 Rem * output variables:
 Rem *   Direction.Number - direction number.

Sub Find.Link(Direction.Name$,Direction.Number,Entry.Link)
 On Local Error Resume Next ' local error resume
 Select Case Ucase$(Direction.Name$) ' select direction string
 Case "N" ' north
    Direction.Number=1 ' direction number
 Case "E" ' east
    Direction.Number=2 ' direction number
 Case "S" ' south
    Direction.Number=3 ' direction number
 Case "W" ' west
    Direction.Number=4 ' direction number
 Case "NE" ' northeast
    Direction.Number=5 ' direction number
 Case "SE" ' southeast
    Direction.Number=6 ' direction number
 Case "SW" ' southwest
    Direction.Number=7 ' direction number
 Case "NW" ' northwest
    Direction.Number=8 ' direction number
 Case "U" ' up
    Direction.Number=9 ' direction number
 Case "D" ' down
    Direction.Number=10 ' direction number
 Case "I" ' in
    Direction.Number=11 ' direction number
 Case "O" ' out
    Direction.Number=12 ' direction number
 Case "G" ' go to portal
    Direction.Number=13 ' go to direction number
 Case Else ' otherwise
    Direction.Number=Entry.Link ' no direction found
 End Select ' end selection of direction
End Sub ' end routine to convert direction

 Rem * routine determines direction opposite to input direction.
 Rem * input variables:
 Rem *   Direction.Number - direction number.
 Rem * output variables:
 Rem *   Return.Direction - opposite direction number.

Sub Find.Back.Link(Direction.Number,Return.Direction)
 On Local Error Resume Next ' local error resume
 Select Case Direction.Number ' selection of direction number
 Case 1 ' north
    Return.Direction=3 ' south
 Case 2 ' east
    Return.Direction=4 ' west
 Case 3 ' south
    Return.Direction=1 ' north
 Case 4 ' west
    Return.Direction=2 ' east
 Case 5 ' northeast
    Return.Direction=7 ' southwest
 Case 6 ' southeast
    Return.Direction=8 ' northwest
 Case 7 ' southwest
    Return.Direction=5 ' northeast
 Case 8 ' northwest
    Return.Direction=6 ' southeast
 Case 9 ' up
    Return.Direction=10 ' down
 Case 10 ' down
    Return.Direction=9 ' up
 Case 11 ' in
    Return.Direction=12 ' in
 Case 12 ' out
    Return.Direction=11 ' out
 Case Else ' default
    Return.Direction=0 ' no direction
 End Select ' end selection of direction
End Sub ' end routine to find return direction

 Rem * routine displays room number links.
 Rem * input variables:
 Rem *   Room.Number! - room number to display.

Sub Display.Room.Links(Room.Number!)
 On Local Error Resume Next ' local error resume
 Graphics.Off=False ' reset color
 Outpt="Room number"+Str$(Room.Number!)+":" ' make room number message
 Call IO.O ' send message
 Graphics.Off=True ' reset color
 Outpt=Nul ' clear output string
 For Link.Number=1 To 4 ' loop through room directions
    ' make display line containing room directions
    Inpt=Mid$("NESW",Link.Number,1)+"  "+Str$(RoomRecord.Direct(Link.Number))
    Outpt=Outpt+Inpt+Space$(10-Len(Inpt)) ' pad with blanks
 Next ' end loop through room directions
 Call IO.O ' send line one of room directions
 Outpt=Nul ' clear output string
 For Link.Number=5 To 8 ' loop through room directions
    ' make display line containing room directions
    Inpt=Mid$("NESESWNW",(Link.Number-4)*2-1,2)+" "+ _
    Str$(RoomRecord.Direct(Link.Number))
    Outpt=Outpt+Inpt+Space$(10-Len(Inpt)) ' pad with blanks
 Next ' end loop through room directions
 Call IO.O ' send line one of room directions
 Outpt=Nul ' clear output string
 For Link.Number=9 To 12 ' loop through room directions
    ' make display line containing room directions
    Inpt=Mid$("UDIO",Link.Number-8,1)+"  "+ _
    Str$(RoomRecord.Direct(Link.Number))
    Outpt=Outpt+Inpt+Space$(10-Len(Inpt)) ' pad with blanks
 Next ' end loop through room directions
 Call IO.O ' send line two of room directions
 Outpt=Nul ' clear output string
End Sub ' end routine to display room links

 Rem * routine moves player in a certain direction.
 Rem * input variables:
 Rem *   Direction.Number - direction to go.
 Rem * processing variables:
 Rem *   New.Room - true if room can be entered, false if not.

Sub Go.Direction(Direction.Number)
 On Local Error Resume Next ' local error resume
 ' change last command to direction
 Entry.Command=Last.Command.Number ' store room entry command
 Last.Command=Ucase$(Direction(Direction.Number))
 Last.Command.Number=True ' reset last command number
 ' routine to check if next room can be entered
 Call Verify.Room(Direction.Number)
 If New.Room Then ' check next room variable
    Call Enter.Room ' routine to move the player
 Endif ' end check next room
End Sub ' end routine to move player

 Rem * routine compares player input to direction.
 Rem * input variables:
 Rem *   User.Command - original command input.
 Rem * output variables:
 Rem *   Direction.Number - contains direction number.

Sub Get.Direction(Direction.Number)
 On Local Error Resume Next ' local error resume
 For Direction.Number=1 To 12 ' loop through direction names
    Outpts=Direction(Direction.Number) ' store direction name
    Outpts=Rtrim$(Outpts) ' trim name
    Outpts=Ucase$(Outpts) ' uppercase name
    If User.Command=Outpts Then ' compare to player direction
       Exit Sub ' exit routine
    Endif ' end check directions
 Next ' end loop through direction names
 ' routine to get direction
 Call Find.Link(User.Command,Direction.Number,False)
 If Direction.Number=13 Then ' check enter portal link
    Direction.Number=False ' reset direction
 Endif ' end check direction
End Sub ' end routine to compare direction

 Rem * routine to add item of treasure to player inventory.
 Rem * input variables:
 Rem *   Treasure.Number - treasure file index number.
 Rem *   Treasure.Charges - treasure charges.
 Rem * output variables:
 Rem *   Item.Added - true if item added, false if not.

Sub Add.Inventory(Treasure.Number,Treasure.Charges,Item.Added)
 On Local Error Resume Next ' local error resume
 Item.Added=False ' clear return variable
 For Array.Index=1 To 20 ' loop through all player inventory
    If UserRecord.Inv(Array.Index)=False Then ' check for empty inventory
       UserRecord.Inv(Array.Index)=Treasure.Number ' add treasure index
       UserRecord.Charges(Array.Index)=Treasure.Charges ' add treasure charges
       Weight=Weight+TreasureRecord.Weight ' increment player weight
       Item.Added=True ' set return flag
       Exit Sub ' exit routine
    Endif ' end check empty inventory
 Next ' end loop through player inventory
End Sub ' end routine to add item of treasure to player inventory

 Rem * routine to add an object to player inventory.
 Rem * input variables:
 Rem *   Object.Number - object file index number.
 Rem *   Object.Charges - object charges.
 Rem * output variables:
 Rem *   Item.Added - true if item added, false if not.

Sub Add.Object(Object.Number,Object.Charges,Item.Added)
 On Local Error Resume Next ' local error resume
 Item.Added=False ' clear return variable
 For Array.Index=1 To 5 ' loop through all player inventory
    If UserRecord.Object(Array.Index)=False Then ' check for empty inventory
       UserRecord.Object(Array.Index)=Object.Number ' add object index
       UserRecord.ObjCharges(Array.Index)=Object.Charges ' add object charges
       Item.Added=True ' set return flag
       Exit Sub ' exit routine
    Endif ' end check empty inventory
 Next ' end loop through player inventory
End Sub ' end routine to add item of treasure to player inventory

 Rem * routine removes an item of treasure from player inventory.
 Rem * input variables:
 Rem *   Inventory.Number - number of inventory.
 Rem *   Leave.Item - false to leave inventory in room, true to discard.

Sub Discard.Inventory(Inventory.Number,Leave.Item)
 On Local Error Resume Next ' local error resume
 ' store player treasure index
 Inventory.Index=UserRecord.Inv(Inventory.Number)
 ' store player treasure charges
 Inventory.Charges=UserRecord.Charges(Inventory.Number)
 Call Read.Record(TreasureFile,Abs(Inventory.Index)) ' get treasure record of item
 Weight=Weight-TreasureRecord.Weight ' subtract weight
 If Weight<False Then ' compare weight
    Weight=False ' clear weight
 Endif ' end check weight
 For Array.Index=Inventory.Number To 19 ' loop through player inventory
    ' pack item removed
    UserRecord.Inv(Array.Index)=UserRecord.Inv(Array.Index+1)
    ' pack item removed
    UserRecord.Charges(Array.Index)=UserRecord.Charges(Array.Index+1)
 Next ' end loop through player inventory
 UserRecord.Inv(20)=False ' clear last item
 UserRecord.Charges(20)=False ' clear last item
 If UserRecord.Inv(1)=False Then ' check player inventory empty
    Weight=False ' clear weight
 Endif ' end check player inventory
 Select Case Inventory.Number ' select weapon
 Case Weapon4 ' check armor being dropped
    Weapon1=False ' clear item
    Weapon4=False ' clear item
 Case Weapon5 ' check shield being dropped
    Weapon3=False ' clear item
    Weapon5=False ' clear item
 Case Weapon6 ' check weapon being dropped
    Weapon2=False ' clear item
    Weapon6=False ' clear item
    Weapon10=False ' clear item
 Case Weapon7 ' check ring being dropped
    Weapon7=False ' clear item
    Weapon8=False ' clear item
    Weapon9=False ' clear item
 End Select ' end check item
 Select Case Inventory.Number ' select weapon
 Case Is<Weapon4 ' check armor index
    Weapon4=Weapon4-1 ' shift item index
 Case Is<Weapon5 ' check shield index
    Weapon5=Weapon5-1 ' shift item index
 Case Is<Weapon6 ' check weapon index
    Weapon6=Weapon6-1 ' shift item index
 Case Is<Weapon7 ' check ring index
    Weapon7=Weapon7-1 ' shift item index
 End Select ' end check index shift
 If Leave.Item=False Then ' verify drop item in room
    ' routine to add item to room
    Call Add.Room.Treasure(Inventory.Index,Inventory.Charges,False,Item.Added)
 Endif ' end check room
End Sub ' end routine to remove player item

 Rem * routine adds item to room.
 Rem * input variables:
 Rem *   Treasure.Number - treasure file index.
 Rem *   Treasure.Charges - treasure charges.
 Rem *   Treasure.Flags flags
 Rem * output variables:
 Rem *   Item.Added - return true if item added to room, false if not.

Sub Add.Room.Treasure(Treasure.Number, _
Treasure.Charges,Treasure.Flags,Item.Added)
 On Local Error Resume Next ' local error resume
 Item.Added=False ' clear return flag
 For Array.Index=1 To 20 ' loop through room treasure inventory
    ' check empty room inventory
    If RoomRecord.Treasure(Array.Index)=False Then
       RoomRecord.Treasure(Array.Index)=Treasure.Number ' add treasure index
       ' add treasure charges
       RoomRecord.TreCharges(Array.Index)=Treasure.Charges
       RoomRecord.Flags(Array.Index)=Treasure.Flags ' add treasure flags
       Call Share.Room.Record(Room) ' write room record
       Item.Added=True ' set return flag
       Exit Sub ' exit routine
    Endif ' end check empty inventory
 Next ' end loop through room treasure inventory
End Sub ' end routine to add item to room

 Rem * routine removes item of treasure from room.
 Rem * input variables:
 Rem *   Inventory.Number - room inventory number to remove.

Sub Discard.Room.Treasure(Inventory.Number)
 On Local Error Resume Next ' local error resume
 RoomRecord.Treasure(Inventory.Number)=False ' clear treasure items
 RoomRecord.TreCharges(Inventory.Number)=False ' clear treasure items
 RoomRecord.Flags(Inventory.Number)=False ' clear treasure items
 Call Share.Room.Record(Room) ' write room record
End Sub ' end routine to remove item from room

 Rem * routine adds object to room.
 Rem * input variables:
 Rem *   Object.Number - object index.
 Rem *   Object.Charges - object charges.
 Rem * output variables:
 Rem *   Item.Added - true if item added, false if not.

Sub Add.Room.Object(Object.Number,Object.Charges,Item.Added)
 On Local Error Resume Next ' local error resume
 Item.Added=False ' clear return flag
 For Array.Index=1 To 20 ' loop through room object inventory
    ' check empty object inventory
    If RoomRecord.Object(Array.Index)=False Then
       RoomRecord.Object(Array.Index)=Object.Number ' add object index
       RoomRecord.ObjCharges(Array.Index)=Object.Charges ' add object charges
       Call Share.Room.Record(Room) ' write room record
       Item.Added=True ' set return flag
       Exit Sub ' exit routine
    Endif ' end check empty object inventory
 Next ' end loop through room object inventory
End Sub ' end routine to add item to room

 Rem * routine removes an object from room.
 Rem * input variables:
 Rem *   Inventory.Number - room inventory number to remove.

Sub Discard.Room.Object(Inventory.Number)
 On Local Error Resume Next ' local error resume
 RoomRecord.Object(Inventory.Number)=False ' clear treasure items
 RoomRecord.ObjCharges(Inventory.Number)=False ' clear treasure items
 Call Share.Room.Record(Room) ' write room record
End Sub ' end routine to remove item from room

 Rem * routine removes an object from inventory.
 Rem * input variables:
 Rem *   Inventory.Number - player inventory number to remove.

Sub Discard.Inventory.Object(Inventory.Number)
 On Local Error Resume Next ' local error resume
 For Inventory.Count=Inventory.Number To 4 ' loop packer
    ' shift object items
    UserRecord.Object(Inventory.Count)=UserRecord.Object(Inventory.Count+1)
    ' shift object items
    UserRecord.ObjCharges(Inventory.Count)= _
    UserRecord.ObjCharges(Inventory.Count+1)
 Next ' end packing
 UserRecord.Object(5)=False ' clear treasure items
 UserRecord.ObjCharges(5)=False ' clear treasure items
End Sub ' end routine to remove item from room

 Rem * routine removes treasure from room after player leaves to new room.
 Rem * input variables:
 Rem *   Room - number of room to clean.

Sub Clean.Room
 On Local Error Resume Next ' local error resume
 If Room<=False Or Room>Lof(RoomFile)/Len(RoomRecord) Then ' check file bounds
    Exit Sub ' exit routine
 Endif ' end check file bounds
 Call Read.Room.Record(Room) ' get room record
 Call Clear.Container(0,True) ' routine to clear container record
 RoomRecord.Container=ContainerRec ' store container record in room
 Call Share.Room.Record(Room) ' write room record
 For Array.Index=1 To 20 ' loop through room treasure
    Treasure.Number=RoomRecord.Treasure(Array.Index) ' store treasure index
    If Treasure.Number>False And _
    Treasure.Number<=Lof(TreasureFile)/Len(TreasureRecord) Then ' file bounds
       Call Read.Record(TreasureFile,Treasure.Number) ' get treasure record
       If TreasureRecord.Permanent=False Then ' check permanent treasure
          If TreasureRecord.Invisible=False Then ' check invisible treasure
             ' check treasure flags
             If RoomRecord.Flags(Array.Index)=False Then
                ' remove item from room
                Call Discard.Room.Treasure(Array.Index)
             Endif ' end check flags
          Endif ' end check invisible
       Endif ' end check permanent
    Endif ' end check file bounds
 Next ' end loop through room treasure
End Sub ' end routine to clean room

 Rem * routine lists users.

Sub User.List
 On Local Error Resume Next ' local error resume
 Call Share.Record(UserFile,User.Index) ' store player user record
 Outpt="(hit <control-k> to interrupt).." ' make message
 Call IO.O ' send message
 Graphics.Off=True ' reset color
 Gosub Heading ' subroutine to display heading
 Allow.Break=True ' enable control-k checking
 Break=False ' reset control-k flag
 Continue=False ' reset continuous flag
 Page.Length=3 ' set page length
 For User.Number=1 To Lof(UserFile)/Len(UserRecord) ' loop through all users
    Call Read.Record(UserFile,User.Number) ' get next user record
    Inpt=UserRecord.CodeName ' store user codename
    Call Decrypt(Inpt) ' routine to decrypt codename
    Inpt=Lcase$(Inpt) ' lowercase codename,
    List.User=True ' set list user flag
    If Left$(Inpt,9)=Deleted$ Then ' check user record exists
       List.User=False ' reset list user flag
    Else ' check user
       If UserRecord.Flags And Locked.User Then ' check locked user
          If Normal.User Then ' compare DM or Sysop
             List.User=False ' reset list user flag
          Endif ' end compare normal user
       Endif ' end check locked mailbox
    Endif ' end check user
    If List.User Then ' check list user flag
       Outpt=Mid$(Str$(User.Number),2)+"." ' make output line
       Outpt=Outpt+Space$(7-Len(Outpt)) ' with user number,
       Mid$(Inpt,1,1)=Ucase$(Mid$(Inpt,1,1)) ' with codename,
       Outpt=Outpt+Inpt+" " ' make output line
       Inpt=UserRecord.ClassName ' with user class name,
       Call Decrypt(Inpt) ' decrypt classname
       Outpt=Outpt+Inpt+" " ' make output line
       If UserRecord.Race<=False Then ' verify race in bounds
          UserRecord.Race=1 ' reset race
       Endif ' end verify race
       Inpt=Race(UserRecord.Race) ' with user race name
       Inpt=Rtrim$(Inpt) ' make output line
       Inpt=Inpt+Space$(8-Len(Inpt)) ' append blanks
       Outpt=Outpt+Inpt ' with race name,
       If UserRecord.Level<=False Then ' check player level
          Inpt=" "+Dead$ ' player is dead, append
       Else ' check level
          Inpt=Str$(UserRecord.Level) ' add player level,
       Endif ' end check level
       Inpt=Inpt+Space$(7-Len(Inpt)) ' make output line
       If UserRecord.ClassType>=AsstDM Then ' check special class type,
          Inpt=Inpt+"*" ' add an asterick for DMs
       Endif ' end check class type
       If UserRecord.Flags And Locked.User Then ' check locked user
          Inpt=Inpt+Mask$ ' add mask character for locked mailbox
       Endif ' end check class type
       Outpt=Outpt+Inpt ' add to output line
       Call IO.O ' send output line
       If Break Then ' check control-k entered
          Exit For ' exit loop through user file
       Endif ' end check control-k
       Page.Length=Page.Length+1 ' increment page length
       If Page.Length=UserRecord.Pagelength Then ' compare page length
          Page.Length=3 ' reset page length
          If Continue=False Then ' check continuous flag
             Call More.Prompt ' pause for more
             If No Then ' more response
                Exit For ' exit loop through user file
             Endif ' end check response
             Gosub Heading ' subroutine to display heading
          Endif ' end check continuous flag
       Endif ' end compare page length
    Endif ' end check valid user
 Next ' end loop through user file
 Allow.Break=False ' disable control-k checking
 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
 If Page.Length>3 Then ' recheck page length
    Call More.Prompt ' display more prompt
 Endif ' end check last page length
 Call Read.Record(UserFile,User.Index) ' get current user record
 Exit Sub ' exit routine

Heading:
 ' make heading message
 Outpt="The Adventure Door v"+Version$+" User List For "+FNclock$+"."
 Call IO.O ' send message
 Outpt=Nul ' empty cr/lf
 Call IO.O ' send empty cr/lf
 ' make heading message
 Outpt="Number User Name                      Class Name"+ _
 "           Race     Level DM"
 Call IO.O ' send heading message
 Outpt=String$(76,"-") ' make heading
 Call IO.O ' send heading
 Return ' exit subroutine
End Sub ' end routine to display users

 Rem * routine reads player userfile record, sets some variables.
 Rem * input variables:
 Rem *   User.Index - number of user file record.

Sub Get.User.Record
 On Local Error Resume Next ' local error resume
 Call Read.Record(UserFile,User.Index) ' read user file record
 Weight=False ' clear inventory weight
 For Inventory.Number=1 To 20 ' loop through player inventory
    Treasure.Number=UserRecord.Inv(Inventory.Number) ' store treasure number
    If Treasure.Number>False And _
    Treasure.Number<=Lof(TreasureFile)/Len(TreasureRecord) Then ' file bounds
       Call Read.Record(TreasureFile,Treasure.Number) ' get treasur record
       Weight=Weight+TreasureRecord.Weight ' add weight
    Endif ' end check file bounds
 Next ' end loop through player userfile record
 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
 Call Get.User.Stats ' routine to set any special player statistics
 Room=UserRecord.Room ' store player room number
 Hidden.Player=False ' reset hidden player flag
 If UserRecord.Brief Then ' check player brief mode
    Action.Prompt="Next?" ' store command prompt
 Else ' check player
    Action.Prompt="Command? " ' store command prompt
 Endif ' end compare player brief mode
 If UserRecord.Beauty<=1 Or UserRecord.Beauty>MaxStat Then ' check lady player
    UserRecord.Beauty=Int(Rnd*15+5) ' recalculate lady stats
 Endif ' end check lady stats
 ' check lady player
 If UserRecord.Glamour<=1 Or UserRecord.Glamour>MaxStat Then
    UserRecord.Glamour=Int(Rnd*15+5) ' recalculate lady stats
 Endif ' end check lady stats
 Sorting=UserRecord.Sort ' get user sort preference
End Sub ' end routine to read user record

 Rem * routine sets any special player statistics and attributes.

Sub Get.User.Stats
 On Local Error Resume Next ' local error resume
 If UserRecord.Flags And Special.Char1 Then ' check player is town mayor
    Town.Mayor=True ' set town mayor flag
 Else ' check player
    Town.Mayor=False ' set town mayor flag
 Endif ' end check player special stats
 If UserRecord.Flags And Special.Char2 Then ' check player is governor
    Governor=True ' set governor flag
 Else ' check player
    Governor=False ' set governor flag
 Endif ' end check player special stats
 If UserRecord.Flags And Special.Char3 Then ' check player is guild master
    Guild.Master=True ' set guild master flag
 Else ' check player
    Guild.Master=False ' set guild master flag
 Endif ' end check player special stats
 If UserRecord.Flags And Special.Char4 Then ' check player is sysop
    Sysop=True ' set sysop flag
 Else ' check player
    Sysop=False ' set sysop flag
 Endif ' end check player special stats
 If UserRecord.ClassType=AsstDM Then ' check player is assistant DM
    Dungeon.Master.Assistant=True ' set asst. dm flag
 Else ' check player
    Dungeon.Master.Assistant=False ' set asst. dm flag
 Endif ' end check player
 If UserRecord.ClassType=DM Then ' check player is dungeon master
    Dungeon.Master=True ' set dm flag
 Else ' check player
    Dungeon.Master=False ' set dm flag
 Endif ' end check player
 ' check special player types
 If Dungeon.Master Or Dungeon.Master.Assistant Or Sysop Then
    Normal.User=False ' set normal player mode off
 Else ' check player
    Normal.User=True ' set normal  player mode on
 Endif ' end check player
End Sub ' end routine to set player special statistics/attributes

 Rem * routine writes user record.

Sub Put.User.Record
 On Local Error Resume Next ' local error resume
 UserRecord.Echo=User.Echo ' write user preference
 UserRecord.LineFeeds=User.LineFeeds ' write user preference
 UserRecord.LineLength=User.LineLength ' write user preference
 UserRecord.PageLength=User.PageLength ' write user preference
 UserRecord.Wordwrap=User.Wordwrap ' write user preference
 UserRecord.Sort=Sorting ' user sort preference
 UserRecord.Room=Room ' store current room
 Call Share.Record(UserFile,User.Index) ' write user record
End Sub ' end routine to write user record

 Rem * routine updates player health, room lights, drunkeness, and poison.
 Rem * input variables:
 Rem *   Room.Rate - stores rounds counter.
 Rem *   Room.Health.Rate - stores health update rate.

Sub Health.Update
 On Local Error Resume Next ' local error resume
 Graphics.Off=False ' reset color
 Room.Rate=Room.Rate+1 ' increment room health counter
 If Room.Rate<Room.Health.Rate Then ' compare health rate
    Exit Sub ' exit routine
 Endif ' end check counter
 Room.Rate=False ' reset room health counter
 ' determine any lights in player inventory go out
 For Inventory.Number=1 To 20 ' loop through player inventory
    ' get player inventory charges
    Charges.Number=UserRecord.Charges(Inventory.Number)
    If Charges.Number<False Then ' check for light on
       Charges.Number=Charges.Number+1 ' decrement negatively light charges
       UserRecord.Charges(Inventory.Number)=Charges.Number ' store new charges
       If Charges.Number=False Then ' compare charges
          ' get treasure record
          Call Read.Record(TreasureFile,UserRecord.Inv(Inventory.Number))
          Outpts=TreasureRecord.ShortName ' get light name
          Outpts=Rtrim$(Outpts) ' trim name
          Outpts=Lcase$(Outpts) ' lowercase name
          Outpt="The "+Outpts+" went out!" ' make light out message
          Call IO.O ' send message
       Endif ' end compare charges remaining
    Endif ' end check light on
 Next ' end loop through player inventory
 If Intoxicated>False Then ' verify player drunk
    Intoxicated=Intoxicated-1 ' decrement drunkeness
    If Intoxicated<=False Then ' compare drunkeness counter
       Intoxicated=False ' reset counter
       Outpt="Your drunk is over.." ' make message
    Else ' check drunk
       UserRecord.Fatigue=UserRecord.Fatigue-2 ' decrement fatigue for drunk
       If UserRecord.Fatigue<=False Then ' compare fatigue
          UserRecord.Fatigue=False ' reset fatigue
          Intoxicated=False ' reset drunkeness
          Outpt="Your drunk is over.." ' make message
       Else ' compare still drunk
          Outpt="You feel drunk!" ' make message
       Endif ' end compare drunk
    Endif ' end check drunk
    Call IO.O ' send drunkeness message
 Else ' verify drunk player
    New.Stat!=UserRecord.Fatigue+4 ' increment player fatigue
    If New.Stat!>MaxInt Then ' check maximum fatigue
       New.Stat!=MaxInt ' reduce to maximum integer
    Endif ' end check maximum fatigue
    UserRecord.Fatigue=Cint(New.Stat!) ' store new fatigue
 Endif ' end verify drunk player
 If UserRecord.Poison Then ' verify player poisoned
    UserRecord.Vitality=UserRecord.Vitality-2 ' decrement player vitality
    Outpt="You feel poison running through your veins!" ' make message
    Call IO.O ' send poisoned message
    If UserRecord.Vitality<=False Then ' check vitality
       UserRecord.Vitality=False ' reset vitality
       Message1="You finally died from your poisonous wounds!" ' message
       Call Player.Died ' routine for dead player
    Endif ' end check vitality
 Else ' verify poisoned player
    New.Stat!=UserRecord.Vitality+3 ' increment player vitality
    If New.Stat!>MaxInt Then ' check maximum integer
       New.Stat!=MaxInt ' reset to maximum integer
    Endif ' end check maximum integer
    UserRecord.Vitality=Cint(New.Stat!) ' store new vitality
 Endif ' end verify poisoned player
 New.Stat!=UserRecord.Magic+2 ' increment player magic points
 If New.Stat!>MaxInt Then ' compare magic points to maximum integer
    New.Stat!=MaxInt ' reset to maximum integer
 Endif ' end check maximum integer
 UserRecord.Magic=Cint(New.Stat!) ' store new magic points
 New.Stat!=UserRecord.Psionic+1 ' increment psionic points
 If New.Stat!>MaxInt Then ' check maximum psionic points
    New.Stat!=MaxInt ' reset to maximum integer
 Endif ' end check maximum integer
 UserRecord.Psionic=Cint(New.Stat!) ' store new psionic points
 Call New.Stats ' routine to update statistics
 If Invisible>False Then ' check invisible counter
    Invisible=Invisible-1 ' decrement invisible counter
    If Invisible<=False Then ' compare counter
       UserRecord.Invisible=False ' reset invisible
       Invisible=False ' reset invisible
       Outpt="You are no longer invisible!" ' make message
       Call IO.O ' send invisible message
    Endif ' end compare counter
 Endif ' end check counter
End Sub ' end health update routine

 Rem * routine searches current room, displays hidden items.

Sub Search.Room
 On Local Error Resume Next ' local error resume
 Outpt="You search the room.." ' make message
 Call IO.O ' send search message
 Graphics.Off=True ' reset color
 Outpt="You find " ' make first display message
 Carriage.Return=True ' disable cr/lf
 Call IO.O ' send first message
 Items.Displayed=False ' items displayed counter
 For Room.Objects=1 To 20 ' loop through room objects
    Object.Number=RoomRecord.Object(Room.Objects) ' get room object index
    ' file bounds
    If Object.Number>False And _
    Object.Number<=Lof(ObjectFile)/Len(ObjectRecord) Then
       Call Read.Record(ObjectFile,Object.Number) ' get object record
       Charges.Number=False ' set display flag
       If ObjectRecord.Invisible Then ' check object invisible
          If Rnd<.5 Then ' random chance
             Charges.Number=True ' set display flag
          Endif ' end random chance
       Endif ' end check invisible object
       If ObjectRecord.Hidden Then ' check object hidden
          If Normal.User Then ' verify non DM
             Charges.Number=False ' set display flag
          Endif ' end verify normal player
       Endif ' end check hidden object
       If Charges.Number Then ' check display flag
          Carriage.Return=True ' disable cr/lf
          Call IO.O ' send previous string
          Outpt=Rtrim$(ObjectRecord.ObjectName)+", " ' store object name
          Items.Displayed=Items.Displayed+1 ' increment item displayed counter
       Endif ' end check display flag
    Endif ' end check file bounds
 Next ' end loop through room objects
 For Room.Treasure=1 To 20 ' loop through room treasure
    Treasure.Number=RoomRecord.Treasure(Room.Treasure) ' get treasure index
    If Treasure.Number>False And _
    Treasure.Number<=Lof(TreasureFile)/Len(TreasureRecord) Then ' file bounds
       Call Read.Record(TreasureFile,Treasure.Number) ' get treasure record
       Charges.Number=False ' set display flag
       If TreasureRecord.Invisible Then ' check treasure invisible
          If Rnd<.5 Then ' random chance
             Charges.Number=True ' set display flag
          Endif ' end random chance
       Endif ' end invisible treasure
       ' check treasure hidden
       If RoomRecord.Flags(Room.Treasure)=Hidden.Object Then
          If Rnd<.5 Then ' random chance
             Charges.Number=True ' set display flag
          Endif ' end random chance
       Endif ' end check hidden treasure
       If Charges.Number Then ' check display flag
          Carriage.Return=True ' disable cr/lf
          Call IO.O ' send previous string
          Outpt=Rtrim$(TreasureRecord.TreasureName)+", " ' store treasure name
          Items.Displayed=Items.Displayed+1 ' increment displayed counter
       Endif ' end check display flag
    Endif ' end check file bounds
 Next ' end loop through room treasure
 If Items.Displayed=False Then ' check items displayed counter
    Outpt="nothing.." ' make message
 Else ' check item counter
    Outpt=Left$(Outpt,Len(Outpt)-2)+"." ' trim comma, add period
    If Items.Displayed>1 Then ' check counter
       Outpt="and "+Outpt ' append string
    Endif ' end check counter
 Endif ' end check counter
 Call IO.O ' send message
End Sub ' end routine to search room

 Rem * routine processes actions, routine is entered when a trigger is
 Rem * activated.
 Rem * input variables:
 Rem *   Activate.Action$ - the display string which activated the action.
 Rem *   Trigger.Action$ - prefix string of what hit player.

Sub Actions(Activate.Action$,Trigger.Action$)
 On Local Error Resume Next ' local error resume
 If Room=1 Then ' check resurrected room
    Exit Sub ' exit routine
 Endif ' end check room
 Inpt=Nul ' reset output string
 Graphics.Off=False ' reset color
 Select Case ActionRecord.Inventory ' selection of room action
 Case 1 ' inventory action 1 breaks all weapons
    Item.Broke=False ' weapon broke flag
    Weapon2=False ' reset weapon held
    Weapon6=False ' reset weapon held
    Weapon10=False ' reset weapon held
    For Inventory.Number=1 To 20 ' loop through all player inventory
       Treasure.Number=UserRecord.Inv(Inventory.Number) ' get treasure index
       If Treasure.Number>False And _
       Treasure.Number<=Lof(TreasureFile)/Len(TreasureRecord) Then 'file bounds
          Call Read.Record(TreasureFile,Treasure.Number) ' get treasure record
          If TreasureRecord.Plus Then ' check weapon plus
             If TreasureRecord.Type=False Then ' check weapon
                ' check weapon charges
                If UserRecord.Charges(Inventory.Number) Then
                   ' clear weapon charges
                   UserRecord.Charges(Inventory.Number)=False
                   Item.Broke=True ' set weapon broke flag
                Endif ' end check charges
             Endif ' end check weapon
          Endif ' end check weapon plus
       Endif ' end check file bounds
    Next ' end loop through player inventory
    If Item.Broke Then ' compare weapon broke flag
       Outpt=Activate.Action$ ' copy routine string
       Call IO.O ' send string
       Outpt="All your weapons break!" ' make message
       Call IO.O ' send weapon message
    Endif ' end compare broke flag
 Case 2 ' inventory action 2 breaks all shields
    Item.Broke=False ' set shield broke flag
    Weapon3=False ' clear shield held
    Weapon5=False ' clear shield held
    For Inventory.Number=1 To 20 ' loop through all player inventory
       Treasure.Number=UserRecord.Inv(Inventory.Number) ' get treasure index
       If Treasure.Number>False And _
       Treasure.Number<=Lof(TreasureFile)/Len(TreasureRecord) Then 'file bounds
          Call Read.Record(TreasureFile,Treasure.Number) ' get treasure record
          If TreasureRecord.Type<False Then ' check shield type
             If UserRecord.Charges(Inventory.Number) Then ' check charges
                ' clear shield charges
                UserRecord.Charges(Inventory.Number)=False
                Item.Broke=True ' set shield broke flag
             Endif ' end check charges
          Endif ' end check shield
       Endif ' end check file bounds
    Next ' end loop through player inventory
    If Item.Broke Then ' compare shield broke flag
       Outpt=Activate.Action$ ' copy routine string
       Call IO.O ' send string
       Outpt="All your shields break!" ' make message
       Call IO.O ' send shield message
    Endif ' end compare broke flag
 Case 3 ' inventory action 3 breaks all armor
    Item.Broke=False ' set armor broke flag
    Weapon1=False ' clear armor worn
    Weapon4=False ' clear armor worn
    For Inventory.Number=1 To 20 ' loop through all player inventory
       Treasure.Number=UserRecord.Inv(Inventory.Number) ' get treasure index
       If Treasure.Number>False And _
       Treasure.Number<=Lof(TreasureFile)/Len(TreasureRecord) Then 'file bounds
          Call Read.Record(TreasureFile,Treasure.Number) ' get treasure record
          If TreasureRecord.Type>False Then ' check armor
             If UserRecord.Charges(Inventory.Number) Then ' check charges
                ' clear armor charges
                UserRecord.Charges(Inventory.Number)=False
                Item.Broke=True ' set armor broke flag
             Endif ' end check charges
          Endif ' end check armor
       Endif ' end check file bounds
    Next ' end loop through player inventory
    If Item.Broke Then ' compare armor broke flag
       Outpt=Activate.Action$ ' copy routine message
       Call IO.O ' send message
       Outpt="All your armor breaks!" ' make message
       Call IO.O ' send armor message
    Endif ' end compare broke flag
 Case 4 ' inventory action 4 breaks all magic items
    Item.Broke=False ' set magic item broke flag
    Weapon7=False ' clear ring held
    Weapon8=False ' clear ring held
    For Inventory.Number=1 To 20 ' loop through all player inventory
       Treasure.Number=UserRecord.Inv(Inventory.Number) ' get treasure index
       If Treasure.Number>False And _
       Treasure.Number<=Lof(TreasureFile)/Len(TreasureRecord) Then 'file bounds
          Call Read.Record(TreasureFile,Treasure.Number) ' get treasure record
          If TreasureRecord.Spell Then ' check magic item
             If UserRecord.Charges(Inventory.Number) Then ' check charges
                ' clear magic item charges
                UserRecord.Charges(Inventory.Number)=False
                Item.Broke=True ' set magic item broke flag
             Endif ' end check charges
          Endif ' end check magic item
       Endif ' end check file bounds
    Next ' end loop through player inventory
    If Item.Broke Then ' compare magic item broke flag
       Outpt=Activate.Action$ ' copy routine string
       Call IO.O ' send string
       Outpt="All your magic items break!" ' make message
       Call IO.O ' send magic item message
    Endif ' end compare broke flag
 End Select ' end selection of action
 If ActionRecord.Fumble Then ' verify room fumble action
    Call Fumble ' routine to fumble weapon/shield
 Endif ' end verify fumble action
 Teleport.Number=ActionRecord.Teleport
 If Teleport.Number>False And Teleport.Number<>Room Then
    Outpt=Activate.Action$ ' copy routine string
    Call IO.O ' send string
    Outpt="You are teleported elsewhere!" ' make message
    Call IO.O ' send teleport message
    Next.Room=Teleport.Number ' store new room number
    Teleported=True ' set teleporting flag
    Call Enter.Room ' routine to move player to new room
 Endif ' end verify teleport action
 Room.Hits#=Cdbl(Int(ActionRecord.HitPoints)) ' store room hit action
 If Room.Hits#>False Then ' verify hit points action
    Outpt=Activate.Action$ ' copy routine string
    Call IO.O ' send string
    Outpt=Trigger.Action$ ' copy second routine string
    Call Hit.Player(Room.Hits#) ' routine to hit player
 Endif ' end verify hit points action
End Sub ' end routine to activate room actions

 Rem * routine to verify monster blocking exits, then check valid direction.
 Rem * input variables:
 Rem *   Direction.Number - direction to go.
 Rem * output variables:
 Rem *   Next.Room - number of new room to enter.

Sub Verify.Room(Direction.Number)
 On Local Error Resume Next ' local error resume
 New.Room=False ' enter new room flag
 If UserRecord.ClassType<Lady Then ' check normal player class
    For Array.Index=1 To Number.Monsters ' loop through monsters in room
       If MonsterArray(Array.Index).Block Then ' check monster blocks exits
          ' random percent
          If Rnd<(MonsterArray(Array.Index).BlockPercent/100) Then
             Inpt=MonsterArray(Array.Index).MonsterName ' store monster name
             Inpt=Rtrim$(Inpt) ' trim name
             Outpt="The "+Inpt+" blocks your way!" ' make block message
             Call IO.O ' send block message
             Exit Sub ' exit routine
          Endif ' end check random percentage
       Endif ' end check monster blocks exits
    Next ' end loop through monsters
 Endif ' end check normal user
 Next.Room=RoomRecord.Direct(Direction.Number) ' get room number of direction
 If Next.Room=False Then ' check next room number
    If Normal.User Then ' check DM status
       Outpt="You can't go in that direction!" ' make entry message
       Call IO.O ' send entry message
    Else ' check DM status
       Call Add.Room(Direction.Number,Room.Added) ' routine to add new room
       New.Room=Room.Added ' store new room flag
    Endif ' end check DM
    Exit Sub ' exit routine
 Else ' check next room number
    ' routine to verify room direction restricted
    Call Restrict(Direction.Number,Restricted)
    If Restricted Then ' check room restricted flag
       Outpt="Your level does not permit entrance to that room!" ' message
       Call IO.O ' send restricted message
       Exit Sub ' exit routine
    Endif ' end check room restricted
    ' routine to verify room entry type restricted
    Call Restrict.Room.Type(Restricted)
    If Restricted Then ' check room restricted flag
       Outpt="You can't walk to that room!" ' message
       Call IO.O ' send restricted message
       Exit Sub ' exit routine
    Endif ' end check room restricted
 Endif ' end check next room number
 New.Room=True ' store next room valid flag
End Sub ' end routine to verify room entry, direction

 Rem * routine to exit a room with the Out command.

Sub Exit.Room
 On Local Error Resume Next ' local error resume
 Entry.Command=Last.Command.Number ' store room entry command
 User.Command="O" ' store out command
 Last.Command="OUT" ' store out command
 Last.Command.Number=True ' reset command type
 Call Verify.Room(5) ' routine to verify valid room
 If New.Room Then ' check valid room flag
    Call Enter.Room ' routine to move player to room
 Endif ' end check valid room
End Sub ' end routine to go Out

 Rem * routine to use the Up direction.

Sub Climb
 On Local Error Resume Next ' local error resume
 Entry.Command=Last.Command.Number ' store room entry command
 User.Command="U" ' store up command
 Last.Command="UP" ' store up command
 Last.Command.Number=True ' store command type
 Call Verify.Room(6) ' routine to check valid room
 If New.Room Then ' check valid room flag
    Call Enter.Room ' routine to move player to room
 Endif ' end check valid room
End Sub ' end routine to go Up

 Rem * routine processes room traps.

Sub Traps
 On Local Error Resume Next ' local error resume
 New.Room=False ' reset next room flag
 If Rnd<.5 Then ' random chance
    Outpt="It's trapped! " ' make trap message
    Select Case ObjectRecord.Trap ' selection of room trap type
    Case 1 ' type 1
       Outpt=Outpt+"Poison needles!" ' make trap message
       Call IO.O ' send trap message
       UserRecord.Poison=True ' set player poison flag
    Case 2 ' type 2
       New.Room=ObjectRecord.Teleport ' store teleport room number
       ' file bounds
       If New.Room>False And New.Room<=Lof(RoomFile)/Len(RoomRecord) Then
          If New.Room<>Room Then ' check destination room for recursion
             Outpt=Outpt+"Falling door!" ' make trap message
             Call IO.O ' send trap message
             Pass.Door=False ' clear pass door flag
             Number.Monsters=False ' clear number of monsters
             Next.Room=New.Room ' store room trap teleport number
             Teleported=True ' set teleporting flag
             Call Enter.Room ' routine to move player to a room
          Endif ' end check destination room
       Endif ' end check file bounds
    Case 3 ' type 3
       Outpt=Outpt+"Deadly spears!" ' make trap message
       Call IO.O ' send trap message
       Outpt="You are hit for" ' make hits message
       ' get object trap hits on player
       Room.Hits#=Cdbl(Int(ObjectRecord.Teleport))
       If Room.Hits#>False Then ' check hits
          Call Hit.Player(Room.Hits#) ' routine to hit player
       Endif ' end check hits
    End Select ' end selection of trap type
 Endif ' end check random chance
End Sub ' end routine for room traps

 Rem * routine to hide player.

Sub Hide.User
 On Local Error Resume Next ' local error resume
 If Hidden.Player Then ' check player already hidden
    Outpt="You hide in the shadows!" ' make hide message
    Call IO.O ' send hide message
    Exit Sub ' exit routine
 Endif ' end check player hidden
 Hide.Flag=False ' set hide flag
 If Number.Monsters=False Then ' check number of monsters in room
    Hide.Flag=True ' set hide flag
 Else ' check monsters
    If Rnd>.66 Then ' random chance
       Hide.Flag=True ' set hide flag
    Endif ' end check random chance
 Endif ' end check monsters in room
 If Hide.Flag Then ' check hide flag
    Hidden.Player=True ' set player hide flag
    Outpt="You hide in the shadows!" ' make hide message
 Else ' check hide flag
    Outpt="Didn't work!" ' make hide message
 Endif ' end check hide flag
 Call IO.O ' send hide message
End Sub ' end routine to hide player

 Rem * routine for player to use a vehicle.

Sub Enter.Vehicle
 On Local Error Resume Next ' local error resume
 Call Check.Room.Treasure ' routine finds vehicle name in room
 If Index.Number=False Then ' check room vehicle found
    Outpt="That's not a vehicle!" ' make error message
    Call IO.O ' send error message
    Exit Sub ' exit routine
 Endif ' end check vehicle found
 If TreasureRecord.Vehicle=False Then ' check item is vehicle
    Outpt="That's not a vehicle!" ' make error message
    Call IO.O ' send error message
    Exit Sub ' exit routine
 Endif ' end check vehicle
 Outpts=TreasureRecord.ShortName ' store treasure name
 Outpts=Rtrim$(Outpts) ' trim name
 Outpts=Lcase$(Outpts) ' lowercase name
 If Charges.Number=False Then ' check vehicle hits
    Outpt="The "+Outpts+" is damaged!" ' make error message
    Call IO.O ' send error message
    Exit Sub ' exit routine
 Endif ' end chekc vehicle hits
 Vehicle1=Array.Number ' store vehicle variable
 Vehicle2=Charges.Number ' store vehicle variable
 Vehicle3=Index.Number ' store vehicle variable
 Vehicle4=TreasureRecord.VehicleType ' store vehicle variable
 Outpt="You enter the "+Outpts+"." ' make vehicle message
 Call IO.O ' send vehicle message
End Sub ' end routine to use vehicle

 Rem * routine to move player and vehicle in a direction or through a portal.

Sub Ride.Vehicle
 On Local Error Resume Next ' local error resume
 If Vehicle3=False Then ' check player using a vehicle
    Outpt="You're not riding a vehicle!" ' make error message
    Call IO.O ' send error message
    Exit Sub ' exit routine
 Endif ' end check player vehicle
 User.Command=Parsed.Command1 ' store direction parameter
 Call Get.Direction(Direction.Number) ' routine verifies direction
 If Direction.Number Then ' compare direction number
    Next.Room=RoomRecord.Direct(Direction.Number) ' get room direction
    If Next.Room=False Then ' check room direction number
       Outpt="You can't travel in that direction!" ' make error message
       Call IO.O ' send error message
       Exit Sub ' exit routine
    Endif ' end check room direction number
    Call Vehicle.Type ' routine compares vehicle to room type
    If Next.Room=False Then ' check room type flag
       Outpt="You can't travel in that direction!" ' make error message
       Call IO.O ' send error message
       Exit Sub ' exit routine
    Endif ' end compare vehicle to room type
    Outpts=Direction(Direction.Number) ' store dirction name
    Outpts=Rtrim$(Outpts) ' trim name
    Outpts=Lcase$(Outpts) ' lowercase name
    Outpt="You ride "+Outpts+"!" ' make vehicle message
    Call IO.O ' send vehicle message
    Call Enter.Room ' routine moves player to room
    Exit Sub ' exit routine
 Endif ' end compare direction number
 Call Check.Room.Objects ' routine searches room for portal name
 If Index.Number=False Then ' check room portal number
    Outpt="You can't travel in that direction!" ' make error message
    Call IO.O ' send error message
    Exit Sub ' exit routine
 Endif ' end check room portal
 If ObjectRecord.RoomLink=False Then ' check portal goes to room
    Outpt="You can't travel there!" ' make error message
    Call IO.O ' send error message
    Exit Sub ' exit routine
 Endif ' end check portal to room number
 If ObjectRecord.JailTrap Then ' check room portal is a jail trap
    Outpt="Trapped portal!" ' make error message
    Call IO.O ' send error message
    Exit Sub ' exit routine
 Endif ' end check room portal type
 If ObjectRecord.Closed Then ' check roomportal is locked
    If Pass.Door=False Then ' check pass door spell in effect
       Outpt="You can't, it's closed!" ' make entry error message
       Call IO.O ' send entry error message
       Exit Sub ' exit routine
    Endif ' end check pass door spell
 Endif ' end check room portal locked
 If ObjectRecord.Relocks Then ' check room portal relocks
    ObjectRecord.DoorLock=2 ' reset room portal lock
    ObjectRecord.Closed=True ' reset room portal lock
    Call Share.Record(ObjectFile,Index.Number) ' write object record
 Endif ' end check room portal relock
 Outpt=ObjectRecord.ShortDesc ' store room entry display description
 If Outpt<>String$(80,0) Then ' check description to nulls
    Outpt=Rtrim$(Outpt) ' trim description
    If Outpt<>Nul Then ' compare length of description
       Call IO.O ' send room entry description message
    Endif ' end compare description length
 Endif ' end check description
 Pass.Door=False ' reset pass door spell
 Number.Monsters=False ' reset number of monsters in room
 ' store room number of object portal destination
 Next.Room=ObjectRecord.RoomLink ' store
 Call Vehicle.Type ' routine to verify vehicle to room type
 If Next.Room=False Then ' check verified room number
    Outpt="You can't travel in that direction!" ' make error message
    Call IO.O ' send error message
    Exit Sub ' exit routine
 Endif ' end check vehicle to room type
 Outpts=ObjectRecord.ShortName ' store object name
 Outpts=Rtrim$(Outpts) ' trim name
 Outpts=Lcase$(Outpts) ' lowercase name
 Outpt="You ride to the "+Outpts+"!" ' make vehicle message
 Call IO.O ' send message
 Call Enter.Room ' routine moves player to room
End Sub ' end routine to move player and vehicle

 Rem * routine remove player from vehicle.

Sub Exit.Vehicle
 On Local Error Resume Next ' local error resume
 Call Check.Room.Treasure ' routine finds vehicle name in room
 If Array.Number=Vehicle1 Then ' compare treasure number to vehicle number
    Outpts=TreasureRecord.ShortName ' store treasure name
    Outpts=Rtrim$(Outpts) ' trim name
    Outpts=Lcase$(Outpts) ' lowercase name
    Vehicle1=False ' reset vehicle variable
    Vehicle2=False' reset vehicle variable
    Vehicle3=False' reset vehicle variable
    Outpt="You exit the "+Outpts+"!" ' make vehicle message
 Else ' compare vehicle numbers
    Outpt="You can't exit that!" ' make error message
 Endif ' end compare vehicle
 Call IO.O ' send message
End Sub ' end routine to exit vehicle

 Rem * routine verifies vehicle type can enter room type.
 Rem * output variables:
 Rem *   Next.Room - false for invalid vehicle to room type.

Sub Vehicle.Type
 On Local Error Resume Next ' local error resume
 If Next.Room<=False Or _
 Next.Room>Lof(RoomFile)/Len(RoomRecord) Then ' file bounds
    Next.Room=False ' return next room number
    Exit Sub ' exit routine
 Endif ' end check file bounds
 Call Read.Room.Record(Next.Room) ' get destination room
 If Vehicle4<>3 Then ' check all terrain vehicle
    Action.Number=RoomRecord.Action ' store room action number
    If Action.Number>False And _
    Action.Number<=Lof(ActionFile)/Len(ActionRecord) Then
       Call Read.Record(ActionFile,Action.Number) ' read action record
       If ActionRecord.Attribute2<>Vehicle4 Then ' check vehicle terrain type
          Next.Room=False ' reset next room number
       Endif ' end check vehicle terrain type
    Endif ' end check action number range
 Endif ' end check all terrain vehicle
 Call Read.Room.Record(Room) ' restore room record
End Sub ' end routine to compare vehicle to room type

 Rem * routine determines if player can train for next level.

Sub Train
 On Local Error Resume Next ' local error resume
 If UserRecord.Level<=False Then ' verify player level
    Call Train.Stats ' train player
    Exit Sub ' exit routine
 Endif ' end verify player level
 ' calculate experience needed to reach next level
 Call Experience(Exp.Required#)
 If UserRecord.Experience<Exp.Required# Then ' compare player experience
    Outpt="You don't have enough experience to train!" ' train error message
    Call IO.O ' send train error message
    Exit Sub ' exit routine
 Endif ' end compare player experience
 Call Gold(Gold.Required#) ' routine calculates gold needed for level
 If UserRecord.Gold<Gold.Required# Then ' compare to player gold
    Outpt="You don't have enough Gold to train!" ' make train error message
    Call IO.O ' send train error message
    Exit Sub ' exit routine
 Endif ' end compare gold
 Call Train.Stats ' routine to train for next level
End Sub ' end train routine

 Rem * routine teleports player to room.
 Rem * input variables:
 Rem *   Parsed.Command1 - parameter containing room number.

Sub Teleport.User
 On Local Error Resume Next ' local error resume
 Next.Room=Int(Val(Parsed.Command1)) ' convert parameter to room number
 Graphics.Off=True ' reset color
 Outpt="A Dark Cloud Passes Overhead..." ' make ghod message
 Call IO.O ' send ghod message
 Outpt="  A Bolt Of Lightning Strikes..." ' make ghod message
 Call IO.O ' send ghod message
 Outpt="The Cloud Disappears..." ' make ghod message
 Call IO.O ' send ghod message
 Graphics.Off=False ' reset color
 Teleported=True ' set teleporting flag
 Call Enter.Room ' routine moves player to room
End Sub ' end routine to teleport player

 Rem * routine moves player to room number in an object.
 Rem * input variables:
 Rem *   Parsed.Command1 - contains the object name.

Sub Enter.Object
 On Local Error Resume Next ' local error resume
 User.Command=Parsed.Command1 ' store command parameter
 Call Get.Direction(Direction.Number) ' compare name to direction to go to
 If Direction.Number Then ' check direction flag
    Entry.Command=Last.Command.Number ' store room entry command
    Call Verify.Room(Direction.Number) ' routine verifies room number
    If New.Room Then ' check room flag
       Call Enter.Room ' routine moves player
    Endif ' end check room flag
    Exit Sub ' exit routine
 Endif ' end check direction
 Call Check.Room.Objects ' compare object name
 If Index.Number=False Then ' check object name flag
    Call Check.Room.Treasure ' compare treasure name
    If Index.Number Then ' check treasure name flag
       If TreasureRecord.Vehicle Then ' object to move to is vehicle
          Call Enter.Vehicle ' routine to enter vehicle
          Exit Sub ' exit routine
       Endif ' end check object name
    Endif ' end check treasure flag
    Outpt="You can't go there!" ' make error message
    Call IO.O ' send error message
    Exit Sub ' exit routine
 Endif ' end check object name flag
 If ObjectRecord.RoomLink=False Then ' check object portal room number
    Outpt="You can't go there!" ' make error message
    Call IO.O ' send error message
    Exit Sub ' exit routine
 Endif ' end check portal room number
 Call Restrict(12,Restricted) ' routine checks enter command restricted
 If Restricted Then ' compare restrict flag
    Outpt="Your level does not permit entrance to that room!" ' message
    Call IO.O ' send error message
    Exit Sub ' exit routine
 Endif ' end compare restricted room
 If ObjectRecord.JailTrap Then ' check object is jailed
    Outpt="Trapped portal!" ' make error message
    Call IO.O ' send error message
    Exit Sub ' exit routine
 Endif ' end check jailed object
 If ObjectRecord.Closed Then ' check object lock
    If Pass.Door=False Then ' check pass door spell in effect
       Outpt="You can't, it's closed!" ' make error message
       Call IO.O ' send error message
       Exit Sub ' exit routine
    Endif ' end check pass door spell
 Endif ' end check object lock
 If ObjectRecord.Relocks Then ' check object relocks after entry
    ObjectRecord.DoorLock=2 ' relock object
    ObjectRecord.Closed=True ' relock object
    Call Share.Record(ObjectFile,Index.Number) ' write object record
 Endif ' end check relocking object
 Outpt=ObjectRecord.ShortDesc ' store entry description
 If Outpt<>String$(80,0) Then ' compare description to nulls
    Outpt=Rtrim$(Outpt) ' trim description
    If Outpt<>Nul Then ' compare length of description
       Call IO.O ' send entry description message
    Endif ' end compare description length
 Endif ' end compare description
 If ObjectRecord.Trap Then ' verify object has trap
    Call Traps ' routine to activate object trap
    If New.Room Then ' check teleporting trap
       Exit Sub ' exit routine
    Endif ' end check teleporting trap
 Endif ' end verify object trap
 Pass.Door=False ' reset pass door spell
 Number.Monsters=False ' set monsters in room to zero
 Next.Room=ObjectRecord.RoomLink ' store object portal room number
 Call Enter.Room ' routine to move player to new room
End Sub ' end routine to move player through an object to room

 Rem * routine moves player to new room number.
 Rem * input variables:
 Rem *   Next.Room - contains new room number to move player to.

Sub Enter.Room
 On Local Error Resume Next ' local error resume
 New.Room=True ' set room entry flag
 Call Clean.Room ' routine to remove treasure from old room
 If Next.Room>False And _
 Next.Room<=Lof(RoomFile)/Len(RoomRecord) Then ' file bounds
    Swap Room,Next.Room ' store new room, saving old room number
 Endif ' end check room file bounds
 Call Status.Line(False) ' routine updates status line
 Monster.Rate1=False ' reset room monster encounter rate
 Call Read.Room.Record(Room) ' get the new room record
 If Vehicle1>False Then ' verify vehicle variable used
    Move.Vehicle=False ' move vehicle flag
    Entry.Command=Last.Command.Number ' store command number to enter room
    ' vehicle entered room
    If Entry.Command=RideVehicle Or Entry.Command=DriveVehicle Then
       For Treasure.Number=1 To 20 ' loop through room treasure
          ' check empty treasure
          If RoomRecord.Treasure(Treasure.Number)=False Then
             ' store vehicle inventory
             RoomRecord.TreCharges(Treasure.Number)=Vehicle2
             ' store vehicle inventory
             RoomRecord.Treasure(Treasure.Number)=Vehicle3
             Call Share.Room.Record(Room) ' write new room record
             Call Read.Room.Record(Next.Room) ' get previous room
             RoomRecord.Treasure(Vehicle1)=False ' reset vehicle inventory
             RoomRecord.TreCharges(Vehicle1)=False ' reset vehicle inventory
             Call Share.Room.Record(Next.Room) ' write room record
             Call Read.Room.Record(Room) ' get current room record
             Move.Vehicle=True ' set move vehicle flag
             Vehicle1=Treasure.Number ' store new vehicle treasure number
             Exit For ' exit loop through treasure in room
          Endif ' end check for empty treasure in room
       Next ' end loop through room treasure inventory
    Endif ' end check command used to enter room
    If Move.Vehicle=False Then ' verify vehicle moves to new room
       Call Read.Record(TreasureFile,Vehicle3) ' get treasure record
       Outpts=TreasureRecord.ShortName ' store treasure name
       Outpts=Rtrim$(Outpts) ' trim name
       Outpts=Lcase$(Outpts) ' lowercase name
       Outpt="You exit the "+Outpts+"." ' make vehicle message
       Call IO.O ' send vehicle message
       Vehicle1=False ' reset vehicle varible
       Vehicle2=False ' reset vehicle varible
       Vehicle3=False ' reset vehicle varible
       Vehicle4=False ' reset vehicle varible
    Endif ' end verify vehicle moves
 Endif ' end verify vehicle used
 For Array.Index=1 To Number.Monsters ' loop through room monsters
    ' compare permanent monster
    If MonsterArray(Array.Index).Permanent=True Then
       ' store permanent monster file index
       Monster.Number=MonsterIndex(Array.Index)
       Call Read.Record(MonsterFile,Monster.Number) ' get monster file record
       ' store permanent level
       MonsterRecord.Level=MonsterArray(Array.Index).Level
       MonsterRecord.Hits=MonsterArray(Array.Index).Hits ' stor permanent hits
       Call Share.Record(MonsterFile,Monster.Number) ' write monster record
    Endif ' end compare permanent monster
 Next ' end loop through room monsters
 If Room=1 Then ' check safe room
    Monster.Follow=False ' monsters followed flag
 Else ' end check safe room
    If UserRecord.ClassType<Lady Then ' check class number
       Monster.Follow=True ' monsters followed flag
    Else ' check class number
       Monster.Follow=False ' monsters followed flag
    Endif ' end check class number
 Endif ' end check safe room
 Teleported.Flag=Teleported ' store teleporting flag
 Teleported=False ' reset teleporting flag
 If Monster.Follow Then ' compare number of monsters followed
    If Teleported.Flag Then ' compare teleporting flag
       Outpts=" teleports with you!" ' make follow message
    Else ' check teleporting flag
       Outpts=" follows you!" ' make follow message
    Endif ' end check teleporting flag
    Monsters.Followed=False ' number of monsters which followed counter
    For Array.Index=1 To Number.Monsters ' loop through all monsters in room
       Monster.Followed=False ' set followed flag
       If MonsterArray(Array.Index).Follow Then ' check monster follows
          If Teleported.Flag Then ' check player teleported
             ' random chance monster teleports with player
             If Rnd<(MonsterArray(Array.Index).Teleport/100) Then
                Monster.Followed=True ' set followed flag
             Endif ' end random chance
          Else ' check player teleported
             ' random chance monster follows player
             If Rnd<(MonsterArray(Array.Index).FollowPercent/100) Then
                Monster.Followed=True ' set followed flag
             Endif ' end random chance
          Endif ' end check player teleported
          If Monster.Followed Then ' verify followed flag
             ' permanent monster
             If MonsterArray(Array.Index).Permanent=False Then
                ' increment number of monsters
                Monsters.Followed=Monsters.Followed+1
                ' store monster
                MonsterArray(Monsters.Followed)=MonsterArray(Array.Index)
                ' store monster
                MonsterIndex(Monsters.Followed)=MonsterIndex(Array.Index)
                ' store monster name
                Inpt=MonsterArray(Monsters.Followed).MonsterName
                Inpt=Rtrim$(Inpt) ' trim name
                Inpt=Lcase$(Inpt) ' lowercase name
                Outpt="The "+Inpt+Outpts ' make followed message
                Call IO.O ' send message
             Endif ' end check permanent monster
          Endif ' end verify followed flag
       Endif ' end check monster follows
    Next ' end loop through monsters in room
 Endif ' end compare number of monsters following
 Monster.Rate1=False ' reset room monster encounter rate
 Number.Monsters=Monsters.Followed ' store number of monsters followed
 Room.Rate=False ' reset room rate counter
 Rust.Rate=False ' reset room rate counter
 Steal.Rate=False ' reset room rate counter
 Teleported=False ' reset teleporting flag
 Call Check.Next.Room ' routine to get new room record
 Call Encounter.Permanent ' routine to get permanent monsters
 Call Display.Room ' routine displays room description
 Action.Number=RoomRecord.Action ' store room action number
 ' check file bounds
 If Action.Number>False And _
 Action.Number<=Lof(ActionFile)/Len(ActionRecord) Then
    Call Read.Record(ActionFile,Action.Number) ' read action record
    If ActionRecord.SpellTrigger=False Then ' check room spell action
       If ActionRecord.MonsterTrigger=False Then ' check room monster action
          ' check room monster talk action
          If ActionRecord.MonsterTalk=False Then
             Action1$="As you enter the room," ' make action message
             Action2$="You are hit for" ' make action message
             Call Actions(Action1$,Action2$) ' routine for room actions
          Endif ' end check room action
       Endif ' end check room action
    Endif ' end check room action
 Endif ' end check file bounds
End Sub ' end routine to move player to new room

 Rem * routine toggles invisible mode.

Sub Toggle.Invisible
 On Local Error Resume Next ' local error resume
 UserRecord.Invisible=Not UserRecord.Invisible ' negate player invisible mode
 If UserRecord.Invisible Then ' check invisible
    Outpt="You are invisible!" ' make message
 Else ' check invisible
    Outpt="You are no longer invisible!" ' make message
 Endif ' end check invisible
 Call IO.O ' send message
End Sub ' end routine to toggle invisible mode

 Rem * routine toggles linefeed mode.

Sub Toggle.Linefeeds
 On Local Error Resume Next ' local error resume
 User.Linefeeds=Not User.Linefeeds ' negate player linefeed mode
 If User.Linefeeds Then ' check linefeeds
    Outpt="Linefeeds toggled off." ' make message
 Else ' check linefeeds
    Outpt="Linefeeds toggled on." ' make message
 Endif ' end check linefeeds
 Call IO.O ' send message
End Sub ' end routine to toggle linefeed mode

 Rem * routine toggles echo mode.

Sub Toggle.Echo
 On Local Error Resume Next ' local error resume
 User.Echo=Not User.Echo ' negate player echo mode
 If User.Echo Then ' check echo
    Outpt="Echo toggled off." ' make message
 Else ' check echo
    Outpt="Echo toggled on." ' make message
 Endif ' end check echo
 Call IO.O ' send message
End Sub ' end routine to toggle echo mode

 Rem * routine toggles word wrap mode.

Sub Toggle.Wordwrap
 On Local Error Resume Next ' local error resume
 User.Wordwrap=Not User.Wordwrap ' negate player word wrap mode
 If User.Wordwrap Then ' check word wrap
    Outpt="Word wrap toggled off." ' make message
 Else ' check word wrap
    Outpt="Word wrap toggled on." ' make message
 Endif ' end check word wrap
 Call IO.O ' send message
End Sub ' end routine to toggle word wrap mode

Rem * routine to toggle player Ansi mode.

Sub Toggle.ANSI
 On Local Error Resume Next ' local error resume
 Color.Graphics=Not Color.Graphics ' negate ansi color flag
 If Color.Graphics Then ' check ansi toggle
    Outpt="ANSI codes enabled." ' make message
 Else ' check ansi
    Outpt="ANSI codes disabled." ' make message
 Endif ' end check ansi toggle
 Call IO.O ' send message
End Sub ' end routine to toggle ansi

 Rem * routine to toggle brief mode.

Sub Brief.Mode
 On Local Error Resume Next ' local error resume
 If Normal.User Then ' verify non DM
    If UserRecord.Level<=1 Then ' check player level
       Outpt="Brief mode not allowed until level two!" ' make error message
       Call IO.O ' send message
       Exit Sub ' exit routine
    Endif ' end check player level
 Endif ' end check normal player
 UserRecord.Brief=Not UserRecord.Brief ' negate brief mode
 If UserRecord.Brief Then ' check brief mode
    Action.Prompt="Next?" ' store new command prompt
    Outpt="Brief mode on." ' make message
 Else ' check brief mode
    Action.Prompt="Command? " ' store new command prompt
    Outpt="Brief mode off." ' make message
 Endif ' end check brief mode
 Call IO.O ' send message
End Sub ' end routine to toggle brief mode

 Rem * routine to change pagelength.

Sub Change.Pagelength
 On Local Error Resume Next ' local error resume
 Outpt="Enter pagelength(1-50)? " ' make input prompt
 No.Input.Out="24" ' default input
 Call IO.I ' get user input
 Page.Length=Int(Val(Inpt)) ' convert input to integer
 If Page.Length>=1 And Page.Length<=50 Then ' check pagelength bounds
    User.Pagelength=Page.Length ' store new pagelength
    Outpt="Pagelength now"+Str$(Page.Length)+" lines." ' make output message
 Else ' check bounds
    Outpt="Pagelength not changed." ' make output message
 Endif ' end check bounds
 Call IO.O ' send output
End Sub ' end routine to change pagelength

 Rem * routine to change linelength.

Sub Change.Linelength
 On Local Error Resume Next ' local error resume
 Outpt="Enter linelength(1-132)? " ' make input prompt
 No.Input.Out="80" ' default input
 Call IO.I ' get user input
 Line.Length=Int(Val(Inpt)) ' convert input to integer
 If Line.Length>=1 And Line.Length<=132 Then ' check linelength bounds
    User.Linelength=Line.Length ' store new linelength
    Outpt="Linelength now"+Str$(Line.Length)+" characters." ' make output message
 Else ' check bounds
    Outpt="Linelength not changed." ' make output message
 Endif ' end check bounds
 Call IO.O ' send output
End Sub ' end routine to change linelength

 Rem * routine to display preferences.

Sub Display.Prefs
 On Local Error Resume Next ' local error resume
 Graphics.Off=True ' reset color
 If User.Linefeeds Then ' check linefeeds
    Outpt="Linefeeds toggled off." ' make message
 Else ' check linefeeds
    Outpt="Linefeeds toggled on." ' make message
 Endif ' end check linefeeds
 Call IO.O ' send message
 If User.Echo Then ' check echo
    Outpt="Echo toggled off." ' make message
 Else ' check echo
    Outpt="Echo toggled on." ' make message
 Endif ' end check echo
 Call IO.O ' send message
 If User.Wordwrap Then ' check word wrap
    Outpt="Word wrap toggled off." ' make message
 Else ' check word wrap
    Outpt="Word wrap toggled on." ' make message
 Endif ' end check word wrap
 Call IO.O ' send message
 If Color.Graphics Then ' check ansi toggle
    Outpt="ANSI codes enabled." ' make message
 Else ' check ansi
    Outpt="ANSI codes disabled." ' make message
 Endif ' end check ansi toggle
 Call IO.O ' send message
 If UserRecord.Brief Then ' check brief mode
    Outpt="Brief mode on." ' make message
 Else ' check brief mode
    Outpt="Brief mode off." ' make message
 Endif ' end check brief mode
 Call IO.O ' send message
 Outpt="Pagelength now"+Str$(User.Pagelength)+" lines." ' make message
 Call IO.O ' send output
 Outpt="Linelength now"+Str$(User.Linelength)+" characters." ' make message
 Call IO.O ' send output
 Select Case UserRecord.Sort ' check sorting preference
 Case -1 ' check value
    Outpt="Inventory charges sorting on." ' make display message
 Case 0 ' check value
    Outpt="Inventory sorting off." ' make display message
 Case 1 ' check value
    Outpt="Inventory plus sorting on." ' make display message
 Case Else ' check sorting
    Outpt="Inventory sorting off." ' make display message
 End Select ' end check sorting
 Call IO.O ' send display message
 ' check player locked mailbox
 If UserRecord.Flags And Locked.User Then
    Outpt="Mailbox locked." ' make locked message
 Else ' check player locked
    Outpt="Mailbox unlocked." ' make locked message
 Endif ' end check player locked flag
 Call IO.O ' send message
 Graphics.Off=False ' reset color
End Sub ' end display preferences routine

 Rem * routine to have the blacksmith repair some item of treasure.

Sub Weapons.Shop
 On Local Error Resume Next ' local error resume
 Call Check.Inventory.Treasure ' routine to find treasure name
 If Index.Number=False Then ' check treasure index
    Outpt="The Blacksmith says: You can't repair that!" ' make error message
    Call IO.O ' send error message
    Exit Sub ' exit routine
 Endif ' end check treasure index
 If TreasureRecord.Spell Then ' compare treasure is magic
    Outpt="The Blacksmith says: Can't fix that here!" ' make error message
    Call IO.O ' send error message
    Exit Sub ' exit routine
 Endif ' end compare magical treasure
 If TreasureRecord.Type=False Then ' check treasure is weapon, shield, armor
    If TreasureRecord.Plus=False Then ' check weapon plus
       Outpt="The Blacksmith says: Can't fix that here!" ' make error message
       Call IO.O ' send error message
       Exit Sub ' exit routine
    Endif ' end check weapon plus
 Endif ' end check treasuer type
 If UserRecord.Charges(Array.Number)<>False Then ' compare treasure charges
    Outpt="The Blacksmith says: That isn't broken!" ' make error message
    Call IO.O ' send error message
    Exit Sub ' exit routine
 Endif ' end compare treasure charges
 Item.Cost#=Int(TreasureRecord.Gold*.5) ' calculate price to repair item
 If Item.Cost#>UserRecord.Gold Then ' compare price to player gold
    Outpt="The Blacksmith says: You don't have enough gold!" ' make message
    Call IO.O ' send message
    Exit Sub ' exit routine
 Endif ' end compare price to gold
 ' make input prompt
 Outpt="The Blacksmith asks: How about"+Str$(Item.Cost#)+" gold(y/n)? "
 No.Input.Out="Y" ' default input
 Call IO.I ' get input
 If Yes Then ' compare response
    UserRecord.Gold=UserRecord.Gold-Item.Cost# ' decrement player gold
    ' store repaired charges
    UserRecord.Charges(Array.Number)=TreasureRecord.Charges
    Outpt="The Blacksmith says: There, it's repaired!" ' make message
 Else ' compare yresponse
    Outpt="The Blacksmith says: It ain't repaired!" ' make message
 Endif ' end compare response
 Call IO.O ' send message
End Sub ' end routine to repair item

 Rem * routine to repair an item of magical treasure.

Sub Alchemist
 On Local Error Resume Next ' local error resume
 Call Check.Inventory.Treasure ' routine to find treasure name
 If Index.Number=False Then ' check treasure index found
    Outpt="The Alchemist says: That can't be recharged here!" ' make message
    Call IO.O ' send error message
    Exit Sub ' exit routine
 Endif ' end check treasure index
 Spell.Number=TreasureRecord.Spell ' store treasure spell number
 ' file bounds
 If Spell.Number<=False Or Spell.Number>Lof(SpellFile)/Len(SpellRecord) Then
    Outpt="The Alchemist says: You can't recharge that here!" ' make message
    Call IO.O ' send error message
    Exit Sub ' exit routine
 Endif ' end check file bounds
 Call Read.Record(SpellFile,Spell.Number) ' get spell record of magic item
 If SpellRecord.SpellType=Wish Then ' compare to wish item
    Outpt="The Alchemist says: I won't recharge that item!" ' make message
    Call IO.O ' send error message
    Exit Sub ' exit routine
 Endif ' end cmopare wish item
 If UserRecord.Charges(Array.Number)<>False Then ' check item charges
    Outpt="The Alchemist says: That's not discharged!" ' make message
    Call IO.O ' send error message
    Exit Sub ' exit routine
 Endif ' end check charges remaining
 Item.Cost#=Int(TreasureRecord.Gold*.5) ' calculate price to repair
 If Item.Cost#>UserRecord.Gold Then ' compare price to player gold
    Outpt="The Alchemist says: You don't have enough gold!" ' make message
    Call IO.O ' send error message
    Exit Sub ' exit routine
 Endif ' end compare price to gold
 ' make input prompt
 Outpt="The Alchemist says: How about"+Str$(Item.Cost#)+" gold(y/n)? "
 No.Input.Out="Y" ' default input
 Call IO.I ' get input
 If Yes Then ' compare response
    UserRecord.Gold=UserRecord.Gold-Item.Cost# ' decrement player gold
    ' store item charges
    UserRecord.Charges(Array.Number)=TreasureRecord.Charges
    Outpt="The Alchemist chants an invocation!" ' make message
 Else ' compare response
    Outpt="The Alchemist says: Didn't repair it!" ' make message
 Endif ' end compare response
 Call IO.O ' send message
End Sub ' end routine to repair magic item

 Rem * routine to sell treasure item from list.
 Rem * input variables:
 Rem *   Parsed.Command1 - number of item to purchase.

Sub Weapons.Shoppe
 On Local Error Resume Next ' local error resume
 Treasure.Number=Int(Val(Parsed.Command1)) ' convert parameter to integer
 If Treasure.Number<=False Or Treasure.Number>20 Then ' compare integer bounds
    Outpt="The Blacksmith says: You can't buy that!" ' make error message
    Call IO.O ' send error message
    Exit Sub ' exit routine
 Endif ' end compare range
 If Treasure.Number>Lof(TreasureFile)/Len(TreasureRecord) Then ' check bounds
    Outpt="The Blacksmith says: You can't buy that!" ' make error message
    Call IO.O ' send error message
    Exit Sub ' exit routine
 Endif ' end compare file bounds
 Call Read.Record(TreasureFile,Treasure.Number) ' get treasure record
 If UserRecord.Gold-TreasureRecord.Gold<False Then ' compute price
    Outpt="The Blacksmith says: You don't have enough gold!" ' make message
    Call IO.O ' send error message
    Exit Sub ' exit routine
 Endif ' end compare price to player gold
 If Weight+TreasureRecord.Weight>UserRecord.Stats(1)*10 Then ' compute weight
    Outpt="The Blacksmith says: You can't carry any more!" ' make message
    Call IO.O ' send error message
    Exit Sub ' exit routine
 Endif ' end compare weight of new item
 Call TreasureCharges(Charges.Amount) ' routine to get treasure charges
 ' routine to add item to player inventory
 Call Add.Inventory(Treasure.Number,Charges.Amount,Item.Added)
 If Item.Added Then ' check return variable for added inventory
    UserRecord.Gold=UserRecord.Gold-TreasureRecord.Gold ' decrement gold
    Outpt="The Blacksmith says: There, sold!" ' make message
 Else ' check inventory added
    Outpt="The Blacksmith says: You can't carry any more!" ' make message
 Endif ' end check inventory added flag
 Call IO.O ' send output message
End Sub ' end routine to purchase item for sale

 Rem * routine displays a sorted list of the top ten players, writes the
 Rem * top ten ranking bulletin file.

Sub Top.Ten
 On Local Error Resume Next ' local error resume
 Call Share.Record(UserFile,User.Index) ' store player user record
 Max.Users=Lof(UserFile)/Len(UserRecord) ' store length of user file
 Redim Temp.Array1(1 To Max.Users) As Integer, _
 Temp.ArrayZ(1 To Max.Users) As Double ' dimension working arrays
 Close #TempFile ' close work file
 Open "ranklist.dat" For Output As #TempFile ' open to work file
 Outpt="The Adventure Door v"+Version$+" Top Ten Player Rankings For "+FNclock$+"."
 Print #TempFile,Outpt ' write to file
 Outpt=Nul ' make empty string
 Print #TempFile,Outpt ' write to file
 Player.Count=False ' reset player counter
 For User.Number=1 To Max.Users ' loop through user file
    Call Read.Record(UserFile,User.Number) ' get next user file record
    Outpt=UserRecord.CodeName ' store player codename
    Call Decrypt(Outpt) ' decrypt codename
    If Left$(Outpt,9)<>Deleted$ Then ' compare deleted user record
       If UserRecord.Level>False Then ' check user level
          If (UserRecord.Flags And Locked.User)=False Then ' check locked user
             Score#=UserRecord.MonstersKilled*UserRecord.Level ' compute score
             If Score#>False Then ' compare score
                ' increment high score player counter
                Player.Count=Player.Count+1
                Temp.Array1(Player.Count)=User.Number ' store record index
                Temp.ArrayZ(Player.Count)=Int(Score#) ' store score
             Endif ' end compare score
          Endif ' end check locked user record
       Endif ' end check user level
    Endif ' end compare deleted user
 Next ' end loop through user file
 ' bubble sort
 For Sort1=1 To Player.Count ' loop through all items to sort
    For Sort2=Sort1+1 To Player.Count ' loop through remaining items
       If Temp.ArrayZ(Sort1)<Temp.ArrayZ(Sort2) Then ' compare scores
          Swap Temp.Array1(Sort1),Temp.Array1(Sort2) ' swap lower array
          Swap Temp.ArrayZ(Sort1),Temp.ArrayZ(Sort2) ' swap lower array
       Endif ' end compare scores
    Next ' end loop through array
 Next ' end loop through array
 If Player.Count>10 Then ' check maximum number of users
    Player.Count=10 ' reset to top ten
 Endif ' end check maximum scoring players
 ' make header
 Outpt="Username                       Level Classname            Ranking"
 Print #TempFile,Outpt ' write to file
 Outpt=String$(65,"-") ' make header line
 Print #TempFile,Outpt ' write to file
 For Array.Number=1 To Player.Count ' loop through high scoring players
    User.Number=Temp.Array1(Array.Number) ' get user file record number
    Call Read.Record(UserFile,User.Number) ' get user file record
    Outpt=UserRecord.CodeName ' store player codename
    Call Decrypt(Outpt) ' decrypt codename
    Outpt=Lcase$(Outpt) ' lowercase codename
    Mid$(Outpt,1,1)=Ucase$(Mid$(Outpt,1,1)) ' uppercase first word
    Outpt=Outpt+Str$(UserRecord.Level) ' add player level
    Outpt=Outpt+Space$(7-Len(Str$(UserRecord.Level))) ' pad blanks
    Inpt=UserRecord.ClassName ' store player class name
    Call Decrypt(Inpt) ' decrypt class name
    Outpt=Outpt+Inpt ' append class name
    Outpt=Outpt+Str$(Temp.ArrayZ(Array.Number)) ' add score
    Print #TempFile,Outpt ' write to file
 Next ' end loop through top ten players
 If Player.Count=False Then ' compare number of players
    Outpt="No users have top scores." ' make score message
    Print #TempFile,Outpt ' write to file
 Endif ' end compare number of players
 Close #TempFile ' close work file
 Call Read.Record(UserFile,User.Index) ' get user file record
 User.Line.Length=User.Linelength
 User.Linelength=80
 Call Out.File("ranklist.dat")
 User.Linelength=User.Line.Length
 Redim Temp.Array1(1) As Integer, _
 Temp.ArrayZ(1) As Double ' remove temporary arrays
End Sub ' end routine to display and write top ten list

 Rem * routine deletes a user record.

Sub Delete.User
 On Local Error Resume Next ' local error resume
 Outpt=Deleted$ ' store deleted string
 Call Valid(Outpt,30) ' validate string
 Call Encrypt(Outpt,True) ' encrypt string
 UserRecord.CodeName=Outpt ' store string in codename
 Outpt=Deleted$ ' store deleted string
 Call Valid(Outpt,20) ' validate string
 Call Encrypt(Outpt,False) ' encrypt string
 UserRecord.PassWord=Outpt ' store string in password
 Outpt=Deleted$ ' store deleted string
 Call Valid(Outpt,20) ' validate string
 Call Encrypt(Outpt,True) ' encrypt string
 UserRecord.ClassName=Outpt ' store string in class name
 UserRecord.ClassType=False ' reset class number
 UserRecord.Flags=False  ' reset user flags
 UserRecord.FromHour=False ' reset time restriction
 UserRecord.FromMin=False ' reset time restriction
 UserRecord.Level=False ' reset player level
 UserRecord.MaxCalls=False ' reset maximum calls allowed
 UserRecord.MonstersKilled=False ' reset score counter
 UserRecord.ToHour=False ' reset time restriction
 UserRecord.ToMin=False ' reset time restriction
 For Array.Index=1 To 20 ' loop through inventory
    UserRecord.Inv(Array.Index)=False ' reset inventory
    UserRecord.Charges(Array.Index)=False ' reset inventory
 Next ' end loop through inventory
 For Array.Index=1 To 5 ' loop through object inventory
    UserRecord.Object(Array.Index)=False ' reset inventory
    UserRecord.ObjCharges(Array.Index)=False ' reset inventory
 Next ' end loop through inventory
 Call Clear.Container(0,True) ' clear container record
 For Array.Index=1 To 3 ' loop through all containers
    UserRecord.Container(Array.Index)=ContainerRec ' store container record
 Next ' end loop through containers
End Sub ' end routine to delete a user record