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

BASIC Source File | 2000-04-28 | 102KB | 2,166 lines

 Rem * Filename: dnds6.bas  Version: v4.5 r1.0
 Rem * This subprogram contains mail and some find routines.

 Rem $Include: 'dnddoor.inc'

 Rem * main routine to enter mail and process mail selections.

Sub Mail
 On Local Error Resume Next ' local error resume
 Redim Array(1 To 19) As String ' dimension message array
 Do ' loop through mail commands
    Graphics.Off=True ' reset color
    Outpt="[E]nter" ' make display message
    Call IO.O ' send message
    Outpt="[K]ill" ' make display message
    Call IO.O ' send message
    Outpt="[L]ock" ' make display message
    Call IO.O ' send message
    Outpt="[N]ew" ' make display message
    Call IO.O ' send message
    Outpt="[R]ead" ' make display message
    Call IO.O ' send message
    Graphics.Off=False ' reset color
    Outpt="Mail command(q to quit)? " ' input prompt
    No.Input.Out="Q" ' default input
    Call IO.I ' get player input
    Select Case Ucase$(Inpt) ' selection of input
    Case "E" ' option to enter message
       Call Enter.Message ' routine to enter message
    Case "K" ' option to kill message
       Call Kill.Message ' routine to kill message
    Case "L" ' option to toggle locked mailbox
       Call Lock.Mailbox ' routine to toggle locked mailbox
    Case "N" ' option to read new messages
       Call New.Messages ' routine to read new messages
    Case "R" ' option to read messages
       Call Read.Messages ' routine to read messages
    Case "Q" ' option to exit mail menu
       Exit Do ' exit mail menu
    End Select ' end mail option selection
 Loop ' end loop through mail menu
End Sub ' end mail routine

 Rem * routine to enter a message.
 Rem * output variables:
 Rem *   Array - array containing message.
 Rem *   Message.Length - number of message text lines.
 Rem *   Message.To - codename or null of player message is to.
 Rem *   Private.Message - true if message is private.
 Rem *   Subject - contains subject of message.

Sub Enter.Message
 On Local Error Resume Next ' local error resume
 If Lof(TableFile)/Len(TableRecord)=MaxInt Then ' check table size
    Outpt="The message table is full." ' make error output message
    Call IO.O ' send error output
    Exit Sub ' exit routine
 Endif ' end check table size
 Call Share.Record(UserFile,User.Index) ' routine to store player record
 Do ' loop until message to stored
    Graphics.Off=True ' reset color
    Private.Message=False ' reset private message flag
    Outpt="Message to(Press <enter> for ALL)? " ' input prompt
    Call IO.I ' get player input
    Message.To=Ucase$(Inpt) ' uppercase and store input
    If Inpt=Nul Then ' compare null input
       Exit Do ' exit loop with message to all
    Endif ' end compare input length
    For User.Number=1 To Lof(UserFile)/Len(UserRecord) ' loop through user file
       Call Read.Record(UserFile,User.Number) ' read next player record
       Outpt=UserRecord.CodeName ' store codename
       Call Decrypt(Outpt) ' routine to decrypt codename
       Outpt=Rtrim$(Outpt) ' trim codename
       Outpt=Ucase$(Outpt) ' uppercase codename
       If Message.To=Outpt Then ' compare codename to input
          If User.Index<>User.Number Then ' check not self
             If (UserRecord.Flags And Locked.User)=False Then ' check locked
                Outpt="Private message(y/n)? " ' input prompt
                No.Input.Out="N" ' default input
                Call IO.I ' get player input
                Private.Message=Yes ' store private message flag
                Exit Do ' exit loop until message to found
             Endif ' end check locked player mailbox
          Endif ' end check player indexes
       Endif ' end check codename
    Next ' end loop through player file
    Outpt="There is no such user." ' make display message
    Call IO.O ' send message
 Loop ' end loop until message to stored
 Call Read.Record(UserFile,User.Index) ' reread player record
 Do ' loop until subject entered
    Outpt="Subject? " ' input prompt
    Call IO.I ' get player input
    Inpt=Ltrim$(Inpt) ' trim input
    Inpt=Rtrim$(Inpt) ' trim input
    Inpt=Lcase$(Inpt) ' lowercase input
    If Inpt<>Nul Then ' check input length
       Subject=Inpt ' store input in subject string
       Exit Do ' exit subject loop
    Endif ' end check input length
    Outpt="Abort message(y/n)? " ' input prompt
    No.Input.Out="N" ' default input
    Call IO.I ' get player input
    If Yes Then ' check input response
       Exit Sub ' exit message enter routine
    Endif ' end check input response
 Loop ' end loop until subject entered
 Message.Reply=False
 Outpt="Enter message." ' make message
 Call IO.O ' send message
 Call Write.Message ' routine to enter and store message
End Sub ' end routine to enter a message

 Rem * routine to write message.

Sub Write.Message
 On Local Error Resume Next ' local error resume
 Message.Length=False ' reset message length entered
 User.Word.Wrap=UserRecord.Wordwrap ' store user word wrap
 UserRecord.Wordwrap=False ' reset word wrap
 Do ' loop until message entered
    Outpt="Press <enter> on a blank line to edit." ' make message
    Call IO.O ' send message
    Do ' loop until blank line entered
       Graphics.Off=True ' reset color
       If Message.Length=19 Then ' compare length of message entered
          Outpt="Message buffer full." ' make buffer message
          Call IO.O ' send message
          Exit Do ' exit message entry loop
       Endif ' end compare message length
       Word.Wrap=True ' set word wrap flag
       Outpt="?" ' input prompt
       Call IO.I ' get player input
       If No.Input Then ' check blank line entered
          Exit Do ' exit message entry loop
       Endif ' end check blank line
       Message.Length=Message.Length+1 ' increment message length counter
       Inpt=Rtrim$(Inpt) ' trim input
       Inpt=Left$(Inpt,79) ' truncate input
       Array(Message.Length)=Inpt ' store next message line
    Loop ' end loop until blank line entered
    Word.Wrap=False ' reset word wrap flag
    UserRecord.Wordwrap=User.Word.Wrap ' restore user word wrap
    Call Edit.Message(Message.Edit) ' routine to edit message text
    ' selection of return variable from message editing
    Select Case Message.Edit
    Case True ' true returned
       Outpt="Continue editing." ' make display message
       Call IO.O ' send message
    Case False ' false returned
       Exit Sub ' message aborted
    Case UnTrue ' other returned
       Call Store.Message ' message stored
       Exit Sub ' exit message entry routine
    End Select ' end selection of edit return variable
 Loop ' end loop until message entered
End Sub

 Rem * routine to lock/unlock player mailbox.

Sub Lock.Mailbox
 On Local Error Resume Next ' local error resume
 ' check player locked mailbox
 If (UserRecord.Flags And Locked.User)=False Then
    Outpt="Mailbox locked." ' make locked message
    UserRecord.Flags=UserRecord.Flags Or Locked.User ' set locked player flag
 Else ' check player locked
    Outpt="Mailbox unlocked." ' make locked message
    UserRecord.Flags=UserRecord.Flags And Not Locked.User ' reset locked flag
 Endif ' end check player locked flag
 Call IO.O ' send message
 Call Share.Record(UserFile,User.Index) ' routine to wite player record
End Sub

 Rem * routine to delete message.

Sub Kill.Message
 On Local Error Resume Next ' local error resume
 Max.Messages=Lof(TableFile)/Len(TableRecord) ' store length of table file
 Outpt="Enter message number to delete" ' make range input prompt
 Call Get.Range2(1,Max.Messages,Message.Number) ' routine to get number
 Call Read.Record(TableFile,Message.Number) ' read table record
 Outpt=UserRecord.CodeName ' store codename
 Call Decrypt(Outpt) ' decrypt codename
 Outpt=Rtrim$(Outpt) ' trim codename
 Outpt=Ucase$(Outpt) ' uppercase codename
 Inpt=TableRecord.To ' store message from codename
 Inpt=Rtrim$(Inpt) ' trim message codename
 Inpt=Ucase$(Inpt) ' uppercase from codename
 If Outpt<>Inpt Then ' compare codenames
    Outpt="Message"+Str$(Message.Number)+" is not a private message to you."
    Call IO.O ' send message
    Exit Sub ' exit routine
 Endif ' end compare codenames
 If TableRecord.Private=False Then
    Outpt="Message"+Str$(Message.Number)+" is not a private message to you."
    Call IO.O ' send message
    Exit Sub ' exit routine
 Endif ' end compare codenames
 If TableRecord.Killed Then ' compare deleted message
    Outpt="Message"+Str$(Message.Number)+" is already deleted." ' error message
    Call IO.O ' send message
    Exit Sub ' exit routine
 Endif ' end compare deleted message
 TableRecord.Killed=True ' set deleted message flag in table record
 Call Share.Record(TableFile,Message.Number) ' routine to write table record
 Outpt="Message"+Str$(Message.Number)+" deleted." ' make deleted message
 Call IO.O ' send message
End Sub ' end routine to delete a message

 Rem * routine to display message.
 Rem * input variables:
 Rem *   Message.Number - contains number of message to display.
 Rem *   ListLines - true to list line numbers

Sub Read.Message(Message.Number,ListLines)
 On Local Error Resume Next ' local error resume
 Call Message.Header(Message.Number) ' routine to display message header
 Allow.Break=True ' set control-k checking flag
 Break=False ' reset control-k flag
 Continue=False ' reset continuous flag
 Page.Length=5 ' reset page length counter
 ' store beginning of message record flag
 Message.Start!=TableRecord.Start
 ' store ending of message record flag
 Message.End!=Message.Start!+Csng(TableRecord.Length-1)
 ' loop through message contents
 Line.Number=False ' reset line counter
 For Message.Record!=Message.Start! To Message.End!
    Call Read.Message.Record(MessageFile,Message.Record!) ' read message text line
    Outpt=MessageRecord.Message ' store message text
    Call Decrypt(Outpt) ' decrypt message text
    Outpt=Rtrim$(Outpt) ' trim message
    Line.Number=Line.Number+1 ' increment line counter
    If ListLines Then ' check line number list flag
       Outpt=Mid$(Str$(Line.Number),2)+":"+Outpt ' make line number
    Endif ' end check line number flag
    Outpt=Left$(Outpt,79) ' truncate message text
    Call IO.O ' send message text line
    If Break Then ' check control-k pressed flag
       Exit For ' exit message display loop
    Endif ' end check control-k pressed
    Page.Length=Page.Length+1 ' increment page length counter
    If Page.Length=UserRecord.Pagelength Then ' check page length
       Page.Length=False ' reset page length
       If Continue=False Then ' check continuous flag
          Call More.Prompt ' routine to pause
          If No Then ' check pause response
             Exit For ' exit message display loop
          Endif ' end check pause response
       Endif ' end check continuous flag
    Endif ' end check page length
 Next ' end loop through message file
 Allow.Break=False ' reset control-k checking 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
End Sub ' end routine to display a message

 Rem * routine to display message header.
 Rem * input variables:
 Rem *   Message.Number - contains number of message.

Sub Message.Header(Message.Number)
 On Local Error Resume Next ' local error resume
 ' make header
 Call Sub.Header(Message.Number) ' routine displays first part of header
 Outpt="Rcvd:  " ' make header
 If TableRecord.Received Then ' check message
    Outpt=Outpt+"Yes" ' append header
 Else ' check message
    Outpt=Outpt+"No" ' append header
 Endif ' end check message
 Outpt=Outpt+Space$(35-Len(Outpt)) ' pad spaces
 Outpt=Outpt+"Read:"+Str$(TableRecord.TimesRead)+" times"
 Call IO.O ' send more header
 Outpt="Reply: " ' make header
 If TableRecord.Reply Then ' check message type
    Outpt=Outpt+"Yes" ' append header
 Else ' check message
    Outpt=Outpt+"No" ' append header
 Endif ' end check message type
 Outpt=Outpt+Space$(35-Len(Outpt)) ' pad spaces
 Outpt=Outpt+"Thread:" ' append more header
 If TableRecord.Reply Then ' check message type again
    If TableRecord.Thread=False Then ' check message thread number
       Outpt=Outpt+"(forward)" ' append default header
    Else ' check thread number
       Outpt=Outpt+Str$(TableRecord.Thread) ' append thread number
    Endif ' end check message type
 Else ' check message type
    Outpt=Outpt+" None" ' append more header
 Endif ' end check message
 Call IO.O ' send header
 Outpt="Stat:  " ' make more header
 Class.Number=TableRecord.ClassType ' store class type from
 Select Case Class.Number ' select class type
 Case 1 To 10 ' check class type range
    Outpt=Outpt+Rtrim$(Class.Name(Class.Number)) ' store class name
 End Select ' end check class type range
 Outpt=Left$(Outpt,35) ' trunacte more header
 Outpt=Outpt+Space$(35-Len(Outpt)) ' pad spaces
 Outpt=Outpt+"Type: " ' append header
 Inpt=Nul ' reset message type from
 If TableRecord.Flags And Special.Char1 Then ' check message from
    Inpt=Inpt+"Town Mayor " ' append class type from
 Endif ' end check class type message from
 If TableRecord.Flags And Special.Char2 Then ' check message from
    Inpt=Inpt+"Governor " ' append class type from
 Endif ' end check class type message from
 If TableRecord.Flags And Special.Char3 Then ' check message from
    Inpt=Inpt+"Guild Master " ' append class type from
 Endif ' end check class type message from
 If TableRecord.Flags And Special.Char4 Then ' check message from
    Inpt=Inpt+"Sysop " ' append class type from
 Endif ' end check class type message from
 If Inpt=Nul Then ' check message from
    Inpt="None" ' reset class type from
 Endif ' end check class type message from
 Outpt=Outpt+Inpt ' append more header
 Outpt=Left$(Outpt,79) ' truncate header
 Outpt=Rtrim$(Outpt) ' trim header
 Call IO.O ' send more header
End Sub ' end routine to display message header

 Rem * routine displays first part of message header
 Rem * input variables:
 Rem *   Message.Number - number of message being read.

Sub Sub.Header(Message.Number)
 On Local Error Resume Next ' local error resume
 Graphics.Off=False ' reset color
 Outpt="Msg#:"+Str$(Message.Number)+" of"+Str$(Lof(TableFile)/Len(TableRecord))
 If TableRecord.Private Then ' check private message
    Outpt=Outpt+"(private)" ' append to header
 Endif ' end check message
 If TableRecord.Killed Then ' check deleted message
    Outpt=Outpt+"(deleted)" ' append to header
 Endif ' end check message
 Call IO.O ' send header
 Graphics.Off=True ' reset color
 Inpt=TableRecord.From ' make header
 Inpt=Lcase$(Inpt) ' lowercase header
 Mid$(Inpt,1,1)=Ucase$(Mid$(Inpt,1,1)) ' uppercase first character
 Outpt="From:  "+Inpt ' make header
 Outpt=Left$(Outpt,35) ' truncate hader
 Outpt=Outpt+Space$(35-Len(Outpt)) ' pad spaces
 Inpt=Rtrim$(TableRecord.Subject) ' make more header
 Mid$(Inpt,1,1)=Ucase$(Mid$(Inpt,1,1)) ' uppercase more header
 Outpt=Outpt+"Subj: "+Inpt ' append header
 Call IO.O ' send more header
 Inpt=TableRecord.To ' make more header
 Inpt=Rtrim$(Inpt) ' trim header
 If Inpt=Nul Then ' check null message to
    Inpt="ALL" ' default to all
 Endif ' end check message to
 Inpt=Lcase$(Inpt) ' lowercase header
 Mid$(Inpt,1,1)=Ucase$(Mid$(Inpt,1,1)) ' uppercase header
 Outpt="To:    "+Inpt ' make more header
 Outpt=Left$(Outpt,35) ' truncate more header
 Outpt=Outpt+Space$(35-Len(Outpt)) ' pad spaces
 Outpt=Outpt+"Time: "+TableRecord.Clock ' append header
 Call IO.O ' send more header
End Sub ' end routine to display subheader

 Rem * routine to read range of messages.

Sub Read.Messages
 On Local Error Resume Next ' local resume next
 Code.Name$=UserRecord.CodeName ' store codename
 Call Decrypt(Code.Name$) ' decrypt codename
 Code.Name$=Rtrim$(Code.Name$) ' trim codename
 Code.Name$=Ucase$(Code.Name$) ' uppercase codename
 Max.Messages=Lof(TableFile)/Len(TableRecord) ' store length of table file
 Outpt="Starting message number" ' make range input prompt
 Call Get.Range2(1,Max.Messages,Message.Number) ' routine to get number
 Do ' message read loop
    If Message.Number>Lof(TableFile)/Len(TableRecord) Then ' compare table end
       Exit Do ' exit message read loop
    Endif ' end compare table
    Call Read.Record(TableFile,Message.Number) ' read next table record
    Inpt=TableRecord.To ' store message from
    Inpt=Rtrim$(Inpt) ' trim message from
    Inpt=Ucase$(Inpt) ' uppercase message from
    If TableRecord.Private And Inpt<>Code.Name$ Then ' compare private message
       Outpt="Message #"+Mid$(Str$(Message.Number),2)+" is private." ' message
       Call IO.O ' send message
    Else ' compare private message, codenames
       If TableRecord.Killed Then ' compare deleted message
          Outpt="Message #"+Mid$(Str$(Message.Number),2)+" was deleted."
          Call IO.O ' send message
       Else ' compare deleted message
          Call Read.Message(Message.Number,False) ' routine to display message
          TableRecord.Received=True ' set message recieved flag
          TableRecord.TimesRead=TableRecord.TimesRead+1 ' increment times read
          Call Share.Record(TableFile,Message.Number) ' write table record
       Endif ' end compare deleted message
    Endif ' end compare private message
    Graphics.Off=False ' reset color
    If Message.Number>UserRecord.LastMessage Then ' check last message pointer
       UserRecord.LastMessage=Message.Number ' store new last message read
    Endif ' end check last message read
    Outpt="Read more (y)es/(n)o/(r)eply/(t)hread, msg number? " ' make prompt
    No.Input.Out="Y" ' default input
    Call IO.I ' get player input
    Select Case Ucase$(Inpt) ' selection of prompt response
    Case "N", "Q" ' check input response
       Exit Do ' exit message read loop
    Case "R" ' reply to message
       Outpt="Private message(y/n)? " ' prompt
       No.Input.Out="N"
       Call IO.I ' get input
       Private.Message=Yes ' set message type
       Message.Reply=True ' set message type
       Message.Thread=Message.Number ' store message number
       Message.To=TableRecord.From ' store message header
       Subject=TableRecord.Subject ' store message header
       Outpt="Enter message reply." ' make message
       Call IO.O ' send message
       Call Write.Message ' routine to enter and write message
       Call Read.Record(TableFile,Message.Number) ' read current table
       TableRecord.Reply=True ' set reply
       Call Share.Record(TableFile,Message.Number) ' write table record
       Message.Number=Message.Number-1 ' adjust loop variable
    Case "T" ' thread selection
       Outpt="Direction (b)ackward/(f)oward/(s)earch? " ' input prompt
       No.Input.Out="F" ' default input
       Call IO.I ' get input
       Select Case Ucase$(Inpt) ' selection of thread direction
       Case "B" ' backward thread
          If TableRecord.Thread=False Then ' check thread
             Outpt="Message has no backward reply thread." ' make message
             Call IO.O ' send message
             Call More.Prompt ' pause prompt
             Message.Number=Message.Number-1 ' reset loop variable
          Else ' check thread
             ' change loop variable to thread number
             Message.Number=TableRecord.Thread-1
          Endif ' end check thread number
       Case "F" ' forward thread
          ' loop through table
          For Message.Search=Message.Number To Lof(TableFile)/Len(TableRecord)
             Call Read.Record(TableFile,Message.Search) ' read table record
             ' compare thread numbers
             If TableRecord.Thread=Message.Number Then
                Message.Number=Message.Search-1 ' change loop variable
                Exit For ' exit search loop
             Endif ' end compare thread numbers
          Next ' end loop through table
          If Message.Search>Lof(TableFile)/Len(TableRecord) Then ' check bounds
             Outpt="Message has no forward thread." ' make message
             Call IO.O ' send message
             Call More.Prompt ' pause prompt
             Message.Number=Message.Number-1 ' reset loop variable
          Endif ' end check loop variable
       Case "S" ' search forward thread
          ' loop through table
          For Message.Search=Message.Number To Lof(TableFile)/Len(TableRecord)
             Call Read.Record(TableFile,Message.Search) ' read table record
             ' compare thread numbers
             If TableRecord.Thread=Message.Number Then
                Call Sub.Header(Message.Search) ' routine displays subheader
                Graphics.Off=False ' reset color
                Outpt="Message thread:(c)ontinue search/(r)ead? " ' prompt
                No.Input.Out="R" ' default input
                Call IO.I ' get user input
                If Ucase$(Inpt)="R" Then ' compare input
                   Message.Number=Message.Search-1 ' change loop variable
                   Exit For ' exit search loop
                Endif ' end compare input
             Endif ' end compare thread numbers
          Next ' end loop through table
          If Message.Search>Lof(TableFile)/Len(TableRecord) Then ' check bounds
             Outpt="There are no more forward threads." ' make message
             Call IO.O ' send message
             Call More.Prompt ' pause prompt
             Message.Number=Message.Number-1 ' reset loop variable
          Endif ' end check loop variable
       End Select ' end thread selection
    Case Else ' other selection
       Next.Message=Int(Val(Inpt)) ' convert input to integer
       ' check input range
       If Next.Message>False And _
       Next.Message<=Lof(TableFile)/Len(TableRecord) Then
          Message.Number=Next.Message-1 ' reset message loop variable
       Endif ' end check input range
    End Select ' end prompt selection
    Message.Number=Message.Number+1 ' increment table number
 Loop ' end loop through message table
 Outpt="End of messages." ' make message
 Call IO.O ' send message
End Sub ' end routine to read messages

 Rem * routine to read range of new messages.

Sub New.Messages
 On Local Error Resume Next ' local error resume
 If UserRecord.LastMessage>=Lof(TableFile)/Len(TableRecord) Then ' compare last
    Outpt="No new messages." ' make message
    Call IO.O ' send message
    Exit Sub ' exit routine
 Endif ' end compare last message read variable to length of table
 Code.Name$=UserRecord.CodeName ' store codename
 Call Decrypt(Code.Name$) ' decrypt codename
 Code.Name$=Rtrim$(Code.Name$) ' trim codename
 Code.Name$=Ucase$(Code.Name$) ' uppercase codename
 Message.Number=UserRecord.LastMessage+1 ' store last message read variable
 Last.Message=Lof(TableFile)/Len(TableRecord) ' store length of table
 Do ' message read loop
    If Message.Number>Last.Message Then ' compare message range
       Exit Do ' exit message loop
    Endif ' end compare message range
    Call Read.Record(TableFile,Message.Number) ' read next table record
    Inpt=TableRecord.To ' store message to
    Inpt=Rtrim$(Inpt) ' trim message to
    Inpt=Ucase$(Inpt) ' uppercase message to
    Message.Read=True ' set read message flag
    If TableRecord.Private Then ' check private message flag
       If Inpt<>Code.Name$ Then ' compare codenames
          Message.Read=False ' reset read message flag
       Endif ' end compare codenames
    Endif ' end check private message flag
    If TableRecord.Killed Then ' check deleted message
       Message.Read=False ' reset read message flag
    Endif ' end check deleted message
    If Message.Read Then ' verify read message flag
       Call Read.Message(Message.Number,False) ' routine to display message
    Endif ' end verify read message flag
    Graphics.Off=False ' reset color
    ' update player last message variable
    UserRecord.LastMessage=Message.Number
    Outpt="Read more (y)es/(n)o/(r)eply? " ' make more prompt
    No.Input.Out="Y" ' default input
    Call IO.I ' get player input
    If Ucase$(Inpt)="R" Then ' check input
       Outpt="Private message(y/n)? " ' input prompt
       Call IO.I ' get player input
       Private.Message=Yes ' set message type
       Message.Reply=True ' set message type
       Message.Thread=Message.Number ' store message number
       Message.To=TableRecord.From ' store message header
       Subject=TableRecord.Subject ' store message header
       Outpt="Enter message reply." ' make message
       Call IO.O ' send message
       Call Write.Message ' routine to enter and write message
       Call Read.Record(TableFile,Message.Number) ' read current table
       TableRecord.Reply=True ' set reply
       Call Share.Record(TableFile,Message.Number) ' write table record
       Message.Number=Message.Number-1 ' adjust read loop variable
    Endif ' end check input response
    If No Or Quit Then ' check input response
       Exit Do ' exit new message read loop
    Endif ' end check response
    Message.Number=Message.Number+1 ' increment message variable
 Loop ' end loop through new messages
End Sub ' end routine to read new messages

 Rem * routine containing status line commands. status line toggle,
 Rem * initializing, clearing, and updating.
 Rem * input variables:
 Rem *   Status.Display -
 Rem *       -2 clear both status lines (rows 24, 25),
 Rem *       -1 toggle status line displaying remote user statistics, or
 Rem *          interactive console function key list,
 Rem *        0 update remote user status line statistics,
 Rem *        1 initialize both status lines.
 Rem * processing variables:
 Rem *   CursorX - temporary variable containing the cursor row position.
 Rem *   CursorY - temporary variable containing the cursor column position.
 Rem *   Statusline.Mode - static variable saved between calls containing the
 Rem *      toggle mode of the status line.
 Rem * notes on routine:
 Rem *   since the status line can be toggled while an online user is
 Rem *   entering input, the color of the screen is restored upon exit
 Rem *   from the routine. i.e. the status line toggles during any
 Rem *   character of i/o.

Sub Status.Line(Status.Display)
 On Local Error Resume Next ' local error resume
 Static Statusline.Mode ' status line toggle (variable saved between calls)
 If Status.Display=-1 Then ' compare to toggle command
    If Local.Mode Then ' compare local console logged in
       Exit Sub ' exit routine w/o toggling status line
    Endif ' end compare local mode
    Statusline.Mode=Not Statusline.Mode ' toggle status line
 Endif ' end compare toggle command
 If Status.Display=-2 Then ' compare to clear status line command
    For FunctionKeys=1 To 10 ' loop through all ten function keys
       Key FunctionKeys,Nul ' reset/disable function key
    Next ' end loop through function keys
    CursorX=Csrlin ' store current cursor row
    CursorY=Pos(0) ' store current cursor column
    Color 7,0 ' set color white on black non-intensity
    Locate 25,1 ' locate at bottom status line
    Print Space$(79); ' clear status line w/ blanks
    Locate 24,1 ' locate at second to bottom status line
    Print Space$(79); ' clear status line w/ blanks
    Locate CursorX,CursorY,1 ' relocate at stored cursor row, column
    Call Restore.Color ' subroutine to restore screen color
    Exit Sub ' exit routine
 Endif ' end compare clear status line command
 If Status.Display>0 Then ' compare to initialize status line command
    Statusline.Mode=False ' set the default status line mode
    If Local.Mode Then ' check console logged in
       If Normal.User=False Then ' verify user logged in is not DM/Sysop
          Statusline.Mode=True ' reset the default status line mode
       Endif ' end verify DM/Sysop
    Endif ' end check local mode
    Call Door.Status.Line ' initialize the door information status line
 Endif ' end compare initialize status line command
 If Statusline.Mode=False Then ' compare status line mode
    Call Make.Status.Line ' routine to update status line w/ player stats
 Else ' status line mode
    If Status.Display<>0 Then ' any status line command than update
       Call Sysop.Status.Line ' routine for sysop function key status line
    Endif ' end compare status line command
 Endif ' end compare status line command
End Sub ' end status line commands routine

 Rem * routine to make status line containing player character statistics.
 Rem * processing variables:
 Rem *   CursorX - contains the current cursor row.
 Rem *   CursorY - contains the current cursor column.

Sub Make.Status.Line
 On Local Error Resume Next ' local error resume
 Status$=UserRecord.CodeName ' store player codename
 Call Decrypt(Status$) ' decrypt codename
 Status$=Lcase$(Status$) ' set codename lowercase
 If Left$(Status$,9)=Deleted$ Then ' check codename is invalid/deleted
    Exit Sub ' exit routine
 Endif ' end check codename
 Mid$(Status$,1,1)=Ucase$(Mid$(Status$,1,1)) ' uppercase first codename letter
 If UserRecord.ClassType=MagicUser Then ' compare player class type to MU
    Status2$="MU" ' set status line player class name to MU abbreviation
 Else ' compare to non MU
    ' set status line player class name to left part of entire class name
    Status2$=Left$(Class.Name(UserRecord.ClassType),8)
 Endif ' end compare MU
 If Dungeon.Master.Assistant Then ' compare player class name to Asst. DM
    Status2$="ADM" ' set status line to Asst. DM abbreviation
 Endif ' end compare ADM
 If Dungeon.Master Then ' compare player class name to DM
    Status2$="DM" ' set status line to DM abbreviation
 Endif ' end compare DM
 If Sysop Then ' compare player to sysop
    Status2$="SYS" ' set status line to sysop abbreviation
 Endif ' end compare sysop
 Status$=Status$+" "+Status2$ ' combine player codename with class name
 Status$=Left$(Status$,39) ' truncate to left half
 Status$=Status$+Space$(39-Len(Status$)) ' append trailing blanks
 Status.Value=UserRecord.Fatigue ' store current player fatigue
 If Status.Value<False Then ' check validity of fatigue
    Status.Value=False ' reset to zero
 Endif ' end check validity
 Status$=Status$+" Fat:"+Mid$(Str$(Status.Value),2) ' append fatigue message
 Status.Value=UserRecord.Vitality ' store current player vitality
 If Status.Value<False Then ' check validity of vitality
    Status.Value=False ' reset to zero
 Endif ' end check validity
 Status$=Status$+" Vit:"+Mid$(Str$(Status.Value),2) ' append vitality message
 Status.Value=UserRecord.Magic ' store current player magic points
 If Status.Value<False Then ' check magic points validity
    Status.Value=False ' reset to zero
 Endif ' end check validity
 ' append magic points message
 Status$=Status$+" Mag:"+Mid$(Str$(Status.Value),2)
 Status.Value=UserRecord.Psionic ' store current player psionic points
 If Status.Value<False Then ' check psionic points validity
    Status.Value=False ' reset to zero
 Endif ' end check validity
 ' append psionic points message
 Status$=Status$+" Psi:"+Mid$(Str$(Status.Value),2)
 Status.Value=UserRecord.Level ' store player level
 If Status.Value<False Then ' compare level validity
    Status.Value=False ' reset to zero
 Endif ' end compare validity
 Status2$=" Lvl:"+Mid$(Str$(Status.Value),2) ' append level message
 ' verify string appended to status line
 If Len(Status$)+Len(Status2$)<=79 Then
    ' string is less than screen line length, and append
    Status$=Status$+Status2$
 Endif ' end verify status line length
 Status.Value=Room ' store current room number
 If Status.Value<False Then ' check validity of room number
    Status.Value=False ' reset to zero
 Endif ' end check validity
 Status2$=" Rm:"+Mid$(Str$(Status.Value),2) ' append room message
 ' verify string appended to status line
 If Len(Status$)+Len(Status2$)<=79 Then
    ' string is less than screen line length, and append
    Status$=Status$+Status2$
 Endif ' end verify status line length
 Status$=Left$(Status$,79) ' truncate status string length
 Status$=Status$+Space$(79-Len(Status$)) ' append blanks to status string
 CursorX=Csrlin ' store current cursor row
 CursorY=Pos(0) ' store current cursor column
 Locate 25,1 ' position cursor at row 25
 Color 14,1 ' color hi-intensity yellow on blue
 Print Status$; ' display the combined status string
 Locate CursorX,CursorY,1 ' restore cursor position
 Call Restore.Color ' routine to restore screen color
End Sub ' end routine to make and display status line

 Rem * routine to initialize the console function keys, initialize the
 Rem * DM/sysop status line with the function key names.
 Rem * processing variables:
 Rem *   CursorX, CursorY - contain the current cursor position.

Sub Sysop.Status.Line
 On Local Error Resume Next ' local error resume
 For FunctionKeys=1 To 10 ' loop through all ten function keys
    Key FunctionKeys,Nul ' clear the function key
 Next ' loop through keys
 If Local.Mode Then ' check console logged in
    If Normal.User=False Then ' check user is DM/sysop
       Key 1,"!EDIT"+Chr$(13) ' assign key 1
       Key 2,"!STA"+Chr$(13) ' assign key 2
       Key 3,"!DIS " ' assign key 3
       Key 4,"!REDU " ' assign key 4
       Key 5,"!CALL" ' assign key 5
       Key 6,"!KILL " ' assign key 6
       Key 7,"!TELE " ' assign key 7
       Key 8,"!INV"+Chr$(13) ' assign key 8
       Key 9,"!GET " ' assign key 9
       Key 10,"!LINK"+Chr$(13) ' assign key 10
    Endif ' end check DM
 Endif ' end check local mode
 CursorX=Csrlin ' store cursor row
 CursorY=Pos(0) ' store cursor column
 Color 14,1 ' set color to hi-intensity yellow on blue
 For FunctionKeys=1 To 10 ' loop through the ten function key numbers
    ' position the cursor at the function key column
    Locate 25,FunctionKeys*8-7
    ' display the function key and number
    Print "F"+Right$(Str$(FunctionKeys+10),1);
 Next ' end loop through function key numbers
 Color 15,1 ' set color to hi-intensity white on blue
 ' store function key names
 FunctionKeys$="EDITSTA DIS REDUCALLKILLTELEINV GET LINK"
 For FunctionKeys=1 To 10 ' loop through ten function key names
    ' position the cursor at the status function key name
    Locate 25,FunctionKeys*8-5
    ' make the function key name with DM prefix from the function string
    Status$="!"+Mid$(FunctionKeys$,(FunctionKeys-1)*4+1,4)
    If FunctionKeys<10 Then ' check for last key
       Status$=Status$+" " ' append space
    Endif ' end check last key
    Print Status$; ' display the function key name
 Next ' end loop through function key names
 Locate CursorX,CursorY,1 ' restore cursor position
 Call Restore.Color ' routine to restore screen color
End Sub ' end routine to initialize function keys and DM status line

 Rem * routine to display door information on the 24th status line.
 Rem * processing variables:
 Rem *   CursorX, CursorY - contains the cursor position.

Sub Door.Status.Line
 On Local Error Resume Next ' local error resume
 CursorX=Csrlin ' store cursor row
 CursorY=Pos(0) ' store cursor column
 Color 14,1 ' color hi-intensity yellow on blue
 Locate 24,1 ' position cursor
 Status2$=Left$(BBS.Name,19) ' get BBS name, truncate
 Status2$=Status2$+Space$(19-Len(Status2$)) ' append blanks
 Status3$=Left$(Door.Name,30) ' get name of user, truncate
 Status3$=Status3$+Space$(30-Len(Status3$)) ' append blanks
 Status4$=Space$(5)+"Time: " ' time user logged in
 Status4$=Status4$+Format$(Timelogged.On,"hh:mm:ssa/p") ' append time
 Status$="BBS:"+Status2$+" Name:"+Status3$+Status4$ ' combine all strings
 Status$=Left$(Status$,79) ' truncate line to left
 Status$=Status$+Space$(79-Len(Status$)) ' append blanks to right
 Print Status$; ' display door information status line
 Locate CursorX,CursorY,1 ' restore cursor position
 Call Restore.Color ' restore screen color
End Sub ' end routine to display 24th line

 Rem * routine to restore current ansi color after status line is displayed.
 Rem * input variables:
 Rem *   Color.Code - contains current color in cycling.

Sub Restore.Color
 On Local Error Resume Next ' local error resume
 If Graphics.Off Then ' check color cycling
    Call Convert.Color(37) ' restore color to white
 Else ' color check
    Call Convert.Color(Color.Code) ' restore color
 Endif ' end check color cycling on
End Sub ' end routine to restore color

 Rem * routine displays spell types.

Sub Spell.Types
 On Local Error Resume Next
 Graphics.Off=True ' reset color
 Outpt="[A]Enchant      [O]Psionic"
 Call IO.O ' send output
 Outpt="[B]Offense      [P]Detect Lock"
 Call IO.O ' send output
 Outpt="[C]Bless        [R]Detect Evil"
 Call IO.O ' send output
 Outpt="[D]Wish         [S]Detect Trap"
 Call IO.O ' send output
 Outpt="[E]Poison       [T]Intoxicate"
 Call IO.O ' send output
 Outpt="[F]Vigor        [U]Set Trap"
 Call IO.O ' send output
 Outpt="[G]Heal         [V]Hide"
 Call IO.O ' send output
 Outpt="[H]Curepoison   [W]Search"
 Call IO.O ' send output
 Outpt="[I]Level Drain  [X]Invisibility"
 Call IO.O ' send output
 Outpt="[J]Teleport     [Y]Identify"
 Call IO.O ' send output
 Outpt="[K]Befuddle     [Z]Enlighten"
 Call IO.O ' send output
 Outpt="[L]Turn Undead  [1]Illuminate"
 Call IO.O ' send output
 Outpt="[M]Pass Door    [2]Psyche"
 Call IO.O ' send output
 Outpt="[N]Conjure      [3]Telepathy"
 Call IO.O ' send output
End Sub

 Rem * routine changes message.

Sub Change.Message
 On Local Error Resume Next ' local error resume
 Do ' loop through message changing
    Graphics.Off=False ' reset color
    Max.Messages=Lof(TableFile)/Len(TableRecord) 'store length of message table
    Outpt="Message number to edit" ' make range input prompt
    Call Get.Range2(1,Max.Messages,Message.Number) ' routine to get number
    Call Read.Record(TableFile,Message.Number) ' read table record
    Graphics.Off=False ' reset color
    Outpt="Edit message header(y/n)? " ' make input prompt
    No.Input.Out="N" ' default input
    Call IO.I ' get user input
    If Yes Then ' check nput response
       Call Message.Header(Message.Number) ' routine to display header
       Graphics.Off=False ' reset color
       Outpt="Enter new message header:" ' make display message
       Call IO.O ' send message
       Graphics.Off=True ' reset color
       Outpt="From(press <enter> for Sysop)? " ' make input prompt
       No.Input.Out="Sysop" ' default input
       Call IO.I ' get user input
       TableRecord.From=Inpt ' store message from
       Outpt="To(press <enter> for ALL)? " ' make input prompt
       Call IO.I ' get user input
       TableRecord.To=Ucase$(Inpt) ' store message to
       Outpt="Subject? " ' make input prompt
       Call IO.I ' get user input
       TableRecord.Subject=Lcase$(Inpt) ' store message subject
       Call Share.Record(TableFile,Message.Number) ' routine to write table record
    Endif ' end check response
    Do ' loop through message text editing
       Graphics.Off=False ' reset color
       Outpt="Edit more message text(y/n)? " ' make input prompt
       No.Input.Out="N" ' default input
       Call IO.I ' get user input
       If No Then ' check input response
          Exit Do ' exit message editing loop
       Endif ' end check response
       Call Read.Message(Message.Number,True) ' routine to display message
       Graphics.Off=False ' rset color
       MessageRec.Length=TableRecord.Length ' store message length
       Outpt="Line number to edit" ' make range input prompt
       ' routine to get number
       Call Get.Range2(0,MessageRec.Length,Message.Line)
       If Message.Line>False Then ' check range
          Outpt="New message text:" ' make display message
          Call IO.O ' send message
          Graphics.Off=True ' reset color
          Outpt="?" ' make input prompt
          Call IO.I ' get user input
          Call Valid(Inpt,80) ' validate input
          Call Encrypt(Inpt,True) ' encrypt input
          MessageRecord.Message=Inpt ' store new message text
          MessageRec.Number!=Csng(TableRecord.Start+Message.Line-1)
          Call Share.Message(MessageFile,MessageRec.Number!) ' write message record
       Endif ' end check range
    Loop ' end loop through editing
    Graphics.Off=False ' reset color
    Outpt="Edit another message(y/n)? " ' make input prompt
    No.Input.Out="Y" ' default input
    Call IO.I ' get user input
    If No Then ' check input response
       Exit Sub ' exit routine
    Endif ' end check response
 Loop ' end loop through editing
End Sub ' end message editing routine

 Rem * routine to delete message.

Sub Delete.Message
 On Local Error Resume Next ' local error resume
 Do ' loop through delete routine
    Max.Messages=Lof(TableFile)/Len(TableRecord) ' store length of table file
    Outpt="Message number to delete" ' make range input prompt
    Call Get.Range2(1,Max.Messages,Message.Number) ' routine to get number
    Call Read.Record(TableFile,Message.Number) ' read table record
    If TableRecord.Killed Then ' check deleted message flag
       Outpt="Message"+Str$(Message.Number)+" is already deleted." ' message
    Else ' check deleted message
       TableRecord.Killed=True ' set deleted message flag
       Call Share.Record(TableFile,Message.Number) ' routine to write table record
       Outpt="Message"+Str$(Message.Number)+" deleted." ' make deleted message
    Endif ' end check deleted message flag
    Call IO.O ' send message
    Graphics.Off=False ' rset color
    Outpt="Delete more messages(y/n)? " ' make input prompt
    No.Input.Out="Y" ' default input
    Call IO.I ' get user input
    If No Then ' check input response
       Exit Sub ' exit routine
    Endif ' end check response
 Loop ' end loop through deleting
End Sub ' end delete message routine

 Rem * routine to list range of messages.

Sub List.Messages
 On Local Error Resume Next ' local error resume
 Messages.Max=Lof(TableFile)/Len(TableRecord) ' store length of table
 ' routine to get range of numbers
 Call Get.Range(Messages.Max,Messages1,Messages2)
 For Message.List=Messages1 To Messages2 ' loop through range of messages
    Call Read.Record(TableFile,Message.List) ' read table record
    Call Read.Message(Message.List,False) ' routine to display message
    Graphics.Off=False ' reset color
    Outpt="Read more(y/n)? " ' make prompt
    No.Input.Out="Y" ' default input
    Call IO.I ' get player input
    If No Then ' check input response
       Exit Sub ' exit routine
    Endif ' end check response
 Next ' end message display loop
End Sub ' end message list routine

 Rem * routine to undelete messages.

Sub Undelete.Message
 On Local Error Resume Next ' local error resume
 Do ' loop through undeleting
    Max.Messages=Lof(TableFile)/Len(TableRecord) ' store table length
    Outpt="Message number to undelete" ' make range input prompt
    Call Get.Range2(1,Max.Messages,Message.Number) ' routine to get number
    Call Read.Record(TableFile,Message.Number) ' read table record
    If TableRecord.Killed=False Then ' check deleted message
       Outpt="Message"+Str$(Message.Number)+" is not deleted." ' make message
    Else ' check deleted message
       TableRecord.Killed=False ' set deleted message flag
       Call Share.Record(TableFile,Message.Number) ' routine to write table record
       Outpt="Message"+Str$(Message.Number)+" undeleted." ' make message
    Endif ' end check undeleted message
    Call IO.O ' send message
    Graphics.Off=False ' reset color
    Outpt="Undelete more messages(y/n)? " ' make input prompt
    No.Input.Out="Y" ' default input
    Call IO.I ' get user input
    If No Then ' check input response
       Exit Sub ' exit routine
    Endif ' end check input
 Loop ' end undeleting loop
End Sub ' end undelete routine

 Rem * routine to pack messages files.

Sub Pack.Messages
 On Local Error Resume Next ' local error resume
 Outpt="Pack messages(y/n)? " ' make input prompt
 No.Input.Out="N" ' default input
 Call IO.I ' get user input
 If Yes Then ' check response
    Outpt="Packing messages.." ' make message
    Call IO.O ' send message
    Call Share.Record(UserFile,User.Index) ' store user record
    Max.Users=Lof(UserFile)/Len(UserRecord) ' store length of user file
    ' dimension working array
    Redim ArrayX(1 To Max.Users) As Integer
    ' packing pass 1
    For User.Number=1 To Max.Users ' loop through user file
       Call Read.Record(UserFile,User.Number) ' get next user file record
       ArrayX(User.Number)=UserRecord.LastMessage ' store last message number
    Next ' end user file loop
    For Message.Number=1 To Lof(TableFile)/Len(TableRecord) 'loop through table
       Call Read.Record(TableFile,Message.Number) ' read table record
       If TableRecord.Killed Then ' check for deleted message
          For User.Number=1 To Max.Users ' loop through user array
             Last.Message=ArrayX(User.Number) ' store last message
             If Last.Message<=Message.Number Then ' check last message
                Last.Message=Last.Message-1 ' decrement last message read
                ArrayX(User.Number)=Last.Message ' store last message read
             Endif ' end check last message
          Next ' end user array loop
       Endif ' end check deleted message
    Next ' end message pack loop
    For User.Number=1 To Max.Users ' loop through user file
       Call Read.Record(UserFile,User.Number) ' get next user file record
       UserRecord.LastMessage=ArrayX(User.Number) ' store last message number
       Call Share.Record(UserFile,User.Number) ' write user record
    Next ' end user file loop
    Call Read.Record(UserFile,User.Index) ' reread current player record
    ' packing pass 2
    Max.Messages=Lof(TableFile)/Len(TableRecord) ' store maximum table records
    ' dimension working array
    Redim ArrayX(1 To Max.Messages) As Integer
    For Message.Number=1 To Max.Messages ' loop through table file
       Call Read.Record(TableFile,Message.Number) ' read table record
       ArrayX(Message.Number)=TableRecord.Thread ' store thread number
    Next ' end table file rad loop
    For Message.Number=1 To Max.Messages ' loop through table file
       Call Read.Record(TableFile,Message.Number) ' read table record
       If TableRecord.Killed Then ' check for deleted message
          Thread.Number=ArrayX(Message.Number) ' store thread number
          ' search for forward thread
          For Message.Search=Message.Number+1 To Max.Messages
             ' verify forward message thread
             If ArrayX(Message.Search)=Message.Number Then
                ArrayX(Message.Search)=Thread.Number ' store thread number
                If Thread.Number=False Then ' check for thread start
                   ' search for end of thread
                   For Thread.Search=Message.Search+1 To Max.Messages
                      ' compare thread has another ending thread
                      If ArrayX(Thread.Search)=Message.Search Then
                         Exit For ' exit thread end loop
                      Endif ' end compare for end thread
                   Next ' end end thread search loop
                   If Thread.Search>Max.Messages Then ' compare end thread
                      Call Read.Record(TableFile,Message.Search) ' read table
                      TableRecord.Reply=False ' reset thread reply start
                      Call Share.Record(TableFile,Message.Search) 'write table
                   Endif ' end compare end thread
                Endif ' end check thread start
             Endif ' end verify forward message thread
          Next ' end forward message thread search loop
          ' search through all forward thread numbers
          For Message.Search=Message.Number+1 To Max.Messages
             Thread.Number=ArrayX(Message.Search) ' store thread number
             If Thread.Number>=Message.Number Then ' verify forward thread
                Thread.Number=Thread.Number-1 ' decrement thread number
                ArrayX(Message.Search)=Thread.Number ' store thread number
             Endif ' end verify forward message thread
          Next ' end forward message thread search loop
       Endif ' end check deleted message
    Next ' end message pack loop
    For Message.Number=1 To Max.Messages ' loop through table file
       Call Read.Record(TableFile,Message.Number) ' read table record
       TableRecord.Thread=ArrayX(Message.Number) ' store thread number
       Call Share.Record(TableFile,Message.Number) ' write table record
    Next ' end table file read loop
    ' packing pass 3
    Close #TempFile ' close temporary file
    FileName="msgtable.bak" ' get table filename
    Kill FileName ' remove temporary file
    ' open temporary backup file
    Open FileName For Random Shared As #TempFile Len=Len(TableRecord)
    For Message.Number=1 To Lof(TableFile)/Len(TableRecord) ' loop through table
       Call Read.Record(TableFile,Message.Number) ' read table record
       Call Share.Record(TempFile,Message.Number) ' store table record
    Next ' end message pack loop
    Close #TempFile ' close temporary file
    FileName="messages.bak" ' get table filename
    Kill FileName ' remove temporary file
    ' open temporary backup file
    Open FileName For Random Shared As #TempFile Len=Len(MessageRecord)
    For Message.Number!=1 To Lof(MessageFile)/Len(MessageRecord) ' loop message
       Call Read.Message.Record(MessageFile,Message.Number!) ' read record
       Call Share.Message(TempFile,Message.Number!) ' store message record
    Next ' end message pack loop
    Close #TableFile,#MessageFile,#TempFile,#TempFile2 ' close temp, mail files
    FileName="messages.dat" ' get mail filename
    Kill FileName ' remove mail file
    FileName="msgtable.dat" ' get mail filename
    Kill FileName ' remove mail file
    Open "msgtable.dat" For Random Shared As #TableFile Len=Len(TableRecord)
    Open "messages.dat" For Random Shared As #MessageFile Len=Len(MessageRecord)
    Open "msgtable.bak" For Random Shared As #TempFile Len=Len(TableRecord)
    Open "messages.bak" For Random Shared As #TempFile2 Len=Len(MessageRecord)
    Table.Number=False ' reset table record number
    New.Message.Record!=False ' reset message file record counter
    For Message.Number=1 To Lof(TempFile)/Len(TableRecord) 'loop through table
       Call Read.Record(TempFile,Message.Number) ' read table record
       If TableRecord.Killed=False Then ' check for deleted message
          Message.Start!=TableRecord.Start ' store beginning
          Message.End!=Message.Start!+Csng(TableRecord.Length-1) ' store end
          Table.Number=Table.Number+1 ' increment next table record
          TableRecord.Start=New.Message.Record!+1 ' store message beginning
          Call Share.Record(TableFile,Table.Number) ' write new table file record
          For Message.Record!=Message.Start! To Message.End! ' message loop
             Call Read.Message.Record(TempFile2,Message.Record!) 'read message
             New.Message.Record!=New.Message.Record!+1! ' store next message
             Call Share.Message(MessageFile,New.Message.Record!) ' write message
          Next ' end loop through message text array
       Endif ' end check deleted message
    Next ' end table file loop
    Close #TempFile,#TempFile2 ' close temporary files
 Endif ' end check response
End Sub ' end routine to pack messages

 Rem * routine to store message.

Sub Store.Message
 On Local Error Resume Next ' local error resume
 Call Read.Record(UserFile,User.Index) ' read user file
 Outpt=UserRecord.CodeName ' store codename
 Call Decrypt(Outpt) ' decrypt codename
 Inpt=Rtrim$(Outpt) ' store codename
 Inpt=Ucase$(Inpt) ' uppercase ccodename
 Outpts=Message.To ' store message header
 Outpts=Rtrim$(Outpts) ' trim header
 Outpts=Ucase$(Outpts) ' uppercase header
 If Inpt=Outpts Then ' compare codenames
    Message.To=Nul ' reset message header
 Endif ' end compare codenames
 TableRecord.ClassType=UserRecord.ClassType ' store user class type
 TableRecord.Clock=FNclock$ ' store message creation time
 TableRecord.Date=Date$ ' store system date
 TableRecord.Flags=UserRecord.Flags ' store user flags
 TableRecord.From=Outpt ' store user codename
 TableRecord.Killed=False ' reset deleted message flag
 TableRecord.Length=Message.Length ' store length of message
 TableRecord.Private=Private.Message ' store private message flag
 TableRecord.Received=False ' store flag for message received
 TableRecord.Reply=Message.Reply ' store message reply flag
 Message.Record.Number!=Csng(Lof(MessageFile)/Len(MessageRecord))
 TableRecord.Start=Message.Record.Number!+1! ' store message beginning
 TableRecord.Subject=Subject ' store message subject
 TableRecord.Time=Time$ ' store system time
 TableRecord.Timer=Timer ' store system time in seconds
 TableRecord.TimesRead=False ' reset number of times message read
 TableRecord.To=Message.To ' store message to
 If Message.Reply Then ' check message type
    TableRecord.Thread=Message.Thread ' store message thread number
 Else ' check message
    TableRecord.Thread=False ' store thread number
 Endif ' end check message
 Table.Record.Number=Lof(TableFile)/Len(TableRecord)+1 'store next table record
 Call Share.Record(TableFile,Table.Record.Number) ' routine to write table record
 For Message.Number=1 To Message.Length ' loop through message text array
    Outpt=Array(Message.Number) ' store message text line
    Call Valid(Outpt,80) ' routine to validate text
    Call Encrypt(Outpt,True) ' encrypt text
    MessageRecord.Message=Outpt ' store text line
    Message.Record.Number!=Message.Record.Number!+1! ' store next message
    Call Share.Message(MessageFile,Message.Record.Number!) ' write message text
 Next ' end loop through message text array
 Outpt="Message stored." ' make message
 Call IO.O ' send message
End Sub ' end routine to store message

 Rem * routine to check for new messages.

Sub Check.Mail
 On Local Error Resume Next ' local error resume
 New.Message=False ' reset number of new messages
 Outpt=UserRecord.CodeName ' store codename
 Call Decrypt(Outpt) ' decrypt codename
 Outpt=Rtrim$(Outpt) ' trim codename
 Outpt=Lcase$(Outpt) ' lowercase codename
 Last.Message=UserRecord.LastMessage ' store last message number read
 Table.Number=Lof(TableFile)/Len(TableRecord) ' store length of message table
 ' compare range of messages
 If Last.Message>False And Last.Message<=Table.Number Then
    For Table.Index=Last.Message To Table.Number ' loop through new messages
       Call Read.Record(TableFile,Table.Index) ' read table record
       If TableRecord.Killed=False Then ' check deleted message
          Inpt=TableRecord.To ' store message to
          Inpt=Rtrim$(Inpt) ' trim message to
          Inpt=Lcase$(Inpt) ' lowercase message to
          If Inpt<>Nul Then ' check public message to
             If Inpt=Outpt Then ' compare codenames
                New.Message=New.Message+1 ' increment number of new message
             Endif ' end compare codenames
          Endif ' end check public message
       Endif ' end check deleted message
    Next ' end loop through new messages
 Endif ' end compare new message range
 Graphics.Off=False ' reset color
 If New.Message>False Then ' check new messages
    Outpt="You have"+Str$(New.Message)+" new messages." ' make message
 Else ' check new message variable
    Outpt="You have no new messages." ' make output message
 Endif ' end check new message variable
 Call IO.O ' send message
 Graphics.Off=False ' reset color
End Sub ' end routine to check for new mail

 Rem * routine to replace line of message text.

Sub Replace.Line
 On Local Error Resume Next ' local error resume
 Messages.Max=Message.Length ' store message length
 Outpt="Line number" ' store input range prompt
 Call Get.Range2(1,Messages.Max,Message.Number) ' routine to get number
 Outpt="Replacement line:" ' input prompt
 Call IO.O ' send prompt
 Outpt="?" ' input prompt
 Call IO.I ' get user input
 Inpt=Rtrim$(Inpt) ' trim input
 Inpt=Left$(Inpt,79) ' truncate input
 Array(Message.Number)=Inpt ' store new message line
 Outpt="Line number"+Str$(Message.Number)+" replaced." ' make display message
 Call IO.O ' send message
End Sub ' end routine to replace line of message text

 Rem * routine to edit a line of message text.

Sub Edit.Line
 On Local Error Resume Next ' local error resume
 Messages.Max=Message.Length ' store length of message
 Outpt="Line number" ' make input range prompt
 Call Get.Range2(1,Messages.Max,Message.Number) ' routine to get number
 Outpt="Replace what word? " ' make input prompt
 Call IO.I ' get user input
 If Inpt=Nul Then ' check input length
    Outpt="No replacements made." ' make display message
    Call IO.O ' send message
    Exit Sub ' exit routine
 Endif ' end check input length
 Message.Number$=Inpt ' store input
 Outpt="Replace with what word? " ' make input prompt
 Call IO.I ' get user input
 If Inpt=Nul Or Inpt=Message.Number$ Then ' check input length, compare inputs
    Outpt="No replacements made." ' make display message
    Call IO.O ' send message
    Exit Sub ' exit routine
 Endif ' end check inputs
 Edit.Replace$=Inpt ' store input
 Outpt="Replace all occurences? " ' make input prompt
 No.Input.Out="Y" ' default input
 Call IO.I ' get user input
 Replace.Word=1 ' reset string search index
 Replace.All=Yes ' store input response
 Replacements=False ' reset replacement flag
 EditLine$=Rtrim$(Array(Message.Number)) ' store message line to edit
 ' routine loop replaces Message.Number$ in EditLine$ with Edit.Replace$
 Do ' loop until replacements finished
    If EditLine$=Nul Then ' check length of message line
       Exit Do ' exit loop if line length reduced to null
    Endif ' end check length of message line
    ' get position of search string
    Replace=Instr(Replace.Word,EditLine$,Message.Number$)
    If Replace=False Then ' check search string exists
       Exit Do ' exit loop if search string not found
    Endif ' end check search string exists
    ' replace search string with replacement string
    EditLine$=Left$(EditLine$,Replace-1)+Edit.Replace$+ _
    Mid$(EditLine$,Replace+Len(Message.Number$))
    EditLine$=Left$(EditLine$,79) ' truncate message line
    ' recalculate next position index for search
    Replace.Word=Replace+Len(Edit.Replace$)
    Replacements=Replacements+1 ' increment number of replacements made
    If Replacements=1 Then ' check first replacement
       If Replace.All=False Then ' check flag to replace all searches
          Exit Do ' exit loop after only one replacement made
       Endif ' end check replacement flag
    Endif ' end check replacement number
 Loop ' end replacement loop
 Array(Message.Number)=EditLine$ ' store edited message line
 Select Case Replacements ' selectionn of number of replacements made
 Case 0 ' no replacements
    Outpt="No replacements made." ' make display message
 Case 1 ' one replacement
    Outpt="One replacement made." ' make display message
 Case Else ' more than one replacement
    Outpt=Mid$(Str$(Replacements),2)+" replacements made." ' make message
 End Select ' end selection of number of replacements
 Call IO.O ' send display message
End Sub ' end routine to edit message line

 Rem * routine to delete range of lines from message text.

Sub Delete.Line
 On Local Error Resume Next ' local error resume
 Outpt="Enter line numbers:" ' make display message
 Call IO.O ' send message
 Messages.Max=Message.Length ' store length of message
 ' routine to get range of numbers
 Call Get.Range(Messages.Max,Message.Line1,Message.Line2)
 ' input prompt
 Outpt="Delete lines"+Str$(Message.Line1)+" to"+Str$(Message.Line2)+"(y/n)? "
 No.Input.Out="Y" ' default input
 Call IO.I ' get user input
 If No Then ' check input response
    Exit Sub ' exit routine
 Endif ' end check input response
 ' loop through the total number of lines to delete
 For Message.Index=1 To Message.Line2-Message.Line1+1
    Message.Length=Message.Length-1 ' decrement the length of message
    ' loop from the first line to delete
    For Array.Index=Message.Line1 To Message.Length
       Array(Array.Index)=Array(Array.Index+1) ' packing the remaining message
    Next ' end loop through deleted lines
 Next ' end loop through number of lines to delete
 If Message.Length=False Then ' check length of message
    Outpt="No message left." ' make error message
    Call IO.O ' send message
    Exit Sub ' exit routine
 Endif ' end check message length
 Outpt="Line numbers"+Str$(Message.Line1)+" to"+ _
 Str$(Message.Line2)+" deleted." ' make message
 Call IO.O ' send message
End Sub ' end routine to delete range of lines

 Rem * routine to insert lines into message text.

Sub Insert.Lines
 On Local Error Resume Next ' local error resume
 If Message.Length=64 Then ' check length of message
    Outpt="Message buffer full." ' make message
    Call IO.O ' send message
    Exit Sub ' exit routine
 Endif ' end check message length
 Messages.Max=Message.Length ' store message length
 Outpt="Before line number" ' make input range prompt
 Call Get.Range2(1,Messages.Max,Message.Line) ' routine to get number
 Graphics.Off=True ' reset color
 User.Word.Wrap=UserRecord.Wordwrap ' store user word wrap
 UserRecord.Wordwrap=False ' reset word wrap
 Do While Message.Length<64 ' loop while message length range
    Word.Wrap=True ' set word wrap flag
    Outpt="?" ' make input prompt
    Call IO.I ' get user input
    Word.Wrap=False ' reset word wrap flag
    If No.Input Then ' check length of input flag
       Exit Do ' exit message netry loop
    Endif ' end check input length
    ' loop backwards through message
    For Array.Index=Message.Length To Message.Line Step -1
       ' pack lines before inserted line
       Array(Array.Index+1)=Array(Array.Index)
    Next ' end backward loop
    Inpt=Rtrim$(Inpt) ' trim input
    Inpt=Left$(Inpt,79) ' truncate input
    Array(Message.Line)=Inpt ' store new inserted message line
    Message.Line=Message.Line+1 ' increment line number to insert before
    Message.Length=Message.Length+1 ' increment length of message
 Loop ' end message insert loop
 UserRecord.Wordwrap=User.Word.Wrap ' restore word wrap
 Graphics.Off=False ' reset color
 If Message.Length=64 Then ' compare length of message
    Outpt="Message buffer full." ' make buffer message
    Call IO.O ' send message
 Endif ' end check length of message
End Sub ' end insert routine

 Rem * routine to list range of message text lines.

Sub List.Lines
 On Local Error Resume Next ' local error resume
 Outpt="Enter line numbers:" ' make display message
 Messages.Max=Message.Length ' store length of message
 ' routine to get range of numbers
 Call Get.Range(Messages.Max,Message.Line1,Message.Line2)
 Outpt="Display line numbers(y/n)? " ' make input prompt
 No.Input.Out="Y" ' default input
 Call IO.I ' get user input
 ListLines=Yes ' store response
 Allow.Break=True ' turn on allow break flag
 Break=False ' reset control-k flag
 Continue=False ' reset continuous flag
 Page.Length=False ' reset page counter
 Graphics.Off=True ' reset color
 ' loop through range of message lines
 User.Line.Length=UserRecord.Linelength ' store user line length
 UserRecord.Linelength=False ' store line length
 For Message.Line=Message.Line1 To Message.Line2
    If ListLines Then ' check line number list flag
       Outpt=Mid$(Str$(Message.Line),2)+":" ' make line number
    Else ' check line number flag
       Outpt=Nul ' reset line number string
    Endif ' end check line number flag
    Outpt=Outpt+Array(Message.Line) ' make line display
    Outpt=Left$(Outpt,79) ' truncate line
    Call IO.O ' send line display
    If Break Then ' check control-k pressed
       Exit For ' exit text input loop
    Endif ' end check control-k
    Page.Length=Page.Length+1 ' increment page counter
    If Page.Length=UserRecord.Pagelength Then ' check page counter
       Page.Length=False ' reset page counter
       If Continue=False Then ' check continuous flag
          Call More.Prompt ' routine to pause
          If No Then ' check pause response
             Exit For ' exit routine
          Endif ' end check response
       ENdif ' end check continuous flag
    Endif ' end check page counter
 Next ' end loop through range of lines
 UserRecord.Linelength=User.Line.Length ' restore line length
 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 ' recheck page counter
    Call More.Prompt ' pause routine
 Endif ' end recheck counter
End Sub ' end list lines routine

 Rem * routine to edit rooms.

Sub Edit.Room
 On Local Error Resume Next ' local error resume
 Call Share.Room.Record(Room) ' store current room
 Do ' loop through room edit menu
    Graphics.Off=False ' reset color
    Outpt="Room edit:" ' make output display
    Call IO.O ' send output
    Graphics.Off=True ' reset color
    Outpt="[A]dd" ' make output display
    Call IO.O ' send output
    Outpt="[C]hange" ' make output display
    Call IO.O ' send output
    Outpt="[L]ist" ' make output display
    Call IO.O ' send output
    Graphics.Off=False ' reset color
    Outpt="Enter room edit option(q to quit)? " ' make input prompt
    No.Input.Out="Q" ' default input
    Call IO.I
    Select Case Ucase$(Inpt) ' selection of input
    Case "A" ' option to add new room
       Next.Room=Lof(RoomFile)/Len(RoomRecord)+1 ' store next room record
       Call Add.Room(False,Room.Added) ' routine to add room
    Case "C" ' option to select another room number to edit
       Outpt="Enter room number" ' prompt
       Max.Rooms!=Lof(RoomFile)/Len(RoomRecord) ' store length of room records
       ' routine to get number from range
       Call Get.Room.Range2(1!,Max.Rooms!,Room.Number!)
       Call Change.Room(Room.Number!) ' routine to edit room descriptions
    Case "L" ' display room description
       Max.Rooms!=Lof(RoomFile)/Len(RoomRecord) ' store length of room record
       ' routine to get range to display
       Call Get.Room.Range(Max.Rooms!,Start.Room!,End.Room!)
       ' loop through range of room numbers
       Allow.Break=True ' set allow break flag
       Break=False ' reset control-k flag
       Continue=False ' set continuous flag
       For Room.Number!=Start.Room! To End.Room!
          Call Read.Room.Record(Room.Number!) ' get room record
          Call Display.Room.Desc(Room.Number!) ' routine to display room
          If Break Then ' check break flag
             Exit For ' exit display loop
          Endif
          Graphics.Off=False ' reset color
          If Continue=False Then ' check continuous flag
             Call More.Prompt ' pause prompt
             If No Then ' compare continue
                Exit For ' exit loop through rooms
             Endif ' end compare
          Endif ' end check continuous flag
       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
    Case "Q" ' option to exit menu
       Call Read.Room.Record(Room) ' get current room
       Exit Do ' exit edit menu
    End Select ' end input selection
 Loop ' end room edit menu
End Sub ' end room edit routine

 Rem * routine to read !edit help.

Sub Edit.Help
 On Local Error Resume Next ' local error resume
 Do ' help menu loop
    Graphics.Off=False ' reset color
    Outpt="Edit help:" ' make output message
    Call IO.O ' send output message
    Graphics.Off=True ' reset color
    Outpt="[C]ontents" ' make output message
    Call IO.O ' send output message
    Outpt="[T]opic" ' make output message
    Call IO.O ' send output message
    Graphics.Off=False ' reset color
    No.Input.Out="Q" ' default input
    Outpt="Enter help option(q to quit)? " ' make input prompt
    Call IO.I ' get user input
    Select Case Ucase$(Inpt) ' selection of input
    Case "C" ' display !edit help contents
       Stored.Parsed.Command1="contents" ' store help topic
       Call Read.Help(1) ' routine to read !edit help
    Case "T" ' select help topic number
       Outpt="Enter help topic number sequence? " ' make input prompt
       Call IO.I ' get user input
       Stored.Parsed.Command1=Inpt ' store help topic
       Call Read.Help(1) ' routine to read !edit help
    Case "Q" ' exit menu loop
       Exit Do ' exit loop
    End Select ' end input selection
 Loop ' end menu loop
End Sub ' end routine to read !edit help

 Rem * routine to edit room description and monster class.
 Rem * input variables:
 Rem *   Room.Number! - room number to edit.

Sub Change.Room(Room.Number!)
 On Local Error Resume Next ' local error resume
 Call Read.Room.Record(Room.Number!) ' get room record to edit
 Do ' loop while edit
    Call Display.Room.Desc(Room.Number!) ' routine to display room
    Graphics.Off=False ' reset color
    Outpt="Room edit options:" ' make display output
    Call IO.O ' send output
    Graphics.Off=True ' reset color
    Outpt="[A]ction" ' make display message
    Call IO.O ' send message
    Outpt="[D]escription" ' make display message
    Call IO.O ' send message
    Outpt="[M]onster class" ' make display message
    Call IO.O ' send message
    Outpt="[O]bjects" ' make display message
    Call IO.O ' send message
    Outpt="[T]reasure" ' make display message
    Call IO.O ' send message
    Graphics.Off=False ' reset color
    Outpt="Room edit option(q to quit)? " ' make input prompt
    No.Input.Out="Q" ' default input
    Call IO.I ' get user input
    Select Case Ucase$(Inpt) ' selection of room edit option
    Case "A" ' option to change room action number
       Outpt="Enter action number" ' prompt
       Max.Action=Lof(ActionFile)/Len(ActionRecord) ' store length of room
       ' routine to get number from range
       Call Get.Range2(0,Max.Action,Action.Number)
       RoomRecord.Action=Action.Number ' store action number
    Case "D" ' option to edit room descriptions
       Do ' loop through room description edit menu
          Graphics.Off=True ' reset color
          Outpt="[L]ong description" ' make option message
          Call IO.O ' send option message
          Outpt="[S]hort description" ' make option message
          Call IO.O ' send option message
          Graphics.Off=False ' reset color
          Outpt="Enter room edit option(q to quit)? " ' make option prompt
          No.Input.Out="Q" ' store default input
          Call IO.I ' get option input
          Select Case Ucase$(Inpt) ' make selection of input option
          Case "L" ' edit long description
             Graphics.Off=False ' reset color
             Outpt="Edit room long description(y/n)? " ' input prompt
             No.Input.Out="N" ' default input
             Call IO.I ' get input
             If Yes Then ' compare input
                Graphics.Off=False ' reset color
                Outpt="Enter four lines for long description:" ' make message
                Call IO.O ' send edit message
                Outpt="Press <enter> when done." ' make edit message
                Call IO.O ' send edit message
                Graphics.Off=True ' reset color
                For Room.Desc=1 To 4 ' loop through room long description
                   ' clear room long description
                   RoomRecord.LongDesc(Room.Desc)=Nul
                Next ' end loop through room
                User.Word.Wrap=UserRecord.Wordwrap ' store user word wrap
                UserRecord.Wordwrap=False ' reset word wrap
                Word.Wrap=True ' enable word wrap
                For Room.Desc=1 To 4 ' loop through input for long description
                   Outpt="?" ' make input prompt
                   If Room.Desc=4 Then ' check last long description line
                      Word.Wrap=False ' disable word wrap
                   Endif ' end check last input
                   Call IO.I ' get input
                   If No.Input Then ' check empty cr/lf entered
                      Exit For ' exit description edit loop
                   Endif ' end check empty input
                   ' store long description
                   RoomRecord.LongDesc(Room.Desc)=Inpt
                Next ' end loop through input
                Word.Wrap=False ' disable word wrap
                UserRecord.Wordwrap=User.Word.Wrap ' restore word wrap
             Endif ' end compare input
          Case "S" ' edit short description
             Graphics.Off=False ' reset color
             Outpt="Edit room short decription(y/n)? " ' input prompt
             No.Input.Out="N" ' default input
             Call IO.I ' get input
             If Yes Then ' compare input
                Graphics.Off=False ' reset color
                Outpt="Enter short description(78 characters):" ' make message
                Call IO.O ' send message
                Outpt="Press <enter> to leave unchanged." ' make message
                Call IO.O ' send message
                Graphics.Off=True ' reset color
                Line.Length=78 ' set length of input
                Outpt="?" ' set input prompt
                Call IO.I ' get input
                If No.Input=False Then ' check length of input
                   RoomRecord.ShortDesc=Inpt ' store room short description
                Endif ' end check input length
             Endif ' end compare input
          Case "Q" ' quit
             Exit Do ' exit prompt loop
          End Select ' end selection of input
       Loop ' end loop through selection input
    Case "M" ' edit monster class
       Outpt="Enter monster class" ' make input prompt
       Call Get.Range2(0,Monclass.Max,Monclass.Number) ' get number from range
       RoomRecord.MonsterClass=Monclass.Number ' store new monster class
       Outpt="Monster class"+Str$(Monclass.Number)+" added to room"+ _
       Str$(Room.Number!)+"."
       Call IO.O ' send display message
    Case "O" ' option to edit room objects
       Do ' loop through room object editing
          Graphics.Off=True ' reset color
          For Array.Index=1 To 20 ' loop through room objects
             Object.Number=RoomRecord.Object(Array.Index) ' store object index
             If Object.Number>False And _
             Object.Number<=Lof(ObjectFile)/Len(ObjectRecord) Then ' bounds
                Call Read.Record(ObjectFile,Object.Number) ' read object record
                Outpt="["+Mid$(Str$(Array.Index),2)+"]"+ _
                Rtrim$(ObjectRecord.ObjectName) ' make object name display
                Call IO.O ' send object message
             Endif ' end check object file bounds
          Next ' end loop through room objects
          Graphics.Off=False ' reset color
          Outpt="Room object options:" ' make display message
          Call IO.O ' send message
          Graphics.Off=True ' reset color
          Outpt="[A]dd" ' make display message
          Call IO.O ' send message
          Outpt="[D]elete" ' make display message
          Call IO.O ' send message
          Graphics.Off=False ' reset color
          Outpt="Room object edit option(q to quit)? " ' make input prompt
          No.Input.Out="Q" ' default input
          Call IO.I ' get user input
          Select Case Ucase$(Inpt) ' selection of room object edit option
          Case "A" ' option to add room object
             Object.Added=False ' object added flag
             Call Find.Objects(Item.Found) ' routine to get object number
             If Item.Found>False Then ' check object number
                Swap Room,Room.Number! ' store room number
                Call Add.Room.Object(Index.Number,Charges.Number,Object.Added)
                Swap Room,Room.Number! ' store room number
             Endif ' end check object number
             If Object.Added Then ' check object added flag
                Outpt="Object added to room." ' make message
             Else ' check object added flag
                Outpt="Object not added to room." ' make message
             Endif ' end check object added flag
             Call IO.O ' send message
          Case "D" ' option to delete room object
             Outpt="Object number to delete" ' make range prompt
             Call Get.Range2(1,10,Object.Number) ' get number from range
             Swap Room,Room.Number! ' store room number
             Call Discard.Room.Object(Object.Number) ' discard object
             Swap Room,Room.Number! ' store room number
             Outpt="Object deleted from room." ' make message
             Call IO.O ' send message
          Case "Q" ' option to exit room object edit menu
             Exit Do ' exit room object edit menu
          End Select ' end select room object edit options
       Loop ' end loop through room object option menu
    Case "T" ' option to edit room treasure
       Do ' loop through room treasure edit menu
          Graphics.Off=True ' reset color
          For Array.Index=1 To 20 ' loop through room treasure
             ' store room treasure number
             Treasure.Number=RoomRecord.Treasure(Array.Index)
             If Treasure.Number>False And _
             Treasure.Number<=Lof(TreasureFile)/Len(TreasureRecord) Then
                Call Read.Record(TreasureFile,Treasure.Number) ' read treasure
                Outpt="["+Mid$(Str$(Array.Index),2)+"]"+ _
                Rtrim$(TreasureRecord.TreasureName) ' make treasure name
                Call IO.O ' send treasure name message
             Endif ' end check file bounds
          Next ' end loop through room treasure
          Graphics.Off=False ' reset color
          Outpt="Room treasure options:" ' make display message
          Call IO.O ' send message
          Graphics.Off=True ' reset color
          Outpt="[A]dd" ' make display message
          Call IO.O ' send message
          Outpt="[D]elete" ' make display message
          Call IO.O ' send message
          Graphics.Off=False ' reset color
          Outpt="Room treasure edit option(q to quit)? " ' make input prompt
          No.Input.Out="Q" ' default input
          Call IO.I ' get user input
          Select Case Ucase$(Inpt) ' selection of room treasure option
          Case "A" ' option to add room treasure
             Treasure.Added=False ' set treasure added flag
             ' routine to get treasure number
             Call Find.Treasure(Treasure.Found)
             If Treasure.Found>False Then ' check treasure number
                Swap Room,Room.Number! ' store room number
                Call Add.Room.Treasure(Index.Number,Charges.Number, _
                False,Treasure.Added)
                Swap Room,Room.Number! ' store room number
             Endif ' end check treasure number
             If Treasure.Added Then ' check treasure added flag
                Outpt="Treasure added to room." ' make message
             Else ' check flag
                Outpt="Treasure not added to room." ' make message
             Endif ' end check treasure added flag
             Call IO.O ' send message
          Case "D" ' option to delete treasure number
             Outpt="Treasure number to delete" ' make range prompt
             Call Get.Range2(1,10,Treasure.Number) ' get number from range
             Swap Room,Room.Number! ' store room number
             Call Discard.Room.Treasure(Treasure.Number) ' discard treasure
             Swap Room,Room.Number! ' store room number
             Outpt="Treasure deleted from room." ' make message
             Call IO.O ' send message
          Case "Q" ' option to exit room treasure edit menu
             Exit Do ' exit room treasure edit menu
          End Select ' end selection of room treasure menu
       Loop ' end loop through room treasure edit option menu
    Case "Q" ' option to exit room edit menu
       Call Share.Room.Record(Room.Number!) ' write current room number
       Exit Do ' exit room edit menu
    End Select ' end selection of room edit menu
 Loop ' end loop through room edit option menu
End Sub ' end routine to edit room number

 Rem * routine to edit message text.
 Rem * output variables:
 Rem *   Message.Edit - true to continue, false to abort, 1 to store message.

Sub Edit.Message(Message.Edit)
 On Local Error Resume Next ' local error resume
 Do ' loop through message edit menu
    Graphics.Off=False ' reset color
    Outpt="Editing options:" ' make dislay message
    Call IO.O ' send message
    Graphics.Off=True ' reset color
    Outpt="[A]bort" ' make dislay message
    Call IO.O ' send message
    Outpt="[C]ontinue" ' make dislay message
    Call IO.O ' send message
    If Message.Length>False Then ' check length of message
       Outpt="[D]elete" ' make dislay message
       Call IO.O ' send message
    Endif ' end check length
    If Message.Length>False Then ' check length of message
       Outpt="[E]dit" ' make dislay message
       Call IO.O ' send message
    Endif ' end check length
    If Message.Length>False Then ' check length of message
       Outpt="[I]nsert" ' make dislay message
       Call IO.O ' send message
    Endif ' end check length
    If Message.Length>False Then ' check length of message
       Outpt="[L]ist" ' make dislay message
       Call IO.O ' send message
    Endif ' end check length
    If Message.Length>False Then ' check length of message
       Outpt="[R]eplace" ' make dislay message
       Call IO.O ' send message
    Endif ' end check length
    If Message.Length>False Then ' check length of message
       Outpt="[S]tore" ' make dislay message
       Call IO.O ' send message
    Endif ' end check length
    Graphics.Off=False ' reset color
    Outpt="Edit command? " ' make input prompt
    Call IO.I ' get user input
    Select Case Ucase$(Inpt) ' selection of edit option
    Case "C" ' option to continue message
       Message.Edit=True ' set return variable
       Exit Sub ' exit routine
    Case "R" ' option to replace line
       If Message.Length>False Then ' check length of message
          Call Replace.Line ' replace routine
       Endif ' end check length
    Case "E" ' option to edit line
       If Message.Length>False Then ' check length of message
          Call Edit.Line ' line edit routine
       Endif ' end check length
    Case "D" ' option to delete line
       If Message.Length>False Then ' check length of message
          Call Delete.Line ' delete routine
       Endif ' end check length
    Case "I" ' option to insert lines
       If Message.Length>False Then ' check length of message
          Call Insert.Lines ' insert routine
       Endif ' end check length
    Case "A" ' option to abort message
       Outpt="Are you sure you want to abort(y/n)? " ' make input prompt
       No.Input.Out="N" ' default input
       Call IO.I ' get user input
       If Yes Then ' check input response
          Message.Edit=False ' set return variable
          Exit Sub ' exit routine
       Endif ' end check response
    Case "L" ' option to list lines
       If Message.Length>False Then ' check length of message
          Call List.Lines ' line list routine
       Endif ' end check length
    Case "S" ' option to store message
       If Message.Length>False Then ' check length of message
          Message.Edit=UnTrue ' set return variable
          Exit Sub ' exit routine
       Endif ' end check length
    End Select ' end selection of input
 Loop ' end loop through edit menu
End Sub ' end edit menu routine

 Rem * routine to edit messages files.

Sub Edit.Mail
 On Local Error Resume Next ' local error resume
 Do ' loop through mail edit menu
    Graphics.Off=False ' reset color
    Outpt="Mail edit:" ' make display message
    Call IO.O ' send message
    Graphics.Off=True ' reset color
    Outpt="[C]hange" ' make display message
    Call IO.O ' send message
    Outpt="[D]elete" ' make display message
    Call IO.O ' send message
    Outpt="[L]ist" ' make display message
    Call IO.O ' send message
    Outpt="[P]ack" ' make display message
    Call IO.O ' send message
    Outpt="[U]ndelete" ' make display message
    Call IO.O ' send message
    Graphics.Off=False ' reset color
    Outpt="Message edit option(q to quit)? " ' make input prompt
    No.Input.Out="Q" ' default input
    Call IO.I ' get user input
    Select Case Ucase$(Inpt) ' select option
    Case "C" ' change option
       Call Change.Message ' routine to change message
    Case "D" ' delete option
       Call Delete.Message ' routine to delete message
    Case "L" ' list option
       Call List.Messages ' routine to list messages
    Case "P" ' pack option
       Call Pack.Messages ' routine to pack messages
    Case "U" ' undelete option
       Call Undelete.Message ' routine to undelete message
    Case "Q" ' exit mail edit menu option
       Exit Do ' exit edit mail menu
    End Select ' end mail edit option selection
 Loop ' end mail edit menu loop
End Sub ' end mail edit menu routine

 Rem * routine to parse out number after pound sign in a string
 Rem * input variables:
 Rem *   Parsed.Input$ - string to check.
 Rem * output variables:
 Rem *   Parsed.Input$ - string truncated before pound sign, lowercased.
 Rem *   Parsed.Value - number parsed after pound sign.
 Rem * work variables:
 Rem *   Parsed.Token - contains position of # sign.

Sub Parse.Num(Parsed.Input$,Parsed.Value)
 On Local Error Resume Next ' local error resume
 Parsed.Input$=Lcase$(Parsed.Input$) ' lowercase string
 Parsed.Value=False ' set return variable
 Parsed.Token=Instr(Parsed.Input$,"#") ' search string for pound sign
 If Parsed.Token>False Then ' check string search
    ' set return variable
    Parsed.Value=Int(Val(Mid$(Parsed.Input$,Parsed.Token+1)))
    Parsed.Input$=Left$(Parsed.Input$,Parsed.Token-1) ' truncate string
 Endif ' end check string
End Sub ' end routine

 Rem * routine to search player and room treasure for parameter name
 Rem * input variables:
 Rem *   Parsed.Command1 - name of treasure.
 Rem * output variables:
 Rem *   Charges.Number - charges of treasure.
 Rem *   Index.Number - index of treasure to file.
 Rem *   Type.Number - 0 for treasure in inventory, 1 for treasure in room.

Sub Examine.Treasure
 On Local Error Resume Next ' local error resume
 Type.Number=False ' store treasure flag
 Call Check.Inventory.Treasure ' routine to search player inventory treasure
 If Index.Number=False Then ' check player treasure found
    Call Num ' decrement counters
    Type.Number=1 ' store treasure flag
    Call Check.Room.Treasure ' routine to search room inventory treasure
 Endif ' end check player treasure found
End Sub ' end routine to search inventory treasure for treasure name

 Rem * routine to search player and room objects for parameter name
 Rem * input variables:
 Rem *   Parsed.Command1 - name of object.
 Rem * output variables:
 Rem *   Charges.Number - charges of object.
 Rem *   Index.Number - index of object to file.
 Rem *   Type.Number - 0 for object in inventory, 1 for object in room.

Sub Examine.Objects
 On Local Error Resume Next ' local error resume
 Type.Number=False ' store object flag
 Call Check.Inventory.Objects ' routine to search player inventory objects
 If Index.Number=False Then ' check player inventory object found
    Call Num ' decrement counters
    Type.Number=1 ' store object flag
    Call Check.Room.Objects ' routine to search room inventory objects
 Endif ' end check player inventory object found
End Sub ' end routine to search inventory objects for object name

 Rem * routine to search player inventory for treasure name
 Rem * input variables:
 Rem *   Parsed.Command2 - contains command parameter.
 Rem * output variables:
 Rem *   Charges.Number - treasure charges.
 Rem *   Index.Number - treasure index to file.

Sub Find.Inventory
 On Local Error Resume Next ' local error resume
 Call Parse ' parse command parameter
 If Parser Then ' check for parsed command
    Call Numeric ' store # sign counter
 Endif ' end check parsed command
 Call Check.Inventory.Treasure ' routine to search player treasure inventory
End Sub ' end routine to search player treasure inventory

 Rem * routine to search player inventory for object name
 Rem * input variables:
 Rem *   Parsed.Command2 - contains command parameter.
 Rem * output variables:
 Rem *   Charges.Number - object charges.
 Rem *   Index.Number - object index to file.

Sub Find.Object
 On Local Error Resume Next ' local error resume
 Call Parse ' parse command parameter
 If Parser Then ' check for parsed command
    Call Numeric ' store # sign counter
 Endif ' end check parsed command
 Call Check.Inventory.Objects ' routine to search player object inventory
End Sub ' end routine to search player object inventory

 Rem * routine searches for treasure name in room treasure inventory
 Rem * input variables:
 Rem *   Parsed.Command1 - name of treasure to search for.
 Rem *   Parse.Number - number increment of treasure.
 Rem * output variables:
 Rem *   Charges.Number - treasure charges.
 Rem *   Index.Number - treasure file index.
 Rem *   Outpts - treasure name.
 Rem * processing variables:
 Rem *   Parse.Count - counter of treasure found in search.

Sub Check.Room.Treasure
 On Local Error Resume Next ' local error resume
 Charges.Number=False ' reset treasure charges
 Index.Number=False ' reset treasure index
 Parse.Count=False ' reset treasure counter
 If Parsed.Command1<>Nul Then ' compare search string length
    For Array.Number=1 To 20 ' loop through room inventory
       If RoomRecord.Treasure(Array.Number) Then ' check room inventory index
          ' get treasure record
          Call Read.Record(TreasureFile,RoomRecord.Treasure(Array.Number))
          Outpts=TreasureRecord.ShortName ' store treasure name
          ' trim length of treasure name to length of search string
          Outpts=Left$(Outpts,Len(Parsed.Command1)) ' trim
          ' compare treasure name to search name
          If Outpts=Parsed.Command1 Then
             Parse.Count=Parse.Count+1 ' increment counter
             ' check increment counter not specified,
             ' or counter equals increment counter.
             If Parse.Number=False Or Parse.Count=Parse.Number Then
                Outpts=TreasureRecord.TreasureName ' get treasure name
                Outpts=Rtrim$(Outpts) ' trim name
                ' store treasure index
                Index.Number=RoomRecord.Treasure(Array.Number)
                ' store treasure charges
                Charges.Number=RoomRecord.TreCharges(Array.Number)
                Exit For ' exit loop through room treasure inventory
             Endif ' end check counters equal
          Endif ' end compare treasure names
       Endif ' end check room inventory index
    Next ' end loop through room treasure inventory
 Endif ' end compare search string length
End Sub ' end room treasure inventory search

 Rem * routine searches for object name in room object inventory
 Rem * input variables:
 Rem *   Parsed.Command1 - name of object to search for.
 Rem *   Parse.Number - number increment of object.
 Rem * output variables:
 Rem *   Charges.Number - object charges.
 Rem *   Index.Number - object file index.
 Rem *   Outpts - object name.
 Rem * processing variables:
 Rem *   Parse.Count - counter of object found in search.

Sub Check.Room.Objects
 On Local Error Resume Next ' local error resume
 Charges.Number=False ' reset object charges
 Index.Number=False ' reset object index
 Parse.Count=False ' reset object counter
 If Parsed.Command1<>Nul Then ' check search string length
    For Array.Number=1 To 20 ' loop through room object inventory
       If RoomRecord.Object(Array.Number) Then ' check room object index
          ' get room object record
          Call Read.Record(ObjectFile,RoomRecord.Object(Array.Number))
          Outpts=ObjectRecord.ShortName ' store room object name
          ' trim length of object name to length of search string
          Outpts=Left$(Outpts,Len(Parsed.Command1)) ' trim
          ' compare object name to search string
          If Outpts=Parsed.Command1 Then
             Parse.Count=Parse.Count+1 ' increment counter
             ' check increment counter not specified,
             ' or counter equals increment counter.
             If Parse.Number=False Or Parse.Count=Parse.Number Then
                Outpts=ObjectRecord.ObjectName ' store object name
                Outpts=Rtrim$(Outpts) ' trim name
                ' store object index
                Index.Number=RoomRecord.Object(Array.Number)
                ' store object charges
                Charges.Number=RoomRecord.ObjCharges(Array.Number)
                Exit For ' exit loop through room object inventory
             Endif ' end check counters
          Endif ' end compare object names
       Endif ' end check room object index
    Next ' end loop through room object inventory
 Endif ' end check search string length
End Sub ' end routine to search room object inventory

 Rem * routine searches for treasure name in player treasure inventory
 Rem * input variables:
 Rem *   Parsed.Command1 - name of treasure to search for.
 Rem *   Parse.Number - number increment of treasure.
 Rem * output variables:
 Rem *   Charges.Number - treasure charges.
 Rem *   Index.Number - treasure file index.
 Rem *   Outpts - treasure name.
 Rem * processing variables:
 Rem *   Parse.Count - counter of treasure found in search.

Sub Check.Inventory.Treasure
 On Local Error Resume Next ' local error resume
 Charges.Number=False ' reset treasure charges
 Index.Number=False ' reset treasure index
 Parse.Count=False ' reset treasure counter
 If Parsed.Command1<>Nul Then ' compare search string length
    For Array.Number=1 To 20 ' loop through player treasure inventory
       If UserRecord.Inv(Array.Number) Then ' check player inventory index
          ' get treasure record
          Call Read.Record(TreasureFile,UserRecord.Inv(Array.Number))
          Outpts=TreasureRecord.ShortName ' store treasure name
          ' trim length of treasure name to length of search string
          Outpts=Left$(Outpts,Len(Parsed.Command1)) ' trim
          ' compare treasure name to search string
          If Outpts=Parsed.Command1 Then
             Parse.Count=Parse.Count+1 ' increment counter
             ' check increment counter not specified,
             ' or counter equals increment counter.
             If Parse.Number=False Or Parse.Count=Parse.Number Then
                Outpts=TreasureRecord.TreasureName ' store treasure name
                Outpts=Rtrim$(Outpts) ' trim name
                ' store treasure index
                Index.Number=UserRecord.Inv(Array.Number)
                ' store treasure charges
                Charges.Number=UserRecord.Charges(Array.Number)
                Exit For ' exit loop through player treasure inventory
             Endif ' end check counters
          Endif ' end compare treasure names
       Endif ' end check player treasure inventory index
    Next ' end loop through player treasure inventory
 Endif ' end check search string length
End Sub ' end routine to search player treasure inventory for treasure name

 Rem * routine searches for object name in player object inventory
 Rem * input variables:
 Rem *   Parsed.Command1 - name of object to search for.
 Rem *   Parse.Number - number increment of object.
 Rem * output variables:
 Rem *   Charges.Number - object charges.
 Rem *   Index.Number - object file index.
 Rem *   Outpts - object name.
 Rem * processing variables:
 Rem *   Parse.Count - counter of object found in search.

Sub Check.Inventory.Objects
 On Local Error Resume Next ' local error resume
 Charges.Number=False ' reset object charges
 Index.Number=False ' reset object index
 Parse.Count=False ' reset counter
 If Parsed.Command1<>Nul Then ' check search strig length
    For Array.Number=1 To 5 ' loop through player object inventory
       If UserRecord.Object(Array.Number) Then ' check player object index
          ' get object record
          Call Read.Record(ObjectFile,UserRecord.Object(Array.Number))
          Outpts=ObjectRecord.ShortName ' store object name
          ' trim length of object name to length of search string
          Outpts=Left$(Outpts,Len(Parsed.Command1)) ' trim
          ' compare object name to search string
          If Outpts=Parsed.Command1 Then
             Parse.Count=Parse.Count+1 ' increment counter
             ' check increment counter not specified,
             ' or counter equals increment counter.
             If Parse.Number=False Or Parse.Count=Parse.Number Then
                Outpts=ObjectRecord.ObjectName ' store objecct name
                Outpts=Rtrim$(Outpts) ' trim name
                ' store object index
                Index.Number=UserRecord.Object(Array.Number)
                ' store object charges
                Charges.Number=UserRecord.ObjCharges(Array.Number)
                Exit For ' exit loop through player object inventory
             Endif ' end check counters
          Endif ' end compare object names
       Endif ' end check player object index
    Next ' end loop through player object inventory
 Endif ' end check search string length
End Sub ' end routine to search player object inventory

 Rem * routine to search for monster name in room monsters
 Rem * input variables:
 Rem *   Parsed.Command1 - name of monster to search for.
 Rem * output variables:
 Rem *   Monster.Number - number of monster array.
 Rem *   Last.Monster - name of monster found.
 Rem * work variables:
 Rem *   Word.Parse1, Word.Parse2.

Sub Check.Monster
 On Local Error Resume Next ' local error resume
 Array.Number=False ' reset monster number loop counter
 Parse.Count=False ' reset increment counter
 Monster.Number=False ' reset monster number
 If Parsed.Command1<>Nul Then ' check search string length
    For Array.Number=1 To Number.Monsters ' loop through all room monsters
       Word.Parse1=False ' reset monster name parse variable
       Word.Parse2=False ' reset monster name parse variable
       Outpts=MonsterArray(Array.Number).MonsterName ' store monster name
       Outpts=Rtrim$(Outpts) ' trim name
       Outpts=Ucase$(Outpts) ' uppercase name
       ' locate first imbedded space in name
       Word.Parse1=Instr(Word.Parse1+1,Outpts," ")
       While Word.Parse1 ' loop until last space in monster name found
          Word.Parse2=Word.Parse1 ' store position of last space
          Word.Parse1=Instr(Word.Parse1+1,Outpts," ") ' locate next space
       Wend ' end loop
       ' monster name is last word of full name
       Inpt=Mid$(Outpts,Word.Parse2+1)
       ' trim length of monster name to length of search string
       Inpt=Left$(Inpt,Len(Parsed.Command1)) ' trim
       If Inpt=Parsed.Command1 Then ' compare monster name to search string
          Parse.Count=Parse.Count+1 ' increment counter
          ' check increment counter not specified,
          ' or counter equals increment counter.
          If Parse.Number=False Or Parse.Count=Parse.Number Then
             ' store monster name
             Outpts=MonsterArray(Array.Number).MonsterName
             Outpts=Rtrim$(Outpts) ' trim name
             Monster.Number=Array.Number ' store monster number
             Last.Monster=Parsed.Command1 ' store monster name
             Exit For ' exit loop through room monsters
          Endif ' end check counters
       Endif ' end compare search strings
    Next ' end loop through room monsters
 Endif ' end check search string length
End Sub ' end routine to search room monsters for monster name