home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
ftp.wwiv.com
/
ftp.wwiv.com.zip
/
ftp.wwiv.com
/
pub
/
MISC
/
DNDOOR45.ZIP
/
DNDDOOR.BAS
< prev
next >
Wrap
BASIC Source File
|
2000-04-28
|
110KB
|
2,416 lines
Rem * Filename: dnddoor.bas Version: v4.5 r1.0
Rem * This subprogram contains the main input and communication routines.
Rem $Include: 'dnddoor.inc'
' main program. all processing starts here.
On Error Resume Next ' error trapping
Stack 4096 ' increase stack space
Randomize Timer ' reseed random generator
Call Read.Config ' loads all necessary variables, and configuration
Call Login ' logs in local or remote player
Do ' main input loop
Call Encounter.Monster ' search for random monster encounter
Call Health.Update ' increment/decrement player statistics
Call Monster.Attack ' search for active monsters that attack
Call New.Stats ' recalculate player statistics
Call Restricted.Login ' compute restrictive time
Call Rust.Weapon ' get weapon rusting rate
Call Steal.Treasure ' get treasure stealing rate
Call Set.Clock ' reset hanging clock
Call Sorter ' sorts player inventory
If Room.Rate=False Then ' compare room rate reset
Call Status.Line(False) ' redisplay status line with player statistics
Endif
Call Main.Input ' get and process player input
Loop ' end main input loop
End ' prevent drop through of loop into routines
Rem * Configure routine:
Rem * routine to read command line, dimension and load dynamic arrays,
Rem * open files, read door file, and read monster class arrays.
Sub Read.Config
On Local Error Resume Next ' local error resume
Call Get.Command ' read command line
Call Read.Arrays ' load runtime arrays
Call Open.Files ' open work files
Call Read.Door ' read door file
Call Read.Monclass ' load monster class arrays
Call System.Type ' store os type
Call Check.Share ' see if share loaded
End Sub ' end routine to read configure
Rem * routine to process action prompt input. all commands processed
Rem * in this routine call most major routines.
Sub Main.Input
On Local Error Resume Next ' local error resume
Graphics.Off=False ' ansi/color on
Outpt=Action.Prompt ' set prompt (normally Do? is brief, Action? is verbose)
Upper.Case=True ' set uppercase flag
Word.Wrap=True ' set word wrap
Call IO.I ' get player command input
Upper.Case=False ' reset uppercase flag
Word.Wrap=False ' reset word wrap
If Len(Func.Buffer) Then ' process funtion key during remote player on
Function.Key.Number=Asc(Func.Buffer) ' convert function key to variable
Func.Buffer=Nul ' reset function key buffer to null
Call Function.Key(Function.Key.Number) ' process function key
Exit Sub ' exit routine
Endif ' end process function key
Inpt=Ltrim$(Inpt) ' strip leading blanks from command
If Inpt="?" Then ' command is a question mark
Graphics.Off=True ' ansi/color to white
Outpt="Type Hint for for short help, Help for detailed help," ' message
Call IO.O ' send help output
Outpt="Catalog for command list, or Commands for detailed command list."
Call IO.O ' send help output
Graphics.Off=False ' set ansi/color on
Exit Sub ' return to main
Endif ' end question mark command
If Inpt="??" Then ' check for brief help
Err=False ' reset error flag
Redim Array.List(1 To 155) As String*16 ' dimension string array
If Err=14 Then ' check array size
Outpt="Out of memory for array." ' make message
Call IO.O ' send message
Exit Sub ' exit routine
Endif ' end check array size
Restore CommandSet1 ' reset data pointer
Data.Element=False ' reset data read counter
For Data.Number=1 To 170 ' loop to read all user commands
Read Outpt ' read command
Outpt=Lcase$(Outpt) ' lowercase command
Mid$(Outpt,1,1)=Ucase$(Mid$(Outpt,1,1)) ' uppercase start
If Rtrim$(Outpt)<>"<>" Then ' check command name
Data.Element=Data.Element+1 ' increment data read counter
Array.List(Data.Element)=Outpt ' store command
Endif ' end check data read counter
Next ' end command read loop
For Sort1=1 To 154 ' bubble sort loop
For Sort2=Sort1+1 To 154 ' bubble sort inner loop
If Array.List(Sort1)>Array.List(Sort2) Then ' compare values
Swap Array.List(Sort1),Array.List(Sort2) ' swap values
Endif ' end compare values
Next ' end inner sort
Next ' end sort loop
Item.Counter=False ' reset line count
Line.Counter=2 ' reset page count
Outpt=Nul ' reset output line
Previous.Item$=Nul ' reset display item
For Data.Number=1 To 154 ' loop to read all user commands
Data.Item$=Rtrim$(Array.List(Data.Number)) ' store command
If Previous.Item$<>Data.Item$ Then ' compare duplicates
Previous.Item$=Data.Item$ ' store previous item
Outpt=Outpt+Data.Item$+Space$(15-Len(Data.Item$)) ' make output line
Item.Counter=Item.Counter+1
If Item.Counter=5 Then ' count line length
Item.Counter=False ' reset line count
Outpt=Rtrim$(Outpt) ' strip blanks
Graphics.Off=True ' ansi color off
Call IO.O ' send output
Line.Counter=Line.Counter+1 ' increment page count
If Line.Counter>=User.PageLength Then ' compare to page length
Line.Counter=2 ' reset lines counted
Call More.Prompt ' routine for more
If No Then ' check no reply
Exit Sub ' exit routine
Endif ' end check reply
Endif ' end check page count
Endif ' end counter line length
Endif ' end compare duplicates
Next ' end command read loop
Erase Array.List ' clear temporary array
Exit Sub ' exit routine
Endif ' end check help
Sysop.Command=False ' set sysop entered command flag to false
If Left$(Inpt,1)="!" Then ' sysop entered a command (sysop prefix of !)
Sysop.Command=True ' set sysop entered command flag to true
If Normal.User Then ' verify player has no special character
Sysop.Command=False ' reset sysop command flag
Outpt="That command is reserved for DMs only!" ' format message
Call IO.O ' send output
Exit Sub ' return to main
Endif ' end verify normal player
If Len(Inpt)<=1 Then ' length of command is too brief
Sysop.Command=False ' reset sysop command flag
Outpt="That command is reserved for DMs only!" ' message
Call IO.O ' send output
Exit Sub ' return to main
Endif ' end compare command length
If Inpt="!?" Then ' check for short dm help
Graphics.Off=True ' ansi color off
Restore SysopCommands1 ' reset data pointer
For Last.Command.Number=1 To 18 ' loop to read all nine sysop commands
Read Outpt ' read command
If Outpt<>"<>" Then ' check valid command
Select Case Last.Command.Number ' compare unique command
Case 1, 2, 3, 4, 5, 6, 7, 9, 12, 14, 16, 17, 18 ' commands
Outpt=Lcase$(Outpt) ' lowercase command
Mid$(Outpt,1,1)=Ucase$(Mid$(Outpt,1,1)) ' uppercase start
Outpt="!"+Outpt ' prepend DM prefix
Call IO.O ' send output
End Select
Endif ' end check command
Next ' end command read loop
Exit Sub ' exit command routine
Endif
Endif ' end compute sysop entered a command
Stored.Parsed.Command1=Inpt ' store the original command entered
Inpt=Ucase$(Inpt) ' convert original command to upper case
Stored.Parsed.Command2=Inpt ' store the upper case command
If Left$(Inpt,1)="\" Then ' verify command is the repeat command character
User.Command=Previous.Command1 ' restore previous command
Stored.Parsed.Command1=Previous.Command2 ' restore previous parsed
Stored.Parsed.Command2=Previous.Command3 ' restore previous parsed
Else ' not the repeat command
User.Command=Inpt ' store original command
Previous.Command1=User.Command ' store original command
Previous.Command2=Stored.Parsed.Command1 ' store original command
Previous.Command3=Stored.Parsed.Command2 ' store upper case command
Endif ' end compare repeat command
If User.Command=Nul Then ' command entered is null
Exit Sub ' return to main
Endif ' end command is null
Magic.Spell=False ' reset magic spell is being cast flag
Command.Name=User.Command ' store command entered
If Instr(Command.Name," ") Then ' check temporary command variable for space
Command.Name=Left$(Command.Name,Instr(Command.Name," ")-1) ' parse left of
Endif ' space and store in temporary variable
Parser=Instr(User.Command," ") ' set parsed flag if command has space
If Parser=False Then ' check command has no space/parameters
If Sysop.Command Then ' command entered is sysop command
Restore SysopCommands1 ' reset data pointer
Command.Number=False ' set variable containing command number to false
Command.Name=Mid$(Command.Name,2) ' strip leading ! from command
For Last.Command.Number=1 To 9 ' loop to read all nine sysop commands
Read Outpt ' read command
If Left$(Outpt,Len(Command.Name))=Command.Name Then ' compare to
Command.Number=Last.Command.Number ' and store command number
OutX$=Outpt ' store command from data
Exit For ' exit the loop, command found
Endif ' end compare
Next ' end data read loop
If Command.Number=False Then ' no command found
Outpt="Unknown command. Type !? for help." ' message
Call IO.O ' send output
Exit Sub ' return to main
Endif ' end check command variable
Last.Command=OutX$ ' store data command
Last.Command.Number=Command.Number ' store command number
Select Case Command.Number ' select routine to call
Case 1 ' abort function
Call Abort
Case 2 ' hint display
Call Out.File("dmhint.doc")
Case 3 ' summon random monster
Call Call.Monster
Case 4 ' editor routine
Call Editor ' editor routine
Case 5 ' read dm help
Stored.Parsed.Command1="HELP" ' help text to search for
Call Read.Help(True) ' true equals read dmhelp
Case 6 ' toggle sysop invisible status
Call Toggle.Invisible
Case 7 ' enter room link edit routine
Call Link.Room
Case 9 ' display memory, free data space
Call Display.Memory
End Select ' end select routine
Else ' command entered is not sysop command
If User.Command="OU" Then ' compare player command to parse of OUT
User.Command="O" ' reset player command to abbreviation of out
Endif ' end compare player command
If User.Command="OUT" Then ' compare player command to parse of OUT
User.Command="O" ' reset player command to abbreviation of out
Endif ' end compare player command
' routine to verify command entered is direction
Call Get.Direction(Direction.Number)
If Direction.Number Then ' returned variable true if direction
Call Go.Direction(Direction.Number) ' routine goes certain direction
Exit Sub ' return to main
Endif ' end verify direction entered
Command.Number=False ' set variable containing command number to false
Restore CommandSet1 ' reset data pointer
For Last.Command.Number=1 To 85 ' loop to read all user commands
Read Last.Command ' read command
If Command.Name=Left$(Last.Command,Len(Command.Name)) Then ' compare
Command.Number=Last.Command.Number ' command from data, left part
Exit For ' of player command, set variable to command number and
Endif ' exit data read loop
Next ' next data item
If Command.Number=False Then ' loop ended without any matching commands
Graphics.Off=True ' ansi/color off
Outpt="Unknown command! Type ? for help or ?? for a brief list of all commands."
Call IO.O ' send output
Graphics.Off=False ' ansi/color on
Exit Sub ' return to main
Endif ' end command number
Last.Command.Number=Command.Number ' set command variable to match
Select Case Command.Number ' select command number
Case 1 To 4 ' attack commands
Parsed.Command1=Last.Monster ' restore last monster number attacked
Last.Command.Number=55 ' attack command number
Call Attack.Monster ' go attack the monster
Case 5, 6 ' display the current room
Call Display.Room
Case 7, 8 ' panic the character
Call Panic
Case 9 ' search the current room
Call Search.Room
Case 10, 51 ' update the player file
Call Put.User.Record ' store the player record
Outpt="Player file updated." ' message
Call IO.O ' send output
Case 11 ' display player information
Call Display.Stats
Case 12 ' display player inventory
Call Display.Inventory
Case 13 ' kill of the character
Call Suicide
Case 14 ' train character (must have 0 experience and enough gold)
Call Train ' train routine
Case 15 ' health command
Call Display.Health
Case 16 ' appeal for low stats/room w/o exits
Call Appeal
Case 17 To 20 ' end session
Call Quit.Game
Case 21 ' experience
Call Display.Experience
Case 22 ' enter help
Stored.Parsed.Command1="HELP" ' get help text
Call Read.Help(False) ' false equals help.dat file
Case 23 ' hide
Call Hide.User
Case 24 ' cast command
Call Cast.Spell(True) ' true equals enter chant
Case 25 ' list command
Call Weapon.List
Case 26 ' brief mode toggle/must be level 2 at least
Call Brief.Mode
Case 27 ' bank command
Call Bank
Case 28 To 30 ' display time on/time left
Call Time.Online
Case 33 ' ansi on/off
Call Toggle.ANSI
Case 39 ' lunge attack command
Parsed.Command1=Last.Monster ' restore last monster attacked
Last.Command.Number=39 ' store lunge command number
Call Attack.Monster ' go attack the monster
Case 40 ' dodge attack command
Parsed.Command1=Last.Monster ' restore last monster attacked
Last.Command.Number=40 ' store dodge command number
Call Attack.Monster ' go attack the monster
Case 41 ' display top ten players/create ranklist.dat
Call Put.User.Record ' store player record
Call Top.Ten ' generate top ten list
Call Get.User.Record ' read player record
Case 42 ' bless w/o parameter
Call Bless.Self ' therefore bless self
Case 43 ' curse w/o parameters
Call Curse.Self ' therefore curse self
Case 44 ' change password
Call Change.PassWord ' call routine
Call Put.User.Record ' put player record
Case 45 ' mail routine
Call Mail
Case 46 ' display list of all players
Call Put.User.Record ' store player record
Call User.List ' generate player list
Call Get.User.Record ' restore player record
Case 47 ' page sysop
Call Page.Sysop
Case 48, 49 ' exit/leave room
Call Exit.Room
Case 50 ' climb/go up/up
Call Climb
Case 52, 53 ' relogin if player level >1
Call Relogin
Case 54 ' display preferences
Call Display.Prefs ' routine to display preferences
Case 55 ' change line length
Call Change.Linelength ' routine to change line length
Case 56 ' display catalog file
Call Out.File("catalog.doc") ' display text file
Case 57 ' toggle linefeed mode
Call Toggle.Linefeeds ' routine to toggle linefeed mode
Case 58 ' change pagelength
Call Change.Pagelength ' routine to change pagelength
Case 59 ' change echo mode
Call Toggle.Echo ' routine to toggle echo mode
Case 60 ' toggle word wrap
Call Toggle.Wordwrap ' routine to toggle word wrap
Case 31 To 35 ' attack commands
Call Attack.Monster ' go attack monster
Case 61 ' realign once per character
Call Align
Case 64 To 75 ' direction entered
' set direction of data set number to 1-12
Direction.Number=Command.Number-63
' get the direction and move player
Call Go.Direction(Direction.Number)
Case 76 ' display hint file
Call Out.File("hint.doc") ' display text file
Case 77 ' toggle inventory sorting preference
Call Sort.Inventory
Case 78 ' display summary file
Call Out.File("summary.doc") ' display text file
Case 83 ' reroll all character statistics once per character
Call Reroll.Character
Case 85 ' wish for an item
Call Wish.Item
End Select
Endif ' end compare player command
Else ' command has parameter(s)
Parsed.Command1=Mid$(User.Command,Parser+1) ' get first parsed part of
Parsed.Command2=Parsed.Command1 ' command and store remaining parsed
Stored.Parsed.Command1=Mid$(Stored.Parsed.Command1, _
Instr(Stored.Parsed.Command1," ")+1) ' truncate stored parsed command
Stored.Parsed.Command2=Mid$(Stored.Parsed.Command2, _
Instr(Stored.Parsed.Command2," ")+1) ' truncate stored parsed command
Call Numeric ' store parse number
If Sysop.Command Then ' command entered is sysop command
Restore SysopCommands2 ' reset data pointer
Command.Number=False ' set variable containing command number to false
Command.Name=Mid$(Command.Name,2) ' strip leading ! from command
For Last.Command.Number=1 To 9 ' loop to read all nine commands
Read Outpt ' read command
If Left$(Outpt,Len(Command.Name))=Command.Name Then ' compare to,
Command.Number=Last.Command.Number ' set command number variable
OutX$=Outpt ' store command from data
Exit For ' exit loop, command found
Endif ' end compare sysop command
Next ' end loop through data
If Command.Number=False Then ' if no matching command in variable
Outpt="Unknown command. Type !? for help." ' message
Call IO.O ' send output
Exit Sub ' return to main
Endif ' end matching compare
Last.Command=OutX$ ' store data command
Last.Command.Number=Command.Number ' store command number
Select Case Command.Number ' select sysop command number
Case 2 ' get monster number and call
Call Summon.Monster
Case 3 ' get object/treasure name and discard
Call Discard.Object
Case 4 ' edit room and room monclass
Change.Number=Val(Parsed.Command1) ' room number parameter to edit
If Change.Number>False Then ' check file bounds
If Change.Number<=Lof(RoomFile)/Len(RoomRecord) Then ' file bounds
Call Change.Room(Change.Number) ' edit room number
Endif ' end check room number range
Endif ' end check room number range
Case 5 ' get object/treasure name
Call Drop.Object ' get from files, drop in room
Case 6 ' call DM help about command in parameter
Call DM.Help
Case 7 ' kill monster name in parameter
Call Kill.Monster
Case 8 ' reduce monsters by the value in number parameter
Call Reduce.Monsters
Case 9 ' teleport self/online player to room number in parameter
Call Teleport.User
End Select ' end select sysop command
Else ' not sysop command
Command.Number=False ' set variable containing command number to false
Restore CommandSet2 ' reset data pointer
For Last.Command.Number=1 To 85 ' loop to read all user commands
Read Last.Command ' read command
If Command.Name=Left$(Last.Command,Len(Command.Name)) Then ' compare
Command.Number=Last.Command.Number ' to and store command number
Exit For ' exit read data loop
Endif ' end compare
Next ' end data loop
If Command.Number=False Then ' if command number not matched
Graphics.Off=True ' ansi/color off
Outpt="Unknown command! Type ? for help or ?? for a brief list of all commands."
Call IO.O ' send output
Graphics.Off=False ' ansi/color on
Exit Sub ' return to main
Endif ' end command number match
Last.Command.Number=Command.Number ' store command number
Select Case Command.Number ' select command number
Case 1, 2, 74, 79 ' enter/go object command
Call Enter.Object
Case 3 To 5 ' display player information commands
Call Display.Information
Case 6 ' cast spell on target
Call Cast.Spell(False) ' false equals get chant
Case 7, 8 ' take command
If Instr(Parsed.Command2," ") Then ' second parameter
Call Take.From.Container ' must be from container
Else ' no extra parameters
Call Take.Object ' must be from room
Endif ' end compare second parameter
Case 9, 10 ' drop command
If Instr(Parsed.Command2," ") Then ' second parameter
Call Drop.Into.Container ' must be into container
Else ' no extra parameters
Call Drop.Item ' must be into room
Endif ' end compare second parameter
Case 11, 12 ' sell an item
Call Pawn.Shop
Case 13, 14 ' smash commands
Call Smash.Object
Case 15 ' close command
Call Close.Object
Case 16 ' open command
Call Open.Object
Case 17 To 19 ' hold/wield command
Call Hold.Object
Case 20 ' wear command
Call Wear.Object
Case 21 ' return a weapon command
Call Return.Object
Case 22 ' cast spell on target
Call Cast.Spell(True) ' true equals no chant
Case 23 ' repair item
Call Weapons.Shoppe
Case 24 ' lock command
Call Lock.Object
Case 25, 26 ' unlock/picklock commands
Call Unlock.Object
Case 27 ' fix command
Call Fix.Object
Case 28 ' buy command
Call Weapons.Shop
Case 29 ' charge to repair magic item
Call Alchemist
Case 30 ' drink command
Call Drink.Potion
Case 32 ' throw command
Call Throw.Object
Case 33 ' steal command
Call Steal.Object
Case 35 ' bless a target
Call Bless.Object
Case 36 ' curse a target
Call Curse.Object
Case 37 ' fuel command
Call Fuel.Object
Case 40, 41 ' talk/parley commands
Call Talk.To.Monster
Case 42, 43 ' offer commands
Call Offer
Case 44 ' load command
Call Load.Object
Case 45 ' fire command
Call Fire.Object
Case 46 ' enter vehicle command
Call Enter.Vehicle
Case 48, 73 ' ride/go vehicle commands
Call Ride.Vehicle
Case 49 ' hide command
If Instr(Parsed.Command2," ") Then ' second parameter
Call Drop.Into.Container ' must be hide in container
Else ' no extra parameters
Call Drop.Item ' must be hide in room
Endif ' end check hide parameters
Case 50 ' search command
Call Search.Object
Case 51 ' help w/ parameter of help topic
Call Read.Help(False) ' read help file
Case 52 ' identify/extended information
Call Identify.Object
Case 55 To 58 ' attack routine
Last.Command.Number=55
Call Attack.Monster
Case 59 To 70, 82 To 85 ' attack routine
Call Attack.Monster
Case 71 ' psi mode, attack/defense
Call Psi.Mode
Case 72 ' eat command
Call Eat.Object
Case 75 ' move command
Call Move.Object
Case 76 ' launch command
Call Launch.Object
Case 77 ' learn spell, parameter equals spell name to learn
Call Learn.Spell ' prompts for spell chant
Case 78 ' light command
Call Light.Object
Case 47, 80, 81 ' exit vehicle commands
Call Exit.Vehicle
End Select ' end select commmand number
Endif ' end command type
Endif ' end parameter type
End Sub ' end command processing
Rem * routine to logoff player and terminate program.
Rem * any call to this routine results in program termination.
Sub Terminate.Program
On Local Error Resume Next ' local error resume
Logged.In=False ' reset player logged in flag
Call Status.Line(-2) ' erase status lines
Call Put.User.Record ' record player record structure
Call Clean.Room ' remove extra treasure from room
Graphics.Off=False ' reset color
Outpt="Your online time was:" ' make message
Call IO.O ' display message
Graphics.Off=True ' reset color
Call Time.Online ' display time used and time left
Call More.Prompt ' pause for more
Call Top.Ten ' top player list
Call Out.File("logoff.dat") ' display logoff text file
Outpt="Press "+Enter$+" to exit the adventure:" ' exit program prompt
No.Echo=True ' no echo of player input
Line.Length=1 ' get one character
Call IO.I ' get player input
No.Echo=False ' reset no echo player input
Call IO.O ' empty C/R
Outpt="Returning you to "+BBS.Name+".." ' display return message
Call IO.O ' send output
Call Reset.ANSI ' restore local color and remote ansi color
End ' terminate program
End Sub ' end terminate program routine
Rem * routine to allow player login with another codename.
Sub Relogin
On Local Error Resume Next ' local error resume
If Normal.User Then ' check non DM
If UserRecord.Level<=1 Then ' minimum player level requirement to relogin
Outpt="You can't relogin until level two!" ' display restriction
Call IO.O ' send output
Exit Sub ' return from routine
Endif ' end check minimum level
Endif ' end check normal player
Outpt="Are you sure you want to relogin(y/n)? " ' verify player relogin
No.Input.Out="N" ' default input to no
Call IO.I ' get player input
If Yes Then ' verified to suicide
Logged.In=False ' reset player logged in flag
Call Put.User.Record ' store player record structure
Call Clean.Room ' remove extra treasure from room
Call Login ' get player codename
Endif ' end check response
End Sub ' end relogin routine
Rem * routine allows player to erase character.
Rem * sometimes player characters are no longer useful
Rem * when their statistics become too low.
Sub Suicide
On Local Error Resume Next ' local error resume
Outpt="Are you sure you want to commit suicide(y/n)? " ' verify player suicide
No.Input.Out="N" ' default input to no
Call IO.I ' get player input
If Yes Then ' verified to suicide
Logged.In=False ' reset player logged in flag
Graphics.Off=True ' ansi/color to white
Outpt="Your character falls into deep sleep.." ' display suicide message
Call IO.O ' send output
Outpt=" The Ghods take your player to another world.." ' display
Call IO.O ' send output
Graphics.Off=False ' ansi/color to normal
Call Delete.User ' remove player record from file
Call Share.Record(UserFile,User.Index) ' put deleted record in player file
Call Terminate.Program ' end program
Endif ' end check response
End Sub ' end suicide routine
Rem * routine for normal logoff.
Sub Quit.Game
On Local Error Resume Next ' local error resume
Graphics.Off=True ' ansi/color to white
Outpt="Are you sure you want to quit(y/n)? " ' verify player to quit
No.Input.Out="N" ' default to no
Call IO.I ' get input
If Yes Then ' verified to quit
Logged.In=False ' reset player logged in flag
Call Terminate.Program ' end program
Endif ' end check response
End Sub ' end quit routine
Rem * routine to quit and terminate quick.
Sub Abort
On Local Error Resume Next ' local error resume
Outpt="Are you sure you want to abort(y/n)? " ' verify abort
No.Input.Out="N" ' default to no
Call IO.I ' get input
If Yes Then ' verified yes
Logged.In=False ' reset player logged in flag
Outpt="Program task abort!" ' display abort message
Call IO.O ' output
Call Put.User.Record ' store player record structure
Call Reset.ANSI ' restore ansi/color
Call Status.Line(-2) ' remove status lines
End ' end program
Endif ' end check response
End Sub ' end abort routine
Rem * routine reads command line node number 0-9, A-Z, 10-99, and switches.
Sub Get.Command
On Local Error Goto Command.Error ' local error routine
Locate ,,1 ' turn on cursor
Max.Row=22 ' set maximum rows on screen before scroll
Local.Mode=False ' default not local mode
Node1=False ' reset node number
Node2=False ' reset node number
User.Echo=False ' reset preference
User.LineFeeds=False ' reset preference
User.LineLength=80 ' reset preference
User.PageLength=24 ' reset preference
User.Wordwrap=False ' reset preference
Command.Line$=Command$ ' store command line
Do ' loop to remove spaces form command
Imbedded=Instr(Command.Line$," ") ' check for space
If Imbedded Then ' verify space
Command.Line$=Left$(Command.Line$,Imbedded-1)+ _
Mid$(Command.Line$,Imbedded+1) ' remove space
Else ' verify space
Exit Do ' exit no space
Endif ' end check space
Loop ' end loop to remove spaces
If Command.Line$="" Or Command.Line$="/?" Then ' check command
Goto Command.Error ' jump to command display
Endif ' end check command
Imbedded=Instr(Command.Line$,"/P:") ' check port over-ride switch
If Imbedded Then ' check switch
Store.Command$=Left$(Command.Line$,Imbedded-1) ' store command line
Command.Line$=Mid$(Command.Line$,Imbedded+3) ' get remaining command line
Gosub Get.Numeric ' convert command to value
Command.Line$=Store.Command$+Command.Line$ ' restore command line
Port.Value=Int(Val(Value$)) ' store value
If Port.Value>=1 And Port.Value<=16 Then ' compare value range
Port.Override=Port.Value ' store value
Endif ' end compare
If Port.Override=False Then ' check port value
Goto Command.Error ' jump to usage
Endif ' end check port
Endif ' end check switch
Imbedded=Instr(Command.Line$,"/B:") ' check baud over-ride switch
If Imbedded Then ' check switch
Store.Command$=Left$(Command.Line$,Imbedded-1) ' store command line
Command.Line$=Mid$(Command.Line$,Imbedded+3) ' get remaining command line
Gosub Get.Numeric ' convert command to value
Command.Line$=Store.Command$+Command.Line$ ' restore command line
Baud.Value!=Int(Val(Value$)) ' store value
If Baud.Value!>0! Then ' compare value range
Baud.Override=Cint(Baud.Value!/100!) ' store value
Endif ' end compare
If Baud.Override=False Then ' check baud value
Goto Command.Error ' jump to usage
Endif ' end check baud
Endif ' end check switch
Imbedded=Instr(Command.Line$,"/L") ' check command
If Imbedded Then ' verify command is local mode
Command.Line$=Left$(Command.Line$,Imbedded-1)+ _
Mid$(Command.Line$,Imbedded+2) ' take switch from command
Command.Line$=Rtrim$(Command.Line$) ' trim command
Command.Line$=Ltrim$(Command.Line$) ' trim command
Local.Mode=True ' reset local mode
Endif ' end verify command switch
If Len(Command.Line$)=False Then ' check command
If Local.Mode Or Port.Override Then ' check switches
Node="<n/a>" ' assign default node type
Exit Sub ' exit from command line routine
Endif ' end check switches
Endif ' end check command
If Left$(Command.Line$,1)="/" Then ' check for command switch
Command.Line$=Mid$(Command.Line$,2) ' store command line
Select Case Len(Command.Line$) ' get length of command line node
Case 1 ' command line length
Select Case Command.Line$ ' get command line node number
Case "0" To "9", "A" To "Z" ' command line node
Node1=Asc(Command.Line$) ' assign to node type 1 variable
End Select ' end command line node number
Case 2 ' command line length
Select Case Int(Val(Command.Line$)) ' select extended node number
Case 10 To 99 ' command line node
Node2=Int(Val(Command.Line$)) ' assign to node type 2 variable
End Select ' end select node number
End Select ' end select node number
Endif ' end check command
If Node1>False Or Node2>False Then ' verify valid node number
Exit Sub ' exit routine
Endif ' end check node number
Command.Error:
Color 15,0 ' color white on black
Print "Dnddoor usage:"
Color 14,0 ' color yellow on black
Print " Dnddoor [/#] [/L] [/P:x] [/B:<rate>]"
Color 15,0 ' color white on black
Print "Where:"
Color 14,0 ' color yellow on black
Print " /# is door node number 0 - 9, A - Z, or 10 - 99."
Print " /L to logon without door support."
Print " /P:x over-ride port number (1 to 16)."
Print " /B:<rate> over-ride connect baud rate."
Color 7,0 ' color white on black
End ' halt program
' routine to convert string to value
Get.Numeric:
Value$=Nul ' reset value
Do ' start convert loop
Line.Value$=Left$(Command.Line$,1) ' get command line character
If Line.Value$>="0" And Line.Value$<="9" Then ' check ascii value
Value$=Value$+Line.Value$ ' store value
Command.Line$=Mid$(Command.Line$,2) ' get next command character
Else ' check ascii value
Exit Do ' exit routine loop
Endif ' end check ascii value
Loop ' end convert loop
Return ' exit form routine
End Sub ' end routine to read command line
Rem * routine reads runtime arrays.
Sub Read.Arrays
On Local Error Goto Arrays.Error ' local error routine
' allocate runtime arrays
Redim Alignment.Name1(1 To 3) As String*7, _
Alignment.Name2(1 To 3) As String*7, _
Class.Name(1 To 10) As String*15, _
Direction(1 To 12) As String*9, _
High.Class.Name(1 To 10) As String*15, _
Race(1 To 8) As String*8, _
Stat(1 To 7) As String*12, _
Training.Stats(1 To 10,1 To 4) As Integer, _
Weapon.Type.Name(1 To 4) As String*9
Restore Config.Data
For Array.Index1=1 To 10 ' loop through ten class statistic increment array
For Array.Index2=1 To 4 ' loop through each four class statistic array
Read Training.Stats(Array.Index1,Array.Index2) ' read statistics
Next ' loop through
Next ' loop through
For Array.Index2=1 To 10 ' loop through high class names
Read High.Class.Name(Array.Index2) ' read high class names
Next ' loop through
For Array.Index2=1 To 8 ' loop through race names
Read Race(Array.Index2) ' read race names
Next ' loop through
For Array.Index2=1 To 10 ' loop through class names
Read Class.Name(Array.Index2) ' read class names
Next ' loop through
For Array.Index2=1 To 7 ' loop through statistic names
Read Stat(Array.Index2) ' read statistic names
Next ' loop through
For Array.Index2=1 To 12 ' loop through direction names
Read Direction(Array.Index2) ' read direction names
Next ' loop through
For Array.Index2=1 To 4 ' loop through weapon proficiency names
Read Weapon.Type.Name(Array.Index2) ' read weapons proficiency names
Next ' loop through
For Array.Index2=1 To 3 ' loop through first set of alignment names
Read Alignment.Name1(Array.Index2) ' read alignment names
Next ' loop through
For Array.Index2=1 To 3 ' loop through second set of alignment names
Read Alignment.Name2(Array.Index2) ' read alignment names
Next ' loop through
Exit Sub ' exit routine
Arrays.Error:
Color 15, 0 ' color white on black
Print "Error reading data. Increase RAM size." ' output error message
Color 7, 0 ' reset color
End ' halt program
End Sub ' end routine to read arrays
Rem * routine opens runtime file handles.
Sub Open.Files
On Local Error Goto Files.Error ' local error routine
Close ' close all files
' files opened in random mode, opened in share mode for multi access, and each
' file record length specified as the length of the random record which will
' be used to get/put data to the file. 10 files, 2 mail files. Remaining unopened
' files include 2 temp files, 1 help file.
Open "actions.dat" For Random Shared As #ActionFile Len=Len(ActionRecord)
Open "messages.dat" For Random Shared As #MessageFile Len=Len(MessageRecord)
Open "montalk.dat" For Random Shared As #MonTalkFile Len=Len(MonsterTalkRecord)
Open "monclass.dat" For Random Shared As #MonClassFile Len=Len(MonclassRecord)
Open "monsters.dat" For Random Shared As #MonsterFile Len=Len(MonsterRecord)
Open "msgtable.dat" For Random Shared As #TableFile Len=Len(TableRecord)
Open "nonplyrs.dat" For Random Shared As #NonPlayerFile Len=Len(MonsterRecord)
Open "objects.dat" For Random Shared As #ObjectFile Len=Len(ObjectRecord)
Open "rooms.dat" For Random Shared As #RoomFile Len=Len(RoomRecord)
Open "spells.dat" For Random Shared As #SpellFile Len=Len(SpellRecord)
Open "treasure.dat" For Random Shared As #TreasureFile Len=Len(TreasureRecord)
Open "users.dat" For Random Shared As #UserFile Len=Len(UserRecord)
Exit Sub ' exit routine
Files.Error:
Color 15, 0 ' color white on black
' output error message
Print "Error"+Str$(Err)+" opening files. Increase files= in config.sys and reboot."
Color 7, 0 ' reset color
End ' halt program
End Sub ' end routine to open files
Rem * routine makes door file.
Sub Read.Door
On Local Error Goto Door.Error ' local error routine
BBS.Name=Nul ' reset name of bbs
Color.Graphics=True ' default remote ansi color on
Door.Name=Nul ' reset name of user
Door.Time=1800! ' reset time remaining
If Node1 Then ' check node type 1
Node=Chr$(Node1) ' store node in string form
Else ' check door node
If Node2 Then ' check node type 2
Node=Mid$(Str$(Node2),2) ' store node in string form
Endif ' end check node
Endif ' end check node type
If Local.Mode Then ' verify local command line switch
BBS.Name="SYSTEM" ' store name of bbs
Port=False ' reset modem port
Modem.Baud=96 ' reset modem baud
Door.Name="LOCAL SYSOP" ' store name of user
Color.Type=2 ' store color value
Exit Sub ' exit door file routine
Endif ' end verify local switch
If Node1=False And Node2=False Then ' check node type
BBS.Name="SYSTEM" ' store name of bbs
Port=False ' reset modem port
Modem.Baud=96 ' reset modem baud
Door.Name="REMOTE USER" ' store name of user
Color.Type=2 ' store color value
If Port.Override Then ' verify port number for no node
Port=Port.Override-1 ' store port value
Endif ' end check port/node
If Baud.Override Then ' check baud value for no node
Modem.Baud=Baud.Override ' store baud value
Endif ' end check baud/node
Call Set.Driver ' init baud rate
Exit Sub ' exit routine
Endif ' end check node type
If Len(Node)=1 Then ' check node length
FileName="DORINFO"+Node+".DEF" ' make door info filename
If Dir$(Filename)=Filename Then ' check file exists
Call Read.Door.File ' routine to read door file
Exit Sub ' exit door file routine
Endif ' end check file
Endif ' end check node length
FileName="DINF"+Node+".DEF" ' make door info filename
If Dir$(Filename)=Filename Then ' check file exists
Call Read.Door.File ' routine to read door file
Exit Sub ' exit door file routine
Endif ' end check file
Door.Error:
Color 15, 0 ' color white on black
Print "Error reading door node "+Node+" information file." ' output error message
Color 7, 0 ' reset color
End ' halt program
End Sub ' end routine to read door file
Rem * routine reads door file.
Sub Read.Door.File
On Local Error Goto Read.Door.Error
Close #TempFile ' close work file
Open FileName For Input Shared As #TempFile ' open the door file for input
For Door.File.Line=1 To 13 ' loop through all lines in door file
Line Input #TempFile,Inpt ' read next text line from door file
Inpt=Ucase$(Inpt) ' convert text string to upper case
Select Case Door.File.Line ' select which line to process
Case 1 ' line one
BBS.Name=Inpt ' store name of bbs
Case 4 ' line four
Port=Val(Mid$(Inpt,4,1)) ' set port to value of rightmost character
If Port=False Then ' port zero speficies local console mode
Local.Mode=True ' set local mode flag
Else ' other port number
Port=Port-1 ' convert modem comm (1-8) to modem port (0-7)
If Port.Override Then ' check over-ride switch
Port=Port.Override-1 ' store value
Endif ' end check switch
Endif ' end compare port number
Case 5 ' line five
Input.Length=Instr(Inpt," ")-3 ' get baud rate
Inpt=Left$(Inpt,Input.Length) ' store rate
Modem.Baud=Int(Val(Inpt)) ' store modem baud rate
If Baud.Override Then ' check over-ride switch
Modem.Baud=Baud.Override ' store value
Endif ' end check switch
Case 7 ' line seven
Door.Name=Inpt ' store name of user
If Left$(Inpt,5)="SYSOP" Then ' compare user name to 'sysop'
Local.Mode=True ' set local mode flag
Endif 'end compare user name
Case 8 ' line eight
If Len(Inpt) Then ' compare length of user last name
Door.Name=Door.Name+" "+Inpt ' append user last name
Endif ' end compare user name length
Case 10 ' line ten
Color.Type=Int(Val(Inpt)) ' get value of text line
If Color.Type<2 Then ' compare graphics preference
Color.Graphics=False ' value other than two sets graphics off
Endif ' end compare graphcis
Case 12 ' line twelve
Door.Time=Val(Inpt)*60! ' store value of text line of remaining time
End Select ' end process line
Next ' end loop through file
Call Set.Driver
Exit Sub ' exit routine
Read.Door.Error:
Color 15, 0 ' color white on black
Print "Error reading door information file: "+FileName ' output error message
Color 7, 0 ' reset color
End ' halt program
End Sub ' end routine to read door file
Rem * routine loads runtime file data.
Sub Read.Monclass
On Local Error Goto Monclass.Error ' local error routine
Locate ,,1 ' turn on cursor
Monclass.Max=Lof(MonClassFile)/Len(MonclassRecord) ' compute number of records
If Monclass.Max=False Then ' monster class file, compare to minimum
Monclass.Max=1 ' and increment if none found
For Monster.Classes=1 To 10 ' loop through all monsters in class
MonclassRecord.Monsters(Monster.Classes)=False ' reset to empty
Next ' end loop
Call Share.Record(MonClassFile,1) ' write first monster class record if empty
Endif ' end compare length of file
' check upper bounds on monclass file
If Monclass.Max>1024 Then ' check bounds
Monclass.Max=1024 ' reset maximum
Endif ' end check bounds
' allocate monster class, rate, and percent arrays
Redim Monster.Class(1 To Monclass.Max,1 To 10) As Integer, _
Monster.Percent(1 To Monclass.Max,1 To 10) As Integer, _
Monster.Rate(1 To Monclass.Max,1 To 10) As Integer
' loop through all monster classes in file
For Monster.Classes=1 To Monclass.Max
Call Read.Record(MonClassFile,Monster.Classes) ' read monster class record
For Monster.Class.Number=1 To 10 ' loop through all monsters in record
' get monster number in class
Monster.Array.Number=MonclassRecord.Monsters(Monster.Class.Number)
' store in monster class array
Monster.Class(Monster.Classes,Monster.Class.Number)= _
Monster.Array.Number
If Monster.Array.Number>False And _
Monster.Array.Number<=Lof(MonsterFile)/Len(MonsterRecord) Then
' read monster number from monster file
Call Read.Record(MonsterFile,Monster.Array.Number)
' store encounter rate
Monster.Rate(Monster.Classes,Monster.Class.Number)= _
MonsterRecord.Rate
' store encounter rate percent
Monster.Percent(Monster.Classes,Monster.Class.Number)= _
MonsterRecord.RatePercent
Endif ' end compare file bounds
Next ' end loop through ten monsters in class
Next ' end loop through all monster classes
Max.Spells=Lof(SpellFile)/Len(SpellRecord) ' get number of spell records
' check bounds of spell file
If Max.Spells>1024 Then ' check bounds
Max.Spells=1024 ' reste maximum
Endif ' end check bounds
Spell.Number=Len(Learned.Spells) ' get length of learned spells array
If Max.Spells>Spell.Number Then ' compare spells length
' extended array
Learned.Spells=Learned.Spells+String$(Max.Spells-Spell.Number,"0")
Endif ' end compare length
Exit Sub ' exit routine
Monclass.Error:
Color 15, 0 ' color white on black
Print "Error reading arrays. Increase RAM size." ' output error message
Color 7, 0 ' reset color
End ' halt program
End Sub ' end configure routine
Rem * routine determines if share is loaded
Sub Check.Share
On Local Error Resume Next ' local error resume
Inregs.AX=&H1000 ' store dos function call
Call Interrupt(&H2F,Inregs,Outregs) ' call multiplex interrupt
If (Outregs.AX And &HFF)=&HFF Then ' compare share loaded
Share.Installed=True ' store share variable
Else ' compare share loaded
Share.Installed=False ' store share variable
Endif ' end compare share loaded
If Win.Major=False Then ' check os type
If DOS.Major=7 Then ' check dos type
If DOS.Minor=10 Then ' check dos type
Share.Installed=False ' disable share for dos 7.10
Endif ' end check type
Endif ' end check type
Endif ' end check os type
End Sub ' end routine to check for share loaded
Rem * routine matches online baud rate.
Sub Set.Driver
On Local Error Resume Next ' local error resume
If Local.Mode Then ' check online mode
Exit Sub ' return from routine
Endif ' end check online mode
Call Driver(&H0400) ' initialize port
Select Case Modem.Baud ' select baud rate to match
Case 3 ' 300 baud
Modem.Speed=&H0043 ' calculate baud bits
Case 6 ' 600 baud
Modem.Speed=&H0063 ' calculate baud bits
Case 12 ' 1200 baud
Modem.Speed=&H0083 ' calculate baud bits
Case 24 ' 2400 baud
Modem.Speed=&H00A3 ' calculate baud bits
Case 48 ' 4800 baud
Modem.Speed=&H00C3 ' calculate baud bits
Case 96, 144 ' multiple bauds (set to 9600)
Modem.Speed=&H00E3 ' calculate baud bits
Case 192, 288 ' multiple bauds (set to 19200)
Modem.Speed=&H0003 ' calculate baud bits
Case 384, 576, 786, 1152, 2304 ' multiple bauds (set to 38400)
Modem.Speed=&H0023 ' calculate baud bits
End Select ' end calculate baud bits
Call Driver(Modem.Speed) ' set computer to modem baud rate
End Sub ' end routine to match baud rates
Rem * routine to give back time slice in tight loops to multi systems.
Rem * input variables:
Rem * Var - number of slices to give back
Rem * processing variables:
Rem * Supported.Call - stores valid call flag
Sub Release.Time(Var)
On Local Error Resume Next ' local error resume
Static Supported.Call ' define valid call flag
If Supported.Call=False Then ' check flag already implemented
For Var2=1 To Var ' loop through slices to give
Inregs.AX=&H1680 ' set bios call
Inregs.BX=&H0000 ' set bios call
Call Interrupt(&H2F,Inregs,Outregs) ' call bios routine
If (Outregs.AX And &HFF)=&H80 Then ' verify supported call
Supported.Call=True ' reset flag
Exit For ' exit call loop
Endif ' end verify supported call
Next ' end slice loop
Endif ' end check flag
End Sub ' end time slice routine
Rem * standard output routine to send data to the screen and modem.
Rem * input variables:
Rem * Allow.Break - set to true to allow control-k checking.
Rem * Carriage.Return - set to true to suppress cr/lf after output.
Rem * Outpt - contains text to output to screen/modem.
Rem * output variables:
Rem * Break - set to true if user entered control-k.
Rem * Carriage.Return, Outpt - reset to zero/null.
Rem * processing variables:
Rem * Char.Output$ - character to send to modem/screen.
Rem * Count - loop variable for character of output sent.
Sub IO.O
On Local Error Resume Next ' local error resume
If Len(Outpt) Then ' check length of output string
Call Out.ANSI ' routine to output ansi sequence to modem/color code locally
Endif ' end check output string
Count=False ' reset output character counter
Do ' output characters loop
Call Keyboard(Keyboard.Break) ' routine reads keyboard
If Break Then ' check break flag
Exit Do ' exit output loop
Endif ' end check break flag
Count=Count+1 ' increment output counter
Gosub IO.Wrap ' subroutine to word wrap
If Count>Len(Outpt) Then ' check length of output
Exit Do ' exit output loop
Endif ' end check length of output
Char.Output$=Mid$(Outpt,Count,1) ' get single character to output
Call Put.Modem(Char.Output$) ' send character to modem
Call Scrn(Char.Output$) ' send character to screen
Loop ' output character loop
If Carriage.Return=False Then ' check output cr/lf suppressed
If Break=False Then ' check control-k flag
Call Line.Return ' routine to send cr/lf to modem/screen
Endif ' end check control-k flag
Endif ' end check i/o cr/lf
Carriage.Return=False ' reset supressed cr/lf
Outpt=Nul ' reset output
Exit Sub ' exit routine
' subroutine to word wrap
IO.Wrap:
If User.Linelength=False Then ' check linelength
Return ' exit subroutine
Endif ' end check of linelength
Select Case User.Wordwrap ' check word wrap preference
Case True ' word wrap toggled off
If Pos(0)>=User.Linelength Then ' check line length
If Mid$(Outpt,Count,1)=" " Then ' check wrapped space
Count=Count+1 ' increment space from loop
Endif ' end check wrapped space
If Count<=Len(Outpt) Then ' check end of line
Call Line.Return ' send cr/lf
Endif ' check eol
Endif ' end check line length
Case False ' word wrap toggled on
Space.Wrap=Instr(Count+1,Outpt," ") ' store next word
If Space.Wrap Then ' find first imbedded space
Word$=Mid$(Outpt,Count) ' truncate word
Space.Wrap=Instr(2,Word$," ") ' store next word
Word$=Left$(Word$,Space.Wrap-1) ' store remaining output of line
Else ' store empty remaining word to wrap
If Mid$(Outpt,Count,1)=" " Then ' verify last possible word
Word$=Mid$(Outpt,Count) ' store last remaining word
Else ' calculate last word
Word$=Nul ' store empty word
Endif ' end calculate last word
Endif ' end storing next word to send
' compute line position plus next word
If Pos(0)+Len(Word$)>User.Linelength Then
If Mid$(Outpt,Count,1)=" " Then ' check next word is space
Count=Count+1 ' increment space from loop
Endif ' end check next word is space
Call Line.Return ' next word wraps, send cr/lf
Endif ' end compute wrap length
End Select ' end select word wrap preference
Return ' exit subroutine
End Sub ' end routine to send a string to the modem and screen
Rem * standard input routine to get data from the keyboard and modem.
Rem * input variables:
Rem * Buffer - any previous user input stored during output.
Rem * Carriage.Return - set to true to suppress cr/lf after output.
Rem * Hide - flag to echo mask characters in place of input.
Rem * Line.Length - maximum characters allowed to input.
Rem * No.Echo - do not echo user input.
Rem * No.Input.Out - string to use if no input entered.
Rem * Outpt - contains input prompt.
Rem * Word.Wrap - allow words entered to wrap.
Rem * output variables:
Rem * Inpt - contains user input string.
Rem * No.Input - flag set if return entered.
Rem * No - set if N was entered.
Rem * Yes - set if Y was entered.
Rem * Quit - set if Q was entered.
Rem * processing variables:
Rem * Buffered.Input$ 0 stores buffered input to add to next input prompt.
Rem * Char$ - current character received from modem/keyboard.
Rem * Char - ascii code of character input.
Rem * Line.Limit - stores length of input line during input.
Rem * Time.Out! - current time character input loop entered.
Rem * Word - set if a word wrapped.
Rem * OutY$, Valid.Char$, Last.Wrap, Last.Word - local work variables.
Sub IO.I
On Local Error Resume Next ' local error resume
Static Buffered.Input$ ' stores data input between calls to input routine
If Pos(0)>1 Then ' check io supressed cr/lf
Call Line.Return ' make cr/lf before input prompt
Endif ' end check previous supressed cr/lf
Carriage.Return=True ' set cr/lf flag
Line.Limit=Len(Outpt) ' reset length of line for io.o
Outpt=Outpt+Buffered.Input$ ' add stored data input to input prompt
Call IO.O ' output the input prompt
Inpt=Buffered.Input$ ' reset input string+data input between calls
Buffered.Input$=Nul ' reset data input between calls
Do ' loop through input characters
Char$=Nul ' reset input character
Time.Out!=Timer ' set time loop entered
Do While Char$=Nul ' loop until received a character
Gosub IO.Timing ' routine to calculate timing values
Call Keyboard(Keyboard.Break) ' routine to get any keyboard input
' keyboard input received is a function key/extended key
If Keyboard.Break Then
Buffer=Nul ' reset type ahead buffer
Carriage.Return=False ' reset cr/lf flag
No.Input.Out=Nul ' reset null input echo string
Exit Sub ' exit routine to process extended keyboard input
Endif ' end check keyboard routine flag
Call Get.Modem(Input.Char) ' routine to get character from modem
If Input.Char Then ' modem input in return variable
' append modem input to buffer variable
Buffer=Buffer+Chr$(Input.Char)
Endif ' end check modem for character
If Len(Buffer) Then ' check buffer contents
Char$=Left$(Buffer,1) ' get first buffer character
Buffer=Mid$(Buffer,2) ' store buffer minus first character
Endif ' end check buffer
Call Release.Time(1) ' give up time slice
Loop ' end loop until character received
Char=Asc(Char$) ' convert character string to ascii integer
Select Case Char ' process character ascii integer
Case 8 ' backspace
If Len(Inpt) Then ' check length of input
Inpt=Left$(Inpt,Len(Inpt)-1) ' strip off last character from input
Call Back.Space ' routine to send backspace codes
Endif ' end check string length
Case 13 ' return key
If Inpt=Nul Then ' no input in string
If Len(No.Input.Out) Then ' check null input echo string
Inpt=No.Input.Out ' set input string to default input string
OutY$=Lcase$(No.Input.Out) ' convert null input string
Call Scrn(OutY$) ' send string to screen
If User.Echo=False Then ' check echo mode
Call Put.Modem(OutY$) ' send string to modem
Endif ' end check echo mode
Endif ' end check null input flag
Endif ' end check null input
Call Scrn(Chr$(13)) ' send carriage return to screen
If User.Echo=False Then ' check echo mode
Call Put.Modem(Chr$(13)) ' send carriage return to modem
Endif ' end check echo mode
Exit Do ' end routine after return key prssed/return input string
Case 32 To 127 ' remaining valid input ascii codes
If Inpt=Nul Then ' check length of stored input
If Upper.Case Then ' verify force uppercase
Char$=Ucase$(Char$) ' change first character to uppercase
Endif ' end verify force
Endif ' end check length
Valid.Char$=Char$ ' store character
If No.Echo=False Then ' check echo flag
If Hidden Then ' check hide flag
Valid.Char$=Mask$ ' echo mask character
Endif ' end check hide flag
If User.Echo=False Then ' check echo mode
Call Put.Modem(Valid.Char$) ' echo character entered to modem
Endif ' end check echo mode
If Word.Wrap=False Then ' check word wrap flag
Call Scrn(Valid.Char$) ' echo character entered to screen
Endif ' end check word wrap flag
Endif ' end check echo flag
Inpt=Inpt+Char$ ' append character input to input string
' check echo and word wrap
If No.Echo=False And Word.Wrap And User.Wordwrap=False Then
Select Case Len(Inpt)+Line.Limit ' check length of input+line length
Case 0 To User.Linelength-2 ' position to left, no word wrap
Call Scrn(Valid.Char$) ' send echo character
Case Else ' position to left, word wrap
Last.Word=False ' counter of characters at last word to wrap
Word=False ' set flag for word wrapped
' loop through last word reverse
For Last.Wrap=Len(Inpt) To 1 Step -1
If Mid$(Inpt,Last.Wrap,1)=" " Then ' locate space of word
For Word.Break=1 To Last.Word ' loop through length of word
Call Back.Space ' routine to backspace
Next ' end loop through word
' store wrapped word for next i/o
Buffered.Input$=Mid$(Inpt,Last.Wrap+1)
' truncate word from input string
Inpt=Left$(Inpt,Last.Wrap)
Call Scrn(Chr$(13)) ' send return
Word=True ' word has wrapped flag
Exit For ' end loop for a space
Endif ' end check space location
Last.Word=Last.Word+1 ' increment last word wrapped counter
Next
If Word=False Then ' check flag for word wrapped
Call Scrn(Chr$(13)) ' send return to screen
Endif ' end check word wrapped flag
Call Put.Modem(Chr$(13)) ' send return to modem
Exit Do ' end input loop
End Select ' end check length of input+line length
Else ' word wrap flag not set
If Line.Length>False Then ' check line length variable
If Len(Inpt)>=Line.Length Then ' check input string length
Call Scrn(Chr$(13)) ' send return to screen
Call Put.Modem(Chr$(13)) ' send return to modem
Exit Do ' exit input loop
Endif ' end check input string length
Else ' check line length
' check right column
If Len(Inpt)+Line.Limit>User.Linelength-2 Then
Call Scrn(Chr$(13)) ' send return to screen
Call Put.Modem(Chr$(13)) ' send return to modem
Exit Do ' exit input loop
Endif ' end check line limit
Endif ' end check line length
Endif ' end check word wrap
End Select ' end select character ascii code
Loop ' end input loop
Carriage.Return=False ' reset output cr/lf flag
Outpt=Nul ' reset input prompt
No.Echo=False ' reset echoing mask character flag
No.Input=False ' reset null input flag
Line.Length=False ' reset length of input line
If Inpt=Nul Then ' check input string to null
No.Input=True ' set null input flag
Endif ' end check input string length
No.Input.Out=Nul ' reset echo string for null input flag
If User.Linefeeds=False Then ' check linefeed mode
If User.Echo=False Then ' check echo mode
Call Put.Modem(Chr$(10)) ' send linefeed
Endif ' end check echo mode
Endif ' end check linefeed mode
Word.Char$=Ucase$(Left$(Inpt,1)) ' get uppercase of first character of input
No=(Word.Char$="N") ' set no flag (user entered N as first character)
Yes=(Word.Char$="Y") ' set yes flag (user entered Y as first character)
Quit=(Word.Char$="Q") ' set quit flag (user entered Q as first character)
Continue=(Word.Char$="C") ' set continuous flag
Exit Sub ' exit routine to get input string in Inpt
Rem * subroutine to verify time limits.
IO.Timing:
' routine to calculate input timing
Call Second.Timer(Time.Expired,Time.Out!,180!)
If Time.Expired Then ' timing has expired
Call Hang.Up(1) ' routine to hang up modem with message
Endif ' end check timing
' routine to calculate time on
Call Second.Timer(Time.Expired,Timeon,Time.Left)
If Time.Expired Then ' time limit has expired
Call Hang.Up(2) ' routine to hang up modem with message
Endif ' end check time limit
If Two.Minutes.Left=False Then ' check two minutes message flag
' calculate two minutes time
Call Second.Timer(Time.Expired,Timeon,Time.Left-120!)
If Time.Expired Then ' time has expired, user has two minutes left
Two.Minutes.Left=True ' set two minutes message flag
Outpt=Nul ' reset output string
Call IO.O ' send null return
Call Put.Modem(Chr$(7)) ' send beep to modem
Outpt="Two Minutes Left!" ' send two minutes remaining message
Call IO.O ' to modem
Endif ' end check two minutes
Endif ' end check two minutes flag
Return ' end timing subroutine
End Sub ' end routine to get input string in Inpt
Rem * Routine to send a string to the modem.
Rem * input variables:
Rem * Allow.Break - set if control-k checking allowed.
Rem * Local.Mode - flag if the console is operating program.
Rem * Output$ - string to send.
Rem * output variables:
Rem * Break - flag set if control-k entered.
Rem * Buffer - any input from modem during output.
Rem * processing variables:
Rem * Char - ascii code of character to send.
Rem * Count - loop variable of output string sent.
Rem * Input.Char - local work variable.
Sub Put.Modem(Output$)
On Local Error Resume Next ' local error resume
If Local.Mode=False Then ' check if local mode is activated
For Count=1 To Len(Output$) ' loop through output string
Call Get.Modem(Input.Char) ' routine to get data from modem
If Input.Char Then ' character received from modem
If Input.Char=11 Then ' check if character is control-k
If Allow.Break Then ' check if break allowed
Break=True ' set break flag
Exit Sub ' end routine
Endif ' end check break allowed
Else ' any other character
Buffer=Buffer+Chr$(Input.Char) ' append to input buffer
Endif ' end check character is control-k
Endif ' end check character received
' convert output string character to ascii
Char=Asc(Mid$(Output$,Count,1))
Call Driver(&H0100+Char) ' driver routine/send character
Next ' end loop through output string
Endif ' end check local mode
End Sub ' end routine to send output to modem
Rem * Routine to get a character from the modem.
Rem * input variables:
Rem * Local.Mode - flag if console is operating system.
Rem * output variables:
Rem * Input.Char - character received from modem.
Rem * processing variables:
Rem * Outregs - register of modem status.
Sub Get.Modem(Input.Char)
On Local Error Resume Next ' local error resume
Input.Char=False ' set received character to zero
If Local.Mode=False Then ' check if local mode is activated
Call Driver(&H0300) ' driver routine/get modem status
If (Outregs.AX And &HFF)=&HFF Then ' check modem port status
Call Status.Line(-2) ' routine to clear lower two console status areas
Color 15, 0 ' reset color
Outpt=Chr$(13)+"Termination of Dnddoor from missing modem."+Chr$(13)
Call Scrn(Outpt) ' send message
Outpt="Logoff: port"+Str$(Port)+" at "+FNclock$+", node "+Node+"."+Chr$(13)
Call Scrn(Outpt) ' send message
Color 7, 0 ' reset color
End ' terminate program
Endif ' end check carrier
If (Outregs.AX And &H80)=False Then ' check modem carrier status
Call Status.Line(-2) ' routine to clear lower two console status areas
Color 15, 0 ' reset color
Outpt=Chr$(13)+"Termination of Dnddoor from lost carrier."+Chr$(13)
Call Scrn(Outpt) ' send message
Outpt="Logoff: port"+Str$(Port)+" at "+FNclock$+", node "+Node+"."+Chr$(13)
Call Scrn(Outpt) ' send message
Color 7, 0 ' reset color
End ' terminate program
Endif ' end check carrier
If (Outregs.AX And &H0100)=&H0100 Then ' check character receive ready
Call Driver(&H0200) ' driver routine/read character
Input.Char=Outregs.AX And &HFF ' return lower byte of register received
Endif ' end check character received ready
Endif ' end check local mode
End Sub ' end routine to get a character from the modem
Rem * routine to call the dos function for modem access.
Rem * input variables:
Rem * Sub.Function - the Bios call 0, 1, 2, 3, or 4.
Rem * output variables:
Rem * Outregs - register values of the modem.
Sub Driver(Sub.Function)
On Local Error Resume Next ' local error resume
Inregs.AX=Sub.Function ' modem function plus parameters
Inregs.DX=Port ' modem port line 0 to 3
Call Interrupt(&H14,Inregs,Outregs) ' modem dos function hexidecimal 14
End Sub ' end routine to call modem function
Rem * routine to calculate elapsed time
Rem * input variables:
Rem * Start.Time! - equals stored start time from Timer function.
Rem * Wait.Time! - equals elapsed time to calculate in seconds.
Rem * output variables:
Rem * Time.Expired - set to true if Wait.Time has elapsed.
Rem * working variables:
Rem * Time.Elapsed! - contains time difference.
Sub Second.Timer(Time.Expired,Start.Time!,Wait.Time!)
On Local Error Resume Next ' local error resume
Time.Expired=False ' set return flag time has not expired
Time.Elapsed!=Timer-Start.Time! ' calculate time elapsed from start time
If Time.Elapsed!<0! Then ' check if midnight has passed
Time.Elapsed!=Time.Elapsed!+86400! ' increment calculated time elapsed
Endif ' end check midnight passed
' compare calculated elapsed time to wait time
If Time.Elapsed!>=Wait.Time! Then
Time.Expired=True ' set return flag time has expired
Endif ' end compare times
End Sub ' end routine to calculate time
Rem * Routine to adjust system clock during midnight errors.
Sub Set.Clock
On Local Error Resume Next ' local error resume
If Time$>"23:59:59" Then ' compare system time to midnight
Sleep 2 ' wait for two seconds for system date to change
If Time$="24:00:00" Then ' system clock is stuck
Time$="00:00:01" ' reset system time past midnight
Endif ' end check stuck system clock
Endif ' end check incorrect midnight time
End Sub ' end routine to adjust system clock
Rem * Routine to get and process keyboard entry.
Rem * output variables:
Rem * Keyboard.Break - true to exit from IO.I when function key pressed.
Rem * work variables:
Rem * Keyboard.Char$ - contains key pressed.
Sub Keyboard(Keyboard.Break)
On Local Error Resume Next ' local error resume
Keyboard.Break=False ' reset extended/function key input flag
Keyboard.Char$=Nul ' reset next keyboard character
Inregs.AX=&H600 ' read direct console function
Inregs.DX=&H0FF ' read subfunction
Call Interrupt(&H21,Inregs,Outregs) ' routine reads keyboard
If (Outregs.Flags And &H40)=&H0 Then ' check zero flag
Keyboard.Char$=Chr$(Outregs.AX And &HFF) ' store next character
If Asc(Keyboard.Char$)=0 Then ' check for ascii zero
Inregs.AX=&H600 ' read direct console function
Inregs.DX=&H0FF ' read subfunction
Call Interrupt(&H21,Inregs,Outregs) ' routine reads keyboard
Keyboard.Char$=Chr$(0)+Chr$(Outregs.AX And &HFF) ' store extended key
Endif ' end check ascii
Endif ' end check zero flag
Select Case Len(Keyboard.Char$) ' process keyboard character type
Case 0 ' nothing entered
Exit Sub ' end routine
Case 1 ' single keystroke
Select Case Asc(Keyboard.Char$) ' process single key
Case 8, 13, 32 To 127 ' valid keys entered during i/o
Buffer=Buffer+Keyboard.Char$ ' append keystroke to buffer
Case 11 ' control-k
If Allow.Break Then ' check break allowed
Break=True ' set break flag
Endif ' end check break allowed
Case 27 ' escape key
If Chat Then ' check in chat flag
Chat=False ' set chat exit flag
Keyboard.Break=True ' set function/extended key flag
Else ' escape key at console
If Logged.In Then ' check player in game
Call Status.Line(True) ' toggles status line area
Endif ' end check player logged in game
Endif ' end check flag
End Select ' end sigle keystroke
Case 2 ' function/extended key
Select Case Asc(Right$(Keyboard.Char$,1)) ' process extended key code
Case 79 ' end key/terminate key
Call Hang.Up(4) ' routine to hang up modem with message
Keyboard.Break=True ' set function/extended key flag
Case 71 ' home key/chat key
If Chat=False Then ' check if already in chat
If Local.Mode=False Then ' check local mode not activated
If Logged.In Then ' check user logged in flag
Chat=True ' set in chat flag
Call Enter.Chat ' routine to chat with user
Chat=False ' reset in chat flag
Keyboard.Break=True ' set function/extended key flag
Endif ' end check user logged in
Endif ' end check local mode
Endif ' end check chat flag
Case 59 To 68 ' function key entered
If Logged.In Then ' check user logged in flag
Func.Buffer=Right$(Keyboard.Char$,1) ' store function key in buffer
Keyboard.Break=True ' set function/extended key flag
Endif ' end check user logged in
End Select ' end process extended key code
End Select ' end process keyboard character type
End Sub ' end routine to get/process keyboard entry
Rem * Routine to send carriage return/linefeed (cr/lf) to screen/modem.
Sub Line.Return
On Local Error Resume Next ' local error resume
Call Scrn(Chr$(13)) ' send return character to screen
Call Put.Modem(Chr$(13)) ' send cr to modem
If User.Linefeeds=False Then ' check linefeed mode
Call Put.Modem(Chr$(10)) ' send lf to modem
Endif ' end check linefeed mode
End Sub ' end routine to send cr/lf
Rem * Routine to backspace over one previous character.
Sub Back.Space
On Local Error Resume Next ' local error resume
' Store current screen location of cursor column minus one
Cursor.Column=Pos(0)-1
Locate Csrlin,Cursor.Column,0 ' locate back one space, cursor off
Print " "; ' erase character with space
Locate Csrlin,Cursor.Column,1 ' locate back one space, cursor on
If User.Echo=False Then ' check echo mode
Call Put.Modem(Chr$(8)+" "+Chr$(8)) ' send backspace to modem
Endif ' end check echo mode
End Sub ' end routine to backspace
Rem * Routine to change color. ANSI to modem, COLOR statement to screen.
Sub Out.ANSI
On Local Error Resume Next ' local error resume
Ansi.ColorCode=37 ' default to ANSI white
If Graphics.Off=False Then ' check graphics color change flag
Color.Code=Color.Code+1 ' increment current ANSI color variable
If Color.Code<31 Or Color.Code>36 Then ' check ANSI color bounds
Color.Code=31 ' reset to base ANSI color
Endif ' end check color bounds
Ansi.ColorCode=Color.Code ' store new color code
Endif ' end check graphics change flag
Call Modem.ANSI(Ansi.ColorCode) ' send ANSI color code number
End Sub ' end routine to change color
Rem * Routine to send ANSI color change code to modem/screen.
Rem * input variables:
Rem * Ansi.ColorCode - contains the Ansi color code number.
Rem * work variables:
Rem * Ansi.Output$ - stores the Ansi string to send.
Sub Modem.ANSI(Ansi.ColorCode)
On Local Error Resume Next ' local error resume
Call Convert.Color(Ansi.ColorCode) ' change screen color
If Color.Graphics Then ' check remote ANSI graphics flag
' construct ANSI code
Ansi.Output$=Chr$(27)+"[0;1;"+Mid$(Str$(Ansi.ColorCode),2)+"m"
Call Put.Modem(Ansi.Output$) ' send code to modem
Endif ' end check remote ANSI flag
End Sub ' end routine to send ANSI code
Rem * Routine to reset ANSI color code to default.
Rem * work variables:
Rem * Ansi.Output$ - stores the default Ansi color string.
Sub Reset.ANSI
On Local Error Resume Next ' local error resume
If Color.Graphics Then ' check remote ANSI graphics flag
Ansi.Output$=Chr$(27)+"[0;37m" ' construct ANSI black on white code
Call Put.Modem(Ansi.Output$) ' send code to modem
Endif ' end check remote ANSI flag
Color 7,0 ' reset local screen to black on white
Print Nul; ' display a zero length string to change color
End Sub ' end routine to reset ANSI color code
Rem * Routine to change local screen color to ANSI color code number.
Rem * input variables:
Rem * Ansi.ColorCode - the Ansi color code number.
Rem * work variables:
Rem * Scrn.ColorCode - stores the CGA screen color number.
Sub Convert.Color(Ansi.ColorCode)
On Local Error Resume Next ' local error resume
Select Case Ansi.ColorCode ' choose ANSI color code number
Case 31 ' ANSI red
Scrn.ColorCode=12 ' COLOR statement red
Case 32 ' ANSI green
Scrn.ColorCode=10 ' COLOR statement green
Case 33 ' ANSI yellow
Scrn.ColorCode=14 ' COLOR statement yellow
Case 34 ' ANSI blue
Scrn.ColorCode=9 ' COLOR statement blue
Case 35 ' ANSI magenta
Scrn.ColorCode=13 ' COLOR statement magenta
Case 36 ' ANSI cyan
Scrn.ColorCode=11 ' COLOR statement cyan
Case 37 ' ANSI white
Scrn.ColorCode=15 ' COLOR statement white
Case Else ' default ANSI white
Scrn.ColorCode=15 ' COLOR statement white
End Select ' end choose ANSI color code
Color Scrn.ColorCode,0 ' change screen color
End Sub ' end routine to change local screen color
Rem * Routine to process stored function key pressed during remote play.
Rem * input variables:
Rem * FunctionKey.Number - the ascii value of the extended function key.
Sub Function.Key(FunctionKey.Number)
On Local Error Resume Next ' local error resume
If Logged.In=False Then ' check user is logged in
Exit Sub ' exit routine
Endif ' end check user logged in
If Local.Mode Then ' check console is logged in
Select Case FunctionKey.Number ' choose function key number
Case 59 ' F1 - !Edit
Call IO.O ' empty output
Call Editor ' editor routine
Case 60 ' F2 - !Status
Call IO.O ' empty output
Call Display.Memory ' routine to display memory stats
Case 61 ' F3 - !Discard
Outpt=Action.Prompt+"!DISCARD " ' display action prompt plus command
Call IO.I ' get item to discard
Parsed.Command1=Ucase$(Inpt) ' store item name
Call Discard.Object ' routine to discard item from player inventory
Case 62 ' F4 - !Reduce
Outpt=Action.Prompt+"!REDUCE " ' display action prompt plus command
Call IO.I ' get number
Parsed.Command1=Inpt ' store number
Call Reduce.Monsters ' routine to reduce monsters in room
Case 63 ' F5 - !Call
Outpt=Action.Prompt+"!CALL " ' display action prompt plus command
Call IO.I ' get monster number
Parsed.Command1=Inpt ' store monster number
Call Summon.Monster ' routine to get a monster into room
Case 64 ' F6 - !Kill
Outpt=Action.Prompt+"!KILL " ' display action prompt plus command
Call IO.I ' get monster name
Parsed.Command1=Ucase$(Inpt) ' store monster name
Parsed.Command2=Parsed.Command1 ' store monster name
Call Kill.Monster ' routine to kill monster name
Case 65 ' F7 - !Teleport
Outpt=Action.Prompt+"!TELEPORT " ' display action prompt plus command
Call IO.I ' get room number
Parsed.Command1=Inpt ' store room number
Parsed.Command2=Parsed.Command1 ' store room number
Call Teleport.User ' routine to teleport user to a room number
Case 66 ' F8 - !Invisibility
Call IO.O ' empty output
Call Toggle.Invisible ' routine to toggle invisibility mode
Case 67 ' F9 - !Get
Outpt=Action.Prompt+"!GET " ' display action prompt plus command
Call IO.I ' get item name
Inpt=Ucase$(Inpt) ' store item name
Stored.Parsed.Command2=Inpt ' store item name
Call Drop.Object ' routine to get an item
Case 68 ' F9 - !Link
Call IO.O ' empty output
Call Link.Room ' routine to add/remove room links
End Select ' end select function key number
Exit Sub ' exit routine
Endif ' end check console logged in
Inpt=Nul ' reset input string
Outpt=Nul ' reset output string
Call IO.O ' send empty cr/lf
Select Case FunctionKey.Number ' choose function key number
Case 59 ' F1 - !Edit
Outpt="System Operator is using the editor. Please wait.." ' send message
Call IO.O ' sysop will edit during game
Call Put.User.Record ' store user stats
Local.Mode=True ' set local mode
Outpt="Sysop: Enter room number to edit, or press enter to start !Edit:"
Call IO.O ' write local sysop info message
Outpt=Action.Prompt+"!EDIT " ' display action prompt plus command
Call IO.I ' get room number to edit(if any)
If Inpt<>Nul Then ' determine edit room number
Room.Number=Int(Val(Inpt)) ' room number parameter to edit
If Room.Number>False And _
Room.Number<=Lof(RoomFile)/Len(RoomRecord) Then ' range
Call Change.Room(Room.Number) ' edit room from number parameter
Endif ' end compare room number range
Else ' edit users
Call Editor ' editor routine
Endif ' end determine edit prompt
Local.Mode=False ' reset local mode
Case 60 ' F2 - !Status
Local.Mode=True ' reset local mode
Call Display.Memory ' routine to display memory stats
Local.Mode=False ' restore local mode
Case 61 ' F3 - !Discard
Local.Mode=True ' reset local mode
Outpt="Sysop: Enter player inventory treasure name to discard:"
Call IO.O ' write local sysop info message
Outpt=Action.Prompt+"!DISCARD " ' display action prompt plus command
Call IO.I ' get item to discard
Parsed.Command1=Ucase$(Inpt) ' store item name
Call Discard.Object ' routine to discard item from player inventory
Local.Mode=False ' restore local mode
Case 62 ' F4 - !Reduce
Local.Mode=True ' reset local mode
Outpt="Sysop: Enter number of monsters in room to reduce to:"
Call IO.O ' write local sysop info message
Outpt=Action.Prompt+"!REDUCE " ' display action prompt plus command
Call IO.I ' get number
Parsed.Command1=Inpt ' store number
Call Reduce.Monsters ' routine to reduce monsters in room
Local.Mode=False ' restore local mode
Case 63 ' F5 - !Call
Local.Mode=True ' reset local mode
Outpt="Sysop: Enter name or number of monster to call:"
Call IO.O ' write local sysop info message
Outpt=Action.Prompt+"!CALL " ' display action prompt plus command
Call IO.I ' get monster number
Local.Mode=False ' restore local mode
Parsed.Command1=Inpt ' store monster number
Call Summon.Monster ' routine to get a monster into room
Case 64 ' F6 - !Kill
Local.Mode=True ' reset local mode
Outpt="Sysop: Enter name of monster in room to kill off:"
Call IO.O ' write local sysop info message
Outpt=Action.Prompt+"!KILL " ' display action prompt plus command
Call IO.I ' get monster name
Local.Mode=False ' restore local mode
Parsed.Command1=Ucase$(Inpt) ' store monster name
Parsed.Command2=Parsed.Command1 ' store monster name
Call Kill.Monster ' routine to kill monster name
Case 65 ' F7 - !Teleport
Local.Mode=True ' reset local mode
Outpt="Sysop: Enter number of room to teleport player to:"
Call IO.O ' write local sysop info message
Outpt=Action.Prompt+"!TELEPORT " ' display action prompt plus command
Call IO.I ' get room number
Local.Mode=False ' restore local mode
Parsed.Command1=Inpt ' store room number
Parsed.Command2=Parsed.Command1 ' store room number
Call Teleport.User ' routine to teleport user to a room number
Case 66 ' F8 - !Invisibility
Call Toggle.Invisible ' routine to toggle invisibility mode
Case 67 ' F9 - !Get
Local.Mode=True ' reset local mode
Outpt="Sysop: Enter name of treasure item to get from treasure file:"
Call IO.O ' write local sysop info message
Outpt=Action.Prompt+"!GET " ' display action prompt plus command
Call IO.I ' get item name
Local.Mode=False ' restore local mode
Inpt=Ucase$(Inpt) ' store item name
Stored.Parsed.Command2=Inpt ' store item name
Call Drop.Object ' routine to get an item
Case 68 ' F10 - !Link
Outpt="System Operator is using the editor. Please wait.." ' send message
Call IO.O ' sysop will edit during game
Local.Mode=True ' reset local mode
Call Link.Room ' routine to add/remove room links
Local.Mode=False ' restore local mode
End Select ' end choose function key number
Outpt=Nul ' reset output string
Inpt=Nul ' reset input string
End Sub ' end routine to process game function keys
Rem * Routine to hang up modem with a message.
Rem * input variables:
Rem * HangUp.Type - the hang up message to display.
Sub Hang.Up(HangUp.Type)
On Local Error Resume Next ' local error resume
Allow.Break=False ' disable break
Break=False ' reset control-k flag
Buffer=Nul ' reset buffer
Func.Buffer=Nul ' reset function key buffer
Graphics.Off=True ' turn off graphics color changing
Inpt=Nul ' set input string to null
Outpt=Nul ' set output string to null
Timeon=Timer ' store current time in time on variable
Time.Left=180 ' store 3 minutes remaining in variable
Call IO.O ' empty output
Outpt="Dnddoor terminating at "+FNclock$+", "+Node+"." ' make message
Call IO.O ' send message
Select Case HangUp.Type ' choose hang up message
Case 1 ' type 1
Outpt="Connect timeout"
Case 2 ' type 2
Outpt="Time limit exceeded"
Case 4 ' type 4
Outpt="Forced logoff"
Case 5 ' type 5
Outpt="Call limit exceeded"
Case 6 ' type 6
Call Restriction.Notice ' routine to display restricted time
Case 7 ' type 7
Outpt="Illegal login attempt"
Case 8 ' type 8
Outpt="Password verification!"
End Select ' end choose hang up message
Outpt="Reason: "+Outpt+"."
Call IO.O ' display message
Call Status.Line(-2) ' clear status line areas
Color 7,0 ' reset screen color
End ' terminate program
End Sub ' end routine to hang up modem
Rem * Routine to put a character on the screen at current row/column.
Rem * input variables:
Rem * Scrn.Char$ - the character to display.
Sub Scrn(Scrn.Char$)
On Local Error Resume Next ' local error resume
Row=Csrlin-1 ' calculate current row, minus one for bios offset
Column=Pos(0)-1 ' calculate current column, minus one for bios offset
Select Case Row ' compare current row
Case Is>Max.Row ' will scroll past max.row (status area)
Call Scroll.Screen ' scroll the screen
Case Max.Row ' scroll at max.row (status area)
If Column=User.LineLength Then ' verify column to scroll
Print; ' force screen scroll from basic
If Scrn.Char$=Chr$(13) Then ' check cr/lf at corner
Exit Sub ' return from routine
Endif ' end check corner cr/lf
Endif ' end verify column
End Select ' end compare row
Print Scrn.Char$; ' display character at row, column
End Sub ' end routine to display a character on screen
Rem * Routine to scroll screen at Max.Row.
' ----------1006-------------------------------
' INT 10 - VIDEO - SCROLL UP WINDOW
' AH = 06h
' AL = number of lines by which to scroll up
' BH = attribute used to write blank lines at bottom of window
' CH,CL = row,column of window's upper left corner
' DH,DL = row,column of window's lower right corner
Sub Scroll.Screen
On Local Error Resume Next ' local error resume
Inregs.AX=&H0601 ' function AH=06, scroll 1 lines
Inregs.BX=&H0700 ' attribute of blank line, white on black
Inregs.CX=&H0000 ' upper left corner, 0,0
Inregs.DX=Max.Row*256+&H4F ' lower right corner, DH=Max.Row,DL=80
Call Interrupt(&H10,Inregs,Outregs) ' routine for BIOS call, function Hex10
Locate Max.Row+1,1 ' set cursor at lower row, column 1
End Sub ' end routine to scroll screen
Rem * Routine to make users restricted time online output message.
Sub Restriction.Notice
On Local Error Resume Next ' local error resume
Outpt="Your calls are restricted from" ' start of message
Restrict.Time=UserRecord.FromHour ' store users hour of restricted time
If Restrict.Time>12 Then ' compare 24 hour format time to standard time
Outpt=Outpt+Str$(UserRecord.FromHour-12) ' decrement to 24 hour format
Inpt="pm" ' 24 hour indicator
Else ' compare to standard time
Outpt=Outpt+Str$(UserRecord.FromHour) ' store hour format
Inpt="am" ' 12 hour indicator
Endif ' end compare time type
' format string of restricted time from, plus minutes
Outpt=Outpt+":"+Right$(Str$(UserRecord.FromMin+100),2)+Inpt+" to"
Restrict.Time=UserRecord.ToHour ' store users hour of restricted time
If Restrict.Time>12 Then ' compare 24 hour format time to standard time
Outpt=Outpt+Str$(UserRecord.ToHour-12) ' decrement to 24 huur format
Inpt="pm" ' 24 hour indicator
Else ' compare to standard time
Outpt=Outpt+Str$(UserRecord.ToHour) ' store hour format
Inpt="am" ' 12 hour indicator
Endif ' end compare time type
' format string of restricted time to, plus minutes
Outpt=Outpt+":"+Right$(Str$(UserRecord.ToMin+100),2)+Inpt+"."
End Sub ' end routine to make restricted time message
Rem * Routine to display a text file.
Rem * input variables:
Rem * File.Output$ - filename of file to display.
Rem * processing variables:
Rem * Allow.Break - flag to allow control-k.
Rem * Break - set to true if control-k pressed.
Rem * Continue - set to true for continuous output
Rem * Page.Length, Page.Break - paginating variables.
Sub Out.File(File.Output$)
On Local Error Goto OutFile.Error ' local error routine
Graphics.Off=True ' turn off graphics color changing
File.Page=User.Pagelength ' store pagelength
If File.Page=False Then ' check pagelength
File.Page=24 ' reset pagelength
Endif ' end check pagelength
Allow.Break=True ' turn on allow break flag
Break=False ' reset control-k flag
Continue=False ' reset continuous flag
Page.Length=False ' reset page counter
Close #TempFile ' close temporary file
If Dir$(File.Output$)=Nul Then ' check file exists
Outpt="File "+File.Output$+" not found." ' make output
Call IO.O ' send output
Goto Outfile.Exit ' jump to exit
Endif ' end check file exists
Open File.Output$ For Random Shared As #TempFile Len=1 ' open the file
If Lof(TempFile)=False Then ' check file length
Outpt="File "+File.Output$+" length zero." ' make output
Call IO.O ' send output
Goto Outfile.Exit ' jump to exit
Endif ' end check file length
Close #TempFile ' close temporary file
Open File.Output$ For Input Shared As #TempFile ' open the file
Do While Not Eof(TempFile) ' loop through all the text in file
Line Input #TempFile,Outpt ' get the next text line
Call IO.O ' display the text line
If Break Then ' check control-k pressed
Exit Do ' exit text input loop
Endif ' end check control-k
Page.Length=Page.Length+1 ' increment line displayed counter
If Page.Length=File.Page Then ' compare page counter
Page.Length=False ' reset page counter
If Continue=False Then ' check continuous flag
Call More.Prompt ' routine to prompt for more
If No Then ' check more prompt returned no flag
Exit Do ' exit text input loop
Endif ' end check more prompt no flag
Endif ' end check page counter
Endif ' end check continuous flag
Loop ' end text file input loop
Allow.Break=False ' reset allow break flag
If Break Then ' check control-k flag
Break=False ' reset control-k flag
Outpt=Nul ' set output to null
Call IO.O ' send empty return
Endif ' end check control-k flag
Graphics.Off=False ' reset graphics color changer
If Page.Length Then ' check page counter
Call More.Prompt ' routine to prompt for more
Endif ' end check page counter
OutFile.Exit:
Allow.Break=False ' reset allow break flag
Break=False ' reset control-k flag
Graphics.Off=False ' reset color change flag
Exit Sub ' exit routine
OutFile.Error:
Resume OutFile.Exit
End Sub ' end routine to display a text file
Rem * Routine to display the more prompt.
Rem * work variables:
Rem * Allow.Type - store break flag type
Rem * Graphics.Type - stores graphics cycling variable.
Sub More.Prompt
On Local Error Resume Next ' local error resume
Allow.Type=Allow.Break ' store break type
Allow.Break=False ' disable break during prompt
Graphics.Type=Graphics.Off ' store graphics changing flag
Graphics.Off=False ' turn off graphics changing
Outpt=More$ ' get the more prompt
Line.Length=1 ' allow one key input
No.Echo=True ' do not echo any key
Call IO.I ' input routine
Allow.Break=Allow.Type ' restore break type
Graphics.Off=Graphics.Type ' restore graphics changing flag
End Sub
Rem * Routine to restrict a room direction to a players level.
Rem * input variable:
Rem * Room.Direction - direction to restrict.
Rem * output variable:
Rem * Direction.Restricted - set true to restrict player.
Rem * work variables:
Rem * Action.Number - contains the room action number.
Sub Restrict(Room.Direction,Direction.Restricted)
On Local Error Resume Next ' local error resume
Direction.Restricted=False ' reset return variable
Action.Number=RoomRecord.Action ' store room action number
If Action.Number>False And _
Action.Number<=Lof(ActionFile)/Len(ActionRecord) Then ' check file bounds
Call Read.Record(ActionFile,Action.Number) ' read action record
Select Case ActionRecord.Level ' determine player level
Case Is>False ' player at least room level
If UserRecord.Level<ActionRecord.Level Then ' compare levels
' compare room direction
If ActionRecord.Restrictions And 2^Room.Direction Then
Direction.Restricted=True ' direction restricted flag
Endif ' end compare room direction
Endif ' end compare levels
Case Is<False ' player at most room level
If UserRecord.Level>Abs(ActionRecord.Level) Then ' compare levels
' compare room direction
If ActionRecord.Restrictions And 2^Room.Direction Then
Direction.Restricted=True ' direction restricted flag
Endif ' end compare room direction
Endif ' end compare levels
End Select ' end choose room/player level
Endif ' end check file bounds
End Sub ' end routine to restrict room entrance
Rem * Routine to restrict a room direction to entry type.
Rem * output variable:
Rem * Direction.Restricted - set true to restrict player.
Rem * work variables:
Rem * Action.Number - contains the room action number.
Sub Restrict.Room.Type(Direction.Restricted)
On Local Error Resume Next ' local error resume
Call Read.Room.Record(Next.Room) ' read next room number record
Direction.Restricted=False ' reset return variable
Action.Number=RoomRecord.Action ' store room action number
If Action.Number>False And _
Action.Number<=Lof(ActionFile)/Len(ActionRecord) Then ' check file bounds
Call Read.Record(ActionFile,Action.Number) ' read action record
If ActionRecord.Attribute2=Air Then ' verify room is air
If Entry.Command<>Fly Then ' verify player fly
Direction.Restricted=True ' set restricted flag
Endif ' end verify player fly command
Endif ' end verify room air attribute
If ActionRecord.Attribute2<>Air Then ' verify room is air
If Entry.Command=Fly Then ' verify player fly
Direction.Restricted=True ' set restricted flag
Endif ' end verify player fly command
Endif ' end verify room air attribute
If ActionRecord.Attribute2=Water Then ' verify room water
If Entry.Command<>Swim Then ' verify player swim
Direction.Restricted=True ' set restricted flag
Endif ' end verify player swim command
Endif ' end verify room water attribute
If ActionRecord.Attribute2<>Water Then ' verify room water
If Entry.Command=Swim Then ' verify player swim
Direction.Restricted=True ' set restricted flag
Endif ' end verify player swim command
Endif ' end verify room water attribute
Else ' check file bounds
If Entry.Command=Fly Or Entry.Command=Swim Then ' check room entry
Direction.Restricted=True ' set restricted flag
Endif ' end check room entry
Endif ' end check file bounds
Call Read.Room.Record(Room) ' read current room record
End Sub ' end routine to restrict room entrance
Rem * Routine to determine validity of a string.
Rem * input variables:
Rem * Validate$ - string to verify.
Rem * Length - stores length string must be (an even number).
Rem * output variables:
Rem * Validate$ - set to null if invalid.
Rem * work variables:
Rem * String.Length - loop counter of string to validate.
Rem * Char - character in string to check.
Sub Valid(Validate$,Length)
On Local Error Resume Next ' local error resume
Validate$=Left$(Validate$,Length) ' truncate string to length
Validate$=Validate$+Space$(Length-Len(Validate$)) ' extend string length
For String.Length=1 To Len(Validate$) ' loop through all characters in string
' get ascii value of string character
Char=Asc(Mid$(Validate$,String.Length,1))
If Char<32 Or Char>127 Then ' verify bounds of character
Validate$=Nul ' return null if not valid
Exit Sub ' end routine
Endif ' end verify ascii code
Next ' end loop
End Sub ' end routine to determine string validity
Rem * Routine to encrypt a string.
Rem * input variables:
Rem * Encrypted$ - the string to encrypt.
Rem * Add.Checksum - set to false to add byte checksum.
Rem * output variables:
Rem * Encrypted$ - the encrypted string.
Rem * work variables:
Rem * Encrypt.Work$ - variable containing encrypted string.
Rem * Encrypt.Count - loop variable.
Rem * Encrypted.Sum - calculated byte encryption variable.
Rem * Encrypt.Work1, Encrypt.Work2, Encrypt.Work3.
Sub Encrypt(Encrypted$,Add.Checksum)
On Local Error Resume Next ' local error resume
Encrypt.Work$=Nul ' reset encrypted work variable
' loop through string to encrypt in byte pairs
For Encrypt.Count=1 To Len(Encrypted$) Step 2
' get first byte substring of pair
Encrypt.Work1=Asc(Mid$(Encrypted$,Encrypt.Count,1))
' get second byte substring of pair
Encrypt.Work2=Asc(Mid$(Encrypted$,Encrypt.Count+1,1))
If Add.Checksum Then ' check checksum ordering
Encrypted.Sum=20000 ' checksum bit off
Else ' checksum ordering on
Encrypt.Work3=Encrypt.Work1+Encrypt.Work2 ' compute sum
' compute even sum of bytes
If Int(Encrypt.Work3/2)=Encrypt.Work3/2 Then
Encrypted.Sum=10000 ' checksum bit for even parity
Else ' checksum ordering
Encrypted.Sum=False ' checksum bit for odd parity
Endif ' end check checksum ordering
Endif ' end verify checksum used
' convert checksum and bytes to integer
Encrypted.Sum=Encrypted.Sum+(Encrypt.Work1-32)*100+(Encrypt.Work2-32)
' convert integer to string
Encrypt.Work$=Encrypt.Work$+Mki$(Encrypted.Sum)
Next ' end loop through string to encrypt
Encrypted$=Encrypt.Work$ ' set return variable to encrypted string
End Sub ' end routine to encrypt a string
Rem * Routine to decrypt a string.
Rem * input variables:
Rem * Decrypted$ - the string to decrypt.
Rem * output variables:
Rem * Decrypted$ - the decrypted string, or null for checksum error.
Rem * work variables:
Rem * Decrypt.Work$ - variable containing encrypted string.
Rem * Decrypt.Count - loop variable.
Rem * Decrypted.Sum - calculated byte encryption variable.
Rem * Decrypt.Work1, Decrypt.Work2, Decrypt.Work3.
Rem * Decrypted.Checksum - contains the bit parity.
Sub Decrypt(Decrypted$)
On Local Error Resume Next ' local error resume
Decrypt.Work$=Nul ' reset decrypted work variable
' loop through string to decrypt in byte pairs
For Decrypt.Count=1 To Len(Decrypted$) Step 2
' convert the two byte string to integer
Decrypted.Sum=Cvi(Mid$(Decrypted$,Decrypt.Count,2))
' divide two byte integer to one byte integer
Decrypted.Checksum=Decrypted.Sum\100
' get low byte from pair
Decrypt.Work1=Decrypted.Sum-Decrypted.Checksum*100
' adjust byte ascii value
Decrypt.Work1=Decrypt.Work1+32
' reset integer of string to high byte
Decrypted.Sum=Decrypted.Checksum
' divide byte integer out leaving checksum bit
Decrypted.Checksum=Decrypted.Sum\100
' get high byte from pair
Decrypt.Work2=Decrypted.Sum-Decrypted.CHecksum*100
Decrypt.Work2=Decrypt.Work2+32 ' adjust byte ascii value
Decrypt.Work3=Decrypt.Work1+Decrypt.Work2 ' compute sum
Select Case Decrypted.Checksum ' select checksum parity
Case 0 ' verify the checksum bit for odd parity
If Int(Decrypt.Work3/2)=Decrypt.Work3/2 Then ' check not odd parity
Decrypted$=Nul ' return null for checksum error
Exit Sub ' end routine
Endif ' end check not odd parity
Case 1 ' verify the checksum bit for even parity
If Int(Decrypt.Work3/2)<>Decrypt.Work3/2 Then ' check not even parity
Decrypted$=Nul ' return null for checksum error
Exit Sub ' end routine
Endif ' end check not even parity
End Select ' end verify checksum bit
' convert integer bytes to string
Decrypt.Work$=Decrypt.Work$+Chr$(Decrypt.Work2)+Chr$(Decrypt.Work1)
Next ' end loop through string to decrypt
Decrypted$=Decrypt.Work$ ' set return variable to decryptes string
End Sub ' end routine to decrypt a string
Rem * Routine to store a file record
Rem * input variables:
Rem * File.Number - number of the file to write record.
Rem * Record.Number - the number of the record to write.
Sub Share.Record(File.Number,Record.Number)
On Local Error Goto Share.Error ' local error trap
If Share.Installed Then ' check share loaded
Lock File.Number,Record.Number ' lock record number
Endif ' end check share loaded
Select Case File.Number ' select file number to write a record to
Case UserFile ' type 1
Put UserFile,Record.Number,UserRecord ' write user record
Case NonPlayerFile ' type 2
Put NonPlayerFile,Record.Number,MonsterRecord ' write nonplayers record
Case ObjectFile ' type 4
Put ObjectFile,Record.Number,ObjectRecord ' write object record
Case MonsterFile ' type 5
Put MonsterFile,Record.Number,MonsterRecord ' write monsters record
Case TreasureFile ' type 6
Put TreasureFile,Record.Number,TreasureRecord ' write treasure record
Case MonTalkFile ' type 7
Put MonTalkFile,Record.Number,MonsterTalkRecord ' write monster talk record
Case MonClassFile ' type 8
Put MonClassFile,Record.Number,MonclassRecord ' write monster class record
Case SpellFile ' type 9
Put SpellFile,Record.Number,SpellRecord ' write spell record
Case TableFile ' type 10
Put TableFile,Record.Number,TableRecord ' write message table record
Case ActionFile ' type 12
Put ActionFile,Record.Number,ActionRecord ' write action record
Case TempFile ' type 13
Put TempFile,Record.Number,TableRecord ' write temp table record
Case HelpFile ' type 15
Put HelpFile,Record.Number,HelpRecord
End Select ' end select file number
If Share.Installed Then ' check share loaded
Unlock File.Number,Record.Number ' lock record number
Endif ' end check share loaded
Exit Sub ' exit record routine
Share.Error:
If Share.Installed Then ' compare share loaded
If Err=70 Then ' check record lock error
Resume ' resume to same statement
Endif ' end check record lock error
Endif ' end compare share loaded
Resume Next ' resume from error trap
End Sub ' end routine to write file record using share
Rem * Routine to read a file record
Rem * input variables:
Rem * File.Number - number of the file to read record.
Rem * Record.Number - the number of the record to read.
Sub Read.Record(File.Number,Record.Number)
On Local Error Goto Share.Read ' local error trap
Select Case File.Number ' select file number to read a record to
Case UserFile ' type 1
Get UserFile,Record.Number,UserRecord ' read user record
Case NonPlayerFile ' type 2
Get NonPlayerFile,Record.Number,MonsterRecord ' read nonplayers record
Case ObjectFile ' type 4
Get ObjectFile,Record.Number,ObjectRecord ' read object record
Case MonsterFile ' type 5
Get MonsterFile,Record.Number,MonsterRecord ' read monsters record
Case TreasureFile ' type 6
Get TreasureFile,Record.Number,TreasureRecord ' read treasure record
Case MonTalkFile ' type 7
Get MonTalkFile,Record.Number,MonsterTalkRecord ' read monster talk record
Case MonClassFile ' type 8
Get MonClassFile,Record.Number,MonclassRecord ' read monster class record
Case SpellFile ' type 9
Get SpellFile,Record.Number,SpellRecord ' read spell record
Case TableFile ' type 10
Get TableFile,Record.Number,TableRecord ' read message table record
Case ActionFile ' type 12
Get ActionFile,Record.Number,ActionRecord ' read action record
Case TempFile ' type 13
Get TempFile,Record.Number,TableRecord ' read temp table record
Case HelpFile ' type 15
Get HelpFile,Record.Number,HelpRecord ' read help record
End Select ' end select file number
Exit Sub ' exit record routine
Share.Read:
If Share.Installed Then ' compare share loaded
If Err=70 Then ' check record lock error
Resume ' resume to same statement
Endif ' end check record lock error
Endif ' end compare share loaded
Resume Next ' resume from error trap
End Sub ' end routine to read file record using share
Rem * Routine to store a message file record
Rem * input variables:
Rem * File.Number - number of the file to write record.
Rem * Record.Number! - the number of the record to write.
Sub Share.Message(File.Number,Record.Number!)
On Local Error Goto Message.Error ' local error trap
If Share.Installed Then ' check share loaded
Lock File.Number,Record.Number! ' lock record number
Endif ' end check share loaded
Put File.Number,Record.Number!,MessageRecord ' write message record
If Share.Installed Then ' check share loaded
Unlock File.Number,Record.Number! ' lock record number
Endif ' end check share loaded
Exit Sub ' exit record routine
Message.Error:
If Share.Installed Then ' compare share loaded
If Err=70 Then ' check record lock error
Resume ' resume to same statement
Endif ' end check record lock error
Endif ' end compare share loaded
Resume Next ' resume from error trap
End Sub ' end routine to write file record using share
Rem * Routine to read a message file record
Rem * input variables:
Rem * File.Number - number of the file to read record.
Rem * Record.Number! - the number of the record to read.
Sub Read.Message.Record(File.Number,Record.Number!)
On Local Error Goto Message.Read.Error ' local error trap
Get File.Number,Record.Number!,MessageRecord ' write message record
Exit Sub ' exit record routine
Message.Read.Error:
If Share.Installed Then ' compare share loaded
If Err=70 Then ' check record lock error
Resume ' resume to same statement
Endif ' end check record lock error
Endif ' end compare share loaded
Resume Next ' resume from error trap
End Sub ' end routine to write file record using share
Rem * Routine to store a room file record
Rem * input variables:
Rem * Record.Number! - the number of the record to write.
Sub Share.Room.Record(Record.Number!)
On Local Error Goto Room.Error ' local error trap
If Share.Installed Then ' check share loaded
Lock RoomFile,Record.Number! ' lock record number
Endif ' end check share loaded
Put RoomFile,Record.Number!,RoomRecord ' write room record
If Share.Installed Then ' check share loaded
Unlock RoomFile,Record.Number! ' lock record number
Endif ' end check share loaded
Exit Sub ' exit record routine
Room.Error:
If Share.Installed Then ' compare share loaded
If Err=70 Then ' check record lock error
Resume ' resume to same statement
Endif ' end check record lock error
Endif ' end compare share loaded
Resume Next ' resume from error trap
End Sub ' end routine to write file record using share
Rem * Routine to read a room file record
Rem * input variables:
Rem * Record.Number! - the number of the record to read.
Sub Read.Room.Record(Record.Number!)
On Local Error Goto Room.Read.Error ' local error trap
Get RoomFile,Record.Number!,RoomRecord ' write message record
Exit Sub ' exit record routine
Room.Read.Error:
If Share.Installed Then ' compare share loaded
If Err=70 Then ' check record lock error
Resume ' resume to same statement
Endif ' end check record lock error
Endif ' end compare share loaded
Resume Next ' resume from error trap
End Sub ' end routine to write file record using share
SysopCommands1:
Data "ABORT","HINT","CALL","EDIT","HELP","INVISIBLE","LINK","<>","STATUS"
SysopCommands2:
Data "<>","CALL","DISCARD","EDIT","GET","HELP","KILL","REDUCE","TELEPORT"
CommandSet1:
Data "KILL","ATTACK","HIT","STRIKE","READ","LOOK","RUN","PANIC","SEARCH","SAVE"
Data "INFORMATION","INVENTORY","SUICIDE","TRAIN","HEALTH","APPEAL","BYE","STOP","QUIT","END"
Data "EXPERIENCE","HELP","HIDE","CAST","LIST","BRIEF","BANK","TIME","DATE","CLOCK"
Data "CHARM","BEGUILE","ANSI","SHIELD","GUARD","<>","<>","<>","LUNGE","DODGE"
Data "TOP","BLESS","CURSE","PASSWORD","MAIL","USERS","CHAT","EXIT","LEAVE","CLIMB"
Data "STORE","LOGIN","RELOGIN","STATUS","LINELENGTH","CATALOG","LINEFEEDS","PAGELENGTH","ECHO","WORDWRAP"
Data "ALIGNMENT","<>","<>","NORTH","EAST","SOUTH","WEST","NORTHEAST","SOUTHEAST","SOUTHWEST"
Data "NORTHWEST","UP","DOWN","IN","OUT","HINT","SORT","COMMANDS","<>","<>"
Data "<>","<>","REROLL","<>","WISH"
CommandSet2:
Data "GO","ENTER","READ","EXAMINE","LOOK","USE","GET","TAKE","DROP","PUT"
Data "SELL","PAWN","BREAK","SMASH","CLOSE","OPEN","DRAW","WIELD","HOLD","WEAR"
Data "RETURN","CAST","BUY","LOCK","UNLOCK","PICKLOCK","FIX","REPAIR","RECHARGE","DRINK"
Data "<>","THROW","STEAL","<>","BLESS","CURSE","FUEL","<>","<>","TALK"
Data "PARLEY","BRIBE","OFFER","LOAD","FIRE","MOUNT","DISMOUNT","RIDE","HIDE","SEARCH"
Data "HELP","IDENTIFY","<>","<>","KILL","ATTACK","HIT","STRIKE","BACKSTAB","CIRCLE"
Data "FEINT","PARRY","THRUST","CHARGE","TURN","COUNTER","BEMUSE","BEFUDDLE","PUMMEL","RESIST"
Data "PSIONIC","EAT","DRIVE","FLY","MOVE","LAUNCH","LEARN","LIGHT","SWIM","EXIT"
Data "LEAVE","BEAT","PUNCH","BEWITCH","BEWILDER"
Config.Data:
Data 12,4,6,3,9,6,10,5,10,3,5,4,9,6,5,4,11,5,6,3,11,4,6,3,10,3,7,3,9,6,8,3,125,125,125,125,250,250,250,250
Data "Lord","Wizard","Assassin","Bard","Monk","Knight","Priest","Empress","Assistant DM","Dungeon Master"
Data "Human","Elf","Gnome","Dwarf","Halfling","Half-elf","Half-orc","Ogre"
Data "Fighter","Magic User","Thief","Cleric","Paladin","Ranger","Druid","Lady","Assistant DM","Dungeon Master"
Data "Strength","Intelligence","Wisdom","Dexterity","Constitution","Piety","Charisma"
Data "north","east","south","west","northeast","southeast","southwest","northwest","up","down","in","out"
Data "blunt","pole","sharp","thrusting","good","neutral","evil","lawful","neutral","chaotic"