home *** CD-ROM | disk | FTP | other *** search
/ ftp.wwiv.com / ftp.wwiv.com.zip / ftp.wwiv.com / pub / MISC / DNDOOR46.ZIP / DNDS6.BAS < prev    next >
BASIC Source File  |  2001-07-11  |  102KB  |  2,166 lines

  1.  Rem * Filename: dnds6.bas  Version: v4.6 r1.0
  2.  Rem * This subprogram contains mail and some find routines.
  3.  
  4.  Rem $Include: 'dnddoor.inc'
  5.  
  6.  Rem * main routine to enter mail and process mail selections.
  7.  
  8. Sub Mail
  9.  On Local Error Resume Next ' local error resume
  10.  Redim Array(1 To 19) As String ' dimension message array
  11.  Do ' loop through mail commands
  12.     Graphics.Off=True ' reset color
  13.     Outpt="[E]nter" ' make display message
  14.     Call IO.O ' send message
  15.     Outpt="[K]ill" ' make display message
  16.     Call IO.O ' send message
  17.     Outpt="[L]ock" ' make display message
  18.     Call IO.O ' send message
  19.     Outpt="[N]ew" ' make display message
  20.     Call IO.O ' send message
  21.     Outpt="[R]ead" ' make display message
  22.     Call IO.O ' send message
  23.     Graphics.Off=False ' reset color
  24.     Outpt="Mail command(q to quit)? " ' input prompt
  25.     No.Input.Out="Q" ' default input
  26.     Call IO.I ' get player input
  27.     Select Case Ucase$(Inpt) ' selection of input
  28.     Case "E" ' option to enter message
  29.        Call Enter.Message ' routine to enter message
  30.     Case "K" ' option to kill message
  31.        Call Kill.Message ' routine to kill message
  32.     Case "L" ' option to toggle locked mailbox
  33.        Call Lock.Mailbox ' routine to toggle locked mailbox
  34.     Case "N" ' option to read new messages
  35.        Call New.Messages ' routine to read new messages
  36.     Case "R" ' option to read messages
  37.        Call Read.Messages ' routine to read messages
  38.     Case "Q" ' option to exit mail menu
  39.        Exit Do ' exit mail menu
  40.     End Select ' end mail option selection
  41.  Loop ' end loop through mail menu
  42. End Sub ' end mail routine
  43.  
  44.  Rem * routine to enter a message.
  45.  Rem * output variables:
  46.  Rem *   Array - array containing message.
  47.  Rem *   Message.Length - number of message text lines.
  48.  Rem *   Message.To - codename or null of player message is to.
  49.  Rem *   Private.Message - true if message is private.
  50.  Rem *   Subject - contains subject of message.
  51.  
  52. Sub Enter.Message
  53.  On Local Error Resume Next ' local error resume
  54.  If Lof(TableFile)/Len(TableRecord)=MaxInt Then ' check table size
  55.     Outpt="The message table is full." ' make error output message
  56.     Call IO.O ' send error output
  57.     Exit Sub ' exit routine
  58.  Endif ' end check table size
  59.  Call Share.Record(UserFile,User.Index) ' routine to store player record
  60.  Do ' loop until message to stored
  61.     Graphics.Off=True ' reset color
  62.     Private.Message=False ' reset private message flag
  63.     Outpt="Message to(Press <enter> for ALL)? " ' input prompt
  64.     Call IO.I ' get player input
  65.     Message.To=Ucase$(Inpt) ' uppercase and store input
  66.     If Inpt=Nul Then ' compare null input
  67.        Exit Do ' exit loop with message to all
  68.     Endif ' end compare input length
  69.     For User.Number=1 To Lof(UserFile)/Len(UserRecord) ' loop through user file
  70.        Call Read.Record(UserFile,User.Number) ' read next player record
  71.        Outpt=UserRecord.CodeName ' store codename
  72.        Call Decrypt(Outpt) ' routine to decrypt codename
  73.        Outpt=Rtrim$(Outpt) ' trim codename
  74.        Outpt=Ucase$(Outpt) ' uppercase codename
  75.        If Message.To=Outpt Then ' compare codename to input
  76.           If User.Index<>User.Number Then ' check not self
  77.              If (UserRecord.Flags And Locked.User)=False Then ' check locked
  78.                 Outpt="Private message(y/n)? " ' input prompt
  79.                 No.Input.Out="N" ' default input
  80.                 Call IO.I ' get player input
  81.                 Private.Message=Yes ' store private message flag
  82.                 Exit Do ' exit loop until message to found
  83.              Endif ' end check locked player mailbox
  84.           Endif ' end check player indexes
  85.        Endif ' end check codename
  86.     Next ' end loop through player file
  87.     Outpt="There is no such user." ' make display message
  88.     Call IO.O ' send message
  89.  Loop ' end loop until message to stored
  90.  Call Read.Record(UserFile,User.Index) ' reread player record
  91.  Do ' loop until subject entered
  92.     Outpt="Subject? " ' input prompt
  93.     Call IO.I ' get player input
  94.     Inpt=Ltrim$(Inpt) ' trim input
  95.     Inpt=Rtrim$(Inpt) ' trim input
  96.     Inpt=Lcase$(Inpt) ' lowercase input
  97.     If Inpt<>Nul Then ' check input length
  98.        Subject=Inpt ' store input in subject string
  99.        Exit Do ' exit subject loop
  100.     Endif ' end check input length
  101.     Outpt="Abort message(y/n)? " ' input prompt
  102.     No.Input.Out="N" ' default input
  103.     Call IO.I ' get player input
  104.     If Yes Then ' check input response
  105.        Exit Sub ' exit message enter routine
  106.     Endif ' end check input response
  107.  Loop ' end loop until subject entered
  108.  Message.Reply=False
  109.  Outpt="Enter message." ' make message
  110.  Call IO.O ' send message
  111.  Call Write.Message ' routine to enter and store message
  112. End Sub ' end routine to enter a message
  113.  
  114.  Rem * routine to write message.
  115.  
  116. Sub Write.Message
  117.  On Local Error Resume Next ' local error resume
  118.  Message.Length=False ' reset message length entered
  119.  User.Word.Wrap=UserRecord.Wordwrap ' store user word wrap
  120.  UserRecord.Wordwrap=False ' reset word wrap
  121.  Do ' loop until message entered
  122.     Outpt="Press <enter> on a blank line to edit." ' make message
  123.     Call IO.O ' send message
  124.     Do ' loop until blank line entered
  125.        Graphics.Off=True ' reset color
  126.        If Message.Length=19 Then ' compare length of message entered
  127.           Outpt="Message buffer full." ' make buffer message
  128.           Call IO.O ' send message
  129.           Exit Do ' exit message entry loop
  130.        Endif ' end compare message length
  131.        Word.Wrap=True ' set word wrap flag
  132.        Outpt="?" ' input prompt
  133.        Call IO.I ' get player input
  134.        If No.Input Then ' check blank line entered
  135.           Exit Do ' exit message entry loop
  136.        Endif ' end check blank line
  137.        Message.Length=Message.Length+1 ' increment message length counter
  138.        Inpt=Rtrim$(Inpt) ' trim input
  139.        Inpt=Left$(Inpt,79) ' truncate input
  140.        Array(Message.Length)=Inpt ' store next message line
  141.     Loop ' end loop until blank line entered
  142.     Word.Wrap=False ' reset word wrap flag
  143.     UserRecord.Wordwrap=User.Word.Wrap ' restore user word wrap
  144.     Call Edit.Message(Message.Edit) ' routine to edit message text
  145.     ' selection of return variable from message editing
  146.     Select Case Message.Edit
  147.     Case True ' true returned
  148.        Outpt="Continue editing." ' make display message
  149.        Call IO.O ' send message
  150.     Case False ' false returned
  151.        Exit Sub ' message aborted
  152.     Case UnTrue ' other returned
  153.        Call Store.Message ' message stored
  154.        Exit Sub ' exit message entry routine
  155.     End Select ' end selection of edit return variable
  156.  Loop ' end loop until message entered
  157. End Sub
  158.  
  159.  Rem * routine to lock/unlock player mailbox.
  160.  
  161. Sub Lock.Mailbox
  162.  On Local Error Resume Next ' local error resume
  163.  ' check player locked mailbox
  164.  If (UserRecord.Flags And Locked.User)=False Then
  165.     Outpt="Mailbox locked." ' make locked message
  166.     UserRecord.Flags=UserRecord.Flags Or Locked.User ' set locked player flag
  167.  Else ' check player locked
  168.     Outpt="Mailbox unlocked." ' make locked message
  169.     UserRecord.Flags=UserRecord.Flags And Not Locked.User ' reset locked flag
  170.  Endif ' end check player locked flag
  171.  Call IO.O ' send message
  172.  Call Share.Record(UserFile,User.Index) ' routine to wite player record
  173. End Sub
  174.  
  175.  Rem * routine to delete message.
  176.  
  177. Sub Kill.Message
  178.  On Local Error Resume Next ' local error resume
  179.  Max.Messages=Lof(TableFile)/Len(TableRecord) ' store length of table file
  180.  Outpt="Enter message number to delete" ' make range input prompt
  181.  Call Get.Range2(1,Max.Messages,Message.Number) ' routine to get number
  182.  Call Read.Record(TableFile,Message.Number) ' read table record
  183.  Outpt=UserRecord.CodeName ' store codename
  184.  Call Decrypt(Outpt) ' decrypt codename
  185.  Outpt=Rtrim$(Outpt) ' trim codename
  186.  Outpt=Ucase$(Outpt) ' uppercase codename
  187.  Inpt=TableRecord.To ' store message from codename
  188.  Inpt=Rtrim$(Inpt) ' trim message codename
  189.  Inpt=Ucase$(Inpt) ' uppercase from codename
  190.  If Outpt<>Inpt Then ' compare codenames
  191.     Outpt="Message"+Str$(Message.Number)+" is not a private message to you."
  192.     Call IO.O ' send message
  193.     Exit Sub ' exit routine
  194.  Endif ' end compare codenames
  195.  If TableRecord.Private=False Then
  196.     Outpt="Message"+Str$(Message.Number)+" is not a private message to you."
  197.     Call IO.O ' send message
  198.     Exit Sub ' exit routine
  199.  Endif ' end compare codenames
  200.  If TableRecord.Killed Then ' compare deleted message
  201.     Outpt="Message"+Str$(Message.Number)+" is already deleted." ' error message
  202.     Call IO.O ' send message
  203.     Exit Sub ' exit routine
  204.  Endif ' end compare deleted message
  205.  TableRecord.Killed=True ' set deleted message flag in table record
  206.  Call Share.Record(TableFile,Message.Number) ' routine to write table record
  207.  Outpt="Message"+Str$(Message.Number)+" deleted." ' make deleted message
  208.  Call IO.O ' send message
  209. End Sub ' end routine to delete a message
  210.  
  211.  Rem * routine to display message.
  212.  Rem * input variables:
  213.  Rem *   Message.Number - contains number of message to display.
  214.  Rem *   ListLines - true to list line numbers
  215.  
  216. Sub Read.Message(Message.Number,ListLines)
  217.  On Local Error Resume Next ' local error resume
  218.  Call Message.Header(Message.Number) ' routine to display message header
  219.  Allow.Break=True ' set control-k checking flag
  220.  Break=False ' reset control-k flag
  221.  Continue=False ' reset continuous flag
  222.  Page.Length=5 ' reset page length counter
  223.  ' store beginning of message record flag
  224.  Message.Start!=TableRecord.Start
  225.  ' store ending of message record flag
  226.  Message.End!=Message.Start!+Csng(TableRecord.Length-1)
  227.  ' loop through message contents
  228.  Line.Number=False ' reset line counter
  229.  For Message.Record!=Message.Start! To Message.End!
  230.     Call Read.Message.Record(MessageFile,Message.Record!) ' read message text line
  231.     Outpt=MessageRecord.Message ' store message text
  232.     Call Decrypt(Outpt) ' decrypt message text
  233.     Outpt=Rtrim$(Outpt) ' trim message
  234.     Line.Number=Line.Number+1 ' increment line counter
  235.     If ListLines Then ' check line number list flag
  236.        Outpt=Mid$(Str$(Line.Number),2)+":"+Outpt ' make line number
  237.     Endif ' end check line number flag
  238.     Outpt=Left$(Outpt,79) ' truncate message text
  239.     Call IO.O ' send message text line
  240.     If Break Then ' check control-k pressed flag
  241.        Exit For ' exit message display loop
  242.     Endif ' end check control-k pressed
  243.     Page.Length=Page.Length+1 ' increment page length counter
  244.     If Page.Length=UserRecord.Pagelength Then ' check page length
  245.        Page.Length=False ' reset page length
  246.        If Continue=False Then ' check continuous flag
  247.           Call More.Prompt ' routine to pause
  248.           If No Then ' check pause response
  249.              Exit For ' exit message display loop
  250.           Endif ' end check pause response
  251.        Endif ' end check continuous flag
  252.     Endif ' end check page length
  253.  Next ' end loop through message file
  254.  Allow.Break=False ' reset control-k checking flag
  255.  If Break Then ' check control-k flag
  256.     Break=False ' reset control-k flag
  257.     Outpt=Nul ' set output to null
  258.     Call IO.O ' send empty return
  259.  Endif ' end check control-k flag
  260. End Sub ' end routine to display a message
  261.  
  262.  Rem * routine to display message header.
  263.  Rem * input variables:
  264.  Rem *   Message.Number - contains number of message.
  265.  
  266. Sub Message.Header(Message.Number)
  267.  On Local Error Resume Next ' local error resume
  268.  ' make header
  269.  Call Sub.Header(Message.Number) ' routine displays first part of header
  270.  Outpt="Rcvd:  " ' make header
  271.  If TableRecord.Received Then ' check message
  272.     Outpt=Outpt+"Yes" ' append header
  273.  Else ' check message
  274.     Outpt=Outpt+"No" ' append header
  275.  Endif ' end check message
  276.  Outpt=Outpt+Space$(35-Len(Outpt)) ' pad spaces
  277.  Outpt=Outpt+"Read:"+Str$(TableRecord.TimesRead)+" times"
  278.  Call IO.O ' send more header
  279.  Outpt="Reply: " ' make header
  280.  If TableRecord.Reply Then ' check message type
  281.     Outpt=Outpt+"Yes" ' append header
  282.  Else ' check message
  283.     Outpt=Outpt+"No" ' append header
  284.  Endif ' end check message type
  285.  Outpt=Outpt+Space$(35-Len(Outpt)) ' pad spaces
  286.  Outpt=Outpt+"Thread:" ' append more header
  287.  If TableRecord.Reply Then ' check message type again
  288.     If TableRecord.Thread=False Then ' check message thread number
  289.        Outpt=Outpt+"(forward)" ' append default header
  290.     Else ' check thread number
  291.        Outpt=Outpt+Str$(TableRecord.Thread) ' append thread number
  292.     Endif ' end check message type
  293.  Else ' check message type
  294.     Outpt=Outpt+" None" ' append more header
  295.  Endif ' end check message
  296.  Call IO.O ' send header
  297.  Outpt="Stat:  " ' make more header
  298.  Class.Number=TableRecord.ClassType ' store class type from
  299.  Select Case Class.Number ' select class type
  300.  Case 1 To 10 ' check class type range
  301.     Outpt=Outpt+Rtrim$(Class.Name(Class.Number)) ' store class name
  302.  End Select ' end check class type range
  303.  Outpt=Left$(Outpt,35) ' trunacte more header
  304.  Outpt=Outpt+Space$(35-Len(Outpt)) ' pad spaces
  305.  Outpt=Outpt+"Type: " ' append header
  306.  Inpt=Nul ' reset message type from
  307.  If TableRecord.Flags And Special.Char1 Then ' check message from
  308.     Inpt=Inpt+"Town Mayor " ' append class type from
  309.  Endif ' end check class type message from
  310.  If TableRecord.Flags And Special.Char2 Then ' check message from
  311.     Inpt=Inpt+"Governor " ' append class type from
  312.  Endif ' end check class type message from
  313.  If TableRecord.Flags And Special.Char3 Then ' check message from
  314.     Inpt=Inpt+"Guild Master " ' append class type from
  315.  Endif ' end check class type message from
  316.  If TableRecord.Flags And Special.Char4 Then ' check message from
  317.     Inpt=Inpt+"Sysop " ' append class type from
  318.  Endif ' end check class type message from
  319.  If Inpt=Nul Then ' check message from
  320.     Inpt="None" ' reset class type from
  321.  Endif ' end check class type message from
  322.  Outpt=Outpt+Inpt ' append more header
  323.  Outpt=Left$(Outpt,79) ' truncate header
  324.  Outpt=Rtrim$(Outpt) ' trim header
  325.  Call IO.O ' send more header
  326. End Sub ' end routine to display message header
  327.  
  328.  Rem * routine displays first part of message header
  329.  Rem * input variables:
  330.  Rem *   Message.Number - number of message being read.
  331.  
  332. Sub Sub.Header(Message.Number)
  333.  On Local Error Resume Next ' local error resume
  334.  Graphics.Off=False ' reset color
  335.  Outpt="Msg#:"+Str$(Message.Number)+" of"+Str$(Lof(TableFile)/Len(TableRecord))
  336.  If TableRecord.Private Then ' check private message
  337.     Outpt=Outpt+"(private)" ' append to header
  338.  Endif ' end check message
  339.  If TableRecord.Killed Then ' check deleted message
  340.     Outpt=Outpt+"(deleted)" ' append to header
  341.  Endif ' end check message
  342.  Call IO.O ' send header
  343.  Graphics.Off=True ' reset color
  344.  Inpt=TableRecord.From ' make header
  345.  Inpt=Lcase$(Inpt) ' lowercase header
  346.  Mid$(Inpt,1,1)=Ucase$(Mid$(Inpt,1,1)) ' uppercase first character
  347.  Outpt="From:  "+Inpt ' make header
  348.  Outpt=Left$(Outpt,35) ' truncate hader
  349.  Outpt=Outpt+Space$(35-Len(Outpt)) ' pad spaces
  350.  Inpt=Rtrim$(TableRecord.Subject) ' make more header
  351.  Mid$(Inpt,1,1)=Ucase$(Mid$(Inpt,1,1)) ' uppercase more header
  352.  Outpt=Outpt+"Subj: "+Inpt ' append header
  353.  Call IO.O ' send more header
  354.  Inpt=TableRecord.To ' make more header
  355.  Inpt=Rtrim$(Inpt) ' trim header
  356.  If Inpt=Nul Then ' check null message to
  357.     Inpt="ALL" ' default to all
  358.  Endif ' end check message to
  359.  Inpt=Lcase$(Inpt) ' lowercase header
  360.  Mid$(Inpt,1,1)=Ucase$(Mid$(Inpt,1,1)) ' uppercase header
  361.  Outpt="To:    "+Inpt ' make more header
  362.  Outpt=Left$(Outpt,35) ' truncate more header
  363.  Outpt=Outpt+Space$(35-Len(Outpt)) ' pad spaces
  364.  Outpt=Outpt+"Time: "+TableRecord.Clock ' append header
  365.  Call IO.O ' send more header
  366. End Sub ' end routine to display subheader
  367.  
  368.  Rem * routine to read range of messages.
  369.  
  370. Sub Read.Messages
  371.  On Local Error Resume Next ' local resume next
  372.  Code.Name$=UserRecord.CodeName ' store codename
  373.  Call Decrypt(Code.Name$) ' decrypt codename
  374.  Code.Name$=Rtrim$(Code.Name$) ' trim codename
  375.  Code.Name$=Ucase$(Code.Name$) ' uppercase codename
  376.  Max.Messages=Lof(TableFile)/Len(TableRecord) ' store length of table file
  377.  Outpt="Starting message number" ' make range input prompt
  378.  Call Get.Range2(1,Max.Messages,Message.Number) ' routine to get number
  379.  Do ' message read loop
  380.     If Message.Number>Lof(TableFile)/Len(TableRecord) Then ' compare table end
  381.        Exit Do ' exit message read loop
  382.     Endif ' end compare table
  383.     Call Read.Record(TableFile,Message.Number) ' read next table record
  384.     Inpt=TableRecord.To ' store message from
  385.     Inpt=Rtrim$(Inpt) ' trim message from
  386.     Inpt=Ucase$(Inpt) ' uppercase message from
  387.     If TableRecord.Private And Inpt<>Code.Name$ Then ' compare private message
  388.        Outpt="Message #"+Mid$(Str$(Message.Number),2)+" is private." ' message
  389.        Call IO.O ' send message
  390.     Else ' compare private message, codenames
  391.        If TableRecord.Killed Then ' compare deleted message
  392.           Outpt="Message #"+Mid$(Str$(Message.Number),2)+" was deleted."
  393.           Call IO.O ' send message
  394.        Else ' compare deleted message
  395.           Call Read.Message(Message.Number,False) ' routine to display message
  396.           TableRecord.Received=True ' set message recieved flag
  397.           TableRecord.TimesRead=TableRecord.TimesRead+1 ' increment times read
  398.           Call Share.Record(TableFile,Message.Number) ' write table record
  399.        Endif ' end compare deleted message
  400.     Endif ' end compare private message
  401.     Graphics.Off=False ' reset color
  402.     If Message.Number>UserRecord.LastMessage Then ' check last message pointer
  403.        UserRecord.LastMessage=Message.Number ' store new last message read
  404.     Endif ' end check last message read
  405.     Outpt="Read more (y)es/(n)o/(r)eply/(t)hread, msg number? " ' make prompt
  406.     No.Input.Out="Y" ' default input
  407.     Call IO.I ' get player input
  408.     Select Case Ucase$(Inpt) ' selection of prompt response
  409.     Case "N", "Q" ' check input response
  410.        Exit Do ' exit message read loop
  411.     Case "R" ' reply to message
  412.        Outpt="Private message(y/n)? " ' prompt
  413.        No.Input.Out="N"
  414.        Call IO.I ' get input
  415.        Private.Message=Yes ' set message type
  416.        Message.Reply=True ' set message type
  417.        Message.Thread=Message.Number ' store message number
  418.        Message.To=TableRecord.From ' store message header
  419.        Subject=TableRecord.Subject ' store message header
  420.        Outpt="Enter message reply." ' make message
  421.        Call IO.O ' send message
  422.        Call Write.Message ' routine to enter and write message
  423.        Call Read.Record(TableFile,Message.Number) ' read current table
  424.        TableRecord.Reply=True ' set reply
  425.        Call Share.Record(TableFile,Message.Number) ' write table record
  426.        Message.Number=Message.Number-1 ' adjust loop variable
  427.     Case "T" ' thread selection
  428.        Outpt="Direction (b)ackward/(f)oward/(s)earch? " ' input prompt
  429.        No.Input.Out="F" ' default input
  430.        Call IO.I ' get input
  431.        Select Case Ucase$(Inpt) ' selection of thread direction
  432.        Case "B" ' backward thread
  433.           If TableRecord.Thread=False Then ' check thread
  434.              Outpt="Message has no backward reply thread." ' make message
  435.              Call IO.O ' send message
  436.              Call More.Prompt ' pause prompt
  437.              Message.Number=Message.Number-1 ' reset loop variable
  438.           Else ' check thread
  439.              ' change loop variable to thread number
  440.              Message.Number=TableRecord.Thread-1
  441.           Endif ' end check thread number
  442.        Case "F" ' forward thread
  443.           ' loop through table
  444.           For Message.Search=Message.Number To Lof(TableFile)/Len(TableRecord)
  445.              Call Read.Record(TableFile,Message.Search) ' read table record
  446.              ' compare thread numbers
  447.              If TableRecord.Thread=Message.Number Then
  448.                 Message.Number=Message.Search-1 ' change loop variable
  449.                 Exit For ' exit search loop
  450.              Endif ' end compare thread numbers
  451.           Next ' end loop through table
  452.           If Message.Search>Lof(TableFile)/Len(TableRecord) Then ' check bounds
  453.              Outpt="Message has no forward thread." ' make message
  454.              Call IO.O ' send message
  455.              Call More.Prompt ' pause prompt
  456.              Message.Number=Message.Number-1 ' reset loop variable
  457.           Endif ' end check loop variable
  458.        Case "S" ' search forward thread
  459.           ' loop through table
  460.           For Message.Search=Message.Number To Lof(TableFile)/Len(TableRecord)
  461.              Call Read.Record(TableFile,Message.Search) ' read table record
  462.              ' compare thread numbers
  463.              If TableRecord.Thread=Message.Number Then
  464.                 Call Sub.Header(Message.Search) ' routine displays subheader
  465.                 Graphics.Off=False ' reset color
  466.                 Outpt="Message thread:(c)ontinue search/(r)ead? " ' prompt
  467.                 No.Input.Out="R" ' default input
  468.                 Call IO.I ' get user input
  469.                 If Ucase$(Inpt)="R" Then ' compare input
  470.                    Message.Number=Message.Search-1 ' change loop variable
  471.                    Exit For ' exit search loop
  472.                 Endif ' end compare input
  473.              Endif ' end compare thread numbers
  474.           Next ' end loop through table
  475.           If Message.Search>Lof(TableFile)/Len(TableRecord) Then ' check bounds
  476.              Outpt="There are no more forward threads." ' make message
  477.              Call IO.O ' send message
  478.              Call More.Prompt ' pause prompt
  479.              Message.Number=Message.Number-1 ' reset loop variable
  480.           Endif ' end check loop variable
  481.        End Select ' end thread selection
  482.     Case Else ' other selection
  483.        Next.Message=Int(Val(Inpt)) ' convert input to integer
  484.        ' check input range
  485.        If Next.Message>False And _
  486.        Next.Message<=Lof(TableFile)/Len(TableRecord) Then
  487.           Message.Number=Next.Message-1 ' reset message loop variable
  488.        Endif ' end check input range
  489.     End Select ' end prompt selection
  490.     Message.Number=Message.Number+1 ' increment table number
  491.  Loop ' end loop through message table
  492.  Outpt="End of messages." ' make message
  493.  Call IO.O ' send message
  494. End Sub ' end routine to read messages
  495.  
  496.  Rem * routine to read range of new messages.
  497.  
  498. Sub New.Messages
  499.  On Local Error Resume Next ' local error resume
  500.  If UserRecord.LastMessage>=Lof(TableFile)/Len(TableRecord) Then ' compare last
  501.     Outpt="No new messages." ' make message
  502.     Call IO.O ' send message
  503.     Exit Sub ' exit routine
  504.  Endif ' end compare last message read variable to length of table
  505.  Code.Name$=UserRecord.CodeName ' store codename
  506.  Call Decrypt(Code.Name$) ' decrypt codename
  507.  Code.Name$=Rtrim$(Code.Name$) ' trim codename
  508.  Code.Name$=Ucase$(Code.Name$) ' uppercase codename
  509.  Message.Number=UserRecord.LastMessage+1 ' store last message read variable
  510.  Last.Message=Lof(TableFile)/Len(TableRecord) ' store length of table
  511.  Do ' message read loop
  512.     If Message.Number>Last.Message Then ' compare message range
  513.        Exit Do ' exit message loop
  514.     Endif ' end compare message range
  515.     Call Read.Record(TableFile,Message.Number) ' read next table record
  516.     Inpt=TableRecord.To ' store message to
  517.     Inpt=Rtrim$(Inpt) ' trim message to
  518.     Inpt=Ucase$(Inpt) ' uppercase message to
  519.     Message.Read=True ' set read message flag
  520.     If TableRecord.Private Then ' check private message flag
  521.        If Inpt<>Code.Name$ Then ' compare codenames
  522.           Message.Read=False ' reset read message flag
  523.        Endif ' end compare codenames
  524.     Endif ' end check private message flag
  525.     If TableRecord.Killed Then ' check deleted message
  526.        Message.Read=False ' reset read message flag
  527.     Endif ' end check deleted message
  528.     If Message.Read Then ' verify read message flag
  529.        Call Read.Message(Message.Number,False) ' routine to display message
  530.     Endif ' end verify read message flag
  531.     Graphics.Off=False ' reset color
  532.     ' update player last message variable
  533.     UserRecord.LastMessage=Message.Number
  534.     Outpt="Read more (y)es/(n)o/(r)eply? " ' make more prompt
  535.     No.Input.Out="Y" ' default input
  536.     Call IO.I ' get player input
  537.     If Ucase$(Inpt)="R" Then ' check input
  538.        Outpt="Private message(y/n)? " ' input prompt
  539.        Call IO.I ' get player input
  540.        Private.Message=Yes ' set message type
  541.        Message.Reply=True ' set message type
  542.        Message.Thread=Message.Number ' store message number
  543.        Message.To=TableRecord.From ' store message header
  544.        Subject=TableRecord.Subject ' store message header
  545.        Outpt="Enter message reply." ' make message
  546.        Call IO.O ' send message
  547.        Call Write.Message ' routine to enter and write message
  548.        Call Read.Record(TableFile,Message.Number) ' read current table
  549.        TableRecord.Reply=True ' set reply
  550.        Call Share.Record(TableFile,Message.Number) ' write table record
  551.        Message.Number=Message.Number-1 ' adjust read loop variable
  552.     Endif ' end check input response
  553.     If No Or Quit Then ' check input response
  554.        Exit Do ' exit new message read loop
  555.     Endif ' end check response
  556.     Message.Number=Message.Number+1 ' increment message variable
  557.  Loop ' end loop through new messages
  558. End Sub ' end routine to read new messages
  559.  
  560.  Rem * routine containing status line commands. status line toggle,
  561.  Rem * initializing, clearing, and updating.
  562.  Rem * input variables:
  563.  Rem *   Status.Display -
  564.  Rem *       -2 clear both status lines (rows 24, 25),
  565.  Rem *       -1 toggle status line displaying remote user statistics, or
  566.  Rem *          interactive console function key list,
  567.  Rem *        0 update remote user status line statistics,
  568.  Rem *        1 initialize both status lines.
  569.  Rem * processing variables:
  570.  Rem *   CursorX - temporary variable containing the cursor row position.
  571.  Rem *   CursorY - temporary variable containing the cursor column position.
  572.  Rem *   Statusline.Mode - static variable saved between calls containing the
  573.  Rem *      toggle mode of the status line.
  574.  Rem * notes on routine:
  575.  Rem *   since the status line can be toggled while an online user is
  576.  Rem *   entering input, the color of the screen is restored upon exit
  577.  Rem *   from the routine. i.e. the status line toggles during any
  578.  Rem *   character of i/o.
  579.  
  580. Sub Status.Line(Status.Display)
  581.  On Local Error Resume Next ' local error resume
  582.  Static Statusline.Mode ' status line toggle (variable saved between calls)
  583.  If Status.Display=-1 Then ' compare to toggle command
  584.     If Local.Mode Then ' compare local console logged in
  585.        Exit Sub ' exit routine w/o toggling status line
  586.     Endif ' end compare local mode
  587.     Statusline.Mode=Not Statusline.Mode ' toggle status line
  588.  Endif ' end compare toggle command
  589.  If Status.Display=-2 Then ' compare to clear status line command
  590.     For FunctionKeys=1 To 10 ' loop through all ten function keys
  591.        Key FunctionKeys,Nul ' reset/disable function key
  592.     Next ' end loop through function keys
  593.     CursorX=Csrlin ' store current cursor row
  594.     CursorY=Pos(0) ' store current cursor column
  595.     Color 7,0 ' set color white on black non-intensity
  596.     Locate 25,1 ' locate at bottom status line
  597.     Print Space$(79); ' clear status line w/ blanks
  598.     Locate 24,1 ' locate at second to bottom status line
  599.     Print Space$(79); ' clear status line w/ blanks
  600.     Locate CursorX,CursorY,1 ' relocate at stored cursor row, column
  601.     Call Restore.Color ' subroutine to restore screen color
  602.     Exit Sub ' exit routine
  603.  Endif ' end compare clear status line command
  604.  If Status.Display>0 Then ' compare to initialize status line command
  605.     Statusline.Mode=False ' set the default status line mode
  606.     If Local.Mode Then ' check console logged in
  607.        If Normal.User=False Then ' verify user logged in is not DM/Sysop
  608.           Statusline.Mode=True ' reset the default status line mode
  609.        Endif ' end verify DM/Sysop
  610.     Endif ' end check local mode
  611.     Call Door.Status.Line ' initialize the door information status line
  612.  Endif ' end compare initialize status line command
  613.  If Statusline.Mode=False Then ' compare status line mode
  614.     Call Make.Status.Line ' routine to update status line w/ player stats
  615.  Else ' status line mode
  616.     If Status.Display<>0 Then ' any status line command than update
  617.        Call Sysop.Status.Line ' routine for sysop function key status line
  618.     Endif ' end compare status line command
  619.  Endif ' end compare status line command
  620. End Sub ' end status line commands routine
  621.  
  622.  Rem * routine to make status line containing player character statistics.
  623.  Rem * processing variables:
  624.  Rem *   CursorX - contains the current cursor row.
  625.  Rem *   CursorY - contains the current cursor column.
  626.  
  627. Sub Make.Status.Line
  628.  On Local Error Resume Next ' local error resume
  629.  Status$=UserRecord.CodeName ' store player codename
  630.  Call Decrypt(Status$) ' decrypt codename
  631.  Status$=Lcase$(Status$) ' set codename lowercase
  632.  If Left$(Status$,9)=Deleted$ Then ' check codename is invalid/deleted
  633.     Exit Sub ' exit routine
  634.  Endif ' end check codename
  635.  Mid$(Status$,1,1)=Ucase$(Mid$(Status$,1,1)) ' uppercase first codename letter
  636.  If UserRecord.ClassType=MagicUser Then ' compare player class type to MU
  637.     Status2$="MU" ' set status line player class name to MU abbreviation
  638.  Else ' compare to non MU
  639.     ' set status line player class name to left part of entire class name
  640.     Status2$=Left$(Class.Name(UserRecord.ClassType),8)
  641.  Endif ' end compare MU
  642.  If Dungeon.Master.Assistant Then ' compare player class name to Asst. DM
  643.     Status2$="ADM" ' set status line to Asst. DM abbreviation
  644.  Endif ' end compare ADM
  645.  If Dungeon.Master Then ' compare player class name to DM
  646.     Status2$="DM" ' set status line to DM abbreviation
  647.  Endif ' end compare DM
  648.  If Sysop Then ' compare player to sysop
  649.     Status2$="SYS" ' set status line to sysop abbreviation
  650.  Endif ' end compare sysop
  651.  Status$=Status$+" "+Status2$ ' combine player codename with class name
  652.  Status$=Left$(Status$,39) ' truncate to left half
  653.  Status$=Status$+Space$(39-Len(Status$)) ' append trailing blanks
  654.  Status.Value=UserRecord.Fatigue ' store current player fatigue
  655.  If Status.Value<False Then ' check validity of fatigue
  656.     Status.Value=False ' reset to zero
  657.  Endif ' end check validity
  658.  Status$=Status$+" Fat:"+Mid$(Str$(Status.Value),2) ' append fatigue message
  659.  Status.Value=UserRecord.Vitality ' store current player vitality
  660.  If Status.Value<False Then ' check validity of vitality
  661.     Status.Value=False ' reset to zero
  662.  Endif ' end check validity
  663.  Status$=Status$+" Vit:"+Mid$(Str$(Status.Value),2) ' append vitality message
  664.  Status.Value=UserRecord.Magic ' store current player magic points
  665.  If Status.Value<False Then ' check magic points validity
  666.     Status.Value=False ' reset to zero
  667.  Endif ' end check validity
  668.  ' append magic points message
  669.  Status$=Status$+" Mag:"+Mid$(Str$(Status.Value),2)
  670.  Status.Value=UserRecord.Psionic ' store current player psionic points
  671.  If Status.Value<False Then ' check psionic points validity
  672.     Status.Value=False ' reset to zero
  673.  Endif ' end check validity
  674.  ' append psionic points message
  675.  Status$=Status$+" Psi:"+Mid$(Str$(Status.Value),2)
  676.  Status.Value=UserRecord.Level ' store player level
  677.  If Status.Value<False Then ' compare level validity
  678.     Status.Value=False ' reset to zero
  679.  Endif ' end compare validity
  680.  Status2$=" Lvl:"+Mid$(Str$(Status.Value),2) ' append level message
  681.  ' verify string appended to status line
  682.  If Len(Status$)+Len(Status2$)<=79 Then
  683.     ' string is less than screen line length, and append
  684.     Status$=Status$+Status2$
  685.  Endif ' end verify status line length
  686.  Status.Value=Room ' store current room number
  687.  If Status.Value<False Then ' check validity of room number
  688.     Status.Value=False ' reset to zero
  689.  Endif ' end check validity
  690.  Status2$=" Rm:"+Mid$(Str$(Status.Value),2) ' append room message
  691.  ' verify string appended to status line
  692.  If Len(Status$)+Len(Status2$)<=79 Then
  693.     ' string is less than screen line length, and append
  694.     Status$=Status$+Status2$
  695.  Endif ' end verify status line length
  696.  Status$=Left$(Status$,79) ' truncate status string length
  697.  Status$=Status$+Space$(79-Len(Status$)) ' append blanks to status string
  698.  CursorX=Csrlin ' store current cursor row
  699.  CursorY=Pos(0) ' store current cursor column
  700.  Locate 25,1 ' position cursor at row 25
  701.  Color 14,1 ' color hi-intensity yellow on blue
  702.  Print Status$; ' display the combined status string
  703.  Locate CursorX,CursorY,1 ' restore cursor position
  704.  Call Restore.Color ' routine to restore screen color
  705. End Sub ' end routine to make and display status line
  706.  
  707.  Rem * routine to initialize the console function keys, initialize the
  708.  Rem * DM/sysop status line with the function key names.
  709.  Rem * processing variables:
  710.  Rem *   CursorX, CursorY - contain the current cursor position.
  711.  
  712. Sub Sysop.Status.Line
  713.  On Local Error Resume Next ' local error resume
  714.  For FunctionKeys=1 To 10 ' loop through all ten function keys
  715.     Key FunctionKeys,Nul ' clear the function key
  716.  Next ' loop through keys
  717.  If Local.Mode Then ' check console logged in
  718.     If Normal.User=False Then ' check user is DM/sysop
  719.        Key 1,"!EDIT"+Chr$(13) ' assign key 1
  720.        Key 2,"!STA"+Chr$(13) ' assign key 2
  721.        Key 3,"!DIS " ' assign key 3
  722.        Key 4,"!REDU " ' assign key 4
  723.        Key 5,"!CALL" ' assign key 5
  724.        Key 6,"!KILL " ' assign key 6
  725.        Key 7,"!TELE " ' assign key 7
  726.        Key 8,"!INV"+Chr$(13) ' assign key 8
  727.        Key 9,"!GET " ' assign key 9
  728.        Key 10,"!LINK"+Chr$(13) ' assign key 10
  729.     Endif ' end check DM
  730.  Endif ' end check local mode
  731.  CursorX=Csrlin ' store cursor row
  732.  CursorY=Pos(0) ' store cursor column
  733.  Color 14,1 ' set color to hi-intensity yellow on blue
  734.  For FunctionKeys=1 To 10 ' loop through the ten function key numbers
  735.     ' position the cursor at the function key column
  736.     Locate 25,FunctionKeys*8-7
  737.     ' display the function key and number
  738.     Print "F"+Right$(Str$(FunctionKeys+10),1);
  739.  Next ' end loop through function key numbers
  740.  Color 15,1 ' set color to hi-intensity white on blue
  741.  ' store function key names
  742.  FunctionKeys$="EDITSTA DIS REDUCALLKILLTELEINV GET LINK"
  743.  For FunctionKeys=1 To 10 ' loop through ten function key names
  744.     ' position the cursor at the status function key name
  745.     Locate 25,FunctionKeys*8-5
  746.     ' make the function key name with DM prefix from the function string
  747.     Status$="!"+Mid$(FunctionKeys$,(FunctionKeys-1)*4+1,4)
  748.     If FunctionKeys<10 Then ' check for last key
  749.        Status$=Status$+" " ' append space
  750.     Endif ' end check last key
  751.     Print Status$; ' display the function key name
  752.  Next ' end loop through function key names
  753.  Locate CursorX,CursorY,1 ' restore cursor position
  754.  Call Restore.Color ' routine to restore screen color
  755. End Sub ' end routine to initialize function keys and DM status line
  756.  
  757.  Rem * routine to display door information on the 24th status line.
  758.  Rem * processing variables:
  759.  Rem *   CursorX, CursorY - contains the cursor position.
  760.  
  761. Sub Door.Status.Line
  762.  On Local Error Resume Next ' local error resume
  763.  CursorX=Csrlin ' store cursor row
  764.  CursorY=Pos(0) ' store cursor column
  765.  Color 14,1 ' color hi-intensity yellow on blue
  766.  Locate 24,1 ' position cursor
  767.  Status2$=Left$(BBS.Name,19) ' get BBS name, truncate
  768.  Status2$=Status2$+Space$(19-Len(Status2$)) ' append blanks
  769.  Status3$=Left$(Door.Name,30) ' get name of user, truncate
  770.  Status3$=Status3$+Space$(30-Len(Status3$)) ' append blanks
  771.  Status4$=Space$(5)+"Time: " ' time user logged in
  772.  Status4$=Status4$+Format$(Timelogged.On,"hh:mm:ssa/p") ' append time
  773.  Status$="BBS:"+Status2$+" Name:"+Status3$+Status4$ ' combine all strings
  774.  Status$=Left$(Status$,79) ' truncate line to left
  775.  Status$=Status$+Space$(79-Len(Status$)) ' append blanks to right
  776.  Print Status$; ' display door information status line
  777.  Locate CursorX,CursorY,1 ' restore cursor position
  778.  Call Restore.Color ' restore screen color
  779. End Sub ' end routine to display 24th line
  780.  
  781.  Rem * routine to restore current ansi color after status line is displayed.
  782.  Rem * input variables:
  783.  Rem *   Color.Code - contains current color in cycling.
  784.  
  785. Sub Restore.Color
  786.  On Local Error Resume Next ' local error resume
  787.  If Graphics.Off Then ' check color cycling
  788.     Call Convert.Color(37) ' restore color to white
  789.  Else ' color check
  790.     Call Convert.Color(Color.Code) ' restore color
  791.  Endif ' end check color cycling on
  792. End Sub ' end routine to restore color
  793.  
  794.  Rem * routine displays spell types.
  795.  
  796. Sub Spell.Types
  797.  On Local Error Resume Next
  798.  Graphics.Off=True ' reset color
  799.  Outpt="[A]Enchant      [O]Psionic"
  800.  Call IO.O ' send output
  801.  Outpt="[B]Offense      [P]Detect Lock"
  802.  Call IO.O ' send output
  803.  Outpt="[C]Bless        [R]Detect Evil"
  804.  Call IO.O ' send output
  805.  Outpt="[D]Wish         [S]Detect Trap"
  806.  Call IO.O ' send output
  807.  Outpt="[E]Poison       [T]Intoxicate"
  808.  Call IO.O ' send output
  809.  Outpt="[F]Vigor        [U]Set Trap"
  810.  Call IO.O ' send output
  811.  Outpt="[G]Heal         [V]Hide"
  812.  Call IO.O ' send output
  813.  Outpt="[H]Curepoison   [W]Search"
  814.  Call IO.O ' send output
  815.  Outpt="[I]Level Drain  [X]Invisibility"
  816.  Call IO.O ' send output
  817.  Outpt="[J]Teleport     [Y]Identify"
  818.  Call IO.O ' send output
  819.  Outpt="[K]Befuddle     [Z]Enlighten"
  820.  Call IO.O ' send output
  821.  Outpt="[L]Turn Undead  [1]Illuminate"
  822.  Call IO.O ' send output
  823.  Outpt="[M]Pass Door    [2]Psyche"
  824.  Call IO.O ' send output
  825.  Outpt="[N]Conjure      [3]Telepathy"
  826.  Call IO.O ' send output
  827. End Sub
  828.  
  829.  Rem * routine changes message.
  830.  
  831. Sub Change.Message
  832.  On Local Error Resume Next ' local error resume
  833.  Do ' loop through message changing
  834.     Graphics.Off=False ' reset color
  835.     Max.Messages=Lof(TableFile)/Len(TableRecord) 'store length of message table
  836.     Outpt="Message number to edit" ' make range input prompt
  837.     Call Get.Range2(1,Max.Messages,Message.Number) ' routine to get number
  838.     Call Read.Record(TableFile,Message.Number) ' read table record
  839.     Graphics.Off=False ' reset color
  840.     Outpt="Edit message header(y/n)? " ' make input prompt
  841.     No.Input.Out="N" ' default input
  842.     Call IO.I ' get user input
  843.     If Yes Then ' check nput response
  844.        Call Message.Header(Message.Number) ' routine to display header
  845.        Graphics.Off=False ' reset color
  846.        Outpt="Enter new message header:" ' make display message
  847.        Call IO.O ' send message
  848.        Graphics.Off=True ' reset color
  849.        Outpt="From(press <enter> for Sysop)? " ' make input prompt
  850.        No.Input.Out="Sysop" ' default input
  851.        Call IO.I ' get user input
  852.        TableRecord.From=Inpt ' store message from
  853.        Outpt="To(press <enter> for ALL)? " ' make input prompt
  854.        Call IO.I ' get user input
  855.        TableRecord.To=Ucase$(Inpt) ' store message to
  856.        Outpt="Subject? " ' make input prompt
  857.        Call IO.I ' get user input
  858.        TableRecord.Subject=Lcase$(Inpt) ' store message subject
  859.        Call Share.Record(TableFile,Message.Number) ' routine to write table record
  860.     Endif ' end check response
  861.     Do ' loop through message text editing
  862.        Graphics.Off=False ' reset color
  863.        Outpt="Edit more message text(y/n)? " ' make input prompt
  864.        No.Input.Out="N" ' default input
  865.        Call IO.I ' get user input
  866.        If No Then ' check input response
  867.           Exit Do ' exit message editing loop
  868.        Endif ' end check response
  869.        Call Read.Message(Message.Number,True) ' routine to display message
  870.        Graphics.Off=False ' rset color
  871.        MessageRec.Length=TableRecord.Length ' store message length
  872.        Outpt="Line number to edit" ' make range input prompt
  873.        ' routine to get number
  874.        Call Get.Range2(0,MessageRec.Length,Message.Line)
  875.        If Message.Line>False Then ' check range
  876.           Outpt="New message text:" ' make display message
  877.           Call IO.O ' send message
  878.           Graphics.Off=True ' reset color
  879.           Outpt="?" ' make input prompt
  880.           Call IO.I ' get user input
  881.           Call Valid(Inpt,80) ' validate input
  882.           Call Encrypt(Inpt,True) ' encrypt input
  883.           MessageRecord.Message=Inpt ' store new message text
  884.           MessageRec.Number!=Csng(TableRecord.Start+Message.Line-1)
  885.           Call Share.Message(MessageFile,MessageRec.Number!) ' write message record
  886.        Endif ' end check range
  887.     Loop ' end loop through editing
  888.     Graphics.Off=False ' reset color
  889.     Outpt="Edit another message(y/n)? " ' make input prompt
  890.     No.Input.Out="Y" ' default input
  891.     Call IO.I ' get user input
  892.     If No Then ' check input response
  893.        Exit Sub ' exit routine
  894.     Endif ' end check response
  895.  Loop ' end loop through editing
  896. End Sub ' end message editing routine
  897.  
  898.  Rem * routine to delete message.
  899.  
  900. Sub Delete.Message
  901.  On Local Error Resume Next ' local error resume
  902.  Do ' loop through delete routine
  903.     Max.Messages=Lof(TableFile)/Len(TableRecord) ' store length of table file
  904.     Outpt="Message number to delete" ' make range input prompt
  905.     Call Get.Range2(1,Max.Messages,Message.Number) ' routine to get number
  906.     Call Read.Record(TableFile,Message.Number) ' read table record
  907.     If TableRecord.Killed Then ' check deleted message flag
  908.        Outpt="Message"+Str$(Message.Number)+" is already deleted." ' message
  909.     Else ' check deleted message
  910.        TableRecord.Killed=True ' set deleted message flag
  911.        Call Share.Record(TableFile,Message.Number) ' routine to write table record
  912.        Outpt="Message"+Str$(Message.Number)+" deleted." ' make deleted message
  913.     Endif ' end check deleted message flag
  914.     Call IO.O ' send message
  915.     Graphics.Off=False ' rset color
  916.     Outpt="Delete more messages(y/n)? " ' make input prompt
  917.     No.Input.Out="Y" ' default input
  918.     Call IO.I ' get user input
  919.     If No Then ' check input response
  920.        Exit Sub ' exit routine
  921.     Endif ' end check response
  922.  Loop ' end loop through deleting
  923. End Sub ' end delete message routine
  924.  
  925.  Rem * routine to list range of messages.
  926.  
  927. Sub List.Messages
  928.  On Local Error Resume Next ' local error resume
  929.  Messages.Max=Lof(TableFile)/Len(TableRecord) ' store length of table
  930.  ' routine to get range of numbers
  931.  Call Get.Range(Messages.Max,Messages1,Messages2)
  932.  For Message.List=Messages1 To Messages2 ' loop through range of messages
  933.     Call Read.Record(TableFile,Message.List) ' read table record
  934.     Call Read.Message(Message.List,False) ' routine to display message
  935.     Graphics.Off=False ' reset color
  936.     Outpt="Read more(y/n)? " ' make prompt
  937.     No.Input.Out="Y" ' default input
  938.     Call IO.I ' get player input
  939.     If No Then ' check input response
  940.        Exit Sub ' exit routine
  941.     Endif ' end check response
  942.  Next ' end message display loop
  943. End Sub ' end message list routine
  944.  
  945.  Rem * routine to undelete messages.
  946.  
  947. Sub Undelete.Message
  948.  On Local Error Resume Next ' local error resume
  949.  Do ' loop through undeleting
  950.     Max.Messages=Lof(TableFile)/Len(TableRecord) ' store table length
  951.     Outpt="Message number to undelete" ' make range input prompt
  952.     Call Get.Range2(1,Max.Messages,Message.Number) ' routine to get number
  953.     Call Read.Record(TableFile,Message.Number) ' read table record
  954.     If TableRecord.Killed=False Then ' check deleted message
  955.        Outpt="Message"+Str$(Message.Number)+" is not deleted." ' make message
  956.     Else ' check deleted message
  957.        TableRecord.Killed=False ' set deleted message flag
  958.        Call Share.Record(TableFile,Message.Number) ' routine to write table record
  959.        Outpt="Message"+Str$(Message.Number)+" undeleted." ' make message
  960.     Endif ' end check undeleted message
  961.     Call IO.O ' send message
  962.     Graphics.Off=False ' reset color
  963.     Outpt="Undelete more messages(y/n)? " ' make input prompt
  964.     No.Input.Out="Y" ' default input
  965.     Call IO.I ' get user input
  966.     If No Then ' check input response
  967.        Exit Sub ' exit routine
  968.     Endif ' end check input
  969.  Loop ' end undeleting loop
  970. End Sub ' end undelete routine
  971.  
  972.  Rem * routine to pack messages files.
  973.  
  974. Sub Pack.Messages
  975.  On Local Error Resume Next ' local error resume
  976.  Outpt="Pack messages(y/n)? " ' make input prompt
  977.  No.Input.Out="N" ' default input
  978.  Call IO.I ' get user input
  979.  If Yes Then ' check response
  980.     Outpt="Packing messages.." ' make message
  981.     Call IO.O ' send message
  982.     Call Share.Record(UserFile,User.Index) ' store user record
  983.     Max.Users=Lof(UserFile)/Len(UserRecord) ' store length of user file
  984.     ' dimension working array
  985.     Redim ArrayX(1 To Max.Users) As Integer
  986.     ' packing pass 1
  987.     For User.Number=1 To Max.Users ' loop through user file
  988.        Call Read.Record(UserFile,User.Number) ' get next user file record
  989.        ArrayX(User.Number)=UserRecord.LastMessage ' store last message number
  990.     Next ' end user file loop
  991.     For Message.Number=1 To Lof(TableFile)/Len(TableRecord) 'loop through table
  992.        Call Read.Record(TableFile,Message.Number) ' read table record
  993.        If TableRecord.Killed Then ' check for deleted message
  994.           For User.Number=1 To Max.Users ' loop through user array
  995.              Last.Message=ArrayX(User.Number) ' store last message
  996.              If Last.Message<=Message.Number Then ' check last message
  997.                 Last.Message=Last.Message-1 ' decrement last message read
  998.                 ArrayX(User.Number)=Last.Message ' store last message read
  999.              Endif ' end check last message
  1000.           Next ' end user array loop
  1001.        Endif ' end check deleted message
  1002.     Next ' end message pack loop
  1003.     For User.Number=1 To Max.Users ' loop through user file
  1004.        Call Read.Record(UserFile,User.Number) ' get next user file record
  1005.        UserRecord.LastMessage=ArrayX(User.Number) ' store last message number
  1006.        Call Share.Record(UserFile,User.Number) ' write user record
  1007.     Next ' end user file loop
  1008.     Call Read.Record(UserFile,User.Index) ' reread current player record
  1009.     ' packing pass 2
  1010.     Max.Messages=Lof(TableFile)/Len(TableRecord) ' store maximum table records
  1011.     ' dimension working array
  1012.     Redim ArrayX(1 To Max.Messages) As Integer
  1013.     For Message.Number=1 To Max.Messages ' loop through table file
  1014.        Call Read.Record(TableFile,Message.Number) ' read table record
  1015.        ArrayX(Message.Number)=TableRecord.Thread ' store thread number
  1016.     Next ' end table file rad loop
  1017.     For Message.Number=1 To Max.Messages ' loop through table file
  1018.        Call Read.Record(TableFile,Message.Number) ' read table record
  1019.        If TableRecord.Killed Then ' check for deleted message
  1020.           Thread.Number=ArrayX(Message.Number) ' store thread number
  1021.           ' search for forward thread
  1022.           For Message.Search=Message.Number+1 To Max.Messages
  1023.              ' verify forward message thread
  1024.              If ArrayX(Message.Search)=Message.Number Then
  1025.                 ArrayX(Message.Search)=Thread.Number ' store thread number
  1026.                 If Thread.Number=False Then ' check for thread start
  1027.                    ' search for end of thread
  1028.                    For Thread.Search=Message.Search+1 To Max.Messages
  1029.                       ' compare thread has another ending thread
  1030.                       If ArrayX(Thread.Search)=Message.Search Then
  1031.                          Exit For ' exit thread end loop
  1032.                       Endif ' end compare for end thread
  1033.                    Next ' end end thread search loop
  1034.                    If Thread.Search>Max.Messages Then ' compare end thread
  1035.                       Call Read.Record(TableFile,Message.Search) ' read table
  1036.                       TableRecord.Reply=False ' reset thread reply start
  1037.                       Call Share.Record(TableFile,Message.Search) 'write table
  1038.                    Endif ' end compare end thread
  1039.                 Endif ' end check thread start
  1040.              Endif ' end verify forward message thread
  1041.           Next ' end forward message thread search loop
  1042.           ' search through all forward thread numbers
  1043.           For Message.Search=Message.Number+1 To Max.Messages
  1044.              Thread.Number=ArrayX(Message.Search) ' store thread number
  1045.              If Thread.Number>=Message.Number Then ' verify forward thread
  1046.                 Thread.Number=Thread.Number-1 ' decrement thread number
  1047.                 ArrayX(Message.Search)=Thread.Number ' store thread number
  1048.              Endif ' end verify forward message thread
  1049.           Next ' end forward message thread search loop
  1050.        Endif ' end check deleted message
  1051.     Next ' end message pack loop
  1052.     For Message.Number=1 To Max.Messages ' loop through table file
  1053.        Call Read.Record(TableFile,Message.Number) ' read table record
  1054.        TableRecord.Thread=ArrayX(Message.Number) ' store thread number
  1055.        Call Share.Record(TableFile,Message.Number) ' write table record
  1056.     Next ' end table file read loop
  1057.     ' packing pass 3
  1058.     Close #TempFile ' close temporary file
  1059.     FileName="msgtable.bak" ' get table filename
  1060.     Kill FileName ' remove temporary file
  1061.     ' open temporary backup file
  1062.     Open FileName For Random Shared As #TempFile Len=Len(TableRecord)
  1063.     For Message.Number=1 To Lof(TableFile)/Len(TableRecord) ' loop through table
  1064.        Call Read.Record(TableFile,Message.Number) ' read table record
  1065.        Call Share.Record(TempFile,Message.Number) ' store table record
  1066.     Next ' end message pack loop
  1067.     Close #TempFile ' close temporary file
  1068.     FileName="messages.bak" ' get table filename
  1069.     Kill FileName ' remove temporary file
  1070.     ' open temporary backup file
  1071.     Open FileName For Random Shared As #TempFile Len=Len(MessageRecord)
  1072.     For Message.Number!=1 To Lof(MessageFile)/Len(MessageRecord) ' loop message
  1073.        Call Read.Message.Record(MessageFile,Message.Number!) ' read record
  1074.        Call Share.Message(TempFile,Message.Number!) ' store message record
  1075.     Next ' end message pack loop
  1076.     Close #TableFile,#MessageFile,#TempFile,#TempFile2 ' close temp, mail files
  1077.     FileName="messages.dat" ' get mail filename
  1078.     Kill FileName ' remove mail file
  1079.     FileName="msgtable.dat" ' get mail filename
  1080.     Kill FileName ' remove mail file
  1081.     Open "msgtable.dat" For Random Shared As #TableFile Len=Len(TableRecord)
  1082.     Open "messages.dat" For Random Shared As #MessageFile Len=Len(MessageRecord)
  1083.     Open "msgtable.bak" For Random Shared As #TempFile Len=Len(TableRecord)
  1084.     Open "messages.bak" For Random Shared As #TempFile2 Len=Len(MessageRecord)
  1085.     Table.Number=False ' reset table record number
  1086.     New.Message.Record!=False ' reset message file record counter
  1087.     For Message.Number=1 To Lof(TempFile)/Len(TableRecord) 'loop through table
  1088.        Call Read.Record(TempFile,Message.Number) ' read table record
  1089.        If TableRecord.Killed=False Then ' check for deleted message
  1090.           Message.Start!=TableRecord.Start ' store beginning
  1091.           Message.End!=Message.Start!+Csng(TableRecord.Length-1) ' store end
  1092.           Table.Number=Table.Number+1 ' increment next table record
  1093.           TableRecord.Start=New.Message.Record!+1 ' store message beginning
  1094.           Call Share.Record(TableFile,Table.Number) ' write new table file record
  1095.           For Message.Record!=Message.Start! To Message.End! ' message loop
  1096.              Call Read.Message.Record(TempFile2,Message.Record!) 'read message
  1097.              New.Message.Record!=New.Message.Record!+1! ' store next message
  1098.              Call Share.Message(MessageFile,New.Message.Record!) ' write message
  1099.           Next ' end loop through message text array
  1100.        Endif ' end check deleted message
  1101.     Next ' end table file loop
  1102.     Close #TempFile,#TempFile2 ' close temporary files
  1103.  Endif ' end check response
  1104. End Sub ' end routine to pack messages
  1105.  
  1106.  Rem * routine to store message.
  1107.  
  1108. Sub Store.Message
  1109.  On Local Error Resume Next ' local error resume
  1110.  Call Read.Record(UserFile,User.Index) ' read user file
  1111.  Outpt=UserRecord.CodeName ' store codename
  1112.  Call Decrypt(Outpt) ' decrypt codename
  1113.  Inpt=Rtrim$(Outpt) ' store codename
  1114.  Inpt=Ucase$(Inpt) ' uppercase ccodename
  1115.  Outpts=Message.To ' store message header
  1116.  Outpts=Rtrim$(Outpts) ' trim header
  1117.  Outpts=Ucase$(Outpts) ' uppercase header
  1118.  If Inpt=Outpts Then ' compare codenames
  1119.     Message.To=Nul ' reset message header
  1120.  Endif ' end compare codenames
  1121.  TableRecord.ClassType=UserRecord.ClassType ' store user class type
  1122.  TableRecord.Clock=FNclock$ ' store message creation time
  1123.  TableRecord.Date=Date$ ' store system date
  1124.  TableRecord.Flags=UserRecord.Flags ' store user flags
  1125.  TableRecord.From=Outpt ' store user codename
  1126.  TableRecord.Killed=False ' reset deleted message flag
  1127.  TableRecord.Length=Message.Length ' store length of message
  1128.  TableRecord.Private=Private.Message ' store private message flag
  1129.  TableRecord.Received=False ' store flag for message received
  1130.  TableRecord.Reply=Message.Reply ' store message reply flag
  1131.  Message.Record.Number!=Csng(Lof(MessageFile)/Len(MessageRecord))
  1132.  TableRecord.Start=Message.Record.Number!+1! ' store message beginning
  1133.  TableRecord.Subject=Subject ' store message subject
  1134.  TableRecord.Time=Time$ ' store system time
  1135.  TableRecord.Timer=Timer ' store system time in seconds
  1136.  TableRecord.TimesRead=False ' reset number of times message read
  1137.  TableRecord.To=Message.To ' store message to
  1138.  If Message.Reply Then ' check message type
  1139.     TableRecord.Thread=Message.Thread ' store message thread number
  1140.  Else ' check message
  1141.     TableRecord.Thread=False ' store thread number
  1142.  Endif ' end check message
  1143.  Table.Record.Number=Lof(TableFile)/Len(TableRecord)+1 'store next table record
  1144.  Call Share.Record(TableFile,Table.Record.Number) ' routine to write table record
  1145.  For Message.Number=1 To Message.Length ' loop through message text array
  1146.     Outpt=Array(Message.Number) ' store message text line
  1147.     Call Valid(Outpt,80) ' routine to validate text
  1148.     Call Encrypt(Outpt,True) ' encrypt text
  1149.     MessageRecord.Message=Outpt ' store text line
  1150.     Message.Record.Number!=Message.Record.Number!+1! ' store next message
  1151.     Call Share.Message(MessageFile,Message.Record.Number!) ' write message text
  1152.  Next ' end loop through message text array
  1153.  Outpt="Message stored." ' make message
  1154.  Call IO.O ' send message
  1155. End Sub ' end routine to store message
  1156.  
  1157.  Rem * routine to check for new messages.
  1158.  
  1159. Sub Check.Mail
  1160.  On Local Error Resume Next ' local error resume
  1161.  New.Message=False ' reset number of new messages
  1162.  Outpt=UserRecord.CodeName ' store codename
  1163.  Call Decrypt(Outpt) ' decrypt codename
  1164.  Outpt=Rtrim$(Outpt) ' trim codename
  1165.  Outpt=Lcase$(Outpt) ' lowercase codename
  1166.  Last.Message=UserRecord.LastMessage ' store last message number read
  1167.  Table.Number=Lof(TableFile)/Len(TableRecord) ' store length of message table
  1168.  ' compare range of messages
  1169.  If Last.Message>False And Last.Message<=Table.Number Then
  1170.     For Table.Index=Last.Message To Table.Number ' loop through new messages
  1171.        Call Read.Record(TableFile,Table.Index) ' read table record
  1172.        If TableRecord.Killed=False Then ' check deleted message
  1173.           Inpt=TableRecord.To ' store message to
  1174.           Inpt=Rtrim$(Inpt) ' trim message to
  1175.           Inpt=Lcase$(Inpt) ' lowercase message to
  1176.           If Inpt<>Nul Then ' check public message to
  1177.              If Inpt=Outpt Then ' compare codenames
  1178.                 New.Message=New.Message+1 ' increment number of new message
  1179.              Endif ' end compare codenames
  1180.           Endif ' end check public message
  1181.        Endif ' end check deleted message
  1182.     Next ' end loop through new messages
  1183.  Endif ' end compare new message range
  1184.  Graphics.Off=False ' reset color
  1185.  If New.Message>False Then ' check new messages
  1186.     Outpt="You have"+Str$(New.Message)+" new messages." ' make message
  1187.  Else ' check new message variable
  1188.     Outpt="You have no new messages." ' make output message
  1189.  Endif ' end check new message variable
  1190.  Call IO.O ' send message
  1191.  Graphics.Off=False ' reset color
  1192. End Sub ' end routine to check for new mail
  1193.  
  1194.  Rem * routine to replace line of message text.
  1195.  
  1196. Sub Replace.Line
  1197.  On Local Error Resume Next ' local error resume
  1198.  Messages.Max=Message.Length ' store message length
  1199.  Outpt="Line number" ' store input range prompt
  1200.  Call Get.Range2(1,Messages.Max,Message.Number) ' routine to get number
  1201.  Outpt="Replacement line:" ' input prompt
  1202.  Call IO.O ' send prompt
  1203.  Outpt="?" ' input prompt
  1204.  Call IO.I ' get user input
  1205.  Inpt=Rtrim$(Inpt) ' trim input
  1206.  Inpt=Left$(Inpt,79) ' truncate input
  1207.  Array(Message.Number)=Inpt ' store new message line
  1208.  Outpt="Line number"+Str$(Message.Number)+" replaced." ' make display message
  1209.  Call IO.O ' send message
  1210. End Sub ' end routine to replace line of message text
  1211.  
  1212.  Rem * routine to edit a line of message text.
  1213.  
  1214. Sub Edit.Line
  1215.  On Local Error Resume Next ' local error resume
  1216.  Messages.Max=Message.Length ' store length of message
  1217.  Outpt="Line number" ' make input range prompt
  1218.  Call Get.Range2(1,Messages.Max,Message.Number) ' routine to get number
  1219.  Outpt="Replace what word? " ' make input prompt
  1220.  Call IO.I ' get user input
  1221.  If Inpt=Nul Then ' check input length
  1222.     Outpt="No replacements made." ' make display message
  1223.     Call IO.O ' send message
  1224.     Exit Sub ' exit routine
  1225.  Endif ' end check input length
  1226.  Message.Number$=Inpt ' store input
  1227.  Outpt="Replace with what word? " ' make input prompt
  1228.  Call IO.I ' get user input
  1229.  If Inpt=Nul Or Inpt=Message.Number$ Then ' check input length, compare inputs
  1230.     Outpt="No replacements made." ' make display message
  1231.     Call IO.O ' send message
  1232.     Exit Sub ' exit routine
  1233.  Endif ' end check inputs
  1234.  Edit.Replace$=Inpt ' store input
  1235.  Outpt="Replace all occurences? " ' make input prompt
  1236.  No.Input.Out="Y" ' default input
  1237.  Call IO.I ' get user input
  1238.  Replace.Word=1 ' reset string search index
  1239.  Replace.All=Yes ' store input response
  1240.  Replacements=False ' reset replacement flag
  1241.  EditLine$=Rtrim$(Array(Message.Number)) ' store message line to edit
  1242.  ' routine loop replaces Message.Number$ in EditLine$ with Edit.Replace$
  1243.  Do ' loop until replacements finished
  1244.     If EditLine$=Nul Then ' check length of message line
  1245.        Exit Do ' exit loop if line length reduced to null
  1246.     Endif ' end check length of message line
  1247.     ' get position of search string
  1248.     Replace=Instr(Replace.Word,EditLine$,Message.Number$)
  1249.     If Replace=False Then ' check search string exists
  1250.        Exit Do ' exit loop if search string not found
  1251.     Endif ' end check search string exists
  1252.     ' replace search string with replacement string
  1253.     EditLine$=Left$(EditLine$,Replace-1)+Edit.Replace$+ _
  1254.     Mid$(EditLine$,Replace+Len(Message.Number$))
  1255.     EditLine$=Left$(EditLine$,79) ' truncate message line
  1256.     ' recalculate next position index for search
  1257.     Replace.Word=Replace+Len(Edit.Replace$)
  1258.     Replacements=Replacements+1 ' increment number of replacements made
  1259.     If Replacements=1 Then ' check first replacement
  1260.        If Replace.All=False Then ' check flag to replace all searches
  1261.           Exit Do ' exit loop after only one replacement made
  1262.        Endif ' end check replacement flag
  1263.     Endif ' end check replacement number
  1264.  Loop ' end replacement loop
  1265.  Array(Message.Number)=EditLine$ ' store edited message line
  1266.  Select Case Replacements ' selectionn of number of replacements made
  1267.  Case 0 ' no replacements
  1268.     Outpt="No replacements made." ' make display message
  1269.  Case 1 ' one replacement
  1270.     Outpt="One replacement made." ' make display message
  1271.  Case Else ' more than one replacement
  1272.     Outpt=Mid$(Str$(Replacements),2)+" replacements made." ' make message
  1273.  End Select ' end selection of number of replacements
  1274.  Call IO.O ' send display message
  1275. End Sub ' end routine to edit message line
  1276.  
  1277.  Rem * routine to delete range of lines from message text.
  1278.  
  1279. Sub Delete.Line
  1280.  On Local Error Resume Next ' local error resume
  1281.  Outpt="Enter line numbers:" ' make display message
  1282.  Call IO.O ' send message
  1283.  Messages.Max=Message.Length ' store length of message
  1284.  ' routine to get range of numbers
  1285.  Call Get.Range(Messages.Max,Message.Line1,Message.Line2)
  1286.  ' input prompt
  1287.  Outpt="Delete lines"+Str$(Message.Line1)+" to"+Str$(Message.Line2)+"(y/n)? "
  1288.  No.Input.Out="Y" ' default input
  1289.  Call IO.I ' get user input
  1290.  If No Then ' check input response
  1291.     Exit Sub ' exit routine
  1292.  Endif ' end check input response
  1293.  ' loop through the total number of lines to delete
  1294.  For Message.Index=1 To Message.Line2-Message.Line1+1
  1295.     Message.Length=Message.Length-1 ' decrement the length of message
  1296.     ' loop from the first line to delete
  1297.     For Array.Index=Message.Line1 To Message.Length
  1298.        Array(Array.Index)=Array(Array.Index+1) ' packing the remaining message
  1299.     Next ' end loop through deleted lines
  1300.  Next ' end loop through number of lines to delete
  1301.  If Message.Length=False Then ' check length of message
  1302.     Outpt="No message left." ' make error message
  1303.     Call IO.O ' send message
  1304.     Exit Sub ' exit routine
  1305.  Endif ' end check message length
  1306.  Outpt="Line numbers"+Str$(Message.Line1)+" to"+ _
  1307.  Str$(Message.Line2)+" deleted." ' make message
  1308.  Call IO.O ' send message
  1309. End Sub ' end routine to delete range of lines
  1310.  
  1311.  Rem * routine to insert lines into message text.
  1312.  
  1313. Sub Insert.Lines
  1314.  On Local Error Resume Next ' local error resume
  1315.  If Message.Length=64 Then ' check length of message
  1316.     Outpt="Message buffer full." ' make message
  1317.     Call IO.O ' send message
  1318.     Exit Sub ' exit routine
  1319.  Endif ' end check message length
  1320.  Messages.Max=Message.Length ' store message length
  1321.  Outpt="Before line number" ' make input range prompt
  1322.  Call Get.Range2(1,Messages.Max,Message.Line) ' routine to get number
  1323.  Graphics.Off=True ' reset color
  1324.  User.Word.Wrap=UserRecord.Wordwrap ' store user word wrap
  1325.  UserRecord.Wordwrap=False ' reset word wrap
  1326.  Do While Message.Length<64 ' loop while message length range
  1327.     Word.Wrap=True ' set word wrap flag
  1328.     Outpt="?" ' make input prompt
  1329.     Call IO.I ' get user input
  1330.     Word.Wrap=False ' reset word wrap flag
  1331.     If No.Input Then ' check length of input flag
  1332.        Exit Do ' exit message netry loop
  1333.     Endif ' end check input length
  1334.     ' loop backwards through message
  1335.     For Array.Index=Message.Length To Message.Line Step -1
  1336.        ' pack lines before inserted line
  1337.        Array(Array.Index+1)=Array(Array.Index)
  1338.     Next ' end backward loop
  1339.     Inpt=Rtrim$(Inpt) ' trim input
  1340.     Inpt=Left$(Inpt,79) ' truncate input
  1341.     Array(Message.Line)=Inpt ' store new inserted message line
  1342.     Message.Line=Message.Line+1 ' increment line number to insert before
  1343.     Message.Length=Message.Length+1 ' increment length of message
  1344.  Loop ' end message insert loop
  1345.  UserRecord.Wordwrap=User.Word.Wrap ' restore word wrap
  1346.  Graphics.Off=False ' reset color
  1347.  If Message.Length=64 Then ' compare length of message
  1348.     Outpt="Message buffer full." ' make buffer message
  1349.     Call IO.O ' send message
  1350.  Endif ' end check length of message
  1351. End Sub ' end insert routine
  1352.  
  1353.  Rem * routine to list range of message text lines.
  1354.  
  1355. Sub List.Lines
  1356.  On Local Error Resume Next ' local error resume
  1357.  Outpt="Enter line numbers:" ' make display message
  1358.  Messages.Max=Message.Length ' store length of message
  1359.  ' routine to get range of numbers
  1360.  Call Get.Range(Messages.Max,Message.Line1,Message.Line2)
  1361.  Outpt="Display line numbers(y/n)? " ' make input prompt
  1362.  No.Input.Out="Y" ' default input
  1363.  Call IO.I ' get user input
  1364.  ListLines=Yes ' store response
  1365.  Allow.Break=True ' turn on allow break flag
  1366.  Break=False ' reset control-k flag
  1367.  Continue=False ' reset continuous flag
  1368.  Page.Length=False ' reset page counter
  1369.  Graphics.Off=True ' reset color
  1370.  ' loop through range of message lines
  1371.  User.Line.Length=UserRecord.Linelength ' store user line length
  1372.  UserRecord.Linelength=False ' store line length
  1373.  For Message.Line=Message.Line1 To Message.Line2
  1374.     If ListLines Then ' check line number list flag
  1375.        Outpt=Mid$(Str$(Message.Line),2)+":" ' make line number
  1376.     Else ' check line number flag
  1377.        Outpt=Nul ' reset line number string
  1378.     Endif ' end check line number flag
  1379.     Outpt=Outpt+Array(Message.Line) ' make line display
  1380.     Outpt=Left$(Outpt,79) ' truncate line
  1381.     Call IO.O ' send line display
  1382.     If Break Then ' check control-k pressed
  1383.        Exit For ' exit text input loop
  1384.     Endif ' end check control-k
  1385.     Page.Length=Page.Length+1 ' increment page counter
  1386.     If Page.Length=UserRecord.Pagelength Then ' check page counter
  1387.        Page.Length=False ' reset page counter
  1388.        If Continue=False Then ' check continuous flag
  1389.           Call More.Prompt ' routine to pause
  1390.           If No Then ' check pause response
  1391.              Exit For ' exit routine
  1392.           Endif ' end check response
  1393.        ENdif ' end check continuous flag
  1394.     Endif ' end check page counter
  1395.  Next ' end loop through range of lines
  1396.  UserRecord.Linelength=User.Line.Length ' restore line length
  1397.  Allow.Break=False ' reset allow break flag
  1398.  If Break Then ' check control-k flag
  1399.     Break=False ' reset control-k flag
  1400.     Outpt=Nul ' set output to null
  1401.     Call IO.O ' send empty return
  1402.  Endif ' end check control-k flag
  1403.  If Page.Length Then ' recheck page counter
  1404.     Call More.Prompt ' pause routine
  1405.  Endif ' end recheck counter
  1406. End Sub ' end list lines routine
  1407.  
  1408.  Rem * routine to edit rooms.
  1409.  
  1410. Sub Edit.Room
  1411.  On Local Error Resume Next ' local error resume
  1412.  Call Share.Room.Record(Room) ' store current room
  1413.  Do ' loop through room edit menu
  1414.     Graphics.Off=False ' reset color
  1415.     Outpt="Room edit:" ' make output display
  1416.     Call IO.O ' send output
  1417.     Graphics.Off=True ' reset color
  1418.     Outpt="[A]dd" ' make output display
  1419.     Call IO.O ' send output
  1420.     Outpt="[C]hange" ' make output display
  1421.     Call IO.O ' send output
  1422.     Outpt="[L]ist" ' make output display
  1423.     Call IO.O ' send output
  1424.     Graphics.Off=False ' reset color
  1425.     Outpt="Enter room edit option(q to quit)? " ' make input prompt
  1426.     No.Input.Out="Q" ' default input
  1427.     Call IO.I
  1428.     Select Case Ucase$(Inpt) ' selection of input
  1429.     Case "A" ' option to add new room
  1430.        Next.Room=Lof(RoomFile)/Len(RoomRecord)+1 ' store next room record
  1431.        Call Add.Room(False,Room.Added) ' routine to add room
  1432.     Case "C" ' option to select another room number to edit
  1433.        Outpt="Enter room number" ' prompt
  1434.        Max.Rooms!=Lof(RoomFile)/Len(RoomRecord) ' store length of room records
  1435.        ' routine to get number from range
  1436.        Call Get.Room.Range2(1!,Max.Rooms!,Room.Number!)
  1437.        Call Change.Room(Room.Number!) ' routine to edit room descriptions
  1438.     Case "L" ' display room description
  1439.        Max.Rooms!=Lof(RoomFile)/Len(RoomRecord) ' store length of room record
  1440.        ' routine to get range to display
  1441.        Call Get.Room.Range(Max.Rooms!,Start.Room!,End.Room!)
  1442.        ' loop through range of room numbers
  1443.        Allow.Break=True ' set allow break flag
  1444.        Break=False ' reset control-k flag
  1445.        Continue=False ' set continuous flag
  1446.        For Room.Number!=Start.Room! To End.Room!
  1447.           Call Read.Room.Record(Room.Number!) ' get room record
  1448.           Call Display.Room.Desc(Room.Number!) ' routine to display room
  1449.           If Break Then ' check break flag
  1450.              Exit For ' exit display loop
  1451.           Endif
  1452.           Graphics.Off=False ' reset color
  1453.           If Continue=False Then ' check continuous flag
  1454.              Call More.Prompt ' pause prompt
  1455.              If No Then ' compare continue
  1456.                 Exit For ' exit loop through rooms
  1457.              Endif ' end compare
  1458.           Endif ' end check continuous flag
  1459.        Next ' end loop through rooms
  1460.        Allow.Break=False ' reset allow break flag
  1461.        If Break Then ' check control-k flag
  1462.           Break=False ' reset control-k flag
  1463.           Outpt=Nul ' set output to null
  1464.           Call IO.O ' send empty return
  1465.        Endif ' end check control-k flag
  1466.     Case "Q" ' option to exit menu
  1467.        Call Read.Room.Record(Room) ' get current room
  1468.        Exit Do ' exit edit menu
  1469.     End Select ' end input selection
  1470.  Loop ' end room edit menu
  1471. End Sub ' end room edit routine
  1472.  
  1473.  Rem * routine to read !edit help.
  1474.  
  1475. Sub Edit.Help
  1476.  On Local Error Resume Next ' local error resume
  1477.  Do ' help menu loop
  1478.     Graphics.Off=False ' reset color
  1479.     Outpt="Edit help:" ' make output message
  1480.     Call IO.O ' send output message
  1481.     Graphics.Off=True ' reset color
  1482.     Outpt="[C]ontents" ' make output message
  1483.     Call IO.O ' send output message
  1484.     Outpt="[T]opic" ' make output message
  1485.     Call IO.O ' send output message
  1486.     Graphics.Off=False ' reset color
  1487.     No.Input.Out="Q" ' default input
  1488.     Outpt="Enter help option(q to quit)? " ' make input prompt
  1489.     Call IO.I ' get user input
  1490.     Select Case Ucase$(Inpt) ' selection of input
  1491.     Case "C" ' display !edit help contents
  1492.        Stored.Parsed.Command1="contents" ' store help topic
  1493.        Call Read.Help(1) ' routine to read !edit help
  1494.     Case "T" ' select help topic number
  1495.        Outpt="Enter help topic number sequence? " ' make input prompt
  1496.        Call IO.I ' get user input
  1497.        Stored.Parsed.Command1=Inpt ' store help topic
  1498.        Call Read.Help(1) ' routine to read !edit help
  1499.     Case "Q" ' exit menu loop
  1500.        Exit Do ' exit loop
  1501.     End Select ' end input selection
  1502.  Loop ' end menu loop
  1503. End Sub ' end routine to read !edit help
  1504.  
  1505.  Rem * routine to edit room description and monster class.
  1506.  Rem * input variables:
  1507.  Rem *   Room.Number! - room number to edit.
  1508.  
  1509. Sub Change.Room(Room.Number!)
  1510.  On Local Error Resume Next ' local error resume
  1511.  Call Read.Room.Record(Room.Number!) ' get room record to edit
  1512.  Do ' loop while edit
  1513.     Call Display.Room.Desc(Room.Number!) ' routine to display room
  1514.     Graphics.Off=False ' reset color
  1515.     Outpt="Room edit options:" ' make display output
  1516.     Call IO.O ' send output
  1517.     Graphics.Off=True ' reset color
  1518.     Outpt="[A]ction" ' make display message
  1519.     Call IO.O ' send message
  1520.     Outpt="[D]escription" ' make display message
  1521.     Call IO.O ' send message
  1522.     Outpt="[M]onster class" ' make display message
  1523.     Call IO.O ' send message
  1524.     Outpt="[O]bjects" ' make display message
  1525.     Call IO.O ' send message
  1526.     Outpt="[T]reasure" ' make display message
  1527.     Call IO.O ' send message
  1528.     Graphics.Off=False ' reset color
  1529.     Outpt="Room edit option(q to quit)? " ' make input prompt
  1530.     No.Input.Out="Q" ' default input
  1531.     Call IO.I ' get user input
  1532.     Select Case Ucase$(Inpt) ' selection of room edit option
  1533.     Case "A" ' option to change room action number
  1534.        Outpt="Enter action number" ' prompt
  1535.        Max.Action=Lof(ActionFile)/Len(ActionRecord) ' store length of room
  1536.        ' routine to get number from range
  1537.        Call Get.Range2(0,Max.Action,Action.Number)
  1538.        RoomRecord.Action=Action.Number ' store action number
  1539.     Case "D" ' option to edit room descriptions
  1540.        Do ' loop through room description edit menu
  1541.           Graphics.Off=True ' reset color
  1542.           Outpt="[L]ong description" ' make option message
  1543.           Call IO.O ' send option message
  1544.           Outpt="[S]hort description" ' make option message
  1545.           Call IO.O ' send option message
  1546.           Graphics.Off=False ' reset color
  1547.           Outpt="Enter room edit option(q to quit)? " ' make option prompt
  1548.           No.Input.Out="Q" ' store default input
  1549.           Call IO.I ' get option input
  1550.           Select Case Ucase$(Inpt) ' make selection of input option
  1551.           Case "L" ' edit long description
  1552.              Graphics.Off=False ' reset color
  1553.              Outpt="Edit room long description(y/n)? " ' input prompt
  1554.              No.Input.Out="N" ' default input
  1555.              Call IO.I ' get input
  1556.              If Yes Then ' compare input
  1557.                 Graphics.Off=False ' reset color
  1558.                 Outpt="Enter four lines for long description:" ' make message
  1559.                 Call IO.O ' send edit message
  1560.                 Outpt="Press <enter> when done." ' make edit message
  1561.                 Call IO.O ' send edit message
  1562.                 Graphics.Off=True ' reset color
  1563.                 For Room.Desc=1 To 4 ' loop through room long description
  1564.                    ' clear room long description
  1565.                    RoomRecord.LongDesc(Room.Desc)=Nul
  1566.                 Next ' end loop through room
  1567.                 User.Word.Wrap=UserRecord.Wordwrap ' store user word wrap
  1568.                 UserRecord.Wordwrap=False ' reset word wrap
  1569.                 Word.Wrap=True ' enable word wrap
  1570.                 For Room.Desc=1 To 4 ' loop through input for long description
  1571.                    Outpt="?" ' make input prompt
  1572.                    If Room.Desc=4 Then ' check last long description line
  1573.                       Word.Wrap=False ' disable word wrap
  1574.                    Endif ' end check last input
  1575.                    Call IO.I ' get input
  1576.                    If No.Input Then ' check empty cr/lf entered
  1577.                       Exit For ' exit description edit loop
  1578.                    Endif ' end check empty input
  1579.                    ' store long description
  1580.                    RoomRecord.LongDesc(Room.Desc)=Inpt
  1581.                 Next ' end loop through input
  1582.                 Word.Wrap=False ' disable word wrap
  1583.                 UserRecord.Wordwrap=User.Word.Wrap ' restore word wrap
  1584.              Endif ' end compare input
  1585.           Case "S" ' edit short description
  1586.              Graphics.Off=False ' reset color
  1587.              Outpt="Edit room short decription(y/n)? " ' input prompt
  1588.              No.Input.Out="N" ' default input
  1589.              Call IO.I ' get input
  1590.              If Yes Then ' compare input
  1591.                 Graphics.Off=False ' reset color
  1592.                 Outpt="Enter short description(78 characters):" ' make message
  1593.                 Call IO.O ' send message
  1594.                 Outpt="Press <enter> to leave unchanged." ' make message
  1595.                 Call IO.O ' send message
  1596.                 Graphics.Off=True ' reset color
  1597.                 Line.Length=78 ' set length of input
  1598.                 Outpt="?" ' set input prompt
  1599.                 Call IO.I ' get input
  1600.                 If No.Input=False Then ' check length of input
  1601.                    RoomRecord.ShortDesc=Inpt ' store room short description
  1602.                 Endif ' end check input length
  1603.              Endif ' end compare input
  1604.           Case "Q" ' quit
  1605.              Exit Do ' exit prompt loop
  1606.           End Select ' end selection of input
  1607.        Loop ' end loop through selection input
  1608.     Case "M" ' edit monster class
  1609.        Outpt="Enter monster class" ' make input prompt
  1610.        Call Get.Range2(0,Monclass.Max,Monclass.Number) ' get number from range
  1611.        RoomRecord.MonsterClass=Monclass.Number ' store new monster class
  1612.        Outpt="Monster class"+Str$(Monclass.Number)+" added to room"+ _
  1613.        Str$(Room.Number!)+"."
  1614.        Call IO.O ' send display message
  1615.     Case "O" ' option to edit room objects
  1616.        Do ' loop through room object editing
  1617.           Graphics.Off=True ' reset color
  1618.           For Array.Index=1 To 20 ' loop through room objects
  1619.              Object.Number=RoomRecord.Object(Array.Index) ' store object index
  1620.              If Object.Number>False And _
  1621.              Object.Number<=Lof(ObjectFile)/Len(ObjectRecord) Then ' bounds
  1622.                 Call Read.Record(ObjectFile,Object.Number) ' read object record
  1623.                 Outpt="["+Mid$(Str$(Array.Index),2)+"]"+ _
  1624.                 Rtrim$(ObjectRecord.ObjectName) ' make object name display
  1625.                 Call IO.O ' send object message
  1626.              Endif ' end check object file bounds
  1627.           Next ' end loop through room objects
  1628.           Graphics.Off=False ' reset color
  1629.           Outpt="Room object options:" ' make display message
  1630.           Call IO.O ' send message
  1631.           Graphics.Off=True ' reset color
  1632.           Outpt="[A]dd" ' make display message
  1633.           Call IO.O ' send message
  1634.           Outpt="[D]elete" ' make display message
  1635.           Call IO.O ' send message
  1636.           Graphics.Off=False ' reset color
  1637.           Outpt="Room object edit option(q to quit)? " ' make input prompt
  1638.           No.Input.Out="Q" ' default input
  1639.           Call IO.I ' get user input
  1640.           Select Case Ucase$(Inpt) ' selection of room object edit option
  1641.           Case "A" ' option to add room object
  1642.              Object.Added=False ' object added flag
  1643.              Call Find.Objects(Item.Found) ' routine to get object number
  1644.              If Item.Found>False Then ' check object number
  1645.                 Swap Room,Room.Number! ' store room number
  1646.                 Call Add.Room.Object(Index.Number,Charges.Number,Object.Added)
  1647.                 Swap Room,Room.Number! ' store room number
  1648.              Endif ' end check object number
  1649.              If Object.Added Then ' check object added flag
  1650.                 Outpt="Object added to room." ' make message
  1651.              Else ' check object added flag
  1652.                 Outpt="Object not added to room." ' make message
  1653.              Endif ' end check object added flag
  1654.              Call IO.O ' send message
  1655.           Case "D" ' option to delete room object
  1656.              Outpt="Object number to delete" ' make range prompt
  1657.              Call Get.Range2(1,10,Object.Number) ' get number from range
  1658.              Swap Room,Room.Number! ' store room number
  1659.              Call Discard.Room.Object(Object.Number) ' discard object
  1660.              Swap Room,Room.Number! ' store room number
  1661.              Outpt="Object deleted from room." ' make message
  1662.              Call IO.O ' send message
  1663.           Case "Q" ' option to exit room object edit menu
  1664.              Exit Do ' exit room object edit menu
  1665.           End Select ' end select room object edit options
  1666.        Loop ' end loop through room object option menu
  1667.     Case "T" ' option to edit room treasure
  1668.        Do ' loop through room treasure edit menu
  1669.           Graphics.Off=True ' reset color
  1670.           For Array.Index=1 To 20 ' loop through room treasure
  1671.              ' store room treasure number
  1672.              Treasure.Number=RoomRecord.Treasure(Array.Index)
  1673.              If Treasure.Number>False And _
  1674.              Treasure.Number<=Lof(TreasureFile)/Len(TreasureRecord) Then
  1675.                 Call Read.Record(TreasureFile,Treasure.Number) ' read treasure
  1676.                 Outpt="["+Mid$(Str$(Array.Index),2)+"]"+ _
  1677.                 Rtrim$(TreasureRecord.TreasureName) ' make treasure name
  1678.                 Call IO.O ' send treasure name message
  1679.              Endif ' end check file bounds
  1680.           Next ' end loop through room treasure
  1681.           Graphics.Off=False ' reset color
  1682.           Outpt="Room treasure options:" ' make display message
  1683.           Call IO.O ' send message
  1684.           Graphics.Off=True ' reset color
  1685.           Outpt="[A]dd" ' make display message
  1686.           Call IO.O ' send message
  1687.           Outpt="[D]elete" ' make display message
  1688.           Call IO.O ' send message
  1689.           Graphics.Off=False ' reset color
  1690.           Outpt="Room treasure edit option(q to quit)? " ' make input prompt
  1691.           No.Input.Out="Q" ' default input
  1692.           Call IO.I ' get user input
  1693.           Select Case Ucase$(Inpt) ' selection of room treasure option
  1694.           Case "A" ' option to add room treasure
  1695.              Treasure.Added=False ' set treasure added flag
  1696.              ' routine to get treasure number
  1697.              Call Find.Treasure(Treasure.Found)
  1698.              If Treasure.Found>False Then ' check treasure number
  1699.                 Swap Room,Room.Number! ' store room number
  1700.                 Call Add.Room.Treasure(Index.Number,Charges.Number, _
  1701.                 False,Treasure.Added)
  1702.                 Swap Room,Room.Number! ' store room number
  1703.              Endif ' end check treasure number
  1704.              If Treasure.Added Then ' check treasure added flag
  1705.                 Outpt="Treasure added to room." ' make message
  1706.              Else ' check flag
  1707.                 Outpt="Treasure not added to room." ' make message
  1708.              Endif ' end check treasure added flag
  1709.              Call IO.O ' send message
  1710.           Case "D" ' option to delete treasure number
  1711.              Outpt="Treasure number to delete" ' make range prompt
  1712.              Call Get.Range2(1,10,Treasure.Number) ' get number from range
  1713.              Swap Room,Room.Number! ' store room number
  1714.              Call Discard.Room.Treasure(Treasure.Number) ' discard treasure
  1715.              Swap Room,Room.Number! ' store room number
  1716.              Outpt="Treasure deleted from room." ' make message
  1717.              Call IO.O ' send message
  1718.           Case "Q" ' option to exit room treasure edit menu
  1719.              Exit Do ' exit room treasure edit menu
  1720.           End Select ' end selection of room treasure menu
  1721.        Loop ' end loop through room treasure edit option menu
  1722.     Case "Q" ' option to exit room edit menu
  1723.        Call Share.Room.Record(Room.Number!) ' write current room number
  1724.        Exit Do ' exit room edit menu
  1725.     End Select ' end selection of room edit menu
  1726.  Loop ' end loop through room edit option menu
  1727. End Sub ' end routine to edit room number
  1728.  
  1729.  Rem * routine to edit message text.
  1730.  Rem * output variables:
  1731.  Rem *   Message.Edit - true to continue, false to abort, 1 to store message.
  1732.  
  1733. Sub Edit.Message(Message.Edit)
  1734.  On Local Error Resume Next ' local error resume
  1735.  Do ' loop through message edit menu
  1736.     Graphics.Off=False ' reset color
  1737.     Outpt="Editing options:" ' make dislay message
  1738.     Call IO.O ' send message
  1739.     Graphics.Off=True ' reset color
  1740.     Outpt="[A]bort" ' make dislay message
  1741.     Call IO.O ' send message
  1742.     Outpt="[C]ontinue" ' make dislay message
  1743.     Call IO.O ' send message
  1744.     If Message.Length>False Then ' check length of message
  1745.        Outpt="[D]elete" ' make dislay message
  1746.        Call IO.O ' send message
  1747.     Endif ' end check length
  1748.     If Message.Length>False Then ' check length of message
  1749.        Outpt="[E]dit" ' make dislay message
  1750.        Call IO.O ' send message
  1751.     Endif ' end check length
  1752.     If Message.Length>False Then ' check length of message
  1753.        Outpt="[I]nsert" ' make dislay message
  1754.        Call IO.O ' send message
  1755.     Endif ' end check length
  1756.     If Message.Length>False Then ' check length of message
  1757.        Outpt="[L]ist" ' make dislay message
  1758.        Call IO.O ' send message
  1759.     Endif ' end check length
  1760.     If Message.Length>False Then ' check length of message
  1761.        Outpt="[R]eplace" ' make dislay message
  1762.        Call IO.O ' send message
  1763.     Endif ' end check length
  1764.     If Message.Length>False Then ' check length of message
  1765.        Outpt="[S]tore" ' make dislay message
  1766.        Call IO.O ' send message
  1767.     Endif ' end check length
  1768.     Graphics.Off=False ' reset color
  1769.     Outpt="Edit command? " ' make input prompt
  1770.     Call IO.I ' get user input
  1771.     Select Case Ucase$(Inpt) ' selection of edit option
  1772.     Case "C" ' option to continue message
  1773.        Message.Edit=True ' set return variable
  1774.        Exit Sub ' exit routine
  1775.     Case "R" ' option to replace line
  1776.        If Message.Length>False Then ' check length of message
  1777.           Call Replace.Line ' replace routine
  1778.        Endif ' end check length
  1779.     Case "E" ' option to edit line
  1780.        If Message.Length>False Then ' check length of message
  1781.           Call Edit.Line ' line edit routine
  1782.        Endif ' end check length
  1783.     Case "D" ' option to delete line
  1784.        If Message.Length>False Then ' check length of message
  1785.           Call Delete.Line ' delete routine
  1786.        Endif ' end check length
  1787.     Case "I" ' option to insert lines
  1788.        If Message.Length>False Then ' check length of message
  1789.           Call Insert.Lines ' insert routine
  1790.        Endif ' end check length
  1791.     Case "A" ' option to abort message
  1792.        Outpt="Are you sure you want to abort(y/n)? " ' make input prompt
  1793.        No.Input.Out="N" ' default input
  1794.        Call IO.I ' get user input
  1795.        If Yes Then ' check input response
  1796.           Message.Edit=False ' set return variable
  1797.           Exit Sub ' exit routine
  1798.        Endif ' end check response
  1799.     Case "L" ' option to list lines
  1800.        If Message.Length>False Then ' check length of message
  1801.           Call List.Lines ' line list routine
  1802.        Endif ' end check length
  1803.     Case "S" ' option to store message
  1804.        If Message.Length>False Then ' check length of message
  1805.           Message.Edit=UnTrue ' set return variable
  1806.           Exit Sub ' exit routine
  1807.        Endif ' end check length
  1808.     End Select ' end selection of input
  1809.  Loop ' end loop through edit menu
  1810. End Sub ' end edit menu routine
  1811.  
  1812.  Rem * routine to edit messages files.
  1813.  
  1814. Sub Edit.Mail
  1815.  On Local Error Resume Next ' local error resume
  1816.  Do ' loop through mail edit menu
  1817.     Graphics.Off=False ' reset color
  1818.     Outpt="Mail edit:" ' make display message
  1819.     Call IO.O ' send message
  1820.     Graphics.Off=True ' reset color
  1821.     Outpt="[C]hange" ' make display message
  1822.     Call IO.O ' send message
  1823.     Outpt="[D]elete" ' make display message
  1824.     Call IO.O ' send message
  1825.     Outpt="[L]ist" ' make display message
  1826.     Call IO.O ' send message
  1827.     Outpt="[P]ack" ' make display message
  1828.     Call IO.O ' send message
  1829.     Outpt="[U]ndelete" ' make display message
  1830.     Call IO.O ' send message
  1831.     Graphics.Off=False ' reset color
  1832.     Outpt="Message edit option(q to quit)? " ' make input prompt
  1833.     No.Input.Out="Q" ' default input
  1834.     Call IO.I ' get user input
  1835.     Select Case Ucase$(Inpt) ' select option
  1836.     Case "C" ' change option
  1837.        Call Change.Message ' routine to change message
  1838.     Case "D" ' delete option
  1839.        Call Delete.Message ' routine to delete message
  1840.     Case "L" ' list option
  1841.        Call List.Messages ' routine to list messages
  1842.     Case "P" ' pack option
  1843.        Call Pack.Messages ' routine to pack messages
  1844.     Case "U" ' undelete option
  1845.        Call Undelete.Message ' routine to undelete message
  1846.     Case "Q" ' exit mail edit menu option
  1847.        Exit Do ' exit edit mail menu
  1848.     End Select ' end mail edit option selection
  1849.  Loop ' end mail edit menu loop
  1850. End Sub ' end mail edit menu routine
  1851.  
  1852.  Rem * routine to parse out number after pound sign in a string
  1853.  Rem * input variables:
  1854.  Rem *   Parsed.Input$ - string to check.
  1855.  Rem * output variables:
  1856.  Rem *   Parsed.Input$ - string truncated before pound sign, lowercased.
  1857.  Rem *   Parsed.Value - number parsed after pound sign.
  1858.  Rem * work variables:
  1859.  Rem *   Parsed.Token - contains position of # sign.
  1860.  
  1861. Sub Parse.Num(Parsed.Input$,Parsed.Value)
  1862.  On Local Error Resume Next ' local error resume
  1863.  Parsed.Input$=Lcase$(Parsed.Input$) ' lowercase string
  1864.  Parsed.Value=False ' set return variable
  1865.  Parsed.Token=Instr(Parsed.Input$,"#") ' search string for pound sign
  1866.  If Parsed.Token>False Then ' check string search
  1867.     ' set return variable
  1868.     Parsed.Value=Int(Val(Mid$(Parsed.Input$,Parsed.Token+1)))
  1869.     Parsed.Input$=Left$(Parsed.Input$,Parsed.Token-1) ' truncate string
  1870.  Endif ' end check string
  1871. End Sub ' end routine
  1872.  
  1873.  Rem * routine to search player and room treasure for parameter name
  1874.  Rem * input variables:
  1875.  Rem *   Parsed.Command1 - name of treasure.
  1876.  Rem * output variables:
  1877.  Rem *   Charges.Number - charges of treasure.
  1878.  Rem *   Index.Number - index of treasure to file.
  1879.  Rem *   Type.Number - 0 for treasure in inventory, 1 for treasure in room.
  1880.  
  1881. Sub Examine.Treasure
  1882.  On Local Error Resume Next ' local error resume
  1883.  Type.Number=False ' store treasure flag
  1884.  Call Check.Inventory.Treasure ' routine to search player inventory treasure
  1885.  If Index.Number=False Then ' check player treasure found
  1886.     Call Num ' decrement counters
  1887.     Type.Number=1 ' store treasure flag
  1888.     Call Check.Room.Treasure ' routine to search room inventory treasure
  1889.  Endif ' end check player treasure found
  1890. End Sub ' end routine to search inventory treasure for treasure name
  1891.  
  1892.  Rem * routine to search player and room objects for parameter name
  1893.  Rem * input variables:
  1894.  Rem *   Parsed.Command1 - name of object.
  1895.  Rem * output variables:
  1896.  Rem *   Charges.Number - charges of object.
  1897.  Rem *   Index.Number - index of object to file.
  1898.  Rem *   Type.Number - 0 for object in inventory, 1 for object in room.
  1899.  
  1900. Sub Examine.Objects
  1901.  On Local Error Resume Next ' local error resume
  1902.  Type.Number=False ' store object flag
  1903.  Call Check.Inventory.Objects ' routine to search player inventory objects
  1904.  If Index.Number=False Then ' check player inventory object found
  1905.     Call Num ' decrement counters
  1906.     Type.Number=1 ' store object flag
  1907.     Call Check.Room.Objects ' routine to search room inventory objects
  1908.  Endif ' end check player inventory object found
  1909. End Sub ' end routine to search inventory objects for object name
  1910.  
  1911.  Rem * routine to search player inventory for treasure name
  1912.  Rem * input variables:
  1913.  Rem *   Parsed.Command2 - contains command parameter.
  1914.  Rem * output variables:
  1915.  Rem *   Charges.Number - treasure charges.
  1916.  Rem *   Index.Number - treasure index to file.
  1917.  
  1918. Sub Find.Inventory
  1919.  On Local Error Resume Next ' local error resume
  1920.  Call Parse ' parse command parameter
  1921.  If Parser Then ' check for parsed command
  1922.     Call Numeric ' store # sign counter
  1923.  Endif ' end check parsed command
  1924.  Call Check.Inventory.Treasure ' routine to search player treasure inventory
  1925. End Sub ' end routine to search player treasure inventory
  1926.  
  1927.  Rem * routine to search player inventory for object name
  1928.  Rem * input variables:
  1929.  Rem *   Parsed.Command2 - contains command parameter.
  1930.  Rem * output variables:
  1931.  Rem *   Charges.Number - object charges.
  1932.  Rem *   Index.Number - object index to file.
  1933.  
  1934. Sub Find.Object
  1935.  On Local Error Resume Next ' local error resume
  1936.  Call Parse ' parse command parameter
  1937.  If Parser Then ' check for parsed command
  1938.     Call Numeric ' store # sign counter
  1939.  Endif ' end check parsed command
  1940.  Call Check.Inventory.Objects ' routine to search player object inventory
  1941. End Sub ' end routine to search player object inventory
  1942.  
  1943.  Rem * routine searches for treasure name in room treasure inventory
  1944.  Rem * input variables:
  1945.  Rem *   Parsed.Command1 - name of treasure to search for.
  1946.  Rem *   Parse.Number - number increment of treasure.
  1947.  Rem * output variables:
  1948.  Rem *   Charges.Number - treasure charges.
  1949.  Rem *   Index.Number - treasure file index.
  1950.  Rem *   Outpts - treasure name.
  1951.  Rem * processing variables:
  1952.  Rem *   Parse.Count - counter of treasure found in search.
  1953.  
  1954. Sub Check.Room.Treasure
  1955.  On Local Error Resume Next ' local error resume
  1956.  Charges.Number=False ' reset treasure charges
  1957.  Index.Number=False ' reset treasure index
  1958.  Parse.Count=False ' reset treasure counter
  1959.  If Parsed.Command1<>Nul Then ' compare search string length
  1960.     For Array.Number=1 To 20 ' loop through room inventory
  1961.        If RoomRecord.Treasure(Array.Number) Then ' check room inventory index
  1962.           ' get treasure record
  1963.           Call Read.Record(TreasureFile,RoomRecord.Treasure(Array.Number))
  1964.           Outpts=TreasureRecord.ShortName ' store treasure name
  1965.           ' trim length of treasure name to length of search string
  1966.           Outpts=Left$(Outpts,Len(Parsed.Command1)) ' trim
  1967.           ' compare treasure name to search name
  1968.           If Outpts=Parsed.Command1 Then
  1969.              Parse.Count=Parse.Count+1 ' increment counter
  1970.              ' check increment counter not specified,
  1971.              ' or counter equals increment counter.
  1972.              If Parse.Number=False Or Parse.Count=Parse.Number Then
  1973.                 Outpts=TreasureRecord.TreasureName ' get treasure name
  1974.                 Outpts=Rtrim$(Outpts) ' trim name
  1975.                 ' store treasure index
  1976.                 Index.Number=RoomRecord.Treasure(Array.Number)
  1977.                 ' store treasure charges
  1978.                 Charges.Number=RoomRecord.TreCharges(Array.Number)
  1979.                 Exit For ' exit loop through room treasure inventory
  1980.              Endif ' end check counters equal
  1981.           Endif ' end compare treasure names
  1982.        Endif ' end check room inventory index
  1983.     Next ' end loop through room treasure inventory
  1984.  Endif ' end compare search string length
  1985. End Sub ' end room treasure inventory search
  1986.  
  1987.  Rem * routine searches for object name in room object inventory
  1988.  Rem * input variables:
  1989.  Rem *   Parsed.Command1 - name of object to search for.
  1990.  Rem *   Parse.Number - number increment of object.
  1991.  Rem * output variables:
  1992.  Rem *   Charges.Number - object charges.
  1993.  Rem *   Index.Number - object file index.
  1994.  Rem *   Outpts - object name.
  1995.  Rem * processing variables:
  1996.  Rem *   Parse.Count - counter of object found in search.
  1997.  
  1998. Sub Check.Room.Objects
  1999.  On Local Error Resume Next ' local error resume
  2000.  Charges.Number=False ' reset object charges
  2001.  Index.Number=False ' reset object index
  2002.  Parse.Count=False ' reset object counter
  2003.  If Parsed.Command1<>Nul Then ' check search string length
  2004.     For Array.Number=1 To 20 ' loop through room object inventory
  2005.        If RoomRecord.Object(Array.Number) Then ' check room object index
  2006.           ' get room object record
  2007.           Call Read.Record(ObjectFile,RoomRecord.Object(Array.Number))
  2008.           Outpts=ObjectRecord.ShortName ' store room object name
  2009.           ' trim length of object name to length of search string
  2010.           Outpts=Left$(Outpts,Len(Parsed.Command1)) ' trim
  2011.           ' compare object name to search string
  2012.           If Outpts=Parsed.Command1 Then
  2013.              Parse.Count=Parse.Count+1 ' increment counter
  2014.              ' check increment counter not specified,
  2015.              ' or counter equals increment counter.
  2016.              If Parse.Number=False Or Parse.Count=Parse.Number Then
  2017.                 Outpts=ObjectRecord.ObjectName ' store object name
  2018.                 Outpts=Rtrim$(Outpts) ' trim name
  2019.                 ' store object index
  2020.                 Index.Number=RoomRecord.Object(Array.Number)
  2021.                 ' store object charges
  2022.                 Charges.Number=RoomRecord.ObjCharges(Array.Number)
  2023.                 Exit For ' exit loop through room object inventory
  2024.              Endif ' end check counters
  2025.           Endif ' end compare object names
  2026.        Endif ' end check room object index
  2027.     Next ' end loop through room object inventory
  2028.  Endif ' end check search string length
  2029. End Sub ' end routine to search room object inventory
  2030.  
  2031.  Rem * routine searches for treasure name in player treasure inventory
  2032.  Rem * input variables:
  2033.  Rem *   Parsed.Command1 - name of treasure to search for.
  2034.  Rem *   Parse.Number - number increment of treasure.
  2035.  Rem * output variables:
  2036.  Rem *   Charges.Number - treasure charges.
  2037.  Rem *   Index.Number - treasure file index.
  2038.  Rem *   Outpts - treasure name.
  2039.  Rem * processing variables:
  2040.  Rem *   Parse.Count - counter of treasure found in search.
  2041.  
  2042. Sub Check.Inventory.Treasure
  2043.  On Local Error Resume Next ' local error resume
  2044.  Charges.Number=False ' reset treasure charges
  2045.  Index.Number=False ' reset treasure index
  2046.  Parse.Count=False ' reset treasure counter
  2047.  If Parsed.Command1<>Nul Then ' compare search string length
  2048.     For Array.Number=1 To 20 ' loop through player treasure inventory
  2049.        If UserRecord.Inv(Array.Number) Then ' check player inventory index
  2050.           ' get treasure record
  2051.           Call Read.Record(TreasureFile,UserRecord.Inv(Array.Number))
  2052.           Outpts=TreasureRecord.ShortName ' store treasure name
  2053.           ' trim length of treasure name to length of search string
  2054.           Outpts=Left$(Outpts,Len(Parsed.Command1)) ' trim
  2055.           ' compare treasure name to search string
  2056.           If Outpts=Parsed.Command1 Then
  2057.              Parse.Count=Parse.Count+1 ' increment counter
  2058.              ' check increment counter not specified,
  2059.              ' or counter equals increment counter.
  2060.              If Parse.Number=False Or Parse.Count=Parse.Number Then
  2061.                 Outpts=TreasureRecord.TreasureName ' store treasure name
  2062.                 Outpts=Rtrim$(Outpts) ' trim name
  2063.                 ' store treasure index
  2064.                 Index.Number=UserRecord.Inv(Array.Number)
  2065.                 ' store treasure charges
  2066.                 Charges.Number=UserRecord.Charges(Array.Number)
  2067.                 Exit For ' exit loop through player treasure inventory
  2068.              Endif ' end check counters
  2069.           Endif ' end compare treasure names
  2070.        Endif ' end check player treasure inventory index
  2071.     Next ' end loop through player treasure inventory
  2072.  Endif ' end check search string length
  2073. End Sub ' end routine to search player treasure inventory for treasure name
  2074.  
  2075.  Rem * routine searches for object name in player object inventory
  2076.  Rem * input variables:
  2077.  Rem *   Parsed.Command1 - name of object to search for.
  2078.  Rem *   Parse.Number - number increment of object.
  2079.  Rem * output variables:
  2080.  Rem *   Charges.Number - object charges.
  2081.  Rem *   Index.Number - object file index.
  2082.  Rem *   Outpts - object name.
  2083.  Rem * processing variables:
  2084.  Rem *   Parse.Count - counter of object found in search.
  2085.  
  2086. Sub Check.Inventory.Objects
  2087.  On Local Error Resume Next ' local error resume
  2088.  Charges.Number=False ' reset object charges
  2089.  Index.Number=False ' reset object index
  2090.  Parse.Count=False ' reset counter
  2091.  If Parsed.Command1<>Nul Then ' check search strig length
  2092.     For Array.Number=1 To 5 ' loop through player object inventory
  2093.        If UserRecord.Object(Array.Number) Then ' check player object index
  2094.           ' get object record
  2095.           Call Read.Record(ObjectFile,UserRecord.Object(Array.Number))
  2096.           Outpts=ObjectRecord.ShortName ' store object name
  2097.           ' trim length of object name to length of search string
  2098.           Outpts=Left$(Outpts,Len(Parsed.Command1)) ' trim
  2099.           ' compare object name to search string
  2100.           If Outpts=Parsed.Command1 Then
  2101.              Parse.Count=Parse.Count+1 ' increment counter
  2102.              ' check increment counter not specified,
  2103.              ' or counter equals increment counter.
  2104.              If Parse.Number=False Or Parse.Count=Parse.Number Then
  2105.                 Outpts=ObjectRecord.ObjectName ' store objecct name
  2106.                 Outpts=Rtrim$(Outpts) ' trim name
  2107.                 ' store object index
  2108.                 Index.Number=UserRecord.Object(Array.Number)
  2109.                 ' store object charges
  2110.                 Charges.Number=UserRecord.ObjCharges(Array.Number)
  2111.                 Exit For ' exit loop through player object inventory
  2112.              Endif ' end check counters
  2113.           Endif ' end compare object names
  2114.        Endif ' end check player object index
  2115.     Next ' end loop through player object inventory
  2116.  Endif ' end check search string length
  2117. End Sub ' end routine to search player object inventory
  2118.  
  2119.  Rem * routine to search for monster name in room monsters
  2120.  Rem * input variables:
  2121.  Rem *   Parsed.Command1 - name of monster to search for.
  2122.  Rem * output variables:
  2123.  Rem *   Monster.Number - number of monster array.
  2124.  Rem *   Last.Monster - name of monster found.
  2125.  Rem * work variables:
  2126.  Rem *   Word.Parse1, Word.Parse2.
  2127.  
  2128. Sub Check.Monster
  2129.  On Local Error Resume Next ' local error resume
  2130.  Array.Number=False ' reset monster number loop counter
  2131.  Parse.Count=False ' reset increment counter
  2132.  Monster.Number=False ' reset monster number
  2133.  If Parsed.Command1<>Nul Then ' check search string length
  2134.     For Array.Number=1 To Number.Monsters ' loop through all room monsters
  2135.        Word.Parse1=False ' reset monster name parse variable
  2136.        Word.Parse2=False ' reset monster name parse variable
  2137.        Outpts=MonsterArray(Array.Number).MonsterName ' store monster name
  2138.        Outpts=Rtrim$(Outpts) ' trim name
  2139.        Outpts=Ucase$(Outpts) ' uppercase name
  2140.        ' locate first imbedded space in name
  2141.        Word.Parse1=Instr(Word.Parse1+1,Outpts," ")
  2142.        While Word.Parse1 ' loop until last space in monster name found
  2143.           Word.Parse2=Word.Parse1 ' store position of last space
  2144.           Word.Parse1=Instr(Word.Parse1+1,Outpts," ") ' locate next space
  2145.        Wend ' end loop
  2146.        ' monster name is last word of full name
  2147.        Inpt=Mid$(Outpts,Word.Parse2+1)
  2148.        ' trim length of monster name to length of search string
  2149.        Inpt=Left$(Inpt,Len(Parsed.Command1)) ' trim
  2150.        If Inpt=Parsed.Command1 Then ' compare monster name to search string
  2151.           Parse.Count=Parse.Count+1 ' increment counter
  2152.           ' check increment counter not specified,
  2153.           ' or counter equals increment counter.
  2154.           If Parse.Number=False Or Parse.Count=Parse.Number Then
  2155.              ' store monster name
  2156.              Outpts=MonsterArray(Array.Number).MonsterName
  2157.              Outpts=Rtrim$(Outpts) ' trim name
  2158.              Monster.Number=Array.Number ' store monster number
  2159.              Last.Monster=Parsed.Command1 ' store monster name
  2160.              Exit For ' exit loop through room monsters
  2161.           Endif ' end check counters
  2162.        Endif ' end compare search strings
  2163.     Next ' end loop through room monsters
  2164.  Endif ' end check search string length
  2165. End Sub ' end routine to search room monsters for monster name
  2166.