games@tekred.TEK.COM (12/01/88)
Submitted by: Richard Skrenta <skrenta@nuacc.acns.nwu.edu>
Comp.sources.games: Volume 5, Issue 91
Archive-name: monster/Part04
#! /bin/sh
# This is a shell archive. Remove anything before this line, then unpack
# it by saving it into a file and typing "sh file". To overwrite existing
# files, type "sh file -c". You can also feed this as standard input via
# unshar, or by typing "sh <file", e.g.. If this archive is complete, you
# will see the following message at the end:
# "End of archive 4 (of 6)."
# Contents: install.txt mon1.pas
# Wrapped by billr@saab on Wed Nov 30 11:28:58 1988
PATH=/bin:/usr/bin:/usr/ucb ; export PATH
if test -f 'install.txt' -a "${1}" != "-c" ; then
echo shar: Will not clobber existing file \"'install.txt'\"
else
echo shar: Extracting \"'install.txt'\" \(1752 characters\)
sed "s/^X//" >'install.txt' <<'END_OF_FILE'
XInstallation Instructions for Monster:
X======================================
X
XThe Monster source code comes in three files:
X
X guts.pas short. VMS system calls and such.
X mon.pas large. The Monster code.
X privusers.pas very short. Local definitions to make Monster
X work on your system.
X
XYou should edit privusers.pas before compiling. Put in the userid's of
Xpeople who will be the game administrators and set the ROOT variable to
Xpoint to the directory where the Monster datafiles will be kept.
X
XThis directory should have read/write access for everyone who will play
XMonster. You can either do this with SET PROT=(W:RWE) or with ACL's.
X
XAfter you've got this all setup, compile Monster:
X
X pas guts
X pas mon
X link mon,guts
X rename mon.exe monster.exe
X
XNow, before you let anyone else play, RUN MONSTER.
XWhen it says "Hit return to start: " DON'T. Instead, this very first
Xtime only, type "rebuild". This will make Monster go and create all of
Xits special datafiles in the directory pointed to by the root variable in
Xprivusers.pas. After Monster is done making its files you will appear in
Xa very small and empty world. Time to start creating!
X
XWe've got a pretty large Monster universe here at Northwestern. It's about
X250+ rooms, and took several months for many people to create. I thought
Xabout shipping the world with the game, but most of the fun of Monster is
Xcreating your own rooms, and it would be difficult to make our Monster world
Xmesh with a foreign VMS system (all the room ownership would be wrong and
Xsuch). If you have problems programming rooms post a note to GameMasters,
Xrec.games.programmer, or send a note here.
X
XLet me know how you like Monster,
X
XRich Skrenta
Xskrenta@nuacc.acns.nwu.edu
Xskrenta@nuacc.bitnet
END_OF_FILE
if test 1752 -ne `wc -c <'install.txt'`; then
echo shar: \"'install.txt'\" unpacked with wrong size!
fi
# end of 'install.txt'
fi
if test -f 'mon1.pas' -a "${1}" != "-c" ; then
echo shar: Will not clobber existing file \"'mon1.pas'\"
else
echo shar: Extracting \"'mon1.pas'\" \(54408 characters\)
sed "s/^X//" >'mon1.pas' <<'END_OF_FILE'
X{
X
X This is Monster, a multiuser adventure game system
X where the players create the universe.
X
X Written by Rich Skrenta at Northwestern University, 1988.
X
X skrenta@nuacc.acns.nwu.edu
X skrenta@nuacc.bitnet
X
X}
X
Xprogram monster(input,output);
X
Xconst
X
X%include 'privusers.pas'
X
X veryshortlen = 12; { very short string length for userid's etc }
X shortlen = 20; { ordinary short string }
X
X maxobjs = 15; { max objects allow on floor in a room }
X maxpeople = 10; { max people allowed in a room }
X maxplayers = 300; { max log entries to make for players }
X maxcmds = 75; { top value for cmd keyword slots }
X maxshow = 50; { top value for set/show keywords }
X maxexit = 6; { 6 exits from each loc: NSEWUD }
X maxroom = 1000; { Total maximum ever possible }
X maxdetail = 5; { max num of detail keys/descriptions per room }
X maxevent = 15; { event slots per event block }
X maxindex = 10000; { top value for bitmap allocation }
X maxhold = 6; { max # of things a player can be holding }
X maxerr = 15; { # of consecutive record collisions before the
X the deadlock error message is printed }
X numevnts = 10; { # of different event records to be maintained }
X numpunches = 12; { # of different kinds of punches there are }
X maxparm = 20; { parms for object USEs }
X maxspells = 50; { total number of spells available }
X
X descmax = 10; { lines per description block }
X
X
X DEFAULT_LINE = 32000; { A virtual one liner record number that
X really means "use the default one liner
X description instead of reading one from
X the file" }
X
X{ Mnemonics for directions }
X
X north = 1;
X south = 2;
X east = 3;
X west = 4;
X up = 5;
X down = 6;
X
X
X{ Index record mnemonics }
X
X I_BLOCK = 1; { True if description block is not used }
X I_LINE = 2; { True if line slot is not used }
X I_ROOM = 3; { True if room slot is not in use }
X I_PLAYER = 4; { True if slot is not occupied by a player }
X I_ASLEEP = 5; { True if player is not playing }
X I_OBJECT = 6; { True if object record is not being used }
X I_INT = 7; { True if int record is not being used }
X
X{ Integer record mnemonics }
X
X N_LOCATION = 1; { Player's location }
X N_NUMROOMS = 2; { How many rooms they've made }
X N_ALLOW = 3; { How many rooms they're allowed to make }
X N_ACCEPT = 4; { Number of open accept exits they have }
X N_EXPERIENCE = 5; { How "good" they are }
X N_SELF = 6; { player's self descriptions }
X
X{ object kind mnemonics }
X
X O_BLAND = 0; { bland object, good for keys }
X O_WEAPON = 1;
X O_ARMOR = 2;
X O_THRUSTER = 3; { use puts player through an exit }
X O_CLOAK = 4;
X
X O_BAG = 100;
X O_CRYSTAL = 101;
X O_WAND = 102;
X O_HAND = 103;
X
X
X{ Command Mnemonics }
X error = 0;
X setnam = 1;
X help = 2;
X quest = 3;
X quit = 4;
X look = 5;
X go = 6;
X form = 7;
X link = 8;
X unlink = 9;
X c_whisper = 10;
X poof = 11;
X desc = 12;
X dbg = 14;
X say = 15;
X
X c_rooms = 17;
X c_system = 18;
X c_disown = 19;
X c_claim = 20;
X c_create = 21;
X c_public = 22;
X c_accept = 23;
X c_refuse = 24;
X c_zap = 25;
X c_hide = 26;
X c_l = 27;
X c_north = 28;
X c_south = 29;
X c_east = 30;
X c_west = 31;
X c_up = 32;
X c_down = 33;
X c_n = 34;
X c_s = 35;
X c_e = 36;
X c_w = 37;
X c_u = 38;
X c_d = 39;
X c_custom = 40;
X c_who = 41;
X c_players = 42;
X c_search = 43;
X c_unhide = 44;
X c_punch = 45;
X c_ping = 46;
X c_health = 47;
X c_get = 48;
X c_drop = 49;
X c_inv = 50;
X c_i = 51;
X c_self = 52;
X c_whois = 53;
X c_duplicate = 54;
X
X c_version = 56;
X c_objects = 57;
X c_use = 58;
X c_wield = 59;
X c_brief = 60;
X c_wear = 61;
X c_relink = 62;
X c_unmake = 63;
X c_destroy = 64;
X c_show = 65;
X c_set = 66;
X
X e_detail = 100; { pseudo command for log_action of desc exit }
X e_custroom = 101; { customizing this room }
X e_program = 102; { customizing (programming) an object }
X e_usecrystal = 103; { using a crystal ball }
X
X
X{ Show Mnemonics }
X
X s_exits = 1;
X s_object = 2;
X s_quest = 3;
X s_details = 4;
X
X
X{ Set Mnemonics }
X
X y_quest = 1;
X y_altmsg = 2;
X y_group1 = 3;
X y_group2 = 4;
X
X
X{ Event Mnemonics }
X
X E_EXIT = 1; { player left room }
X E_ENTER = 2; { player entered room }
X E_BEGIN = 3; { player joined game here }
X E_QUIT = 4; { player here quit game }
X
X E_SAY = 5; { someone said something }
X E_SETNAM = 6; { player set his personal name }
X E_POOFIN = 8; { someone poofed into this room }
X E_POOFOUT = 9; { someone poofed out of this room }
X E_DETACH = 10; { a link has been destroyed }
X E_EDITDONE = 11; { someone is finished editing a desc }
X E_NEWEXIT = 12; { someone made an exit here }
X E_BOUNCEDIN = 13; { an object "bounced" into the room }
X E_EXAMINE = 14; { someone is examining something }
X E_CUSTDONE = 15; { someone is done customizing an exit }
X E_FOUND = 16; { player found something }
X E_SEARCH = 17; { player is searching room }
X E_DONEDET = 18; { done adding details to a room }
X E_HIDOBJ = 19; { someone hid an object here }
X E_UNHIDE = 20; { voluntarily revealed themself }
X E_FOUNDYOU = 21; { someone found someone else hiding }
X E_PUNCH = 22; { someone has punched someone else }
X E_MADEOBJ = 23; { someone made an object here }
X E_GET = 24; { someone picked up an object }
X E_DROP = 25; { someone dropped an object }
X E_DROPALL = 26; { quit & dropped stuff on way out }
X E_IHID = 27; { tell others that I have hidden (!) }
X E_NOISES = 28; { strange noises from hidden people }
X E_PING = 29; { send a ping to a potential zombie }
X E_PONG = 30; { ping answered }
X E_HIDEPUNCH = 31; { someone hidden is attacking }
X E_SLIPPED = 32; { attack caused obj to drop unwillingly }
X E_ROOMDONE = 33; { done customizing this room }
X E_OBJDONE = 34; { done programming an object }
X E_HPOOFOUT = 35; { someone hiding poofed out }
X E_FAILGO = 36; { a player failed to go through an exit }
X E_HPOOFIN = 37; { someone poofed into a room hidden }
X E_TRYPUNCH = 38; { someone failed to punch someone else }
X E_PINGONE = 39; { someone was pinged away . . . }
X E_CLAIM = 40; { someone claimed this room }
X E_DISOWN = 41; { owner of this room has disowned it }
X E_WEAKER = 42; { person is weaker from battle }
X E_OBJCLAIM = 43; { someone claimed an object }
X E_OBJDISOWN = 44; { someone disowned an object }
X E_SELFDONE = 45; { done editing self description }
X E_WHISPER = 46; { someone whispers to someone else }
X E_WIELD = 47; { player wields a weapon }
X E_UNWIELD = 48; { player puts a weapon away }
X E_DONECRYSTALUSE = 49; { done using the crystal ball }
X E_WEAR = 50; { someone has put on something }
X E_UNWEAR = 51; { someone has taken off something }
X E_DESTROY = 52; { someone has destroyed an object }
X E_HIDESAY = 53; { anonymous say }
X E_OBJPUBLIC = 54; { someone made an object public }
X E_SYSDONE = 55; { done with system maint. mode }
X E_UNMAKE = 56; { remove typedef for object }
X E_LOOKDETAIL = 57; { looking at a detail of this room }
X E_ACCEPT = 58; { made an "accept" exit here }
X E_REFUSE = 59; { got rid of an "accept" exit here }
X E_DIED = 60; { someone died and evaporated }
X E_LOOKYOU = 61; { someone is looking at you }
X E_FAILGET = 62; { someone can't get something }
X E_FAILUSE = 63; { someone can't use something }
X E_CHILL = 64; { someone scrys you }
X E_NOISE2 = 65; { say while in crystal ball }
X E_LOOKSELF = 66; { someone looks at themself }
X E_INVENT = 67; { someone takes inventory }
X E_POOFYOU = 68; { MM poofs someone away . . . . }
X E_WHO = 69; { someone does a who }
X E_PLAYERS = 70; { someone does a players }
X E_VIEWSELF = 71; { someone views a self description }
X E_REALNOISE = 72; { make the real noises message print }
X E_ALTNOISE = 73; { alternate mystery message }
X E_MIDNIGHT = 74; { it's midnight now, tell everyone }
X
X E_ACTION = 100; { base command action event }
X
X
X{ Misc. }
X
X GOODHEALTH = 7;
X
X
Xtype
X string = varying[80] of char;
X veryshortstring = varying[veryshortlen] of char;
X shortstring = varying[shortlen] of char;
X
X { This is a list of description block numbers;
X If a number is zero, there is no text for that block }
X
X
X { exit kinds:
X 0: no way - blocked exit
X 1: open passageway
X 2: object required
X
X 6: exit only exists if player is holding the key
X }
X
X exit = record
X toloc: integer; { location exit goes to }
X kind: integer; { type of the exit }
X slot: integer; { exit slot of toloc target }
X
X exitdesc, { one liner description of exit }
X closed, { desc of a closed door }
X fail, { description if can't go thru }
X success, { desc while going thru exit }
X goin, { what others see when you go into the exit }
X{ ofail, }
X comeout: { what others see when you come out of the exit }
X integer; { all refer to the liner file }
X { if zero defaults will be printed }
X
X hidden: integer; { **** about to change this **** }
X objreq: integer; { object required to pass this exit }
X
X alias: veryshortstring; { alias for the exit dir, a keyword }
X
X reqverb: boolean; { require alias as a verb to work }
X reqalias: boolean; { require alias only (no direction) to
X pass through the exit }
X autolook: boolean; { do a look when user comes out of exit }
X end;
X
X
X { index record # 1 is block index }
X { index record # 2 is line index }
X { index record # 3 is room index }
X { index record # 4 is player alloc index }
X { index record # 5 is player awake (in game) index }
X indexrec = record
X indexnum: integer; { validation number }
X free: packed array[1..maxindex] of boolean;
X top: integer; { max records available }
X inuse: integer; { record #s in use }
X end;
X
X
X { names are record #1 }
X { owners are record # 2 }
X { player pers_names are record # 3 }
X { userids are record # 4 }
X { object names are record # 5 }
X { object creators are record # 6 }
X { date of last play is # 7 }
X { time of last play is # 8 }
X namrec = record
X validate: integer;
X loctop: integer;
X idents: array[1..maxroom] of shortstring;
X end;
X
X objectrec = record
X objnum: integer; { allocation number for the object }
X onum: integer; { number index to objnam/objown }
X oname: shortstring; { duplicate of name of object }
X kind: integer; { what kind of object this is }
X linedesc: integer; { liner desc of object Here }
X
X home: integer; { if object at home, then print the }
X homedesc: integer; { home description }
X
X actindx: integer; { action index -- programs for the future }
X examine: integer; { desc block for close inspection }
X worth: integer; { how much it cost to make (in gold) }
X numexist: integer; { number in existence }
X
X sticky: boolean; { can they ever get it? }
X getobjreq: integer; { object required to get this object }
X getfail: integer; { fail-to-get description }
X getsuccess: integer; { successful picked up description }
X
X useobjreq: integer; { object require to use this object }
X uselocreq: integer; { place have to be to use this object }
X usefail: integer; { fail-to-use description }
X usesuccess: integer; { successful use of object description }
X
X usealias: veryshortstring;
X reqalias: boolean;
X reqverb: boolean;
X
X particle: integer; { a,an,some, etc... "particle" is not
X be right, but hey, it's in the code }
X
X parms: array[1..maxparm] of integer;
X
X d1: integer; { extra description # 1 }
X d2: integer; { extra description # 2 }
X exp3,exp4,exp5,exp6: integer;
X end;
X
X anevent = record
X sender, { slot of sender }
X action, { what event this is, E_something }
X target, { opt target of action }
X parm: integer; { expansion parm }
X msg: string; { string for SAY and other cmds }
X loc: integer; { room that event is targeted for }
X end;
X
X eventrec = record
X validat: integer; { validation number for record locking }
X evnt: array[1..maxevent] of anevent;
X point: integer; { circular buffer pointer }
X end;
X
X peoplerec = record
X kind: integer; { 0=none,1=player,2=npc }
X parm: integer; { index to npc controller (object?) }
X
X username: veryshortstring; { actual userid of person }
X name: shortstring; { chosen name of person }
X hiding: integer; { degree to which they're hiding }
X act,targ: integer; { last thing that this person did }
X
X holding: array[1..maxhold] of integer; { objects being held }
X experience: integer;
X
X wearing: integer; { object that they're wearing }
X wielding: integer; { weapon they're wielding }
X health: integer; { how healthy they are }
X
X self: integer; { self description }
X
X ex1,ex2,ex3,ex4,ex5: integer;
X end;
X
X spellrec = record
X recnum: integer;
X level: array[1..maxspells] of integer;
X end;
X
X descrec = record
X descrinum: integer;
X lines: array[1..descmax] of string;
X desclen: integer; { number used in this block }
X end;
X
X linerec = record
X linenum: integer;
X theline: string;
X end;
X
X room = record
X valid: integer; { validation number for record locking }
X locnum: integer;
X owner: veryshortstring; { who owns the room: userid if private
X '' if public
X '*' if disowned }
X nicename: string; { pretty name for location }
X nameprint: integer; { code for printing name:
X 0: don't print it
X 1: You're in
X 2: You're at
X }
X
X primary: integer; { room descriptions }
X secondary: integer;
X which: integer; { 0 = only print primary room desc.
X 1 = only print secondary room desc.
X 2 = print both
X 3 = print primary then secondary
X if has magic object }
X
X magicobj: integer; { special object for this room }
X effects: integer;
X parm: integer;
X
X exits: array[1..maxexit] of exit;
X
X pile: integer; { if more than maxobjs objects here }
X objs: array[1..maxobjs] of integer; { refs to object file }
X objhide: array[1..maxobjs] of integer; { how much each object
X is hidden }
X { see hidden on exitrec
X above }
X
X objdrop: integer; { where objects go when they're dropped }
X objdesc: integer; { what it says when they're dropped }
X objdest: integer; { what it says in target room when
X "bounced" object comes in }
X
X people: array[1..maxpeople] of peoplerec;
X
X grploc1,grploc2: integer;
X grpnam1,grpnam2: shortstring;
X
X detail: array[1..maxdetail] of veryshortstring;
X detaildesc: array[1..maxdetail] of integer;
X
X trapto: integer; { where the "trapdoor" goes }
X trapchance: integer; { how often the trapdoor works }
X
X rndmsg: integer; { message that randomly prints }
X
X xmsg2: integer; { another random block }
X exp2,exp3,exp4: integer;
X exitfail: integer; { default fail description for exits }
X ofail: integer; { what other's see when you fail, default }
X end;
X
X
X intrec = record
X intnum: integer;
X int: array[1..maxplayers] of integer;
X end;
X
X
Xvar
X old_prompt: [external] string;
X line: [external] string;
X oldcmd: string; { string for '.' command to do last command }
X
X inmem: boolean; { Is this rooms roomrec (here....) in memory?
X We call gethere many times to make sure
X here is current. However, we only want to
X actually do a getroom if the roomrec has been
X modified }
X brief: boolean := FALSE; { brief/verbose descriptions }
X
X rndcycle: integer; { integer for rnd_event }
X debug: boolean;
X ping_answered: boolean; { flag for ping answers }
X hiding : boolean := FALSE; { is player hiding? }
X midnight_notyet: boolean := TRUE; { hasn't been midnight yet }
X first_puttoken: boolean := TRUE; { flag for first place into world }
X logged_act : boolean := FALSE; { flag to indicate that a log_action
X has been called, and the next call
X to clear_command needs to clear the
X action parms in the here roomrec }
X
X roomfile : file of room;
X eventfile: file of eventrec;
X namfile: file of namrec;
X descfile: file of descrec;
X linefile: file of linerec;
X indexfile: file of indexrec;
X intfile: file of intrec;
X objfile: file of objectrec;
X spellfile: file of spellrec;
X
X cmds: array[1..maxcmds] of shortstring := (
X
X 'name', { setnam = 1 }
X 'help', { help = 2 }
X '?', { quest = 3 }
X 'quit', { quit = 4 }
X 'look', { look = 5 }
X 'go', { go = 6 }
X 'form', { form = 7 }
X 'link', { link = 8 }
X 'unlink', { unlink = 9 }
X 'whisper', { c_whisper = 10}
X 'poof', { poof = 11 }
X 'describe', { desc = 12 }
X '',
X 'debug', { dbg = 14 }
X 'say', { say = 15 }
X '', { }
X 'rooms', { c_rooms = 17 }
X 'system', { c_system = 18 }
X 'disown', { c_disown = 19 }
X 'claim', { c_claim = 20 }
X 'make', { c_create = 21 }
X 'public', { c_public = 22 }
X 'accept', { c_accept = 23 }
X 'refuse', { c_refuse = 24 }
X 'zap', { c_zap = 25 }
X 'hide', { c_hide = 26 }
X 'l', { c_l = 27 }
X 'north', { c_north = 28 }
X 'south', { c_south = 29 }
X 'east', { c_east = 30 }
X 'west', { c_west = 31 }
X 'up', { c_up = 32 }
X 'down', { c_down = 33 }
X 'n', { c_n = 34 }
X 's', { c_s = 35 }
X 'e', { c_e = 36 }
X 'w', { c_w = 37 }
X 'u', { c_u = 38 }
X 'd', { c_d = 39 }
X 'customize', { c_custom = 40 }
X 'who', { c_who = 41 }
X 'players', { c_players = 42}
X 'search', { c_search = 43 }
X 'reveal', { c_unhide = 44 }
X 'punch', { c_punch = 45 }
X 'ping', { c_ping = 46 }
X 'health', { c_health = 47 }
X 'get', { c_get = 48 }
X 'drop', { c_drop = 49 }
X 'inventory', { c_inv = 50 }
X 'i', { c_i = 51 }
X 'self', { c_self = 52 }
X 'whois', { c_whois = 53 }
X 'duplicate', { c_duplicate = 54 }
X '',
X 'version', { c_version = 56}
X 'objects', { c_objects = 57}
X 'use', { c_use = 58 }
X 'wield', { c_wield = 59 }
X 'brief', { c_brief = 60 }
X 'wear', { c_wear = 61 }
X 'relink', { c_relink = 62 }
X 'unmake', { c_unmake = 63 }
X 'destroy', { c_destroy = 64}
X 'show', { c_show = 65 }
X 'set', { c_set = 66 }
X '',
X '',
X '',
X '',
X '',
X '',
X '',
X '',
X ''
X );
X
X
X numcmds: integer; { number of main level commands there are }
X show: array[1..maxshow] of shortstring;
X numshow: integer;
X setkey: array[1..maxshow] of shortstring;
X numset: integer;
X
X direct: array[1..maxexit] of shortstring :=
X ('north','south','east','west','up','down');
X
X spells: array[1..maxspells] of string; { names of spells }
X numspells: integer; { number of spells there actually are }
X
X done: boolean; { flag for QUIT }
X userid: veryshortstring; { userid of this player }
X location: integer; { current place number }
X
X hold_kind: array[1..maxhold] of integer; { kinds of the objects i'm
X holding }
X
X myslot: integer := 1; { here.people[myslot]... is this player }
X myname: shortstring; { personal name this player chose (setname) }
X myevent: integer; { which point in event buffer we are at }
X
X found_exit: array[1..maxexit] of boolean;
X { has exit i been found by the player? }
X
X mylog: integer; { which log entry this player is }
X mywear: integer; { what I'm wearing }
X mywield: integer; { weapon I'm wielding }
X myhealth: integer; { how well I'm feeling }
X myexperience: integer; { how experienced I am }
X myself: integer; { self description block }
X
X healthcycle: integer; { used in rnd_event to control how quickly a
X player heals }
X
X here: room; { current room record }
X event: eventrec;
X privd: boolean;
X
X objnam, { object names }
X objown, { object owners }
X nam, { record 1 is room names }
X own, { rec 2 is room owners }
X pers, { 3 is player personal names }
X user, { 4 is player userid }
X adate, { 5 is date of last play }
X atime { 6 is time of last play }
X : namrec;
X
X anint: intrec; { info about game players }
X obj: objectrec;
X spell: spellrec;
X
X block: descrec; { a text block of descmax lines }
X indx: indexrec; { an record allocation record }
X oneliner: linerec; { a line record }
X
X heredsc: descrec;
X
X
X[external]
Xprocedure wait(seconds: real); { system SLEEP call }
Xexternal;
X
X[external]
Xfunction random:real; { system random number generator }
Xexternal;
X
X[external]
Xfunction rnd100: integer; { returns a random # between 0-100 }
Xexternal;
X
X[external]
Xprocedure setup_guts; { disables ctrl-Y/ctrl-C }
X { necessary to prevent ZOMBIES in the world }
Xextern;
X
X[external]
Xprocedure finish_guts; { re-enables ctrl-Y/ctrl-C }
Xextern;
X
X[external] function get_userid:string;
Xexternal;
X
X[external] function trim(s: string): string;
Xexternal;
X
X[external]
Xprocedure grab_line(prompt: string; var s:string; echo:boolean := true);
X{ Input routine. Gets a line of text from user which checking
X for async events }
Xexternal;
X
X[external]
Xprocedure putchars(s: string);
Xextern;
X
Xprocedure xpoof(loc: integer);
Xforward;
X
Xprocedure do_exit(exit_slot: integer);
Xforward;
X
Xfunction put_token(room: integer;var aslot:integer;hidelev:integer := 0):boolean;
Xforward;
X
Xprocedure take_token(aslot, roomno: integer);
Xforward;
X
Xprocedure maybe_drop;
Xforward;
X
Xprocedure do_program(objnam: string);
Xforward;
X
Xfunction drop_everything(pslot: integer := 0): boolean;
Xforward;
X
X
Xprocedure collision_wait;
Xvar
X wait_time: real;
X
Xbegin
X wait_time := random;
X if wait_time < 0.001 then
X wait_time := 0.001;
X wait(wait_time);
Xend;
X
X
X{ increment err; if err is too high, suspect deadlock }
X{ this is called by all getX procedures to ease deadlock checking }
Xprocedure deadcheck(var err: integer; s:string);
X
Xbegin
X err := err + 1;
X if err > maxerr then begin
X writeln('%warning- ',s,' seems to be deadlocked; notify the Monster Manager');
X finish_guts;
X halt;
X err := 0;
X end;
Xend;
X
X
X
X{ first procedure of form getX
X attempts to get given room record
X resolves record access conflicts, checks for deadlocks
X Locks record; use freeroom immediately after getroom if data is
X for read-only
X}
Xprocedure getroom(n: integer:= 0);
Xvar
X err: integer;
X
Xbegin
X if n = 0 then
X n := location;
X roomfile^.valid := 0;
X err := 0;
X if debug then
X writeln('%getroom(',n:1,')');
X find(roomfile,n,error := continue);
X while roomfile^.valid <> n do begin
X deadcheck(err,'getroom');
X collision_wait;
X find(roomfile,n,error := continue);
X end;
X here := roomfile^;
X
X inmem := false;
X { since this getroom could be doing anything, we will
X assume that it is bozoing the correct here record for
X this room. If this getroom called by gethere, then
X gethere will correct inmem immediately. Otherwise
X the next gethere will restore the correct here record. }
Xend;
X
Xprocedure putroom;
X
Xbegin
X locate(roomfile,here.valid);
X roomfile^ := here;
X put(roomfile);
Xend;
X
Xprocedure freeroom; { unlock the record if you're not going to write it }
X
Xbegin
X unlock(roomfile);
Xend;
X
Xprocedure gethere(n: integer := 0);
X
Xbegin
X if (n = 0) or (n = location) then begin
X if not(inmem) then begin
X getroom; { getroom(n) okay here also }
X freeroom;
X inmem := true;
X end else if debug then
X writeln('%gethere - here already in memory');
X end else begin
X getroom(n);
X freeroom;
X end;
Xend;
X
X
Xprocedure getown;
Xvar
X err: integer;
X
Xbegin
X namfile^.validate := 0;
X err := 0;
X find(namfile,2,error := continue);
X while namfile^.validate <> 2 do begin
X deadcheck(err,'getown');
X collision_wait;
X find(namfile,2,error := continue);
X end;
X own := namfile^;
Xend;
X
X
X
Xprocedure getnam;
Xvar
X err: integer;
X
Xbegin
X namfile^.validate := 0;
X err := 0;
X find(namfile,1,error := continue);
X while namfile^.validate <> 1 do begin
X deadcheck(err,'getnam');
X collision_wait;
X find(namfile,1,error := continue);
X end;
X nam := namfile^;
Xend;
X
Xprocedure freenam;
X
Xbegin
X unlock(namfile);
Xend;
X
Xprocedure freeown;
X
Xbegin
X unlock(namfile);
Xend;
X
Xprocedure putnam;
X
Xbegin
X locate(namfile,1);
X namfile^:= nam;
X put(namfile);
Xend;
X
Xprocedure putown;
X
Xbegin
X locate(namfile,2);
X namfile^:= own;
X put(namfile);
Xend;
X
X
Xprocedure getobj(n: integer);
Xvar
X err: integer;
X
Xbegin
X if n = 0 then
X n := location;
X objfile^.objnum := 0;
X err := 0;
X find(objfile,n,error := continue);
X while objfile^.objnum <> n do begin
X deadcheck(err,'getobj');
X collision_wait;
X find(objfile,n,error := continue);
X end;
X obj := objfile^;
Xend;
X
Xprocedure putobj;
X
Xbegin
X locate(objfile,obj.objnum);
X objfile^ := obj;
X put(objfile);
Xend;
X
Xprocedure freeobj; { unlock the record if you're not going to write it }
X
Xbegin
X unlock(objfile);
Xend;
X
X
X
Xprocedure getint(n: integer);
Xvar
X err: integer;
X
Xbegin
X intfile^.intnum := 0;
X err := 0;
X find(intfile,n,error := continue);
X while intfile^.intnum <> n do begin
X deadcheck(err,'getint');
X collision_wait;
X find(intfile,n,error := continue);
X end;
X anint := intfile^;
Xend;
X
X
Xprocedure freeint;
X
Xbegin
X unlock(intfile);
Xend;
X
Xprocedure putint;
Xvar
X n: integer;
X
Xbegin
X n := anint.intnum;
X locate(intfile,n);
X intfile^:= anint;
X put(intfile);
Xend;
X
X
X
Xprocedure getspell(n: integer := 0);
Xvar
X err: integer;
X
Xbegin
X if n = 0 then
X n := mylog;
X
X spellfile^.recnum := 0;
X err := 0;
X find(spellfile,n,error := continue);
X while spellfile^.recnum <> n do begin
X deadcheck(err,'getspell');
X collision_wait;
X find(spellfile,n,error := continue);
X end;
X spell := spellfile^;
Xend;
X
X
Xprocedure freespell;
X
Xbegin
X unlock(spellfile);
Xend;
X
Xprocedure putspell;
Xvar
X n: integer;
X
Xbegin
X n := spell.recnum;
X locate(spellfile,n);
X spellfile^:= spell;
X put(spellfile);
Xend;
X
X
X
Xprocedure getuser; { get log rec with everyone's userids in it }
Xvar
X err: integer;
X
Xbegin
X namfile^.validate := 0;
X err := 0;
X find(namfile,4,error := continue);
X while namfile^.validate <> 4 do begin
X deadcheck(err,'getuser');
X collision_wait;
X find(namfile,4,error := continue);
X end;
X user := namfile^;
Xend;
X
Xprocedure freeuser;
X
Xbegin
X unlock(namfile);
Xend;
X
Xprocedure putuser;
X
Xbegin
X locate(namfile,4);
X namfile^:= user;
X put(namfile);
Xend;
X
X
X
Xprocedure getdate; { get log rec with date of last play in it }
Xvar
X err: integer;
X
Xbegin
X namfile^.validate := 0;
X err := 0;
X find(namfile,7,error := continue);
X while namfile^.validate <> 7 do begin
X deadcheck(err,'getdate');
X collision_wait;
X find(namfile,7,error := continue);
X end;
X adate := namfile^;
Xend;
X
Xprocedure freedate;
X
Xbegin
X unlock(namfile);
Xend;
X
Xprocedure putdate;
X
Xbegin
X locate(namfile,7);
X namfile^:= adate;
X put(namfile);
Xend;
X
X
Xprocedure gettime; { get log rec with time of last play in it }
Xvar
X err: integer;
X
Xbegin
X namfile^.validate := 0;
X err := 0;
X find(namfile,8,error := continue);
X while namfile^.validate <> 8 do begin
X deadcheck(err,'gettime');
X collision_wait;
X find(namfile,8,error := continue);
X end;
X atime := namfile^;
Xend;
X
Xprocedure freetime;
X
Xbegin
X unlock(namfile);
Xend;
X
Xprocedure puttime;
X
Xbegin
X locate(namfile,8);
X namfile^:= atime;
X put(namfile);
Xend;
X
X
X
Xprocedure getobjnam;
Xvar
X err: integer;
X
Xbegin
X namfile^.validate := 0;
X err := 0;
X find(namfile,5,error := continue);
X while namfile^.validate <> 5 do begin
X deadcheck(err,'getobjnam');
X collision_wait;
X find(namfile,5,error := continue);
X end;
X objnam := namfile^;
Xend;
X
Xprocedure freeobjnam;
X
Xbegin
X unlock(namfile);
Xend;
X
Xprocedure putobjnam;
X
Xbegin
X locate(namfile,5);
X namfile^:= objnam;
X put(namfile);
Xend;
X
X
X
Xprocedure getobjown;
Xvar
X err: integer;
X
Xbegin
X namfile^.validate := 0;
X err := 0;
X find(namfile,6,error := continue);
X while namfile^.validate <> 6 do begin
X deadcheck(err,'getobjown');
X collision_wait;
X find(namfile,6,error := continue);
X end;
X objown := namfile^;
Xend;
X
Xprocedure freeobjown;
X
Xbegin
X unlock(namfile);
Xend;
X
Xprocedure putobjown;
X
Xbegin
X locate(namfile,6);
X namfile^:= objown;
X put(namfile);
Xend;
X
X
X
Xprocedure getpers; { get log rec with everyone's pers names in it }
Xvar
X err: integer;
X
Xbegin
X namfile^.validate := 0;
X err := 0;
X find(namfile,3,error := continue);
X while namfile^.validate <> 3 do begin
X deadcheck(err,'getpers');
X collision_wait;
X find(namfile,3,error := continue);
X end;
X pers := namfile^;
Xend;
X
Xprocedure freepers;
X
Xbegin
X unlock(namfile);
Xend;
X
Xprocedure putpers;
X
Xbegin
X locate(namfile,3);
X namfile^:= pers;
X put(namfile);
Xend;
X
X
X
X
Xprocedure getevent(n: integer := 0);
Xvar
X err: integer;
X
Xbegin
X if n = 0 then
X n := location;
X
X n := (n mod numevnts) + 1;
X
X eventfile^.validat := 0;
X err := 0;
X find(eventfile,n,error := continue);
X while eventfile^.validat <> n do begin
X deadcheck(err,'getevent');
X collision_wait;
X find(eventfile,n,error := continue);
X end;
X event := eventfile^;
Xend;
X
Xprocedure freeevent;
X
Xbegin
X unlock(eventfile);
Xend;
X
Xprocedure putevent;
X
Xbegin
X locate(eventfile,event.validat);
X eventfile^:= event;
X put(eventfile);
Xend;
X
X
Xprocedure getblock(n: integer);
Xvar
X err: integer;
X
Xbegin
X if debug then
X writeln('%getblock: ',n:1);
X descfile^.descrinum := 0;
X err := 0;
X find(descfile,n,error := continue);
X while descfile^.descrinum <> n do begin
X deadcheck(err,'getblock');
X collision_wait;
X find(descfile,n,error := continue);
X end;
X block := descfile^;
Xend;
X
Xprocedure putblock;
Xvar
X n: integer;
X
Xbegin
X n := block.descrinum;
X if debug then
X writeln('%putblock: ',n:1);
X if n <> 0 then begin
X locate(descfile,n);
X descfile^ := block;
X put(descfile);
X end;
Xend;
X
Xprocedure freeblock; { unlock the record if you're not going to write it }
X
Xbegin
X unlock(descfile);
Xend;
X
X
X
X
X
X{ *** new code begins here *** }
X
X
Xprocedure getline(n: integer);
Xvar
X err: integer;
X
Xbegin
X if n = -1 then begin
X oneliner.theline := '';
X end else begin
X err := 0;
X linefile^.linenum := 0;
X find(linefile,n,error := continue);
X while linefile^.linenum <> n do begin
X deadcheck(err,'getline');
X collision_wait;
X find(linefile,n,error := continue);
X end;
X oneliner := linefile^;
X end;
Xend;
X
Xprocedure putline;
X
Xbegin
X if oneliner.linenum > 0 then begin
X locate(linefile,oneliner.linenum);
X linefile^ := oneliner;
X put(linefile);
X end;
Xend;
X
Xprocedure freeline; { unlock the record if you're not going to write it }
X
Xbegin
X unlock(linefile);
Xend;
X
X
X
X
X{
XIndex record 1 -- Description blocks that are free
XIndex record 2 -- One liners that are free
X}
X
X
Xprocedure getindex(n: integer);
Xvar
X err: integer;
X
Xbegin
X indexfile^.indexnum := 0;
X err := 0;
X find(indexfile,n,error := continue);
X while indexfile^.indexnum <> n do begin
X deadcheck(err,'getindex');
X collision_wait;
X find(indexfile,n,error := continue);
X end;
X indx := indexfile^;
Xend;
X
Xprocedure putindex;
X
Xbegin
X locate(indexfile,indx.indexnum);
X indexfile^ := indx;
X put(indexfile);
Xend;
X
Xprocedure freeindex; { unlock the record if you're not going to write it }
X
Xbegin
X unlock(indexfile);
Xend;
X
X
X
X{
XFirst procedure of form alloc_X
XAllocates the oneliner resource using the indexrec bitmaps
X
XReturn the number of a one liner if one is available
Xand remove it from the free list
X}
Xfunction alloc_line(var n: integer):boolean;
Xvar
X found: boolean;
X
Xbegin
X getindex(I_LINE);
X if indx.inuse = indx.top then begin
X freeindex;
X n := 0;
X alloc_line := false;
X writeln('There are no available one line descriptions.');
X end else begin
X n := 1;
X found := false;
X while (not found) and (n <= indx.top) do begin
X if indx.free[n] then
X found := true
X else
X n := n + 1;
X end;
X if found then begin
X indx.free[n] := false;
X alloc_line := true;
X indx.inuse := indx.inuse + 1;
X putindex;
X end else begin
X freeindex;
X writeln('%serious error in alloc_line; notify Monster Manager');
X
X alloc_line := false;
X end;
X end;
Xend;
X
X{
Xput the line specified by n back on the free list
Xzeroes n also, for convenience
X}
Xprocedure delete_line(var n: integer);
X
Xbegin
X if n = DEFAULT_LINE then
X n := 0
X else if n > 0 then begin
X getindex(I_LINE);
X indx.inuse := indx.inuse - 1;
X indx.free[n] := true;
X putindex;
X end;
X n := 0;
Xend;
X
X
X
Xfunction alloc_int(var n: integer):boolean;
Xvar
X found: boolean;
X
Xbegin
X getindex(I_INT);
X if indx.inuse = indx.top then begin
X freeindex;
X n := 0;
X alloc_int := false;
X writeln('There are no available integer records.');
X end else begin
X n := 1;
X found := false;
X while (not found) and (n <= indx.top) do begin
X if indx.free[n] then
X found := true
X else
X n := n + 1;
X end;
X if found then begin
X indx.free[n] := false;
X alloc_int := true;
X indx.inuse := indx.inuse + 1;
X putindex;
X end else begin
X freeindex;
X writeln('%serious error in alloc_int; notify Monster Manager');
X
X alloc_int := false;
X end;
X end;
Xend;
X
X
Xprocedure delete_int(var n: integer);
X
Xbegin
X if n > 0 then begin
X getindex(I_INT);
X indx.inuse := indx.inuse - 1;
X indx.free[n] := true;
X putindex;
X end;
X n := 0;
Xend;
X
X
X
X{
XReturn the number of a description block if available and
Xremove it from the free list
X}
Xfunction alloc_block(var n: integer):boolean;
Xvar
X found: boolean;
X
Xbegin
X if debug then
X writeln('%alloc_block entry');
X getindex(I_BLOCK);
X if indx.inuse = indx.top then begin
X freeindex;
X n := 0;
X alloc_block := false;
X writeln('There are no available description blocks.');
X end else begin
X n := 1;
X found := false;
X while (not found) and (n <= indx.top) do begin
X if indx.free[n] then
X found := true
X else
X n := n + 1;
X end;
X if found then begin
X indx.free[n] := false;
X alloc_block := true;
X indx.inuse := indx.inuse + 1;
X putindex;
X if debug then
X writeln('%alloc_block successful');
X end else begin
X freeindex;
X writeln('%serious error in alloc_block; notify Monster Manager');
X alloc_block := false;
X end;
X end;
Xend;
X
X
X
X
X{
Xputs a description block back on the free list
Xzeroes n for convenience
X}
Xprocedure delete_block(var n: integer);
X
Xbegin
X if n = DEFAULT_LINE then
X n := 0 { no line really exists in the file }
X else if n > 0 then begin
X getindex(I_BLOCK);
X indx.inuse := indx.inuse - 1;
X indx.free[n] := true;
X putindex;
X n := 0;
X end else if n < 0 then begin
X n := (- n);
X delete_line(n);
X end;
Xend;
X
X
X
X{
XReturn the number of a room if one is available
Xand remove it from the free list
X}
Xfunction alloc_room(var n: integer):boolean;
Xvar
X found: boolean;
X
Xbegin
X getindex(I_ROOM);
X if indx.inuse = indx.top then begin
X freeindex;
X n := 0;
X alloc_room := false;
X writeln('There are no available free rooms.');
X end else begin
X n := 1;
X found := false;
X while (not found) and (n <= indx.top) do begin
X if indx.free[n] then
X found := true
X else
X n := n + 1;
X end;
X if found then begin
X indx.free[n] := false;
X alloc_room := true;
X indx.inuse := indx.inuse + 1;
X putindex;
X end else begin
X freeindex;
X writeln('%serious error in alloc_room; notify Monster Manager');
X alloc_room := false;
X end;
X end;
Xend;
X
X{
XCalled by DEL_ROOM()
Xput the room specified by n back on the free list
Xzeroes n also, for convenience
X}
Xprocedure delete_room(var n: integer);
X
Xbegin
X if n <> 0 then begin
X getindex(I_ROOM);
X indx.inuse := indx.inuse - 1;
X indx.free[n] := true;
X putindex;
X n := 0;
X end;
Xend;
X
X
X
Xfunction alloc_log(var n: integer):boolean;
Xvar
X found: boolean;
X
Xbegin
X getindex(I_PLAYER);
X if indx.inuse = indx.top then begin
X freeindex;
X n := 0;
X alloc_log := false;
X writeln('There are too many monster players, you can''t find a space.');
X end else begin
X n := 1;
X found := false;
X while (not found) and (n <= indx.top) do begin
X if indx.free[n] then
X found := true
X else
X n := n + 1;
X end;
X if found then begin
X indx.free[n] := false;
X alloc_log := true;
X indx.inuse := indx.inuse + 1;
X putindex;
X end else begin
X freeindex;
X writeln('%serious error in alloc_log; notify Monster Manager');
X alloc_log := false;
X end;
X end;
Xend;
X
Xprocedure delete_log(var n: integer);
X
Xbegin
X if n <> 0 then begin
X getindex(I_PLAYER);
X indx.inuse := indx.inuse - 1;
X indx.free[n] := true;
X putindex;
X n := 0;
X end;
Xend;
X
X
Xfunction lowcase(s: string):string;
Xvar
X sprime: string;
X i: integer;
X
Xbegin
X if length(s) = 0 then
X lowcase := ''
X else begin
X sprime := s;
X for i := 1 to length(s) do
X if sprime[i] in ['A'..'Z'] then
X sprime[i] := chr(ord('a')+(ord(sprime[i])-ord('A')));
X lowcase := sprime;
X end;
Xend;
X
X
X{ lookup a spell with disambiguation in the spell list }
X
Xfunction lookup_spell(var n: integer;s:string): boolean;
Xvar
X i,poss,maybe,num: integer;
X
Xbegin
X s := lowcase(s);
X i := 1;
X maybe := 0;
X num := 0;
X for i := 1 to numspells do begin
X if s = spells[i] then
X num := i
X else if index(spells[i],s) = 1 then begin
X maybe := maybe + 1;
X poss := i;
X end;
X end;
X if num <> 0 then begin
X n := num;
X lookup_spell := true;
X end else if maybe = 1 then begin
X n := poss;
X lookup_spell := true;
X end else if maybe > 1 then begin
X lookup_spell := false;
X end else begin
X lookup_spell := false;
X end;
Xend;
X
X
Xfunction lookup_user(var pnum: integer;s: string): boolean;
Xvar
X i,poss,maybe,num: integer;
X
Xbegin
X getuser;
X freeuser;
X getindex(I_PLAYER);
X freeindex;
X
X s := lowcase(s);
X i := 1;
X maybe := 0;
X num := 0;
X for i := 1 to indx.top do begin
X if not(indx.free[i]) then begin
X if s = user.idents[i] then
X num := i
X else if index(user.idents[i],s) = 1 then begin
X maybe := maybe + 1;
X poss := i;
X end;
X end;
X end;
X if num <> 0 then begin
X pnum := num;
X lookup_user := true;
X end else if maybe = 1 then begin
X pnum := poss;
X lookup_user := true;
X end else if maybe > 1 then begin
X{ writeln('-- Ambiguous direction'); }
X lookup_user := false;
X end else begin
X lookup_user := false;
X{ writeln('-- Unknown direction'); }
X end;
Xend;
X
X
Xfunction alloc_obj(var n: integer):boolean;
Xvar
X found: boolean;
X
Xbegin
X getindex(I_OBJECT);
X if indx.inuse = indx.top then begin
X freeindex;
X n := 0;
X alloc_obj := false;
X writeln('All of the possible objects have been made.');
X end else begin
X n := 1;
X found := false;
X while (not found) and (n <= indx.top) do begin
X if indx.free[n] then
X found := true
X else
X n := n + 1;
X end;
X if found then begin
X indx.free[n] := false;
X alloc_obj := true;
X indx.inuse := indx.inuse + 1;
X putindex;
X end else begin
X freeindex;
X writeln('%serious error in alloc_obj; notify Monster Manager');
X alloc_obj := false;
X end;
X end;
Xend;
X
X
Xprocedure delete_obj(var n: integer);
X
Xbegin
X if n <> 0 then begin
X getindex(I_OBJECT);
X indx.inuse := indx.inuse - 1;
X indx.free[n] := true;
X putindex;
X n := 0;
X end;
Xend;
X
X
X
X
Xfunction lookup_obj(var pnum: integer;s: string): boolean;
Xvar
X i,poss,maybe,num: integer;
X tmp: string;
X
Xbegin
X getobjnam;
X freeobjnam;
X getindex(I_OBJECT);
X freeindex;
X
X s := lowcase(s);
X i := 1;
X maybe := 0;
X num := 0;
X for i := 1 to indx.top do begin
X if not(indx.free[i]) then begin
X if s = objnam.idents[i] then
X num := i
X else if index(objnam.idents[i],s) = 1 then begin
X maybe := maybe + 1;
X poss := i;
X end;
X end;
X end;
X if num <> 0 then begin
X pnum := num;
X lookup_obj := true;
X end else if maybe = 1 then begin
X pnum := poss;
X lookup_obj := true;
X end else if maybe > 1 then begin
X{ writeln('-- Ambiguous direction'); }
X lookup_obj := false;
X end else begin
X lookup_obj := false;
X{ writeln('-- Unknown direction'); }
X end;
Xend;
X
X
X
X{ returns true if object N is in this room }
X
Xfunction obj_here(n: integer): boolean;
Xvar
X i: integer;
X found: boolean;
X
Xbegin
X i := 1;
X found := false;
X while (i <= maxobjs) and (not found) do begin
X if here.objs[i] = n then
X found := true
X else
X i := i + 1;
X end;
X obj_here := found;
Xend;
X
X
X
X
X{ returns true if object N is being held by the player }
X
Xfunction obj_hold(n: integer): boolean;
Xvar
X i: integer;
X found: boolean;
X
Xbegin
X if n = 0 then
X obj_hold := false
X else begin
X i := 1;
X found := false;
X while (i <= maxhold) and (not found) do begin
X if here.people[myslot].holding[i] = n then
X found := true
X else
X i := i + 1;
X end;
X obj_hold := found;
X end;
Xend;
X
X
X
X{ return the slot of an object that is HERE }
Xfunction find_obj(objnum: integer): integer;
Xvar
X i: integer;
X
Xbegin
X i := 1;
X find_obj := 0;
X while i <= maxobjs do begin
X if here.objs[i] = objnum then
X find_obj := i;
X i := i + 1;
X end;
Xend;
X
X
X
X{ similar to lookup_obj, but only returns true if the object is in
X this room or is being held by the player }
X
Xfunction parse_obj(var n: integer; s: string;override: boolean := false): boolean;
Xvar
X slot: integer;
X
Xbegin
X if lookup_obj(n,s) then begin
X if obj_here(n) or obj_hold(n) then
X
X { took out a great block of code that wouldn't let
X parse_obj work if player couldn't see object }
X
X parse_obj := true;
X end else
X parse_obj := false;
Xend;
X
X
X
X
Xfunction lookup_pers(var pnum: integer;s: string): boolean;
Xvar
X i,poss,maybe,num: integer;
X pname: string;
X
Xbegin
X getpers;
X freepers;
X getindex(I_PLAYER);
X freeindex;
X
X s := lowcase(s);
X i := 1;
X maybe := 0;
X num := 0;
X for i := 1 to indx.top do begin
X if not(indx.free[i]) then begin
X pname := lowcase(pers.idents[i]);
X
X if s = pname then
X num := i
X else if index(pname,s) = 1 then begin
X maybe := maybe + 1;
X poss := i;
X end;
X end;
X end;
X if num <> 0 then begin
X pnum := num;
X lookup_pers := true;
X end else if maybe = 1 then begin
X pnum := poss;
X lookup_pers := true;
X end else if maybe > 1 then begin
X{ writeln('-- Ambiguous direction'); }
X lookup_pers := false;
X end else begin
X lookup_pers := false;
X{ writeln('-- Unknown direction'); }
X end;
Xend;
X
X
X
Xfunction parse_pers(var pnum: integer;s: string): boolean;
Xvar
X persnum: integer;
X i,poss,maybe,num: integer;
X pname: string;
X
Xbegin
X gethere;
X s := lowcase(s);
X i := 1;
X maybe := 0;
X num := 0;
X for i := 1 to maxpeople do begin
X{ if here.people[i].username <> '' then begin }
X
X if here.people[i].kind > 0 then begin
X pname := lowcase(here.people[i].name);
X
X if s = pname then
X num := i
X else if index(pname,s) = 1 then begin
X maybe := maybe + 1;
X poss := i;
X end;
X end;
X end;
X if num <> 0 then begin
X persnum := num;
X parse_pers := true;
X end else if maybe = 1 then begin
X persnum := poss;
X parse_pers := true;
X end else if maybe > 1 then begin
X persnum := 0;
X parse_pers := false;
X end else begin
X persnum := 0;
X parse_pers := false;
X end;
X if persnum > 0 then begin
X if here.people[persnum].hiding > 0 then
X parse_pers := false
X else begin
X parse_pers := true;
X pnum := persnum;
X end;
X end;
Xend;
X
X
X
X
X
X{
XReturns TRUE if player is owner of room n
XIf no n is given default will be this room (location)
X}
Xfunction is_owner(n: integer := 0;surpress:boolean := false): boolean;
X
Xbegin
X gethere(n);
X if (here.owner = userid) or (privd) then
X is_owner := true
X else begin
X is_owner := false;
X if not(surpress) then
X writeln('You are not the owner of this room.');
X end;
Xend;
X
X
Xfunction room_owner(n: integer): string;
X
Xbegin
X if n <> 0 then begin
X gethere(n);
X room_owner := here.owner;
X gethere; { restore old state! }
X end else
X room_owner := 'no room';
Xend;
X
X{
XReturns TRUE if player is allowed to alter the exit
XTRUE if either this room or if target room is owned by player
X}
X
Xfunction can_alter(dir: integer;room: integer := 0): boolean;
X
Xbegin
X gethere;
X if (here.owner=userid) or (privd) then begin
X can_alter := true
X end else begin
X if here.exits[dir].toloc > 0 then begin
X if room_owner(here.exits[dir].toloc) = userid then
X can_alter := true
X else
X can_alter := false;
X end else
X can_alter := false;
X end;
Xend;
X
Xfunction can_make(dir: integer;room: integer := 0): boolean;
X
Xbegin
X gethere(room); { 5 is accept door }
X if (here.exits[dir].toloc <> 0) then begin
X writeln('There is already an exit there. Use UNLINK or RELINK.');
X can_make := false;
X end else begin
X if (here.owner = userid) or { I'm the owner }
X (here.exits[dir].kind = 5) or { there's an accept }
X (privd) or { Monster Manager }
X (here.owner = '*') { disowned room }
X then
X can_make := true
X else begin
X can_make := false;
X writeln('You are not allowed to create an exit there.');
X end;
X end;
Xend;
X
X
X{
Xprint a one liner
X}
Xprocedure print_line(n: integer);
X
Xbegin
X if n = DEFAULT_LINE then
X writeln('<default line>')
X else if n > 0 then begin
X getline(n);
X freeline;
X writeln(oneliner.theline);
X end;
Xend;
X
X
X
Xprocedure print_desc(dsc: integer;default:string := '<no default supplied>');
Xvar
X i: integer;
X
Xbegin
X if dsc = DEFAULT_LINE then begin
X writeln(default);
X end else if dsc > 0 then begin
X getblock(dsc);
X freeblock;
X i := 1;
X while i <= block.desclen do begin
X writeln(block.lines[i]);
X i := i + 1;
X end;
X end else if dsc < 0 then begin
X print_line(abs(dsc));
X end;
Xend;
X
X
X
X
Xprocedure make_line(var n: integer;prompt : string := '';limit:integer := 79);
Xvar
X s: string;
X ok: boolean;
X
Xbegin
X writeln('Type ** to leave line unchanged, * to make [no line]');
X grab_line(prompt,s);
X if s = '**' then begin
X writeln('No changes.');
X end else if s = '***' then begin
X n := DEFAULT_LINE;
X end else if s = '*' then begin
X if debug then
X writeln('%deleting line ',n:1);
X delete_line(n);
X end else if s = '' then begin
X if debug then
X writeln('%deleting line ',n:1);
X delete_line(n);
X end else if length(s) > limit then begin
X writeln('Please limit your string to ',limit:1,' characters.');
X end else begin
X if (n = 0) or (n = DEFAULT_LINE) then begin
X if debug then
X writeln('%makeline: allocating line');
X ok := alloc_line(n);
X end else
X ok := true;
X
X if ok then begin
X if debug then
X writeln('%ok in makeline');
X getline(n);
X oneliner.theline := s;
X putline;
X
X if debug then
X writeln('%completed putline in makeline');
X end;
X end;
Xend;
X
X
X{ translate a direction s [north, south, etc...] into the integer code }
X
Xfunction lookup_dir(var dir: integer;s:string): boolean;
Xvar
X i,poss,maybe,num: integer;
X
Xbegin
X s := lowcase(s);
X i := 1;
X maybe := 0;
X num := 0;
X for i := 1 to maxexit do begin
X if s = direct[i] then
X num := i
X else if index(direct[i],s) = 1 then begin
X maybe := maybe + 1;
X poss := i;
X end;
X end;
X if num <> 0 then begin
X dir := num;
X lookup_dir := true;
X end else if maybe = 1 then begin
X dir := poss;
X lookup_dir := true;
X end else if maybe > 1 then begin
X lookup_dir := false;
X{ writeln('-- Ambiguous direction'); }
X end else begin
X lookup_dir := false;
X{ writeln('-- Unknown direction'); }
X end;
Xend;
X
X
Xfunction lookup_show(var n: integer;s:string): boolean;
Xvar
X i,poss,maybe,num: integer;
X
Xbegin
X s := lowcase(s);
X i := 1;
X maybe := 0;
X num := 0;
X for i := 1 to numshow do begin
X if s = show[i] then
X num := i
X else if index(show[i],s) = 1 then begin
X maybe := maybe + 1;
X poss := i;
X end;
X end;
X if num <> 0 then begin
X n := num;
X lookup_show := true;
X end else if maybe = 1 then begin
X n := poss;
X lookup_show := true;
X end else if maybe > 1 then begin
X lookup_show := false;
X{ writeln('-- Ambiguous direction'); }
X end else begin
X lookup_show := false;
X{ writeln('-- Unknown direction'); }
X end;
Xend;
X
Xfunction lookup_set(var n: integer;s:string): boolean;
Xvar
X i,poss,maybe,num: integer;
X
Xbegin
X s := lowcase(s);
X i := 1;
X maybe := 0;
X num := 0;
X for i := 1 to numset do begin
X if s = setkey[i] then
X num := i
X else if index(setkey[i],s) = 1 then begin
X maybe := maybe + 1;
X poss := i;
X end;
X end;
X if num <> 0 then begin
X n := num;
X lookup_set := true;
X end else if maybe = 1 then begin
X n := poss;
X lookup_set := true;
X end else if maybe > 1 then begin
X lookup_set := false;
X end else begin
X lookup_set := false;
X end;
Xend;
X
X
Xfunction lookup_room(var n: integer; s: string): boolean;
Xvar
X found: boolean;
X top: integer;
X
X i,
X poss,
X maybe,
X num: integer;
X
Xbegin
X if s <> '' then begin
X s := lowcase(s); { case insensitivity }
X getnam;
X freenam;
X getindex(I_ROOM);
X freeindex;
X top := indx.top;
X
X
X i := 1;
X maybe := 0;
X num := 0;
X for i := 1 to top do begin
X if s = nam.idents[i] then
X num := i
X else if index(nam.idents[i],s) = 1 then begin
X maybe := maybe + 1;
X poss := i;
X end;
X end;
X if num <> 0 then begin
X lookup_room := true;
X n := num;
X end else if maybe = 1 then begin
X lookup_room := true;
X n := poss;
X end else if maybe > 1 then begin
X lookup_room := false;
X end else begin
X lookup_room := false;
X end;
X
X end else
X lookup_room := false;
Xend;
X
X
Xfunction exact_room(var n: integer;s: string): boolean;
Xvar
X match: boolean;
X
Xbegin
X if debug then
X writeln('%exact room: s = ',s);
X if lookup_room(n,s) then begin
X if nam.idents[n] = lowcase(s) then
X exact_room := true
X else
X exact_room := false;
X end else
X exact_room := false;
Xend;
X
X
Xfunction exact_pers(var n: integer;s: string): boolean;
Xvar
X match: boolean;
X
Xbegin
X if lookup_pers(n,s) then begin
X if lowcase(pers.idents[n]) = lowcase(s) then
X exact_pers := true
X else
X exact_pers := false;
X end else
X exact_pers := false;
Xend;
X
X
Xfunction exact_user(var n: integer;s: string): boolean;
Xvar
X match: boolean;
X
Xbegin
X if lookup_user(n,s) then begin
X if lowcase(user.idents[n]) = lowcase(s) then
X exact_user := true
X else
X exact_user := false;
X end else
X exact_user := false;
Xend;
X
X
Xfunction exact_obj(var n: integer;s: string): boolean;
Xvar
X match: boolean;
X
Xbegin
X if lookup_obj(n,s) then begin
X if objnam.idents[n] = lowcase(s) then
X exact_obj := true
X else
X exact_obj := false;
X end else
X exact_obj := false;
Xend;
X
X
X
X{
XReturn n as the direction number if s is a valid alias for an exit
X}
Xfunction lookup_alias(var n: integer; s: string): boolean;
Xvar
X i,poss,maybe,num: integer;
X
Xbegin
X gethere;
X s := lowcase(s);
X i := 1;
X maybe := 0;
X num := 0;
X for i := 1 to maxexit do begin
X if s = here.exits[i].alias then
X num := i
X else if index(here.exits[i].alias,s) = 1 then begin
X maybe := maybe + 1;
X poss := i;
X end;
X end;
X if num <> 0 then begin
X n := num;
X lookup_alias := true;
X end else if maybe = 1 then begin
X n := poss;
X lookup_alias := true;
X end else if maybe > 1 then begin
X lookup_alias := false;
X end else begin
X lookup_alias := false;
X end;
Xend;
X
X
Xprocedure exit_default(dir, kind: integer);
X
Xbegin
X case kind of
X
X 1: writeln('There is a passage leading ',direct[dir],'.');
X 2: writeln('There is a locked door leading ',direct[dir],'.');
X 5: case dir of
X north,south,east,west:
X writeln('A note on the ',direct[dir],' wall says "Your exit here."');
X up: writeln('A note on the ceiling says "Your exit here."');
X down: writeln('A note on the floor says "Your exit here."');
X end;
X otherwise writeln('There is an exit: ',direct[dir]);
X end;
Xend;
X
X
X{
XPrints out the exits here for DO_LOOK()
X}
Xprocedure show_exits;
Xvar
X i: integer;
X one: boolean;
X cansee: boolean;
X
Xbegin
X one := false;
X for i := 1 to maxexit do begin
X if (here.exits[i].toloc <> 0) or { there is an exit }
X (here.exits[i].kind = 5) then begin { there could be an exit }
X
X if (here.exits[i].hidden = 0) or
X (found_exit[i]) then
X cansee := true
X else
X cansee := false;
X
X if here.exits[i].kind = 6 then begin
X { door kind only visible with object }
X if obj_hold( here.exits[i].objreq ) then
X cansee := true
X else
X cansee := false;
X end;
X
X if cansee then begin
X if here.exits[i].exitdesc = DEFAULT_LINE then begin
X exit_default(i,here.exits[i].kind);
X { give it direction and type }
X one := true;
X end else if here.exits[i].exitdesc > 0 then begin
X print_line(here.exits[i].exitdesc);
X one := true;
X end;
X end;
X end;
X end;
X if one then
X writeln;
Xend;
X
X
Xprocedure setevent;
X
Xbegin
X getevent;
X freeevent;
X myevent := event.point;
Xend;
X
X
X
Xfunction isnum(s: string): boolean;
Xvar
X i: integer;
X
Xbegin
X isnum := true;
X if length(s) < 1 then
X isnum := false
X else begin
X i := 1;
X while i <= length(s) do begin
X if not (s[i] in ['0'..'9']) then
X isnum := false;
X i := i + 1;
X end;
X end;
Xend;
X
Xfunction number(s: string): integer;
Xvar
X i: integer;
X
Xbegin
X if (length(s) < 1) or not(s[1] in ['0'..'9']) then
X number := 0
X else begin
X readv(s,i);
X number := i;
X end;
Xend;
X
X
X
Xprocedure log_event( send: integer := 0; { slot of sender }
X act:integer; { what event occurred }
X targ: integer := 0; { target of event }
X p: integer := 0; { expansion parameter }
X s: string := ''; { string for messages }
X room: integer := 0 { room to log event in }
X );
X
Xbegin
X if room = 0 then
X room := location;
X getevent(room);
X event.point := event.point + 1;
X if debug then
X writeln('%logging event ',act:1,' to point ',event.point:1);
X if event.point > maxevent then
X event.point := 1;
X with event.evnt[event.point] do begin
X sender := send;
X action := act;
X target := targ;
X parm := p;
X msg := s;
X loc := room;
X end;
X putevent;
Xend;
X
Xprocedure log_action(theaction,thetarget: integer);
X
Xbegin
X if debug then
X writeln('%log_action(',theaction:1,',',thetarget:1,')');
X getroom;
X here.people[myslot].act := theaction;
X here.people[myslot].targ := thetarget;
X putroom;
X
X logged_act := true;
X log_event(myslot,E_ACTION,thetarget,theaction,myname);
Xend;
X
X
Xfunction desc_action(theaction,thetarget: integer): string;
Xvar
X s: string;
X
Xbegin
X case theaction of { use command mnemonics }
X look: s:= ' looking around the room.';
X form: s:= ' creating a new room.';
X desc: s:= ' editing the description to this room.';
X e_detail: s := ' adding details to the room.';
X c_custom: s := ' customizing an exit here.';
X e_custroom:s := ' customizing this room.';
X e_program: s := ' customizing an object.';
X c_self: s := ' editing a self-description.';
X e_usecrystal: s := ' hunched over a crystal orb, immersed in its glow.';
X link: s := ' creating an exit here.';
X c_system: s := ' in system maintenance mode.';
X
X otherwise s := ' here.'
X end;
X desc_action := s;
Xend;
X
X
Xfunction protected(n: integer := 0): boolean;
X
Xbegin
X if n = 0 then
X n := myslot;
X if here.people[n].act in [e_detail,c_custom,
X e_custroom,e_program,
X c_self,c_system] then
X protected := true
X else
X protected := false;
Xend;
X
X
X
X{
Xuser procedure to designate an exit for acceptance of links
X}
Xprocedure do_accept(s: string);
Xvar
X dir: integer;
X
Xbegin
X if lookup_dir(dir,s) then begin
X if can_make(dir) then begin
X getroom;
X here.exits[dir].kind := 5;
X putroom;
X
X log_event(myslot,E_ACCEPT,0,0);
X writeln('Someone will be able to make an exit ',direct[dir],'.');
X end;
X end else
X writeln('To allow others to make an exit, type ACCEPT <direction of exit>.');
Xend;
X
X
X{
XUser procedure to refuse an exit for links
XNote: may be unlink
X}
Xprocedure do_refuse(s: string);
Xvar
X dir: integer;
X ok: boolean;
X
Xbegin
X if not(is_owner) then
X { is_owner prints error message itself }
X else if lookup_dir(dir,s) then begin
X getroom;
X with here.exits[dir] do begin
X if (toloc = 0) and (kind = 5) then begin
X kind := 0;
X ok := true;
X end else
X ok := false;
X end;
X putroom;
X if ok then begin
X log_event(myslot,E_REFUSE,0,0);
X writeln('Exits ',direct[dir],' will be refused.');
X end else
X writeln('Exits were not being accepted there.');
X end else
X writeln('To undo an Accept, type REFUSE <direction>.');
Xend;
X
X
X
Xfunction systime:string;
Xvar
X hourstring: string;
X hours: integer;
X thetime: packed array[1..11] of char;
X dayornite: string;
X
Xbegin
X time(thetime);
X if thetime[1] = ' ' then
X hours := ord(thetime[2]) - ord('0')
X else
X hours := (ord(thetime[1]) - ord('0'))*10 +
X (ord(thetime[2]) - ord('0'));
X
X if hours < 12 then
X dayornite := 'am'
X else
X dayornite := 'pm';
X if hours >= 13 then
X hours := hours - 12;
X if hours = 0 then
X hours := 12;
X
X writev(hourstring,hours:2);
X
X systime := hourstring + ':' + thetime[4] + thetime[5] + dayornite;
Xend;
X
X
END_OF_FILE
if test 54408 -ne `wc -c <'mon1.pas'`; then
echo shar: \"'mon1.pas'\" unpacked with wrong size!
fi
# end of 'mon1.pas'
fi
echo shar: End of archive 4 \(of 6\).
cp /dev/null ark4isdone
MISSING=""
for I in 1 2 3 4 5 6 ; do
if test ! -f ark${I}isdone ; then
MISSING="${MISSING} ${I}"
fi
done
if test "${MISSING}" = "" ; then
echo You have unpacked all 6 archives.
rm -f ark[1-9]isdone
./fixup.sh
else
echo You still need to unpack the following archives:
echo " " ${MISSING}
fi
## End of shell archive.
exit 0