{

	This is Monster, a multiuser adventure game system
	where the players create the universe.

	Written by Rich Skrenta at Northwestern University, 1988.

		skrenta@nuacc.acns.nwu.edu
		skrenta@nuacc.bitnet

}

program monster(input,output);

const

%include 'privusers.pas'

	veryshortlen = 12;	{ very short string length for userid's etc }
	shortlen = 20;		{ ordinary short string }

	maxobjs = 15;		{ max objects allow on floor in a room }
	maxpeople = 10;		{ max people allowed in a room }
	maxplayers = 300;	{ max log entries to make for players }
	maxcmds = 75;		{ top value for cmd keyword slots }
	maxshow = 50;		{ top value for set/show keywords }
	maxexit = 6;		{ 6 exits from each loc: NSEWUD }
	maxroom = 1000;		{ Total maximum ever possible	}
	maxdetail = 5;		{ max num of detail keys/descriptions per room }
	maxevent = 15;		{ event slots per event block }
	maxindex = 10000;	{ top value for bitmap allocation }
	maxhold = 6;		{ max # of things a player can be holding }
	maxerr = 15;		{ # of consecutive record collisions before the
				  the deadlock error message is printed }
	numevnts = 10;		{ # of different event records to be maintained }
	numpunches = 12;	{ # of different kinds of punches there are }
	maxparm = 20;		{ parms for object USEs }
	maxspells = 50;		{ total number of spells available }

	descmax = 10;		{ lines per description block }


	DEFAULT_LINE = 32000;	{ A virtual one liner record number that
				  really means "use the default one liner
				  description instead of reading one from
				  the file" }

{ Mnemonics for directions }

	north = 1;
	south = 2;
	east = 3;
	west = 4;
	up = 5;
	down = 6;


{ Index record mnemonics }

	I_BLOCK = 1;	{ True if description block is not used		}
	I_LINE = 2;	{ True if line slot is not used			}
	I_ROOM = 3;	{ True if room slot is not in use		}
	I_PLAYER = 4;	{ True if slot is not occupied by a player	}
	I_ASLEEP = 5;	{ True if player is not playing			}
	I_OBJECT = 6;	{ True if object record is not being used	}
	I_INT = 7;	{ True if int record is not being used		}

{ Integer record mnemonics }

	N_LOCATION = 1;		{ Player's location }
	N_NUMROOMS = 2;		{ How many rooms they've made }
	N_ALLOW = 3;		{ How many rooms they're allowed to make }
	N_ACCEPT = 4;		{ Number of open accept exits they have }
	N_EXPERIENCE = 5;	{ How "good" they are }
	N_SELF = 6;		{ player's self descriptions }

{ object kind mnemonics }

	O_BLAND = 0;		{ bland object, good for keys }
	O_WEAPON = 1;
	O_ARMOR = 2;
	O_THRUSTER = 3;		{ use puts player through an exit }
	O_CLOAK = 4;

	O_BAG = 100;
	O_CRYSTAL = 101;
	O_WAND = 102;
	O_HAND = 103;


{ Command Mnemonics }
	error = 0;
	setnam = 1;
	help = 2;
	quest = 3;
	quit = 4;
	look = 5;
	go = 6;
	form = 7;
	link = 8;
	unlink = 9;
	c_whisper = 10;
	poof = 11;
	desc = 12;
	dbg = 14;
	say = 15;

	c_rooms = 17;
	c_system = 18;
	c_disown = 19;
	c_claim = 20;
	c_create = 21;
	c_public = 22;
	c_accept = 23;
	c_refuse = 24;
	c_zap = 25;
	c_hide = 26;
	c_l = 27;
	c_north = 28;
	c_south = 29;
	c_east = 30;
	c_west = 31;
	c_up = 32;
	c_down = 33;
	c_n = 34;
	c_s = 35;
	c_e = 36;
	c_w = 37;
	c_u = 38;
	c_d = 39;
	c_custom = 40;
	c_who = 41;
	c_players = 42;
	c_search = 43;
	c_unhide = 44;
	c_punch = 45;
	c_ping = 46;
	c_health = 47;
	c_get = 48;
	c_drop = 49;
	c_inv = 50;
	c_i = 51;
	c_self = 52;
	c_whois = 53;
	c_duplicate = 54;

	c_version = 56;
	c_objects = 57;
	c_use = 58;
	c_wield = 59;
	c_brief = 60;
	c_wear = 61;
	c_relink = 62;
	c_unmake = 63;
	c_destroy = 64;
	c_show = 65;
	c_set = 66;

	e_detail = 100;		{ pseudo command for log_action of desc exit }
	e_custroom = 101;	{ customizing this room }
	e_program = 102;	{ customizing (programming) an object }
	e_usecrystal = 103;	{ using a crystal ball }


{ Show Mnemonics }

	s_exits = 1;
	s_object = 2;
	s_quest = 3;
	s_details = 4;


{ Set Mnemonics }

	y_quest = 1;
	y_altmsg = 2;
	y_group1 = 3;
	y_group2 = 4;


{ Event Mnemonics }

	E_EXIT = 1;		{ player left room			}
	E_ENTER = 2;		{ player entered room			}
	E_BEGIN = 3;		{ player joined game here		}
	E_QUIT = 4;		{ player here quit game			}
	
	E_SAY = 5;		{ someone said something		}
	E_SETNAM = 6;		{ player set his personal name		}
	E_POOFIN = 8;		{ someone poofed into this room		}
	E_POOFOUT = 9;		{ someone poofed out of this room	}
	E_DETACH = 10;		{ a link has been destroyed		}
	E_EDITDONE = 11;	{ someone is finished editing a desc	}
	E_NEWEXIT = 12;		{ someone made an exit here		}
	E_BOUNCEDIN = 13;	{ an object "bounced" into the room	}
	E_EXAMINE = 14;		{ someone is examining something	}
	E_CUSTDONE = 15;	{ someone is done customizing an exit	}
	E_FOUND = 16;		{ player found something		}
	E_SEARCH = 17;		{ player is searching room		}
	E_DONEDET = 18;		{ done adding details to a room		}
	E_HIDOBJ = 19;		{ someone hid an object here		}
	E_UNHIDE = 20;		{ voluntarily revealed themself		}
	E_FOUNDYOU = 21;	{ someone found someone else hiding	}
	E_PUNCH = 22;		{ someone has punched someone else	}
	E_MADEOBJ = 23;		{ someone made an object here		}
	E_GET = 24;		{ someone picked up an object		}
	E_DROP = 25;		{ someone dropped an object		}
	E_DROPALL = 26;		{ quit & dropped stuff on way out	}
	E_IHID = 27;		{ tell others that I have hidden (!)	}
	E_NOISES = 28;		{ strange noises from hidden people	}
	E_PING = 29;		{ send a ping to a potential zombie	}
	E_PONG = 30;		{ ping answered				}
	E_HIDEPUNCH = 31;	{ someone hidden is attacking		}
	E_SLIPPED = 32;		{ attack caused obj to drop unwillingly }
	E_ROOMDONE = 33;	{ done customizing this room		}
	E_OBJDONE = 34;		{ done programming an object		}
	E_HPOOFOUT = 35;	{ someone hiding poofed	out		}
	E_FAILGO = 36;		{ a player failed to go through an exit }
	E_HPOOFIN = 37;		{ someone poofed into a room hidden	}
	E_TRYPUNCH = 38;	{ someone failed to punch someone else	}
	E_PINGONE = 39;		{ someone was pinged away . . .		}
	E_CLAIM = 40;		{ someone claimed this room		}
	E_DISOWN = 41;		{ owner of this room has disowned it	}
	E_WEAKER = 42;		{ person is weaker from battle		}
	E_OBJCLAIM = 43;	{ someone claimed an object		}
	E_OBJDISOWN = 44;	{ someone disowned an object		}
	E_SELFDONE = 45;	{ done editing self description		}
	E_WHISPER = 46;		{ someone whispers to someone else	}
	E_WIELD = 47;		{ player wields a weapon		}
	E_UNWIELD = 48;		{ player puts a weapon away		}
	E_DONECRYSTALUSE = 49;	{ done using the crystal ball		}
	E_WEAR = 50;		{ someone has put on something		}
	E_UNWEAR = 51;		{ someone has taken off something	}
	E_DESTROY = 52;		{ someone has destroyed an object	}
	E_HIDESAY = 53;		{ anonymous say				}
	E_OBJPUBLIC = 54;	{ someone made an object public		}
	E_SYSDONE = 55;		{ done with system maint. mode		}
	E_UNMAKE = 56;		{ remove typedef for object		}
	E_LOOKDETAIL = 57;	{ looking at a detail of this room	}
	E_ACCEPT = 58;		{ made an "accept" exit here		}
	E_REFUSE = 59;		{ got rid of an "accept" exit here	}
	E_DIED = 60;		{ someone died and evaporated		}
	E_LOOKYOU = 61;		{ someone is looking at you		}
	E_FAILGET = 62;		{ someone can't get something		}
	E_FAILUSE = 63;		{ someone can't use something		}
	E_CHILL = 64;		{ someone scrys you			}
	E_NOISE2 = 65;		{ say while in crystal ball		}
	E_LOOKSELF = 66;	{ someone looks at themself		}
	E_INVENT = 67;		{ someone takes inventory		}
	E_POOFYOU = 68;		{ MM poofs someone away . . . .		}
	E_WHO = 69;		{ someone does a who			}
	E_PLAYERS = 70;		{ someone does a players		}
	E_VIEWSELF = 71;	{ someone views a self description	}
	E_REALNOISE = 72;	{ make the real noises message print	}
	E_ALTNOISE = 73;	{ alternate mystery message		}
	E_MIDNIGHT = 74;	{ it's midnight now, tell everyone	}

	E_ACTION = 100;		{ base command action event }


{ Misc. }

	GOODHEALTH = 7;


type
	string = varying[80] of char;
	veryshortstring = varying[veryshortlen] of char;
	shortstring = varying[shortlen] of char;

	{ This is a list of description block numbers;
	  If a number is zero, there is no text for that block }
	

	{ exit kinds:
		0: no way - blocked exit
		1: open passageway
		2: object required

		6: exit only exists if player is holding the key
	}

	exit = record
		toloc: integer;		{ location exit goes to }
		kind: integer;		{ type of the exit }
		slot: integer;		{ exit slot of toloc target }

		exitdesc,  { one liner description of exit  }
		closed,    { desc of a closed door }
		fail,	   { description if can't go thru   }
		success,   { desc while going thru exit     }
		goin,      { what others see when you go into the exit }
{		ofail,	}
		comeout:   { what others see when you come out of the exit }
			  integer; { all refer to the liner file }
				   { if zero defaults will be printed }

		hidden: integer;	{ **** about to change this **** }
		objreq: integer;	{ object required to pass this exit }

		alias: veryshortstring; { alias for the exit dir, a keyword }

		reqverb: boolean;	{ require alias as a verb to work }
		reqalias: boolean;	{ require alias only (no direction) to
					  pass through the exit }
		autolook: boolean;	{ do a look when user comes out of exit }
	end;


	{ index record # 1 is block index }
	{ index record # 2 is line index }
	{ index record # 3 is room index }
	{ index record # 4 is player alloc index }
	{ index record # 5 is player awake (in game) index }
	indexrec = record
		indexnum: integer;	{ validation number }
		free: packed array[1..maxindex] of boolean;
		top: integer;   { max records available }
		inuse: integer; { record #s in use }
	end;


	{ names are record #1   }
	{ owners are record # 2 }
	{ player pers_names are record # 3 }
	{ userids are record # 4 }
	{ object names are record # 5 }
	{ object creators are record # 6 }
	{ date of last play is # 7 }
	{ time of last play is # 8 }
	namrec = record
		validate: integer;
		loctop: integer;
		idents: array[1..maxroom] of shortstring;
	end;

	objectrec = record
		objnum: integer;	{ allocation number for the object }
		onum: integer;		{ number index to objnam/objown }
		oname: shortstring;	{ duplicate of name of object }
		kind: integer;		{ what kind of object this is }
		linedesc: integer;	{ liner desc of object Here }

		home: integer;		{ if object at home, then print the }
		homedesc: integer;	{ home description }

		actindx: integer;	{ action index -- programs for the future }
		examine: integer;	{ desc block for close inspection }
		worth: integer;		{ how much it cost to make (in gold) }
		numexist: integer;	{ number in existence }

		sticky: boolean;	{ can they ever get it? }
		getobjreq: integer;	{ object required to get this object }
		getfail: integer;	{ fail-to-get description }
		getsuccess: integer;	{ successful picked up description }

		useobjreq: integer;	{ object require to use this object }
		uselocreq: integer;	{ place have to be to use this object }
		usefail: integer;	{ fail-to-use description }
		usesuccess: integer;	{ successful use of object description }

		usealias: veryshortstring;
		reqalias: boolean;
		reqverb: boolean;

		particle: integer;	{ a,an,some, etc... "particle" is not
					  be right, but hey, it's in the code }

		parms: array[1..maxparm] of integer;

		d1: integer;		{ extra description # 1 }
		d2: integer;		{ extra description # 2 }
		exp3,exp4,exp5,exp6: integer;
	end;

	anevent = record
		sender,			{ slot of sender }
		action,			{ what event this is, E_something }
		target,			{ opt target of action }
		parm: integer;		{ expansion parm }
		msg: string;		{ string for SAY and other cmds }
		loc: integer;		{ room that event is targeted for }
	end;

	eventrec = record
		validat: integer;	{ validation number for record locking }
		evnt: array[1..maxevent] of anevent;
		point: integer;		{ circular buffer pointer }
	end;

	peoplerec = record
		kind: integer;		   { 0=none,1=player,2=npc }
		parm: integer;		   { index to npc controller (object?) }

		username: veryshortstring; { actual userid of person }
		name: shortstring;	   { chosen name of person }
		hiding: integer;	   { degree to which they're hiding }
		act,targ: integer;	   { last thing that this person did }

		holding: array[1..maxhold] of integer;	{ objects being held }
		experience: integer;

		wearing: integer;	{ object that they're wearing }
		wielding: integer;	{ weapon they're wielding }
		health: integer;	{ how healthy they are }

		self: integer;		{ self description }

		ex1,ex2,ex3,ex4,ex5: integer;
	end;

	spellrec = record
		recnum: integer;
		level: array[1..maxspells] of integer;
	end;

	descrec = record
		descrinum: integer;
		lines: array[1..descmax] of string;
		desclen: integer;  { number used in this block }
	end;

	linerec = record
		linenum: integer;
		theline: string;
	end;

	room = record
		valid: integer;		{ validation number for record locking }
		locnum: integer;
		owner: veryshortstring; { who owns the room: userid if private
							     '' if public
							     '*' if disowned }
		nicename: string;	{ pretty name for location }
		nameprint: integer;	{ code for printing name:
						0: don't print it
						1: You're in
						2: You're at
					}

		primary: integer;	{ room descriptions }
		secondary: integer;
		which: integer;		{ 0 = only print primary room desc.
					  1 = only print secondary room desc.
					  2 = print both
					  3 = print primary then secondary
						if has magic object }

		magicobj: integer;	{ special object for this room }
		effects: integer;
		parm: integer;

		exits: array[1..maxexit] of exit;

		pile: integer;		{ if more than maxobjs objects here }
		objs: array[1..maxobjs] of integer;	{ refs to object file }
		objhide: array[1..maxobjs] of integer;	{ how much each object
							  is hidden }
							{ see hidden on exitrec
							  above }

		objdrop: integer;	{ where objects go when they're dropped }
		objdesc: integer;	{ what it says when they're dropped }
		objdest: integer;	{ what it says in target room when
					  "bounced" object comes in }

		people: array[1..maxpeople] of peoplerec;

		grploc1,grploc2: integer;
		grpnam1,grpnam2: shortstring;

		detail: array[1..maxdetail] of veryshortstring;
		detaildesc: array[1..maxdetail] of integer;

		trapto: integer;	{ where the "trapdoor" goes }
		trapchance: integer;	{ how often the trapdoor works }

		rndmsg: integer;	{ message that randomly prints }

		xmsg2: integer;		{ another random block }
		exp2,exp3,exp4: integer;
		exitfail: integer;	{ default fail description for exits }
		ofail: integer;		{ what other's see when you fail, default }
	end;


	intrec = record
		intnum: integer;
		int: array[1..maxplayers] of integer;
	end;


var
	old_prompt: [external] string;
	line:	    [external] string;
	oldcmd:	string;		{ string for '.' command to do last command }

	inmem: boolean;	 { Is this rooms roomrec (here....) in memory?
			   We call gethere many times to make sure
			   here is current.  However, we only want to
			   actually do a getroom if the roomrec has been
			   modified	}
	brief: boolean := FALSE;	{ brief/verbose descriptions }

	rndcycle: integer;		{ integer for rnd_event }
	debug: boolean;
	ping_answered: boolean;		  { flag for ping answers }
	hiding : boolean := FALSE;	  { is player hiding? }
	midnight_notyet: boolean := TRUE; { hasn't been midnight yet }
	first_puttoken: boolean := TRUE;  { flag for first place into world }
	logged_act : boolean := FALSE;	  { flag to indicate that a log_action
					  has been called, and the next call
					  to clear_command needs to clear the
					  action parms in the here roomrec }

	roomfile : file of room;
	eventfile: file of eventrec;
	namfile: file of namrec;
	descfile: file of descrec;
	linefile: file of linerec;
	indexfile: file of indexrec;
	intfile: file of intrec;
	objfile: file of objectrec;
	spellfile: file of spellrec;

	cmds: array[1..maxcmds] of shortstring := (

		'name',		{ setnam = 1	}
		'help',		{ help = 2	}
		'?',		{ quest = 3	}
		'quit',		{ quit = 4	}
		'look',		{ look = 5	}
		'go',		{ go = 6	}
		'form',		{ form = 7	}
		'link',		{ link = 8	}
		'unlink',	{ unlink = 9	}
		'whisper',	{ c_whisper = 10}
		'poof',		{ poof = 11	}
		'describe',	{ desc = 12	}
		'',
		'debug',	{ dbg = 14	}
		'say',		{ say = 15	}
		'',		{		}
		'rooms',	{ c_rooms = 17	}
		'system',	{ c_system = 18	}
		'disown',	{ c_disown = 19	}
		'claim',	{ c_claim = 20	}
		'make',		{ c_create = 21	}
		'public',	{ c_public = 22	}
		'accept',	{ c_accept = 23	}
		'refuse',	{ c_refuse = 24	}
		'zap',		{ c_zap = 25	}
		'hide',		{ c_hide = 26	}
		'l',		{ c_l = 27	}
		'north',	{ c_north = 28	}
		'south',	{ c_south = 29	}
		'east',		{ c_east = 30	}
		'west',		{ c_west = 31	}
		'up',		{ c_up = 32	}
		'down',		{ c_down = 33	}
		'n',		{ c_n = 34	}
		's',		{ c_s = 35	}
		'e',		{ c_e = 36	}
		'w',		{ c_w = 37	}
		'u',		{ c_u = 38	}
		'd',		{ c_d = 39	}
		'customize',	{ c_custom = 40	}
		'who',		{ c_who = 41	}
		'players',	{ c_players = 42}
		'search',	{ c_search = 43	}
		'reveal',	{ c_unhide = 44	}
		'punch',	{ c_punch = 45	}
		'ping',		{ c_ping = 46	}
		'health',	{ c_health = 47	}
		'get',		{ c_get = 48	}
		'drop',		{ c_drop = 49	}
		'inventory',	{ c_inv = 50	}
		'i',		{ c_i = 51	}
		'self',		{ c_self = 52	}
		'whois',	{ c_whois = 53	}
		'duplicate',	{ c_duplicate = 54 }
		'',
		'version',	{ c_version = 56}
		'objects',	{ c_objects = 57}
		'use',		{ c_use = 58	}
		'wield',	{ c_wield = 59	}
		'brief',	{ c_brief = 60	}
		'wear',		{ c_wear = 61	}
		'relink',	{ c_relink = 62	}
		'unmake',	{ c_unmake = 63	}
		'destroy',	{ c_destroy = 64}
		'show',		{ c_show = 65	}
		'set',		{ c_set = 66	}
		'',
		'',
		'',
		'',
		'',
		'',
		'',
		'',
		''
	);


	numcmds: integer;	{ number of main level commands there are }
	show: array[1..maxshow] of shortstring;
	numshow: integer;
	setkey: array[1..maxshow] of shortstring;
	numset: integer;

	direct: array[1..maxexit] of shortstring :=
		('north','south','east','west','up','down');

	spells: array[1..maxspells] of string;	  { names of spells }
	numspells: integer;		{ number of spells there actually are }

	done: boolean;		{ flag for QUIT }
	userid: veryshortstring;	{ userid of this player }
	location: integer;	{ current place number }

	hold_kind: array[1..maxhold] of integer; { kinds of the objects i'm
						   holding }

	myslot: integer := 1;	{ here.people[myslot]... is this player }
	myname: shortstring;	{ personal name this player chose (setname) }
	myevent: integer;	{ which point in event buffer we are at }

	found_exit: array[1..maxexit] of boolean;
				{ has exit i been found by the player? }

	mylog: integer;		{ which log entry this player is }
	mywear: integer;	{ what I'm wearing }
	mywield: integer;	{ weapon I'm wielding }
	myhealth: integer;	{ how well I'm feeling }
	myexperience: integer;	{ how experienced I am }
	myself: integer;	{ self description block }

	healthcycle: integer;	{ used in rnd_event to control how quickly a
				  player heals }

	here: room;		{ current room record }
	event: eventrec;
	privd: boolean;

	objnam,			{ object names }
	objown,			{ object owners }
	nam,			{ record 1 is room names }
	own,			{ rec 2 is room owners }
	pers,			{ 3 is player personal names }
	user,			{ 4 is player userid	}
	adate,			{ 5 is date of last play }
	atime			{ 6 is time of last play }
 		: namrec;

	anint: intrec;		{ info about game players }
	obj: objectrec;
	spell: spellrec;

	block: descrec;		{ a text block of descmax lines }
	indx: indexrec;		{ an record allocation record }
	oneliner: linerec;	{ a line record }

	heredsc: descrec;


[external]
procedure wait(seconds: real);	{ system SLEEP call }
external;

[external]
function random:real;	{ system random number generator }
external;

[external]
function rnd100: integer;	{ returns a random # between 0-100 }
external;

[external]
procedure setup_guts;	{ disables ctrl-Y/ctrl-C }
			{ necessary to prevent ZOMBIES in the world }
extern;

[external]
procedure finish_guts;	{ re-enables ctrl-Y/ctrl-C }
extern;

[external] function get_userid:string;
external;

[external] function trim(s: string): string;
external;

[external]
procedure grab_line(prompt: string; var s:string; echo:boolean := true);
{ Input routine.   Gets a line of text from user which checking
  for async events }
external;

[external]
procedure putchars(s: string);
extern;

procedure xpoof(loc: integer);
forward;

procedure do_exit(exit_slot: integer);
forward;

function put_token(room: integer;var aslot:integer;hidelev:integer := 0):boolean;
forward;

procedure take_token(aslot, roomno: integer);
forward;

procedure maybe_drop;
forward;

procedure do_program(objnam: string);
forward;

function drop_everything(pslot: integer := 0): boolean;
forward;


procedure collision_wait;
var
	wait_time: real;

begin
	wait_time := random;
	if wait_time < 0.001 then
		wait_time := 0.001;
	wait(wait_time);
end;


{ increment err; if err is too high, suspect deadlock }
{ this is called by all getX procedures to ease deadlock checking }
procedure deadcheck(var err: integer; s:string);

begin
	err := err + 1;
	if err > maxerr then begin
		writeln('%warning- ',s,' seems to be deadlocked; notify the Monster Manager');
		finish_guts;
		halt;
		err := 0;
	end;
end;



{ first procedure of form getX
  attempts to get given room record
  resolves record access conflicts, checks for deadlocks
  Locks record; use freeroom immediately after getroom if data is
  for read-only
}
procedure getroom(n: integer:= 0);
var
	err: integer;

begin
	if n = 0 then
		n := location;
	roomfile^.valid := 0;
	err := 0;
	if debug then
		writeln('%getroom(',n:1,')');
	find(roomfile,n,error := continue);
	while roomfile^.valid <> n do begin
		deadcheck(err,'getroom');
		collision_wait;
		find(roomfile,n,error := continue);
	end;
	here := roomfile^;

	inmem := false;
		{ since this getroom could be doing anything, we will
		  assume that it is bozoing the correct here record for
		  this room.  If this getroom called by gethere, then
		  gethere will correct inmem immediately.  Otherwise
		  the next gethere will restore the correct here record. }
end;

procedure putroom;

begin
	locate(roomfile,here.valid);
	roomfile^ := here;
	put(roomfile);
end;

procedure freeroom;	{ unlock the record if you're not going to write it }

begin
	unlock(roomfile);
end;

procedure gethere(n: integer := 0);

begin
	if (n = 0) or (n = location) then begin
		if not(inmem) then begin
			getroom;	{ getroom(n) okay here also }
			freeroom;
			inmem := true;
		end else if debug then
			writeln('%gethere - here already in memory');
	end else begin
		getroom(n);
		freeroom;
	end;
end;


procedure getown;
var
	err: integer;

begin
	namfile^.validate := 0;
	err := 0;
	find(namfile,2,error := continue);
	while namfile^.validate <> 2 do begin
		deadcheck(err,'getown');
		collision_wait;
		find(namfile,2,error := continue);
	end;
	own := namfile^;
end;



procedure getnam;
var
	err: integer;

begin
	namfile^.validate := 0;
	err := 0;
	find(namfile,1,error := continue);
	while namfile^.validate <> 1 do begin
		deadcheck(err,'getnam');
		collision_wait;
		find(namfile,1,error := continue);
	end;
	nam := namfile^;
end;

procedure freenam;

begin
	unlock(namfile);
end;

procedure freeown;

begin
	unlock(namfile);
end;

procedure putnam;

begin
	locate(namfile,1);
	namfile^:= nam;
	put(namfile);
end;

procedure putown;

begin
	locate(namfile,2);
	namfile^:= own;
	put(namfile);
end;


procedure getobj(n: integer);
var
	err: integer;

begin
	if n = 0 then
		n := location;
	objfile^.objnum := 0;
	err := 0;
	find(objfile,n,error := continue);
	while objfile^.objnum <> n do begin
		deadcheck(err,'getobj');
		collision_wait;
		find(objfile,n,error := continue);
	end;
	obj := objfile^;
end;

procedure putobj;

begin
	locate(objfile,obj.objnum);
	objfile^ := obj;
	put(objfile);
end;

procedure freeobj;	{ unlock the record if you're not going to write it }

begin
	unlock(objfile);
end;



procedure getint(n: integer);
var
	err: integer;

begin
	intfile^.intnum := 0;
	err := 0;
	find(intfile,n,error := continue);
	while intfile^.intnum <> n do begin
		deadcheck(err,'getint');
		collision_wait;
		find(intfile,n,error := continue);
	end;
	anint := intfile^;
end;


procedure freeint;

begin
	unlock(intfile);
end;

procedure putint;
var
	n: integer;

begin
	n := anint.intnum;
	locate(intfile,n);
	intfile^:= anint;
	put(intfile);
end;



procedure getspell(n: integer := 0);
var
	err: integer;

begin
	if n = 0 then
		n := mylog;

	spellfile^.recnum := 0;
	err := 0;
	find(spellfile,n,error := continue);
	while spellfile^.recnum <> n do begin
		deadcheck(err,'getspell');
		collision_wait;
		find(spellfile,n,error := continue);
	end;
	spell := spellfile^;
end;


procedure freespell;

begin
	unlock(spellfile);
end;

procedure putspell;
var
	n: integer;

begin
	n := spell.recnum;
	locate(spellfile,n);
	spellfile^:= spell;
	put(spellfile);
end;



procedure getuser;	{ get log rec with everyone's userids in it }
var
	err: integer;

begin
	namfile^.validate := 0;
	err := 0;
	find(namfile,4,error := continue);
	while namfile^.validate <> 4 do begin
		deadcheck(err,'getuser');
		collision_wait;
		find(namfile,4,error := continue);
	end;
	user := namfile^;
end;

procedure freeuser;

begin
	unlock(namfile);
end;

procedure putuser;

begin
	locate(namfile,4);
	namfile^:= user;
	put(namfile);
end;



procedure getdate;	{ get log rec with date of last play in it }
var
	err: integer;

begin
	namfile^.validate := 0;
	err := 0;
	find(namfile,7,error := continue);
	while namfile^.validate <> 7 do begin
		deadcheck(err,'getdate');
		collision_wait;
		find(namfile,7,error := continue);
	end;
	adate := namfile^;
end;

procedure freedate;

begin
	unlock(namfile);
end;

procedure putdate;

begin
	locate(namfile,7);
	namfile^:= adate;
	put(namfile);
end;


procedure gettime;	{ get log rec with time of last play in it }
var
	err: integer;

begin
	namfile^.validate := 0;
	err := 0;
	find(namfile,8,error := continue);
	while namfile^.validate <> 8 do begin
		deadcheck(err,'gettime');
		collision_wait;
		find(namfile,8,error := continue);
	end;
	atime := namfile^;
end;

procedure freetime;

begin
	unlock(namfile);
end;

procedure puttime;

begin
	locate(namfile,8);
	namfile^:= atime;
	put(namfile);
end;



procedure getobjnam;
var
	err: integer;

begin
	namfile^.validate := 0;
	err := 0;
	find(namfile,5,error := continue);
	while namfile^.validate <> 5 do begin
		deadcheck(err,'getobjnam');
		collision_wait;
		find(namfile,5,error := continue);
	end;
	objnam := namfile^;
end;

procedure freeobjnam;

begin
	unlock(namfile);
end;

procedure putobjnam;

begin
	locate(namfile,5);
	namfile^:= objnam;
	put(namfile);
end;



procedure getobjown;
var
	err: integer;

begin
	namfile^.validate := 0;
	err := 0;
	find(namfile,6,error := continue);
	while namfile^.validate <> 6 do begin
		deadcheck(err,'getobjown');
		collision_wait;
		find(namfile,6,error := continue);
	end;
	objown := namfile^;
end;

procedure freeobjown;

begin
	unlock(namfile);
end;

procedure putobjown;

begin
	locate(namfile,6);
	namfile^:= objown;
	put(namfile);
end;



procedure getpers;	{ get log rec with everyone's pers names in it }
var
	err: integer;

begin
	namfile^.validate := 0;
	err := 0;
	find(namfile,3,error := continue);
	while namfile^.validate <> 3 do begin
		deadcheck(err,'getpers');
		collision_wait;
		find(namfile,3,error := continue);
	end;
	pers := namfile^;
end;

procedure freepers;

begin
	unlock(namfile);
end;

procedure putpers;

begin
	locate(namfile,3);
	namfile^:= pers;
	put(namfile);
end;




procedure getevent(n: integer := 0);
var
	err: integer;

begin
	if n = 0 then
		n := location;

	n := (n mod numevnts) + 1;

	eventfile^.validat := 0;
	err := 0;
	find(eventfile,n,error := continue);
	while eventfile^.validat <> n do begin
		deadcheck(err,'getevent');
		collision_wait;
		find(eventfile,n,error := continue);
	end;
	event := eventfile^;
end;

procedure freeevent;

begin
	unlock(eventfile);
end;

procedure putevent;

begin
	locate(eventfile,event.validat);
	eventfile^:= event;
	put(eventfile);
end;


procedure getblock(n: integer);
var
	err: integer;

begin
	if debug then
		writeln('%getblock: ',n:1);
	descfile^.descrinum := 0;
	err := 0;
	find(descfile,n,error := continue);
	while descfile^.descrinum <> n do begin
		deadcheck(err,'getblock');
		collision_wait;
		find(descfile,n,error := continue);
	end;
	block := descfile^;
end;

procedure putblock;
var
	n: integer;

begin
	n := block.descrinum;
	if debug then
		writeln('%putblock: ',n:1);
	if n <> 0 then begin
		locate(descfile,n);
		descfile^ := block;
		put(descfile);
	end;
end;

procedure freeblock;	{ unlock the record if you're not going to write it }

begin
	unlock(descfile);
end;





{ *** new code begins here *** }


procedure getline(n: integer);
var
	err: integer;

begin
	if n = -1 then begin
		oneliner.theline := '';
	end else begin
		err := 0;
		linefile^.linenum := 0;
		find(linefile,n,error := continue);
		while linefile^.linenum <> n do begin
			deadcheck(err,'getline');
			collision_wait;
			find(linefile,n,error := continue);
		end;
		oneliner := linefile^;
	end;
end;

procedure putline;

begin
	if oneliner.linenum > 0 then begin
		locate(linefile,oneliner.linenum);
		linefile^ := oneliner;
		put(linefile);
	end;
end;

procedure freeline;	{ unlock the record if you're not going to write it }

begin
	unlock(linefile);
end;




{
Index record 1 -- Description blocks that are free
Index record 2 -- One liners that are free
}


procedure getindex(n: integer);
var
	err: integer;

begin
	indexfile^.indexnum := 0;
	err := 0;
	find(indexfile,n,error := continue);
	while indexfile^.indexnum <> n do begin
		deadcheck(err,'getindex');
		collision_wait;
		find(indexfile,n,error := continue);
	end;
	indx := indexfile^;
end;

procedure putindex;

begin
	locate(indexfile,indx.indexnum);
	indexfile^ := indx;
	put(indexfile);
end;

procedure freeindex;	{ unlock the record if you're not going to write it }

begin
	unlock(indexfile);
end;



{
First procedure of form alloc_X
Allocates the oneliner resource using the indexrec bitmaps

Return the number of a one liner if one is available
and remove it from the free list
}
function alloc_line(var n: integer):boolean;
var
	found: boolean;

begin
	getindex(I_LINE);
	if indx.inuse = indx.top then begin
		freeindex;
		n := 0;
		alloc_line := false;
		writeln('There are no available one line descriptions.');
	end else begin
		n := 1;
		found := false;
		while (not found) and (n <= indx.top) do begin
			if indx.free[n] then
				found := true
			else
				n := n + 1;
		end;
		if found then begin
			indx.free[n] := false;
			alloc_line := true;
			indx.inuse := indx.inuse + 1;
			putindex;
		end else begin
			freeindex;
			writeln('%serious error in alloc_line; notify Monster Manager');
			
			alloc_line := false;
		end;
	end;
end;

{
put the line specified by n back on the free list
zeroes n also, for convenience
}
procedure delete_line(var n: integer);

begin
	if n = DEFAULT_LINE then
		n := 0
	else if n > 0 then begin
		getindex(I_LINE);
		indx.inuse := indx.inuse - 1;
		indx.free[n] := true;
		putindex;
	end;
	n := 0;
end;



function alloc_int(var n: integer):boolean;
var
	found: boolean;

begin
	getindex(I_INT);
	if indx.inuse = indx.top then begin
		freeindex;
		n := 0;
		alloc_int := false;
		writeln('There are no available integer records.');
	end else begin
		n := 1;
		found := false;
		while (not found) and (n <= indx.top) do begin
			if indx.free[n] then
				found := true
			else
				n := n + 1;
		end;
		if found then begin
			indx.free[n] := false;
			alloc_int := true;
			indx.inuse := indx.inuse + 1;
			putindex;
		end else begin
			freeindex;
			writeln('%serious error in alloc_int; notify Monster Manager');
			
			alloc_int := false;
		end;
	end;
end;


procedure delete_int(var n: integer);

begin
	if n > 0 then begin
		getindex(I_INT);
		indx.inuse := indx.inuse - 1;
		indx.free[n] := true;
		putindex;
	end;
	n := 0;
end;



{
Return the number of a description block if available and
remove it from the free list
}
function alloc_block(var n: integer):boolean;
var
	found: boolean;

begin
	if debug then
		writeln('%alloc_block entry');
	getindex(I_BLOCK);
	if indx.inuse = indx.top then begin
		freeindex;
		n := 0;
		alloc_block := false;
		writeln('There are no available description blocks.');
	end else begin
		n := 1;
		found := false;
		while (not found) and (n <= indx.top) do begin
			if indx.free[n] then
				found := true
			else
				n := n + 1;
		end;
		if found then begin
			indx.free[n] := false;
			alloc_block := true;
			indx.inuse := indx.inuse + 1;
			putindex;
			if debug then
				writeln('%alloc_block successful');
		end else begin
			freeindex;
			writeln('%serious error in alloc_block; notify Monster Manager');
			alloc_block := false;
		end;
	end;
end;




{
puts a description block back on the free list
zeroes n for convenience
}
procedure delete_block(var n: integer);

begin
	if n = DEFAULT_LINE then
		n := 0		{ no line really exists in the file }
	else if n > 0 then begin
		getindex(I_BLOCK);
		indx.inuse := indx.inuse - 1;
		indx.free[n] := true;
		putindex;
		n := 0;
	end else if n < 0 then begin
		n := (- n);
		delete_line(n);
	end;
end;



{
Return the number of a room if one is available
and remove it from the free list
}
function alloc_room(var n: integer):boolean;
var
	found: boolean;

begin
	getindex(I_ROOM);
	if indx.inuse = indx.top then begin
		freeindex;
		n := 0;
		alloc_room := false;
		writeln('There are no available free rooms.');
	end else begin
		n := 1;
		found := false;
		while (not found) and (n <= indx.top) do begin
			if indx.free[n] then
				found := true
			else
				n := n + 1;
		end;
		if found then begin
			indx.free[n] := false;
			alloc_room := true;
			indx.inuse := indx.inuse + 1;
			putindex;
		end else begin
			freeindex;
			writeln('%serious error in alloc_room; notify Monster Manager');
			alloc_room := false;
		end;
	end;
end;

{
Called by DEL_ROOM()
put the room specified by n back on the free list
zeroes n also, for convenience
}
procedure delete_room(var n: integer);

begin
	if n <> 0 then begin
		getindex(I_ROOM);
		indx.inuse := indx.inuse - 1;
		indx.free[n] := true;
		putindex;
		n := 0;
	end;
end;



function alloc_log(var n: integer):boolean;
var
	found: boolean;

begin
	getindex(I_PLAYER);
	if indx.inuse = indx.top then begin
		freeindex;
		n := 0;
		alloc_log := false;
		writeln('There are too many monster players, you can''t find a space.');
	end else begin
		n := 1;
		found := false;
		while (not found) and (n <= indx.top) do begin
			if indx.free[n] then
				found := true
			else
				n := n + 1;
		end;
		if found then begin
			indx.free[n] := false;
			alloc_log := true;
			indx.inuse := indx.inuse + 1;
			putindex;
		end else begin
			freeindex;
			writeln('%serious error in alloc_log; notify Monster Manager');
			alloc_log := false;
		end;
	end;
end;

procedure delete_log(var n: integer);

begin
	if n <> 0 then begin
		getindex(I_PLAYER);
		indx.inuse := indx.inuse - 1;
		indx.free[n] := true;
		putindex;
		n := 0;
	end;
end;


function lowcase(s: string):string;
var
	sprime: string;
	i: integer;

begin
	if length(s) = 0 then
		lowcase := ''
	else begin
		sprime := s;
		for i := 1 to length(s) do
			if sprime[i] in ['A'..'Z'] then
			   sprime[i] := chr(ord('a')+(ord(sprime[i])-ord('A')));
		lowcase := sprime;
	end;
end;


{ lookup a spell with disambiguation in the spell list }

function lookup_spell(var n: integer;s:string): boolean;
var
	i,poss,maybe,num: integer;

begin
	s := lowcase(s);
	i := 1;
	maybe := 0;
	num := 0;
	for i := 1 to numspells do begin
		if s = spells[i] then
			num := i
		else if index(spells[i],s) = 1 then begin
			maybe := maybe + 1;
			poss := i;
		end;
	end;
	if num <> 0 then begin
		n := num;
		lookup_spell := true;
	end else if maybe = 1 then begin
		n := poss;
		lookup_spell := true;
	end else if maybe > 1 then begin
		lookup_spell := false;
	end else begin
		lookup_spell := false;
	end;
end;


function lookup_user(var pnum: integer;s: string): boolean;
var
	i,poss,maybe,num: integer;

begin
	getuser;
	freeuser;
	getindex(I_PLAYER);
	freeindex;

	s := lowcase(s);
	i := 1;
	maybe := 0;
	num := 0;
	for i := 1 to indx.top do begin
		if not(indx.free[i]) then begin
			if s = user.idents[i] then
				num := i
			else if index(user.idents[i],s) = 1 then begin
				maybe := maybe + 1;
				poss := i;
			end;
		end;
	end;
	if num <> 0 then begin
		pnum := num;
		lookup_user := true;
	end else if maybe = 1 then begin
		pnum := poss;
		lookup_user := true;
	end else if maybe > 1 then begin
{		writeln('-- Ambiguous direction');	}
		lookup_user := false;
	end else begin
		lookup_user := false;
{		writeln('-- Unknown direction');	}
	end;
end;


function alloc_obj(var n: integer):boolean;
var
	found: boolean;

begin
	getindex(I_OBJECT);
	if indx.inuse = indx.top then begin
		freeindex;
		n := 0;
		alloc_obj := false;
		writeln('All of the possible objects have been made.');
	end else begin
		n := 1;
		found := false;
		while (not found) and (n <= indx.top) do begin
			if indx.free[n] then
				found := true
			else
				n := n + 1;
		end;
		if found then begin
			indx.free[n] := false;
			alloc_obj := true;
			indx.inuse := indx.inuse + 1;
			putindex;
		end else begin
			freeindex;
			writeln('%serious error in alloc_obj; notify Monster Manager');
			alloc_obj := false;
		end;
	end;
end;


procedure delete_obj(var n: integer);

begin
	if n <> 0 then begin
		getindex(I_OBJECT);
		indx.inuse := indx.inuse - 1;
		indx.free[n] := true;
		putindex;
		n := 0;
	end;
end;




function lookup_obj(var pnum: integer;s: string): boolean;
var
	i,poss,maybe,num: integer;
	tmp: string;

begin
	getobjnam;
	freeobjnam;
	getindex(I_OBJECT);
	freeindex;

	s := lowcase(s);
	i := 1;
	maybe := 0;
	num := 0;
	for i := 1 to indx.top do begin
		if not(indx.free[i]) then begin
			if s = objnam.idents[i] then
				num := i
			else if index(objnam.idents[i],s) = 1 then begin
				maybe := maybe + 1;
				poss := i;
			end;
		end;
	end;
	if num <> 0 then begin
		pnum := num;
		lookup_obj := true;
	end else if maybe = 1 then begin
		pnum := poss;
		lookup_obj := true;
	end else if maybe > 1 then begin
{		writeln('-- Ambiguous direction');	}
		lookup_obj := false;
	end else begin
		lookup_obj := false;
{		writeln('-- Unknown direction');	}
	end;
end;



{ returns true if object N is in this room }

function obj_here(n: integer): boolean;
var
	i: integer;
	found: boolean;

begin
	i := 1;
	found := false;
	while (i <= maxobjs) and (not found) do begin
		if here.objs[i] = n then
			found := true
		else
			i := i + 1;
	end;
	obj_here := found;
end;




{ returns true if object N is being held by the player }

function obj_hold(n: integer): boolean;
var
	i: integer;
	found: boolean;

begin
	if n = 0 then
		obj_hold := false
	else begin
		i := 1;
		found := false;
		while (i <= maxhold) and (not found) do begin
			if here.people[myslot].holding[i] = n then
				found := true
			else
				i := i + 1;
		end;
		obj_hold := found;
	end;
end;



{ return the slot of an object that is HERE }
function find_obj(objnum: integer): integer;
var
	i: integer;

begin
	i := 1;
	find_obj := 0;
	while i <= maxobjs do begin
		if here.objs[i] = objnum then
			find_obj := i;
		i := i + 1;
	end;
end;



{ similar to lookup_obj, but only returns true if the object is in
  this room or is being held by the player }

function parse_obj(var n: integer; s: string;override: boolean := false): boolean;
var
	slot: integer;

begin
	if lookup_obj(n,s) then begin
		if obj_here(n) or obj_hold(n) then

			{ took out a great block of code that wouldn't let
			  parse_obj work if player couldn't see object }

			parse_obj := true;
	end else
		parse_obj := false;
end;




function lookup_pers(var pnum: integer;s: string): boolean;
var
	i,poss,maybe,num: integer;
	pname: string;

begin
	getpers;
	freepers;
	getindex(I_PLAYER);
	freeindex;

	s := lowcase(s);
	i := 1;
	maybe := 0;
	num := 0;
	for i := 1 to indx.top do begin
		if not(indx.free[i]) then begin
			pname := lowcase(pers.idents[i]);

			if s = pname then
				num := i
			else if index(pname,s) = 1 then begin
				maybe := maybe + 1;
				poss := i;
			end;
		end;
	end;
	if num <> 0 then begin
		pnum := num;
		lookup_pers := true;
	end else if maybe = 1 then begin
		pnum := poss;
		lookup_pers := true;
	end else if maybe > 1 then begin
{		writeln('-- Ambiguous direction');	}
		lookup_pers := false;
	end else begin
		lookup_pers := false;
{		writeln('-- Unknown direction');	}
	end;
end;



function parse_pers(var pnum: integer;s: string): boolean;
var
	persnum: integer;
	i,poss,maybe,num: integer;
	pname: string;

begin
	gethere;
	s := lowcase(s);
	i := 1;
	maybe := 0;
	num := 0;
	for i := 1 to maxpeople do begin
{		if here.people[i].username <> '' then begin	}

		if here.people[i].kind > 0 then begin
			pname := lowcase(here.people[i].name);

			if s = pname then
				num := i
			else if index(pname,s) = 1 then begin
				maybe := maybe + 1;
				poss := i;
			end;
		end;
	end;
	if num <> 0 then begin
		persnum := num;
		parse_pers := true;
	end else if maybe = 1 then begin
		persnum := poss;
		parse_pers := true;
	end else if maybe > 1 then begin
		persnum := 0;
		parse_pers := false;
	end else begin
		persnum := 0;
		parse_pers := false;
	end;
	if persnum > 0 then begin
		if here.people[persnum].hiding > 0 then
			parse_pers := false
		else begin
			parse_pers := true;
			pnum := persnum;
		end;
	end;
end;





{
Returns TRUE if player is owner of room n
If no n is given default will be this room (location)
}
function is_owner(n: integer := 0;surpress:boolean := false): boolean;

begin
	gethere(n);
	if (here.owner = userid) or (privd) then
		is_owner := true
	else begin
		is_owner := false;
		if not(surpress) then
			writeln('You are not the owner of this room.');
	end;
end;


function room_owner(n: integer): string;

begin
	if n <> 0 then begin
		gethere(n);
		room_owner := here.owner;
		gethere;	{ restore old state! }
	end else
		room_owner := 'no room';
end;

{
Returns TRUE if player is allowed to alter the exit
TRUE if either this room or if target room is owned by player
}

function can_alter(dir: integer;room: integer := 0): boolean;

begin
	gethere;
	if (here.owner=userid) or (privd) then begin
		can_alter := true
	end else begin
		if here.exits[dir].toloc > 0 then begin
			if room_owner(here.exits[dir].toloc) = userid then
				can_alter := true
			else
				can_alter := false;
		end else
			can_alter := false;
	end;
end;

function can_make(dir: integer;room: integer := 0): boolean;

begin
	gethere(room);	{ 5 is accept door }
	if (here.exits[dir].toloc <> 0) then begin
		writeln('There is already an exit there.  Use UNLINK or RELINK.');
		can_make := false;
	end else begin
		if (here.owner = userid) or		{ I'm the owner }
		   (here.exits[dir].kind = 5) or	{ there's an accept }
		   (privd) or		{ Monster Manager }
		   (here.owner = '*')			{ disowned room }
							 then
			can_make := true
		else begin
			can_make := false;
			writeln('You are not allowed to create an exit there.');
		end;
	end;
end;


{
print a one liner
}
procedure print_line(n: integer);

begin
	if n = DEFAULT_LINE then
		writeln('<default line>')
	else if n > 0 then begin
		getline(n);
		freeline;
		writeln(oneliner.theline);
	end;
end;



procedure print_desc(dsc: integer;default:string := '<no default supplied>');
var
	i: integer;

begin
	if dsc = DEFAULT_LINE then begin
		writeln(default);
	end else if dsc > 0 then begin
		getblock(dsc);
		freeblock;
		i := 1;
		while i <= block.desclen do begin
			writeln(block.lines[i]);
			i := i + 1;
		end;
	end else if dsc < 0 then begin
		print_line(abs(dsc));
	end;
end;




procedure make_line(var n: integer;prompt : string := '';limit:integer := 79);
var
	s: string;
	ok: boolean;

begin
	writeln('Type ** to leave line unchanged, * to make [no line]');
	grab_line(prompt,s);
	if s = '**' then begin
		writeln('No changes.');
	end else if s = '***' then begin
		n := DEFAULT_LINE;
	end else if s = '*' then begin
		if debug then
			writeln('%deleting line ',n:1);
		delete_line(n);
	end else if s = '' then begin
		if debug then
			writeln('%deleting line ',n:1);
		delete_line(n);
	end else if length(s) > limit then begin
		writeln('Please limit your string to ',limit:1,' characters.');
	end else begin
		if (n = 0) or (n = DEFAULT_LINE) then begin
			if debug then
				writeln('%makeline: allocating line');
			ok := alloc_line(n);
		end else
			ok := true;

		if ok then begin
			if debug then
				writeln('%ok in makeline');
			getline(n);
			oneliner.theline := s;
			putline;

			if debug then
				writeln('%completed putline in makeline');
		end;
	end;
end;


{ translate a direction s [north, south, etc...] into the integer code }

function lookup_dir(var dir: integer;s:string): boolean;
var
	i,poss,maybe,num: integer;

begin
	s := lowcase(s);
	i := 1;
	maybe := 0;
	num := 0;
	for i := 1 to maxexit do begin
		if s = direct[i] then
			num := i
		else if index(direct[i],s) = 1 then begin
			maybe := maybe + 1;
			poss := i;
		end;
	end;
	if num <> 0 then begin
		dir := num;
		lookup_dir := true;
	end else if maybe = 1 then begin
		dir := poss;
		lookup_dir := true;
	end else if maybe > 1 then begin
		lookup_dir := false;
{		writeln('-- Ambiguous direction');	}
	end else begin
		lookup_dir := false;
{		writeln('-- Unknown direction');	}
	end;
end;


function lookup_show(var n: integer;s:string): boolean;
var
	i,poss,maybe,num: integer;

begin
	s := lowcase(s);
	i := 1;
	maybe := 0;
	num := 0;
	for i := 1 to numshow do begin
		if s = show[i] then
			num := i
		else if index(show[i],s) = 1 then begin
			maybe := maybe + 1;
			poss := i;
		end;
	end;
	if num <> 0 then begin
		n := num;
		lookup_show := true;
	end else if maybe = 1 then begin
		n := poss;
		lookup_show := true;
	end else if maybe > 1 then begin
		lookup_show := false;
{		writeln('-- Ambiguous direction');	}
	end else begin
		lookup_show := false;
{		writeln('-- Unknown direction');	}
	end;
end;

function lookup_set(var n: integer;s:string): boolean;
var
	i,poss,maybe,num: integer;

begin
	s := lowcase(s);
	i := 1;
	maybe := 0;
	num := 0;
	for i := 1 to numset do begin
		if s = setkey[i] then
			num := i
		else if index(setkey[i],s) = 1 then begin
			maybe := maybe + 1;
			poss := i;
		end;
	end;
	if num <> 0 then begin
		n := num;
		lookup_set := true;
	end else if maybe = 1 then begin
		n := poss;
		lookup_set := true;
	end else if maybe > 1 then begin
		lookup_set := false;
	end else begin
		lookup_set := false;
	end;
end;


function lookup_room(var n: integer; s: string): boolean;
var
	found: boolean;
	top: integer;

	i,
	poss,
	maybe,
	num:	integer;

begin
	if s <> '' then begin
		s := lowcase(s);		{ case insensitivity }
		getnam;
		freenam;
		getindex(I_ROOM);
		freeindex;
		top := indx.top;


		i := 1;
		maybe := 0;
		num := 0;
		for i := 1 to top do begin
			if s = nam.idents[i] then
				num := i
			else if index(nam.idents[i],s) = 1 then begin
				maybe := maybe + 1;
				poss := i;
			end;
		end;
		if num <> 0 then begin
			lookup_room := true;
			n := num;
		end else if maybe = 1 then begin
			lookup_room := true;
			n := poss;
		end else if maybe > 1 then begin
			lookup_room := false;
		end else begin
			lookup_room := false;
		end;

	end else
		lookup_room := false;
end;


function exact_room(var n: integer;s: string): boolean;
var
	match: boolean;

begin
	if debug then
		writeln('%exact room: s = ',s);
	if lookup_room(n,s) then begin
		if nam.idents[n] = lowcase(s) then
			exact_room := true
		else
			exact_room := false;
	end else
		exact_room := false;
end;


function exact_pers(var n: integer;s: string): boolean;
var
	match: boolean;

begin
	if lookup_pers(n,s) then begin
		if lowcase(pers.idents[n]) = lowcase(s) then
			exact_pers := true
		else
			exact_pers := false;
	end else
		exact_pers := false;
end;


function exact_user(var n: integer;s: string): boolean;
var
	match: boolean;

begin
	if lookup_user(n,s) then begin
		if lowcase(user.idents[n]) = lowcase(s) then
			exact_user := true
		else
			exact_user := false;
	end else
		exact_user := false;
end;


function exact_obj(var n: integer;s: string): boolean;
var
	match: boolean;

begin
	if lookup_obj(n,s) then begin
		if objnam.idents[n] = lowcase(s) then
			exact_obj := true
		else
			exact_obj := false;
	end else
		exact_obj := false;
end;



{
Return n as the direction number if s is a valid alias for an exit
}
function lookup_alias(var n: integer; s: string): boolean;
var
	i,poss,maybe,num: integer;

begin
	gethere;
	s := lowcase(s);
	i := 1;
	maybe := 0;
	num := 0;
	for i := 1 to maxexit do begin
		if s = here.exits[i].alias then
			num := i
		else if index(here.exits[i].alias,s) = 1 then begin
			maybe := maybe + 1;
			poss := i;
		end;
	end;
	if num <> 0 then begin
		n := num;
		lookup_alias := true;
	end else if maybe = 1 then begin
		n := poss;
		lookup_alias := true;
	end else if maybe > 1 then begin
		lookup_alias := false;
	end else begin
		lookup_alias := false;
	end;
end;


procedure exit_default(dir, kind: integer);

begin
	case kind of

	1: writeln('There is a passage leading ',direct[dir],'.');
	2: writeln('There is a locked door leading ',direct[dir],'.');
	5:	case dir of
			north,south,east,west:
				writeln('A note on the ',direct[dir],' wall says "Your exit here."');
			up: writeln('A note on the ceiling says "Your exit here."');
			down: writeln('A note on the floor says "Your exit here."');
		end;
	otherwise writeln('There is an exit: ',direct[dir]);
	end;
end;


{
Prints out the exits here for DO_LOOK()
}
procedure show_exits;
var
	i: integer;
	one: boolean;
	cansee: boolean;

begin
	one := false;
	for i := 1 to maxexit do begin
		if (here.exits[i].toloc <> 0) or { there is an exit }
		   (here.exits[i].kind = 5) then begin { there could be an exit }

			if (here.exits[i].hidden = 0) or
			   (found_exit[i]) then
				cansee := true
			else
				cansee := false;

			if here.exits[i].kind = 6 then begin
				{ door kind only visible with object }
				if obj_hold( here.exits[i].objreq ) then
					cansee := true
				else
					cansee := false;
			end;

			if cansee then begin
				if here.exits[i].exitdesc = DEFAULT_LINE then begin
					exit_default(i,here.exits[i].kind);
					{ give it direction and type }
					one := true;
				end else if here.exits[i].exitdesc > 0 then begin
					print_line(here.exits[i].exitdesc);
					one := true;
				end;
			end;
		end;
	end;
	if one then
		writeln;
end;


procedure setevent;

begin
	getevent;
	freeevent;
	myevent := event.point;
end;



function isnum(s: string): boolean;
var
	i: integer;

begin
	isnum := true;
	if length(s) < 1 then
		isnum := false
	else begin
		i := 1;
		while i <= length(s) do begin
			if not (s[i] in ['0'..'9']) then
				isnum := false;
			i := i + 1;
		end;
	end;
end;

function number(s: string): integer;
var
	i: integer;

begin
	if (length(s) < 1) or not(s[1] in ['0'..'9']) then
		number := 0
	else begin
		readv(s,i);
		number := i;
	end;
end;



procedure log_event(	send: integer := 0;	{ slot of sender }
			act:integer;		{ what event occurred }
			targ: integer := 0;	{ target of event }
			p: integer := 0;	{ expansion parameter }
			s: string := '';	{ string for messages }
			room: integer := 0	{ room to log event in }
		   );

begin
	if room = 0 then
		room := location;
	getevent(room);
	event.point := event.point + 1;
	if debug then
		writeln('%logging event ',act:1,' to point ',event.point:1);
	if event.point > maxevent then
		event.point := 1;
	with event.evnt[event.point] do begin
		sender := send;
		action := act;
		target := targ;
		parm := p;
		msg := s;
		loc := room;
	end;
	putevent;
end;

procedure log_action(theaction,thetarget: integer);

begin
	if debug then
		writeln('%log_action(',theaction:1,',',thetarget:1,')');
	getroom;
	here.people[myslot].act := theaction;
	here.people[myslot].targ := thetarget;
	putroom;

	logged_act := true;
	log_event(myslot,E_ACTION,thetarget,theaction,myname);
end;


function desc_action(theaction,thetarget: integer): string;
var
	s: string;

begin
	case theaction of	{ use command mnemonics }
		look:      s:= ' looking around the room.';
		form:      s:= ' creating a new room.';
		desc:      s:= ' editing the description to this room.';
		e_detail:  s := ' adding details to the room.';
		c_custom:  s := ' customizing an exit here.';
		e_custroom:s := ' customizing this room.';
		e_program: s := ' customizing an object.';
		c_self:	   s := ' editing a self-description.';
		e_usecrystal: s := ' hunched over a crystal orb, immersed in its glow.';
		link:	   s := ' creating an exit here.';
		c_system:  s := ' in system maintenance mode.';

		otherwise s := ' here.'
	end;
	desc_action := s;
end;


function protected(n: integer := 0): boolean;

begin
	if n = 0 then
		n := myslot;
	if here.people[n].act in [e_detail,c_custom,
				  e_custroom,e_program,
				  c_self,c_system] then
		protected := true
	else
		protected := false;
end;



{
user procedure to designate an exit for acceptance of links
}
procedure do_accept(s: string);
var
	dir: integer;

begin
	if lookup_dir(dir,s) then begin
		if can_make(dir) then begin
			getroom;
			here.exits[dir].kind := 5;
			putroom;

			log_event(myslot,E_ACCEPT,0,0);
			writeln('Someone will be able to make an exit ',direct[dir],'.');
		end;
	end else
		writeln('To allow others to make an exit, type ACCEPT <direction of exit>.');
end;


{
User procedure to refuse an exit for links
Note: may be unlink
}
procedure do_refuse(s: string);
var
	dir: integer;
	ok: boolean;

begin
	if not(is_owner) then
		{ is_owner prints error message itself }
	else if lookup_dir(dir,s) then begin
		getroom;
		with here.exits[dir] do begin
			if (toloc = 0) and (kind = 5) then begin
				kind := 0;
				ok := true;
			end else
				ok := false;
		end;
		putroom;
		if ok then begin
			log_event(myslot,E_REFUSE,0,0);
			writeln('Exits ',direct[dir],' will be refused.');
		end else
			writeln('Exits were not being accepted there.');
	end else
		writeln('To undo an Accept, type REFUSE <direction>.');
end;



function systime:string;
var
	hourstring: string;
	hours: integer;
	thetime: packed array[1..11] of char;
	dayornite: string;

begin
	time(thetime);
	if thetime[1] = ' ' then
		hours := ord(thetime[2]) - ord('0')
	else
		hours := (ord(thetime[1]) - ord('0'))*10 +
			  (ord(thetime[2]) - ord('0'));

	if hours < 12 then
		dayornite := 'am'
	else
		dayornite := 'pm';
	if hours >= 13 then
		hours := hours - 12;
	if hours = 0 then
		hours := 12;

	writev(hourstring,hours:2);

	systime := hourstring + ':' + thetime[4] + thetime[5] + dayornite;
end;



{ substitute a parameter string for the # sign in the source string }
function subs_parm(s,parm: string): string;
var
	right,left: string;
	i: integer;		{ i is point to break at }

begin
	i := index(s,'#');
	if (i > 0) and ((length(s) + length(parm)) <= 80) then begin
		if i >= length(s) then begin
			right := '';
			left := s;
		end else if i < 1 then begin
			right := s;
			left := '';
		end else begin
			right := substr(s,i+1,length(s)-i);
			left := substr(s,1,i);
		end;
		if length(left) <= 1 then
			left := ''
		else
			left := substr(left,1,length(left)-1);

		subs_parm := left + parm + right;
	end else begin
		subs_parm := s;
	end;
end;


procedure time_health;

begin
	if healthcycle > 0 then begin		{ how quickly they heal }
		if myhealth < 7 then begin	{ heal a little bit }
			myhealth := myhealth + 1;

			getroom;
			here.people[myslot].health := myhealth;
			putroom;

			{show new health rating }
		case myhealth of
			9: writeln('You are now in exceptional health.');
			8: writeln('You feel much stronger.  You are in better than average condition.');
			7: writeln('You are now in perfect health.');
			6: writeln('You only feel a little bit dazed now.');
			5: begin
				writeln('You only have some minor cuts and abrasions now.  Most of your serious wounds');
				writeln('have healed.');
			   end;
			4: writeln('You are only suffering from some minor wounds now.');
			3: writeln('Your most serious wounds have healed, but you are still in bad shape.');
			2: writeln('You have healed somewhat, but are still very badly wounded.');
			1: writeln('You are in critical condition, but there may be hope.');
			0: writeln('are still dead.');
			otherwise writeln('You don''t seem to be in any condition at all.');
		end;

		putchars(chr(10)+old_prompt+line);

		end;
		healthcycle := 0;
	end else
		healthcycle := healthcycle + 1;
end;


procedure time_noises;
var
	n: integer;

begin
	if rnd100 <= 2 then begin
		n := rnd100;
		if n in [0..40] then
			log_event(0,E_NOISES,rnd100,0)
		else if n in [41..60] then
			log_event(0,E_ALTNOISE,rnd100,0);
	end;
end;


procedure time_trapdoor(silent: boolean);
var
	fall: boolean;

begin
	if rnd100 < here.trapchance then begin
			{ trapdoor fires! }

		if here.trapto > 0 then begin
				{ logged action should cover {protected) }
			if {(protected) or} (logged_act) then
				fall := false
			else if here.magicobj = 0 then
				fall := true
			else if obj_hold(here.magicobj) then
				fall := false
			else
				fall := true;
		end else
			fall := false;

		if fall then begin
			do_exit(here.trapto);
			if not(silent) then
				putchars(chr(10)+old_prompt+line);
		end;
	end;
end;


procedure time_midnight;

begin
	if systime = '12:00am' then
		log_event(0,E_MIDNIGHT,rnd100,0);
end;


{ cause random events to occurr (ha ha ha) }

procedure rnd_event(silent: boolean := false);
var
	n: integer;

begin
	if rndcycle = 200 then begin	{ inside here 3 times/min }

		time_noises;
		time_health;
		time_trapdoor(silent);
		time_midnight;

		rndcycle := 0;
	end else
		rndcycle := rndcycle + 1;
end;


procedure do_die;
var
	some: boolean;

begin
	writeln;
	writeln('        *** You have died ***');
	writeln;
	some := drop_everything;
	myhealth := 7;
	take_token(myslot,location);
	log_event(0,E_DIED,0,0,myname);
	if put_token(2,myslot) then begin
		location := 2;
		inmem := false;
		setevent;
{ log entry to death loc }
{ perhaps turn off refs to other people }
	end else begin
		writeln('The Monster universe regrets to inform you that you cannot be ressurected at');
		writeln('the moment.');
		halt;
	end;
end;


procedure poor_health(p: integer);
var
	some: boolean;

begin
	if myhealth > p then begin
		myhealth := myhealth - 1;
		getroom;
		here.people[myslot].health := myhealth;
		putroom;
		log_event(myslot,E_WEAKER,myhealth,0);

		{ show new health rating }
		write('You ');
		case here.people[myslot].health of
			9: writeln('are still in exceptional health.');
			8: writeln('feel weaker, but are in better than average condition.');
			7: writeln('are somewhat weaker, but are in perfect health.');
			6: writeln('feel a little bit dazed.');
			5: writeln('have some minor cuts and abrasions.');
			4: writeln('have some wounds, but are still fairly strong.');
			3: writeln('are suffering from some serious wounds.'); 
			2: writeln('are very badly wounded.');
			1: writeln('have many serious wounds, and are near death.');
			0: writeln('are dead.');
			otherwise writeln('don''t seem to be in any condition at all.');
		end;
	end else begin { they died }
		do_die;
	end;
end;



{ count objects here }

function find_numobjs: integer;
var
	sum,i: integer;

begin
	sum := 0;
	for i := 1 to maxobjs do
		if here.objs[i] <> 0 then
			sum := sum + 1;
	find_numobjs := sum;
end;



{ optional parameter is slot of player's objects to count }

function find_numhold(player: integer := 0): integer;
var
	sum,i: integer;

begin
	if player = 0 then
		player := myslot;

	sum := 0;
	for i := 1 to maxhold do
		if here.people[player].holding[i] <> 0 then
			sum := sum + 1;
	find_numhold := sum;
end;




procedure take_hit(p: integer);
var
	i: integer;

begin
	if p > 0 then begin
		if rnd100 < (55 + (p-1) * 30) then { chance that they're hit }
			poor_health(p);

		if find_numobjs < maxobjs + 1 then begin
			{ maybe they drop something if they're hit }
			for i := 1 to p do
				maybe_drop;
		end;
	end;
end;


function punch_force(sock: integer): integer;
var
	p: integer;

begin
	if sock in [2,3,6,7,8,11,12] then	{ no punch or a graze }
		p := 0
	else if sock in [4,9,10] then	{ hard punches }
		p := 2
	else	{ 1,5,13,14,15 }
		p := 1;		{ all others are medium punches }
	punch_force := p;
end;

procedure put_punch(sock: integer;s: string);

begin
	case sock of
		1: writeln('You deliver a quick jab to ',s,'''s jaw.');
		2: writeln('You swing at ',s,' and miss.');
		3: writeln('A quick punch, but it only grazes ',s,'.');
		4: writeln(s,' doubles over after your jab to the stomach.');
		5: writeln('Your punch lands square on ',s,'''s face!');
		6: writeln('You swing wild and miss.');
		7: writeln('A good swing, but it misses ',s,' by a mile!');
		8: writeln('Your punch is blocked by ',s,'.');
		9: writeln('Your roundhouse blow sends ',s,' reeling.');
		10:writeln('You land a solid uppercut on ',s,'''s chin.');
		11:writeln(s,' fends off your blow.');
		12:writeln(s,' ducks and avoids your punch.');
		13:writeln('You thump ',s,' in the ribs.');
		14:writeln('You catch ',s,'''s face on your elbow.');
		15:writeln('You knock the wind out of ',s,' with a punch to the chest.');
	end;
end;


procedure get_punch(sock: integer;s: string);

begin
	case sock of
		1: writeln(s,' delivers a quick jab to your jaw!');
		2: writeln(s,' swings at you but misses.');
		3: writeln(s,'''s fist grazes you.');
		4: writeln('You double over after ',s,' lands a mean jab to your stomach!');
		5: writeln('You see stars as ',s,' bashes you in the face.');
		6: writeln('You only feel the breeze as ',s,' swings wildly.');
		7: writeln(s,'''s swing misses you by a yard.');
		8: writeln('With lightning reflexes you block ',s,'''s punch.');
		9: writeln(s,'''s blow sends you reeling.');
		10:writeln('Your head snaps back from ',s,'''s uppercut!');
		11:writeln('You parry ',s,'''s attack.');
		12:writeln('You duck in time to avoid ',s,'''s punch.');
		13:writeln(s,' thumps you hard in the ribs.');
		14:writeln('Your vision blurs as ',s,' elbows you in the head.');
		15:writeln(s,' knocks the wind out of you with a punch to your chest.');
	end;
end;

procedure view_punch(a,b: string;p: integer);

begin
	case p of
		1: writeln(a,' jabs ',b,' in the jaw.');
		2: writeln(a,' throws a wild punch at the air.');
		3: writeln(a,'''s fist barely grazes ',b,'.');
		4: writeln(b,' doubles over in pain with ',a,'''s punch');
		5: writeln(a,' bashes ',b,' in the face.');
		6: writeln(a,' takes a wild swing at ',b,' and misses.');
		7: writeln(a,' swings at ',b,' and misses by a yard.');
		8: writeln(b,'''s punch is blocked by ',a,'''s quick reflexes.');
		9: writeln(b,' is sent reeling from a punch by ',a,'.');
		10:writeln(a,' lands an uppercut on ',b,'''s head.');
		11:writeln(b,' parrys ',a,'''s attack.');
		12:writeln(b,' ducks to avoid ',a,'''s punch.');
		13:writeln(a,' thumps ',b,' hard in the ribs.');
		14:writeln(a,'''s elbow connects with ',b,'''s head.');
		15:writeln(a,' knocks the wind out of ',b,'.');
	end;
end;




procedure desc_health(n: integer;header:shortstring := '');

begin
	if header = '' then
		write(here.people[n].name,' ')
	else
		write(header);

	case here.people[n].health of
		9: writeln('is in exceptional health, and looks very strong.');
		8: writeln('is in better than average condition.');
		7: writeln('is in perfect health.');
		6: writeln('looks a little dazed.');
		5: writeln('has some minor cuts and abrasions.');
		4: writeln('has some minor wounds.');
		3: writeln('is suffering from some serious wounds.'); 
		2: writeln('is very badly wounded.');
		1: writeln('has many serious wounds, and is near death.');
		0: writeln('is dead.');
		otherwise writeln('doesn''t seem to be in any condition at all.');
	end;
end;


function obj_part(objnum: integer;doread: boolean := TRUE): string;
var
	s: string;

begin
	if doread then begin
		getobj(objnum);
		freeobj;
	end;
	s := obj.oname;
	case obj.particle of
		0:;
		1: s := 'a ' + s;
		2: s := 'an ' + s;
		3: s := 'some ' + s;
		4: s := 'the ' + s;
	end;
	obj_part := s;
end;


procedure print_subs(n: integer;s: string);

begin
	if (n > 0) and (n <> DEFAULT_LINE) then begin
		getline(n);
		freeline;
		writeln(subs_parm(oneliner.theline,s));
	end else if n = DEFAULT_LINE then
		writeln('%<default line> in print_subs');
end;



{ print out a (up to) 10 line description block, substituting string s for
  up to one occurance of # per line }

procedure block_subs(n: integer;s: string);
var
	p,i: integer;

begin
	if n < 0 then
		print_subs(abs(n),s)
	else if (n > 0) and (n <> DEFAULT_LINE) then begin
		getblock(n);
		freeblock;
		i := 1;
		while i <= block.desclen do begin
			p := index(block.lines[i],'#');
			if (p > 0) then
				writeln(subs_parm(block.lines[i],s))
			else
				writeln(block.lines[i]);
			i := i + 1;
		end;
	end;
end;


procedure show_noises(n: integer);

begin
	if n < 33 then
		writeln('There are strange noises coming from behind you.')
	else if n < 66 then
		writeln('You hear strange rustling noises behind you.')
	else
		writeln('There are faint noises coming from behind you.');
end;


procedure show_altnoise(n: integer);

begin
	if n < 33 then
		writeln('A chill wind blows, ruffling your clothes and chilling your bones.')
	else if n < 66 then
		writeln('Muffled scuffling sounds can be heard behind you.')
	else
		writeln('A loud crash can be heard in the distance.');
end;


procedure show_midnight(n: integer;var printed: boolean);

begin
	if midnight_notyet then begin
		if n < 50 then begin
			writeln('A voice booms out of the air from all around you!');
			writeln('The voice says,  " It is now midnight. "');
		end else begin
			writeln('You hear a clock chiming in the distance.');
			writeln('It rings twelve times for midnight.');
		end;
		midnight_notyet := false;
	end else
		printed := false;
end;




procedure handle_event(var printed: boolean);
var
	n,send,act,targ,p: integer;
	s: string;
	sendname: string;

begin
	printed := true;
	if debug then
		writeln('%handling event ',myevent);
	with event.evnt[myevent] do begin
		send := sender;
		act := action;
		targ := target;
		p := parm;
		s := msg;
	end;
	if send <> 0 then
		sendname := here.people[send].name
	else
		sendname := '<Unknown>';

	case act of
		E_EXIT: begin
				if here.exits[targ].goin = DEFAULT_LINE then
					writeln(s,' has gone ',direct[targ],'.')
				else if (here.exits[targ].goin <> 0) and
				(here.exits[targ].goin <> DEFAULT_LINE) then begin
					block_subs(here.exits[targ].goin,s);
				end else
					printed := false;
			end;
		E_ENTER: begin
				if here.exits[targ].comeout = DEFAULT_LINE then
					writeln(s,' has come into the room from: ',direct[targ])
				else if (here.exits[targ].comeout <> 0) and
				(here.exits[targ].comeout <> DEFAULT_LINE) then begin
					block_subs(here.exits[targ].comeout,s);
				end else
					printed := false;
			end;
		E_BEGIN:writeln(s,' appears in a brilliant burst of multicolored light.');
		E_QUIT:writeln(s,' vanishes in a brilliant burst of multicolored light.');
		E_SAY: begin
			if length(s) + length(sendname) > 73 then begin
				writeln(sendname,' says,');
				writeln('"',s,'"');
			end else begin
				if (rnd100 < 50) or (length(s) > 50) then
					writeln(sendname,': "',s,'"')
				else
					writeln(sendname,' says, "',s,'"');
			end;
		       end;
		E_HIDESAY: begin
				writeln('An unidentified voice speaks to you:');
				writeln('"',s,'"');
			   end;
		E_SETNAM: writeln(s);
		E_POOFIN: writeln('In an explosion of orange smoke ',s,' poofs into the room.');
		E_POOFOUT: writeln(s,' vanishes from the room in a cloud of orange smoke.');
		E_DETACH: begin
				writeln(s,' has destroyed the exit ',direct[targ],'.');
			  end;
		E_EDITDONE:begin
				writeln(sendname,' is done editing the room description.');
			   end;
		E_NEWEXIT: begin
				writeln(s,' has created an exit here.');
			   end;
		E_CUSTDONE:begin
				writeln(sendname,' is done customizing an exit here.');
			   end;
		E_SEARCH: writeln(sendname,' seems to be looking for something.');
		E_FOUND: writeln(sendname,' appears to have found something.');
		E_DONEDET:begin
				writeln(sendname,' is done adding details to the room.');
			  end;
		E_ROOMDONE: begin
				writeln(sendname,' is finished customizing this room.');
			    end;
		E_OBJDONE: begin
				writeln(sendname,' is finished customizing an object.');
			   end;
		E_UNHIDE:writeln(sendname,' has stepped out of the shadows.');
		E_FOUNDYOU: begin
				if targ = myslot then begin { found me! }
					writeln('You''ve been discovered by ',sendname,'!');
					hiding := false;
					getroom;
{ they're not hidden anymore }		here.people[myslot].hiding := 0;
					putroom;
				end else
					writeln(sendname,' has found ',here.people[targ].name,' hiding in the shadows!');
			    end;
		E_PUNCH: begin
				if targ = myslot then begin { punched me! }
					get_punch(p,sendname);
					take_hit( punch_force(p) );
{ relic, but not harmful }		ping_answered := true;
					healthcycle := 0;
				end else
					view_punch(sendname,here.people[targ].name,p);
			 end;
		E_MADEOBJ: writeln(s);
		E_GET: writeln(s);
		E_DROP: begin
				writeln(s);
				if here.objdesc <> 0 then
					print_subs(here.objdesc,obj_part(p));
			end;
		E_BOUNCEDIN: begin
				if (targ = 0) or (targ = DEFAULT_LINE) then
					writeln(obj_part(p),' has bounced into the room.')
				else begin
					print_subs(targ,obj_part(p));
				end;
			     end;
		E_DROPALL: writeln('Some objects drop to the ground.');
		E_EXAMINE: writeln(s);
		E_IHID: writeln(sendname,' has hidden in the shadows.');
		E_NOISES: begin
				if (here.rndmsg = 0) or
				   (here.rndmsg = DEFAULT_LINE) then begin
					show_noises(targ);
				end else
					print_line(here.rndmsg);
			  end;
		E_ALTNOISE: begin
				if (here.xmsg2 = 0) or
				   (here.xmsg2 = DEFAULT_LINE) then
					show_altnoise(targ)
				else
					block_subs(here.xmsg2,myname);
			    end;
		E_REALNOISE: show_noises(targ);
		E_HIDOBJ: writeln(sendname,' has hidden the ',s,'.');
		E_PING: begin
				if targ = myslot then begin
					writeln(sendname,' is trying to ping you.');
					log_event(myslot,E_PONG,send,0);
				end else
					writeln(sendname,' is pinging ',here.people[targ].name,'.');
			end;
		E_PONG: begin
				ping_answered := true;
			end;
		E_HIDEPUNCH: begin
				if targ = myslot then begin
					writeln(sendname,' pounces on you from the shadows!');
					take_hit(2);
				end else begin
					writeln(sendname,' jumps out of the shadows and attacks ',here.people[targ].name,'.');
				end;
			     end;
		E_SLIPPED: begin
				writeln('The ',s,' has slipped from ',
					sendname,'''s hands.');
			   end;
		E_HPOOFOUT:begin
				if rnd100 > 50 then
					writeln('Great wisps of orange smoke drift out of the shadows.')
				else
					printed := false;
			   end;
		E_HPOOFIN:begin
				if rnd100 > 50 then
					writeln('Some wisps of orange smoke drift about in the shadows.')
				else
					printed := false;
			  end;
		E_FAILGO: begin
				if targ > 0 then begin
					write(sendname,' has failed to go ');
					writeln(direct[targ],'.');
				end;
			  end;
		E_TRYPUNCH: begin
				if targ = myslot then
					writeln(sendname,' fails to punch you.')
				else
					writeln(sendname,' fails to punch ',here.people[targ].name,'.');
			    end;
		E_PINGONE:begin
				if targ = myslot then begin { ohoh---pinged away }
					writeln('The Monster program regrets to inform you that a destructive ping has');
					writeln('destroyed your existence.  Please accept our apologies.');
					halt;  { ugggg }
				end else
					writeln(s,' shimmers and vanishes from sight.');
			  end;
		E_CLAIM: writeln(sendname,' has claimed this room.');
		E_DISOWN: writeln(sendname,' has disowned this room.');
		E_WEAKER: begin
{				inmem := false;
				gethere;		}

				here.people[send].health := targ;

{ This is a hack for efficiency so we don't read the room record twice;
  we need the current data now for desc_health, but checkevents, our caller,
  is about to re-read it anyway; we make an incremental fix here so desc_health
  is happy, then checkevents will do the real read later }

				desc_health(send);
			  end;
		E_OBJCLAIM: writeln(sendname,' is now the owner of the ',s,'.');
		E_OBJDISOWN: writeln(sendname,' has disowned the object ',s,'.');
		E_SELFDONE: writeln(sendname,'''s self-description is finished.');
		E_WHISPER: begin
				if targ = myslot then begin
					if length(s) < 39 then
						writeln(sendname,' whispers to you, "',s,'"')
					else begin
						writeln(sendname,' whispers something to you:');
						write(sendname,' whispers, ');
						if length(s) > 50 then
							writeln;
						writeln('"',s,'"');
					end;
				end else if (privd) or (rnd100 > 85) then begin
					writeln('You overhear ',sendname,' whispering to ',here.people[targ].name,'!');
					write(sendname,' whispers, ');
					if length(s) > 50 then
						writeln;
					writeln('"',s,'"');
				end else
					writeln(sendname,' is whispering to ',here.people[targ].name,'.');
			   end;
		E_WIELD: writeln(sendname,' is now wielding the ',s,'.');
		E_UNWIELD: writeln(sendname,' is no longer wielding the ',s,'.');
		E_WEAR: writeln(sendname,' is now wearing the ',s,'.');
		E_UNWEAR: writeln(sendname,' has taken off the ',s,'.');
		E_DONECRYSTALUSE: begin
					writeln(sendname,' emerges from the glow of the crystal.');
					writeln('The orb becomes dark.');
				  end;
		E_DESTROY: writeln(s);
		E_OBJPUBLIC: writeln('The object ',s,' is now public.');
		E_SYSDONE: writeln(sendname,' is no longer in system maintenance mode.');
		E_UNMAKE: writeln(sendname,' has unmade ',s,'.');
		E_LOOKDETAIL: writeln(sendname,' is looking at the ',s,'.');
		E_ACCEPT: writeln(sendname,' has accepted an exit here.');
		E_REFUSE: writeln(sendname,' has refused an Accept here.');
		E_DIED: writeln(s,' expires and vanishes in a cloud of greasy black smoke.');
		E_LOOKYOU: begin
				if targ = myslot then begin
					writeln(sendname,' is looking at you.')
				end else
					writeln(sendname,' looks at ',here.people[targ].name,'.');
			   end;
		E_LOOKSELF: writeln(sendname,' is making a self-appraisal.');
		E_FAILGET: writeln(sendname,' fails to get ',obj_part(targ),'.');
		E_FAILUSE: writeln(sendname,' fails to use ',obj_part(targ),'.');
		E_CHILL: if (targ = 0) or (targ = DEFAULT_LINE) then
				writeln('A chill wind blows over you.')
			 else
				print_desc(targ);
		E_NOISE2:begin
				case targ of
					1: writeln('Strange, gutteral noises sound from everywhere.');
					2: writeln('A chill wind blows past you, almost whispering as it ruffles your clothes.');
					3: writeln('Muffled voices speak to you from the air!');
					otherwise writeln('The air vibrates with a chill shudder.');
				end;
			 end;
		E_INVENT: writeln(sendname,' is taking inventory.');
		E_POOFYOU: begin
				if targ = myslot then begin
					writeln;
					writeln(sendname,' directs a firey burst of bluish energy at you!');
					writeln('Suddenly, you find yourself hurtling downwards through misty orange clouds.');
					writeln('Your descent slows, the smoke clears, and you find yourself in a new place...');
					xpoof(p);
					writeln;
				end else begin
					writeln(sendname,' directs a firey burst of energy at ',here.people[targ].name,'!');
					writeln('A thick burst of orange smoke results, and when it clears, you see');
					writeln('that ',here.people[targ].name,' is gone.');
				end;
			   end;
		E_WHO: begin
			case p of
				0: writeln(sendname,' produces a "who" list and reads it.');
				1: writeln(sendname,' is seeing who''s playing Monster.');
				otherwise writeln(sendname,' checks the "who" list.');
			end;
		       end;
		E_PLAYERS:begin
				writeln(sendname,' checks the "players" list.');
			  end;
		E_VIEWSELF: writeln(sendname,' is reading ',s,'''s self-description.');
		E_MIDNIGHT: show_midnight(targ,printed);

		E_ACTION:writeln(sendname,' is',desc_action(p,targ));
		otherwise writeln('*** Bad Event ***');
	end;
end;


[global]
procedure checkevents(silent: boolean := false);
var
	gotone: boolean;
	tmp,printed: boolean;

begin
	getevent;
	freeevent;

	event := eventfile^;
	gotone := false;
	printed := false;
	while myevent <> event.point do begin
		myevent := myevent + 1;
		if myevent > maxevent then
			myevent := 1;

		if debug then begin
			writeln('%checking event ',myevent);
			if event.evnt[myevent].loc = location then
				writeln('  - event here')
			else
				writeln('  - event elsewhere');
			writeln('  - event number = ',event.evnt[myevent].action:1);
		end;

		if (event.evnt[myevent].loc = location) then begin
			if (event.evnt[myevent].sender <> myslot) then begin

						{ if sent by me don't look at it }
						{ will use global record event }
				handle_event(tmp);
				if tmp then
					printed := true;

				inmem := false;	{ re-read important data that }
				gethere;	{ may have been altered }

				gotone := true;
			end;
		end;
	end;
	if (printed) and (gotone) and not(silent) then begin
		putchars(chr(10)+chr(13)+old_prompt+line);
	end;

	rnd_event(silent);
end;



{ count the number of people in this room; assumes a gethere has been done }

function find_numpeople: integer;
var
	sum,i: integer;

begin
	sum := 0;
	for i := 1 to maxpeople do
		if here.people[i].kind > 0 then
{		if here.people[i].username <> '' then	}
			sum := sum + 1;
	find_numpeople := sum;
end;



{ don't give them away, but make noise--maybe
  percent is percentage chance that they WON'T make any noise }

procedure noisehide(percent: integer);

begin
	{ assumed gethere;  }
	if (hiding) and (find_numpeople > 1) then begin
		if rnd100 > percent then
			log_event(myslot,E_REALNOISE,rnd100,0);
			{ myslot: don't tell them they made noise }
	end;
end;



function checkhide: boolean;

begin
	if (hiding) then begin
		checkhide := false;
		noisehide(50);
		writeln('You can''t do that while you''re hiding.');
	end else
		checkhide := true;
end;



procedure clear_command;

begin
	if logged_act then begin
		getroom;
		here.people[myslot].act := 0;
		putroom;
		logged_act := false;
	end;
end;

{ forward procedure take_token(aslot, roomno: integer); }
procedure take_token;
			{ remove self from a room's people list }

begin
	getroom(roomno);
	with here.people[aslot] do begin
		kind := 0;
		username:= '';
		name := '';
	end;
	putroom;
end;


{ fowrard function put_token(room: integer;var aslot:integer;
	hidelev:integer := 0):boolean;
			 put a person in a room's people list
			 returns myslot }
function put_token;
var
	i,j: integer;
	found: boolean;
	savehold: array[1..maxhold] of integer;

begin
	if first_puttoken then begin
		for i := 1 to maxhold do
			savehold[i] := 0;
		first_puttoken := false;
	end else begin
		gethere;
		for i := 1 to maxhold do
			savehold[i] := here.people[myslot].holding[i];
	end;

	getroom(room);
	i := 1;
	found := false;
	while (i <= maxpeople) and (not found) do begin
		if here.people[i].name = '' then
			found := true
		else
			i := i + 1;
	end;
	put_token := found;
	if found then begin
		here.people[i].kind := 1;	{ I'm a real player }
		here.people[i].name := myname;
		here.people[i].username := userid;
		here.people[i].hiding := hidelev;
			{ hidelev is zero for most everyone
			  unless you want to poof in and remain hidden }

		here.people[i].wearing := mywear;
		here.people[i].wielding := mywield;
		here.people[i].health := myhealth;
		here.people[i].self := myself;

		here.people[i].act := 0;

		for j := 1 to maxhold do
			here.people[i].holding[j] := savehold[j];
		putroom;

		aslot := i;
		for j := 1 to maxexit do	{ haven't found any exits in }
			found_exit[j] := false;	{ the new room }

		{ note the user's new location in the logfile }
		getint(N_LOCATION); 
		anint.int[mylog] := room;
		putint;
	end else
		freeroom;
end;

procedure log_exit(direction,room,sender_slot: integer);

begin
	log_event(sender_slot,E_EXIT,direction,0,myname,room);
end;

procedure log_entry(direction,room,sender_slot: integer);

begin
	log_event(sender_slot,E_ENTER,direction,0,myname,room);
end;

procedure log_begin(room:integer := 1);

begin
	log_event(0,E_BEGIN,0,0,myname,room);
end;

procedure log_quit(room:integer;dropped:boolean);

begin
	log_event(0,E_QUIT,0,0,myname,room);
	if dropped then
		log_event(0,E_DROPALL,0,0,myname,room);
end;




{ return the number of people you can see here }

function n_can_see: integer;
var
	sum: integer;
	i: integer;
	selfslot: integer;

begin
	if here.locnum = location then
		selfslot := myslot
	else
		selfslot := 0;

	sum := 0;
	for i := 1 to maxpeople do
		if ( i <> selfslot ) and
		   ( length(here.people[i].name) > 0 ) and
		   ( here.people[i].hiding = 0 ) then
			sum := sum + 1;
	n_can_see := sum;
	if debug then
		writeln('%n_can_see = ',sum:1);
end;



function next_can_see(var point: integer): string;
var
	found: boolean;
	selfslot: integer;

begin
	if here.locnum <> location then
		selfslot := 0
	else
		selfslot := myslot;
	found := false;
	while (not found) and (point <= maxpeople) do begin
		if (point <> selfslot) and
		   (length(here.people[point].name) > 0) and
		   (here.people[point].hiding = 0) then
			found := true
		else
			point := point + 1;
	end;

	if found then begin
		next_can_see := here.people[point].name;
		point := point + 1;
	end else begin
		next_can_see := myname;	{ error!  error! }
		writeln('%searching error in next_can_see; notify the Monster Manager');
	end;
end;


procedure niceprint(var len: integer; s: string);

begin
	if len + length(s) > 78 then begin
		len := 0;
		writeln;
	end else begin
		len := len + length(s);
	end;
	write(s);
end;


procedure people_header(where: shortstring);
var
	point: integer;
	tmp: string;
	i: integer;
	n: integer;
	len: integer;

begin
	point := 1;
	n := n_can_see;
	case n of
		0:;
		1: begin
			writeln(next_can_see(point),' is ',where);
		   end;
		2: begin
			writeln(next_can_see(point),' and ',next_can_see(point),
				' are ',where);
		   end;
		otherwise begin
			len := 0;
			for i := 1 to n - 1 do begin { at least 1 to 2 }
				tmp := next_can_see(point);
				if i <> n - 1 then
					tmp := tmp + ', ';
				niceprint(len,tmp);
			end;

			niceprint(len,' and ');
			niceprint(len,next_can_see(point));
			niceprint(len,' are ' + where);
			writeln;
		end;
	end;
end;


procedure desc_person(i: integer);
var
	pname: shortstring;

begin
	pname := here.people[i].name;

	if here.people[i].act <> 0 then begin
		write(pname,' is');
		writeln(desc_action(here.people[i].act,
			here.people[i].targ));
					{ describes what person last did }
	end;

	if here.people[i].health <> GOODHEALTH then
		desc_health(i);

	if here.people[i].wielding > 0 then
		writeln(pname,' is wielding ',obj_part(here.people[i].wielding),'.');

end;


procedure show_people;
var
	i: integer;

begin
	people_header('here.');
	for i := 1 to maxpeople do begin
		if (here.people[i].name <> '') and
		   (i <> myslot) and
		   (here.people[i].hiding = 0) then
				desc_person(i);
	end;
end;


procedure show_group;
var
	gloc1,gloc2: integer;
	gnam1,gnam2: shortstring;

begin
	gloc1 := here.grploc1;
	gloc2 := here.grploc2;
	gnam1 := here.grpnam1;
	gnam2 := here.grpnam2;

	if gloc1 <> 0 then begin
		gethere(gloc1);
		people_header(gnam1);
	end;
	if gloc2 <> 0 then begin
		gethere(gloc2);
		people_header(gnam2);
	end;
	gethere;
end;


procedure desc_obj(n: integer);

begin
	if n <> 0 then begin
		getobj(n);
		freeobj;
		if (obj.linedesc = DEFAULT_LINE) then begin
			writeln('On the ground here is ',obj_part(n,FALSE),'.');

				{ the FALSE means obj_part shouldn't do its
				  own getobj, cause we already did one }
		end else
			print_line(obj.linedesc);
	end;
end;


procedure show_objects;

var
	i: integer;

begin
	for i := 1 to maxobjs do begin
		if (here.objs[i] <> 0) and (here.objhide[i] = 0) then
			desc_obj(here.objs[i]);
	end;
end;


function lookup_detail(var n: integer;s:string): boolean;
var
	i,poss,maybe,num: integer;

begin
	n := 0;
	s := lowcase(s);
	i := 1;
	maybe := 0;
	num := 0;
	for i := 1 to maxdetail do begin
		if s = here.detail[i] then
			num := i
		else if index(here.detail[i],s) = 1 then begin
			maybe := maybe + 1;
			poss := i;
		end;
	end;
	if num <> 0 then begin
		n := num;
		lookup_detail := true;
	end else if maybe = 1 then begin
		n := poss;
		lookup_detail := true;
	end else if maybe > 1 then begin
		lookup_detail := false;
	end else begin
		lookup_detail := false;
	end;
end;


function look_detail(s: string): boolean;
var
	n: integer;

begin
	if lookup_detail(n,s) then begin
		if here.detaildesc[n] = 0 then
			look_detail := false
		else begin
			print_desc(here.detaildesc[n]);
			log_event(myslot,E_LOOKDETAIL,0,0,here.detail[n]);
			look_detail := true;
		end;
	end else
		look_detail := false;
end;


function look_person(s: string): boolean;
var
	objnum,i,n: integer;
	first: boolean;

begin
	if parse_pers(n,s) then begin
		if n = myslot then begin
			log_event(myslot,E_LOOKSELF,n,0);
			writeln('You step outside of yourself for a moment to get an objective self-appraisal:');
			writeln;
		end else
			log_event(myslot,E_LOOKYOU,n,0);
		if here.people[n].self <> 0 then begin
			print_desc(here.people[n].self);
			writeln;
		end;

		desc_health(n);

			{ Do an inventory of person S }
		first := true;
		for i := 1 to maxhold do begin
			objnum := here.people[n].holding[i];
			if objnum <> 0 then begin
				if first then begin
					writeln(here.people[n].name,' is holding:');
					first := false;
				end;
				writeln('   ',obj_part(objnum));
			end;
		end;
		if first then
			writeln(here.people[n].name,' is empty handed.');

		look_person := true;
	end else
		look_person := false;
end;



procedure do_examine(s: string;var three: boolean;silent:boolean := false);
var
	n: integer;
	msg: string;

begin
	three := false;
	if parse_obj(n,s) then begin
		if obj_here(n) or obj_hold(n) then begin
			three := true;

			getobj(n);
			freeobj;
			msg := myname + ' is examining ' + obj_part(n) + '.';
			log_event(myslot,E_EXAMINE,0,0,msg);
			if obj.examine = 0 then
				writeln('You see nothing special about the ',
						objnam.idents[n],'.')
			else
				print_desc(obj.examine);
		end else
			if not(silent) then
				writeln('That object cannot be seen here.');
	end else
		if not(silent) then
			writeln('That object cannot be seen here.');
end;



procedure print_room;

begin
	case here.nameprint of
		0:;	{ don't print name }
		1: writeln('You''re in ',here.nicename);
		2: writeln('You''re at ',here.nicename);
	end;

	if not(brief) then begin
	case here.which of
		0: print_desc(here.primary);
		1: print_desc(here.secondary);
		2: begin
			print_desc(here.primary);
			print_desc(here.secondary);
		   end;
		3: begin
			print_desc(here.primary);
			if here.magicobj <> 0 then
				if obj_hold(here.magicobj) then
					print_desc(here.secondary);
		   end;
		4: begin
			if here.magicobj <> 0 then begin
				if obj_hold(here.magicobj) then
					print_desc(here.secondary)
				else
					print_desc(here.primary);
			end else
				print_desc(here.primary);
		   end;
	end;
	writeln;
	end;   { if not(brief) }
end;



procedure do_look(s: string := '');
var
	n: integer;
	one,two,three: boolean;

begin
	gethere;
	if s = '' then begin	{ do an ordinary top-level room look }

		if hiding then begin
			writeln('You can''t get a very good view of the details of the room from where');
			writeln('you are hiding.');
			noisehide(67);
		end else begin
			print_room;
			show_exits;
		end;		{ end of what you can't see when you're hiding }
		show_people;
		show_group;
		show_objects;
	end else begin		{ look at a detail in the room }
		one := look_detail(s);
		two := look_person(s);
		do_examine(s,three,TRUE);
		if not(one or two or three) then
			writeln('There isn''t anything here by that name to look at.');
	end;
end;


procedure init_exit(dir: integer);

begin
	with here.exits[dir] do begin
		exitdesc := DEFAULT_LINE;
		fail := DEFAULT_LINE;		{ default descriptions }
		success := 0;			{ until they customize }
		comeout := DEFAULT_LINE;
		goin := DEFAULT_LINE;
		closed := DEFAULT_LINE;

		objreq := 0;		{ not a door (yet) }
		hidden := 0;		{ not hidden }
		reqalias := false;	{ don't require alias (i.e. can use
					  direction of exit North, east, etc. }
		reqverb := false;
		autolook := true;
		alias := '';
	end;
end;



procedure remove_exit(dir: integer);
var
	targroom,targslot: integer;
	hereacc,targacc: boolean;

begin
		{ Leave residual accepts if player is not the owner of
		  the room that the exit he is deleting is in }

	getroom;
	targroom := here.exits[dir].toloc;
	targslot := here.exits[dir].slot;
	here.exits[dir].toloc := 0;
	init_exit(dir);

	if (here.owner = userid) or (privd) then
		hereacc := false
	else
		hereacc := true;

	if hereacc then
		here.exits[dir].kind := 5	{ put an "accept" in its place }
	else
		here.exits[dir].kind := 0;

	putroom;
	log_event(myslot,E_DETACH,dir,0,myname,location);

	getroom(targroom);
	here.exits[targslot].toloc := 0;

	if (here.owner = userid) or (privd) then
		targacc := false
	else
		targacc := true;

	if targacc then
		here.exits[targslot].kind := 5	{ put an "accept" in its place }
	else
		here.exits[targslot].kind := 0;

	putroom;

	if targroom <> location then
		log_event(0,E_DETACH,targslot,0,myname,targroom);
	writeln('Exit destroyed.');
end;


{
User procedure to unlink a room
}
procedure do_unlink(s: string);
var
	dir: integer;

begin
	gethere;
	if checkhide then begin
	if lookup_dir(dir,s) then begin
		if can_alter(dir) then begin
			if here.exits[dir].toloc = 0 then
				writeln('There is no exit there to unlink.')
			else
				remove_exit(dir);
		end else
			writeln('You are not allowed to remove that exit.');
	end else
		writeln('To remove an exit, type UNLINK <direction of exit>.');
	end;
end;



function desc_allowed: boolean;

begin
	if (here.owner = userid) or
	   (privd) then
		desc_allowed := true
	else begin
		writeln('Sorry, you are not allowed to alter the descriptions in this room.');
		desc_allowed := false;
	end;
end;



function slead(s: string):string;
var
	i: integer;
	going: boolean;

begin 
	if length(s) = 0 then
		slead := ''
	else begin
		i := 1;
		going := true;
		while going do begin
			if i > length(s) then
				going := false
			else if (s[i]=' ') or (s[i]=chr(9)) then
				i := i + 1
			else
				going := false;
		end;

		if i > length(s) then
			slead := ''
		else
			slead := substr(s,i,length(s)+1-i);
	end;
end;


function bite(var s: string): string;
var
	i: integer;

begin
	if length(s) = 0 then
		bite := ''
	else begin
		i := index(s,' ');
		if i = 0 then begin
			bite := s;
			s := '';
		end else begin
			bite := substr(s,1,i-1);
			s := slead(substr(s,i+1,length(s)-i));
		end;
	end;
end;

procedure edit_help;

begin
	writeln;
	writeln('A	Append text to end');
	writeln('C	Check text for correct length with parameter substitution (#)');
	writeln('D #	Delete line #');
	writeln('E	Exit & save changes');
	writeln('I #	Insert lines before line #');
	writeln('P	Print out description');
	writeln('Q	Quit: THROWS AWAY CHANGES');
	writeln('R #	Replace text of line #');
	writeln('Z	Zap all text');
	writeln('@	Throw away text & exit with the default description');
	writeln('?	This list');
	writeln;
end;

procedure edit_replace(n: integer);
var
	prompt: string;
	s: string;

begin
	if (n > heredsc.desclen) or (n < 1) then
		writeln('-- Bad line number')
	else begin
		writev(prompt,n:2,': ');
		grab_line(prompt,s);
		if s <> '**' then
			heredsc.lines[n] := s;
	end;
end;

procedure edit_insert(n: integer);
var
	i: integer;

begin
	if heredsc.desclen = descmax then
		writeln('You have already used all ',descmax:1,' lines of text.')
	else if (n < 1) or (n > heredsc.desclen) then begin
		writeln('Invalid line #; valid lines are between 1 and ',heredsc.desclen:1);
		writeln('Use A (add) to add text to the end of your description.');
	end else begin
		for i := heredsc.desclen+1 downto n + 1 do
			heredsc.lines[i] := heredsc.lines[i-1];
		heredsc.desclen := heredsc.desclen + 1;
		heredsc.lines[n] := '';
	end;
end;

procedure edit_doinsert(n: integer);
var
	s: string;
	prompt: string;

begin
	if heredsc.desclen = descmax then
		writeln('You have already used all ',descmax:1,' lines of text.')
	else if (n < 1) or (n > heredsc.desclen) then begin
		writeln('Invalid line #; valid lines are between 1 and ',heredsc.desclen:1);
		writeln('Use A (add) to add text to the end of your description.');
	end else repeat
		writev(prompt,n:1,': ');
		grab_line(prompt,s);
		if s <> '**' then begin
			edit_insert(n);		{ put the blank line in }
			heredsc.lines[n] := s;	{ copy this line onto it }
			n := n + 1;
		end;
	until (heredsc.desclen = descmax) or (s = '**');
end;

procedure edit_show;
var
	i: integer;

begin
	writeln;
	if heredsc.desclen = 0 then
		writeln('[no text]')
	else begin
		i := 1;
		while i <= heredsc.desclen do begin
			writeln(i:2,': ',heredsc.lines[i]);
			i := i + 1;
		end;
	end;
end;

procedure edit_append;
var
	prompt,s: string;
	stilladding: boolean;

begin
	if heredsc.desclen = descmax then
		writeln('You have already used all ',descmax:1,' lines of text.')
	else begin
		stilladding := true;
		writeln('Enter text.  Terminate with ** at the beginning of a line.');
		writeln('You have ',descmax:1,' lines maximum.');
		writeln;
		while (heredsc.desclen < descmax) and (stilladding) do begin
			writev(prompt,heredsc.desclen+1:2,': ');
			grab_line(prompt,s);
			if s = '**' then
				stilladding := false
			else begin
				heredsc.desclen := heredsc.desclen + 1;
				heredsc.lines[heredsc.desclen] := s;
			end;
		end;
	end;
end;

procedure edit_delete(n: integer);
var
	i: integer;

begin
	if heredsc.desclen = 0 then
		writeln('-- No lines to delete')
	else if (n > heredsc.desclen) or (n < 1) then
		writeln('-- Bad line number')
	else if (n = 1) and (heredsc.desclen = 1) then
		heredsc.desclen := 0
	else begin
		for i := n to heredsc.desclen-1 do
			heredsc.lines[i] := heredsc.lines[i + 1];
		heredsc.desclen := heredsc.desclen - 1;
	end;
end;


procedure check_subst;
var
	i: integer;

begin
	if heredsc.desclen > 0 then begin
		for i := 1 to heredsc.desclen do
			if (index(heredsc.lines[i],'#') > 0) and
			   (length(heredsc.lines[i]) > 59) then
				writeln('Warning: line ',i:1,' is too long for correct parameter substitution.');
	end;
end;


function edit_desc(var dsc: integer):boolean;
var
	cmd: char;
	s: string;
	done: boolean;
	n: integer;

begin
	if dsc = DEFAULT_LINE then begin
		heredsc.desclen := 0;
	end else if dsc > 0 then begin
		getblock(dsc);
		freeblock;
		heredsc := block;
	end else if dsc < 0 then begin
		n := (- dsc);
		getline(n);
		freeline;
		heredsc.lines[1] := oneliner.theline;
		heredsc.desclen := 1;
	end else begin
		heredsc.desclen := 0;
	end;

	edit_desc := true;
	done := false;
	if heredsc.desclen = 0 then
		edit_append;
	repeat
		writeln;
		repeat
			grab_line('* ',s);
			s := slead(s);
		until length(s) > 0;
		s := lowcase(s);
		cmd := s[1];

		if length(s)>1 then begin
			n := number(slead(substr(s,2,length(s)-1)))
		end else
			n := 0;

		case cmd of
			'h','?': edit_help;
			'a': edit_append;
			'z': heredsc.desclen := 0;
			'c': check_subst;
			'p','l','t': edit_show;
			'd': edit_delete(n);
			'e': begin
				check_subst;
				if debug then
					writeln('edit_desc: dsc is ',dsc:1);


{ what I do here may require some explanation:

	dsc is a pointer to some text structure:
		dsc = 0 :  no text
		dsc > 0 :  dsc refers to a description block (descmax lines)
		dsc < 0 :  dsc refers to a description "one liner".  abs(dsc)
			   is the actual pointer

	If there are no lines of text to be written out (heredsc.desclen = 0)
	then we deallocate whatever dsc is when edit_desc was invoked, if
	it was pointing to something;

	if there is one line of text to be written out, allocate a one liner
	record, assign the string to it, and return dsc as negative;

	if there is mmore than one line of text, allocate a description block,
	store the lines in it, and return dsc as positive.

	In all cases if there was already a record allocated to dsc then
	use it and don't reallocate a new record.
}

{ kill the default }		if (heredsc.desclen > 0) and
{ if we're gonna put real }		(dsc = DEFAULT_LINE) then
{ texty in here }				dsc := 0;

{ no lines, delete existing }	if heredsc.desclen = 0 then
{ desc, if any }			delete_block(dsc)
				else if heredsc.desclen = 1 then begin
					if (dsc = 0) then begin
						if alloc_line(dsc) then;
						dsc := (- dsc);
					end else if dsc > 0 then begin
						delete_block(dsc);
						if alloc_line(dsc) then;
						dsc := (- dsc);
					end;

					if dsc < 0 then begin
						getline( abs(dsc) );
						oneliner.theline := heredsc.lines[1];
						putline;
					end;
{ more than 1 lines }		end else begin
					if dsc = 0 then begin
						if alloc_block(dsc) then;
					end else if dsc < 0 then begin
						delete_line(dsc);
						if alloc_block(dsc) then;
					end;

					if dsc > 0 then begin
						getblock(dsc);
						block := heredsc;
{ This is a fudge }				block.descrinum := dsc;
						putblock;
					end;
				end;
				done := true;
			     end;
			'r': edit_replace(n);
			'@': begin
				delete_block(dsc);
				dsc := DEFAULT_LINE;
				done := true;
			     end;
			'i': edit_doinsert(n);
			'q': begin
				grab_line('Throw away changes, are you sure? ',s);
				s := lowcase(s);
				if (s = 'y') or (s = 'yes') then begin
					done := true;
					edit_desc := false; { signal caller not to save }
				end;
			     end;
			otherwise writeln('-- Invalid command, type ? for a list.');
		end;
	until done;
end;




function alloc_detail(var n: integer;s: string): boolean;
var
	found: boolean;

begin
	n := 1;
	found := false;
	while (n <= maxdetail) and (not found) do begin
		if here.detaildesc[n] = 0 then
			found := true
		else
			n := n + 1;
	end;
	alloc_detail := found;
	if not(found) then
		n := 0
	else begin
		getroom;
		here.detail[n] := lowcase(s);
		putroom;
	end;
end;


{
User describe procedure.  If no s then describe the room

Known problem: if two people edit the description to the same room one of their
	description blocks could be lost.
This is unlikely to happen unless the Monster Manager tries to edit a
description while the room's owner is also editing it.
}
procedure do_describe(s: string);
var
	i: integer;
	newdsc: integer;

begin
	gethere;
	if checkhide then begin
	if s = '' then begin { describe this room }
		if desc_allowed then begin
			log_action(desc,0);
			writeln('[ Editing the primary room description ]');
			newdsc := here.primary;
			if edit_desc(newdsc) then begin
				getroom;
				here.primary := newdsc;
				putroom;
			end;
			log_event(myslot,E_EDITDONE,0,0);
		end;
	end else begin{ describe a detail of this room }
		if length(s) > veryshortlen then
			writeln('Your detail keyword can only be ',veryshortlen:1,' characters.')
		else if desc_allowed then begin
			if not(lookup_detail(i,s)) then
			if not(alloc_detail(i,s)) then begin
				writeln('You have used all ',maxdetail:1,' details.');
				writeln('To delete a detail, DESCRIBE <the detail> and delete all the text.');
			end;
			if i <> 0 then begin
				log_action(e_detail,0);
				writeln('[ Editing detail "',here.detail[i],'" of this room ]');
				newdsc := here.detaildesc[i];
				if edit_desc(newdsc) then begin
					getroom;
					here.detaildesc[i] := newdsc;
					putroom;
				end;
				log_event(myslot,E_DONEDET,0,0);
			end;
		end;
	end;
{	clear_command;	}
	end;
end;




procedure del_room(n: integer);
var
	i: integer;

begin
	getnam;
	nam.idents[n] := '';	{ blank out name }
	putnam;

	getown;
	own.idents[n] := '';	{ blank out owner }
	putown;

	getroom(n);
	for i := 1 to maxexit do begin
		with here.exits[i] do begin
			delete_line(exitdesc);
			delete_line(fail);
			delete_line(success);
			delete_line(comeout);
			delete_line(goin);
		end;
	end;
	delete_block(here.primary);
	delete_block(here.secondary);
	putroom;
	delete_room(n);	{ return room to free list }
end;



procedure createroom(s: string);	{ create a room with name s }
var
	roomno: integer;
	dummy: integer;
	i:integer;
	rand_accept: integer;

begin
	if length(s) = 0 then begin
		writeln('Please specify the name of the room you wish to create as a parameter to FORM.');
	end else if length(s) > shortlen then begin
		writeln('Please limit your room name to a maximum of ',shortlen:1,' characters.');
	end else if exact_room(dummy,s) then begin
		writeln('That room name has already been used.  Please give a unique room name.');
	end else if alloc_room(roomno) then begin
		log_action(form,0);

		getnam;
		nam.idents[roomno] := lowcase(s);	{ assign room name }
		putnam;					{ case insensitivity }

		getown;
		own.idents[roomno] := userid;	{ assign room owner }
		putown;

		getroom(roomno);

		here.primary := 0;
		here.secondary := 0;
		here.which := 0;	{ print primary desc only by default }
		here.magicobj := 0;

		here.owner := userid;	{ owner and name are stored here too }
		here.nicename := s;
		here.nameprint := 1;	{ You're in ... }
		here.objdrop := 0;	{ objects dropped stay here }
		here.objdesc := 0;	{ nothing printed when they drop }
		here.magicobj := 0;	{ no magic object default }
		here.trapto := 0;	{ no trapdoor }
		here.trapchance := 0;	{ no chance }
		here.rndmsg := DEFAULT_LINE;	{ bland noises message }
		here.pile := 0;
		here.grploc1 := 0;
		here.grploc2 := 0;
		here.grpnam1 := '';
		here.grpnam2 := '';

		here.effects := 0;
		here.parm := 0;

		here.xmsg2 := 0;
		here.exp2 := 0;
		here.exp3 := 0;
		here.exp4 := 0;
		here.exitfail := DEFAULT_LINE;
		here.ofail := DEFAULT_LINE;

		for i := 1 to maxpeople do
			here.people[i].kind := 0;

		for i := 1 to maxpeople do
			here.people[i].name := '';

		for i := 1 to maxobjs do
			here.objs[i] := 0;

		for i := 1 to maxdetail do
			here.detail[i] := '';
		for i := 1 to maxdetail do
			here.detaildesc[i] := 0;

		for i := 1 to maxobjs do
			here.objhide[i] := 0;

		for i := 1 to maxexit do
			with here.exits[i] do begin
				toloc := 0;
				kind := 0;
				slot := 0;
				exitdesc := DEFAULT_LINE;
				fail := DEFAULT_LINE;
				success := 0;	{ no success desc by default }
				goin := DEFAULT_LINE;
				comeout := DEFAULT_LINE;
				closed := DEFAULT_LINE;

				objreq := 0;
				hidden := 0;
				alias := '';

				reqverb := false;
				reqalias := false;
				autolook := true;
			end;
		
{		here.exits := zero;	}

				{ random accept for this room }
		rand_accept := 1 + (rnd100 mod 6);
		here.exits[rand_accept].kind := 5;

		putroom;
	end;
end;



procedure show_help;
var
	i: integer;
	s: string;

begin
	writeln;
	writeln('Accept/Refuse #  Allow others to Link an exit here at direction # | Undo Accept');
	writeln('Brief            Toggle printing of room descriptions');
	writeln('Customize [#]    Customize this room | Customize exit # | Customize object #');
	writeln('Describe [#]     Describe this room | Describe a feature (#) in detail');
	writeln('Destroy #        Destroy an instance of object # (you must be holding it)');
	writeln('Duplicate #      Make a duplicate of an already-created object.');
	writeln('Form/Zap #       Form a new room with name # | Destroy room named #');
	writeln('Get/Drop #       Get/Drop an object');
	writeln('#,Go #           Go towards # (Some: N/North S/South E/East W/West U/Up D/Down)');
	writeln('Health           Show how healthy you are');
	writeln('Hide/Reveal [#]  Hide/Reveal yoursef | Hide object (#)');
	writeln('I,Inventory      See what you or someone else is carrying');
	writeln('Link/Unlink #    Link/Unlink this room to/from another via exit at direction #');
	writeln('Look,L [#]       Look here | Look at something or someone (#) closely');
	writeln('Make #           Make a new object named #');
	writeln('Name #           Set your game name to #');
	writeln('Players          List people who have played Monster');
	writeln('Punch #          Punch person #');
	writeln('Quit             Leave the game');
	writeln('Relink           Move an exit');
	writeln;
	grab_line('-more-',s);
	writeln;
	writeln('Rooms            Show information about rooms you have made');
	writeln('Say, '' (quote)   Say line of text following command to others in the room');
	writeln('Search           Look around the room for anything hidden');
	writeln('Self #           Edit a description of yourself | View #''s self-description');
	writeln('Show #           Show option # (type SHOW ? for a list)');
	writeln('Unmake #         Remove the form definition of object #');
	writeln('Use #            Use object #');
	writeln('Wear #           Wear the object #');
	writeln('Wield #          Wield the weapon #;  you must be holding it first');
	writeln('Whisper #        Whisper something (prompted for) to person #');
	writeln('Who              List of people playing Monster now');
	writeln('Whois #          What is a player''s username');
	writeln('?,Help           This list');
	writeln('. (period)       Repeat last command');
	writeln;
end;


function lookup_cmd(s: string):integer;
var
	i,		{ index for loop }
	poss,		{ a possible match -- only for partial matches }
	maybe,		{ number of possible matches we have: > 2 is ambig. }
	num		{ the definite match }
		: integer;


begin
	s := lowcase(s);
	i := 1;
	maybe := 0;
	num := 0;
	for i := 1 to numcmds do begin
		if s = cmds[i] then
			num := i
		else if index(cmds[i],s) = 1 then begin
			maybe := maybe + 1;
			poss := i;
		end;
	end;
	if num <> 0 then begin
		lookup_cmd := num;
	end else if maybe = 1 then begin
		lookup_cmd := poss;
	end else if maybe > 1 then
		lookup_cmd := error	{ "Ambiguous" }
	else
		lookup_cmd := error;	{ "Command not found " }
end;


procedure addrooms(n: integer);
var
	i: integer;

begin
	getindex(I_ROOM);
	for i := indx.top+1 to indx.top+n do begin
		locate(roomfile,i);
		roomfile^.valid := i;
		roomfile^.locnum := i;
		roomfile^.primary := 0;
		roomfile^.secondary := 0;
		roomfile^.which := 0;
		put(roomfile);
	end;
	indx.top := indx.top + n;
	putindex;
end;



procedure addints(n: integer);
var
	i: integer;

begin
	getindex(I_INT);
	for i := indx.top+1 to indx.top+n do begin
		locate(intfile,i);
		intfile^.intnum := i;
		put(intfile);
	end;
	indx.top := indx.top + n;
	putindex;
end;



procedure addlines(n: integer);
var
	i: integer;

begin
	getindex(I_LINE);
	for i := indx.top+1 to indx.top+n do begin
		locate(linefile,i);
		linefile^.linenum := i;
		put(linefile);
	end;
	indx.top := indx.top + n;
	putindex;
end;

procedure addblocks(n: integer);
var
	i: integer;

begin
	getindex(I_BLOCK);
	for i := indx.top+1 to indx.top+n do begin
		locate(descfile,i);
		descfile^.descrinum := i;
		put(descfile);
	end;
	indx.top := indx.top + n;
	putindex;
end;


procedure addobjects(n: integer);
var
	i: integer;

begin
	getindex(I_OBJECT);
	for i := indx.top+1 to indx.top+n do begin
		locate(objfile,i);
		objfile^.objnum := i;
		put(objfile);
	end;
	indx.top := indx.top + n;
	putindex;
end;


procedure dist_list;
var
	i,j: integer;
	f: text;
	where_they_are: intrec;

begin
	writeln('Writing distribution list . . .');
	open(f,'monsters.dis',history := new);
	rewrite(f);

	getindex(I_PLAYER);	{ Rec of valid player log records  }
	freeindex;		{ False if a valid player log }

	getuser;		{ Corresponding userids of players }
	freeuser;

	getpers;		{ Personal names of players }
	freepers;

	getdate;		{ date of last play }
	freedate;

	if privd then begin
		getint(N_LOCATION);
		freeint;
		where_they_are := anint;

		getnam;
		freenam;
	end;

	for i := 1 to maxplayers do begin
		if not(indx.free[i]) then begin
			write(f,user.idents[i]);
			for j := length(user.idents[i]) to 15 do
				write(f,' ');
			write(f,'! ',pers.idents[i]);
			for j := length(pers.idents[i]) to 21 do
				write(f,' ');

			write(f,adate.idents[i]);
				if length(adate.idents[i]) < 19 then
					for j := length(adate.idents[i]) to 18 do
						write(f,' ');
			if anint.int[i] <> 0 then
				write(f,' * ')
			else
				write(f,'   ');

			if privd then begin
				write(f,nam.idents[ where_they_are.int[i] ]);
			end;
			writeln(f);

		end;
	end;
	writeln('Done.');
end;


procedure system_view;
var
	used,free,total: integer;

begin
	writeln;
	getindex(I_BLOCK);
	freeindex;
	used := indx.inuse;
	total := indx.top;
	free := total - used;

	writeln('               used   free   total');
	writeln('Block file   ',used:5,'  ',free:5,'   ',total:5);

	getindex(I_LINE);
	freeindex;
	used := indx.inuse;
	total := indx.top;
	free := total - used;
	writeln('Line file    ',used:5,'  ',free:5,'   ',total:5);

	getindex(I_ROOM);
	freeindex;
	used := indx.inuse;
	total := indx.top;
	free := total - used;
	writeln('Room file    ',used:5,'  ',free:5,'   ',total:5);

	getindex(I_OBJECT);
	freeindex;
	used := indx.inuse;
	total := indx.top;
	free := total - used;
	writeln('Object file  ',used:5,'  ',free:5,'   ',total:5);

	getindex(I_INT);
	freeindex;
	used := indx.inuse;
	total := indx.top;
	free := total - used;
	writeln('Integer file ',used:5,'  ',free:5,'   ',total:5);

	writeln;
end;


{ remove a user from the log records (does not handle ownership) }

procedure kill_user(s:string);
var
	n: integer;

begin
	if length(s) = 0 then
		writeln('No user specified')
	else begin
		if lookup_user(n,s) then begin
			getindex(I_ASLEEP);
			freeindex;
			if indx.free[n] then begin
				delete_log(n);
				writeln('Player deleted.');
			end else
				writeln('That person is playing now.');
		end else
			writeln('No such userid found in log information.');
	end;
end;


{ disown everything a player owns }

procedure disown_user(s:string);
var
	n: integer;
	i: integer;
	tmp: string;
	theuser: string;

begin
	if length(s) > 0 then begin
		if debug then
			writeln('calling lookup_user with ',s);
		if not lookup_user(n,s) then
			writeln('User not in log info, attempting to disown anyway.');

		theuser := user.idents[n];

		{ first disown all their rooms }

		getown;
		freeown;
		for i := 1 to maxroom do
			if own.idents[i] = theuser then begin
				getown;
				own.idents[i] := '*';
				putown;

				getroom(i);
				tmp := here.nicename;
				here.owner := '*';
				putroom;

				writeln('Disowned room ',tmp);
			end;
		writeln;

		getobjown;
		freeobjown;
		getobjnam;
		freeobjnam;
		for i := 1 to maxroom do
			if objown.idents[i] = theuser then begin
				getobjown;
				objown.idents[i] := '*';
				putobjown;

				tmp := objnam.idents[i];
				writeln('Disowned object ',tmp);
			end;
	end else
		writeln('No user specified.');
end;

procedure move_asleep;
var
	pname,rname:string;	{ player & room names }
	newroom,n: integer;	{ room number & player slot number }

begin
	grab_line('Player name? ',pname);
	grab_line('Room name?   ',rname);
	if lookup_user(n,pname) then begin
		if lookup_room(newroom,rname) then begin
			getindex(I_ASLEEP);
			freeindex;
			if indx.free[n] then begin
				getint(N_LOCATION);
				anint.int[n] := newroom;
				putint;
				writeln('Player moved.');
			end else
				writeln('That player is not asleep.');
		end else
			writeln('No such room found.');
	end else
		writeln('User not found.');
end;


procedure system_help;

begin
	writeln;
	writeln('B	Add description blocks');
	writeln('D	Disown <user>');
	writeln('E	Exit (same as quit)');
	writeln('I	Add Integer records');
	writeln('K	Kill <user>');
	writeln('L	Add one liner records');
	writeln('M	Move a player who is asleep (not playing now)');
	writeln('O	Add object records');
	writeln('P	Write a distribution list of players');
	writeln('Q	Quit (same as exit)');
	writeln('R	Add rooms');
	writeln('V	View current sizes/usage');
	writeln('?	This list');
	writeln;
end;


{ *************** FIX_STUFF ******************** }

procedure fix_stuff;

begin
end;


procedure do_system(s: string);
var
	prompt: string;
	done: boolean;
	cmd: char;
	n: integer;
	p: string;

begin
	if privd then begin
		log_action(c_system,0);
		prompt := 'System> ';
		done := false;
		repeat
			repeat
				grab_line(prompt,s);
				s := slead(s);
			until length(s) > 0;
			s := lowcase(s);
			cmd := s[1];

			n := 0;
			p := '';
			if length(s) > 1 then begin
				p := slead( substr(s,2,length(s)-1) );
				n := number(p)
			end;
			if debug then begin
				writeln('p = ',p);
			end;

			case cmd of
				'h','?': system_help;
				'1': fix_stuff;
{remove a user}			'k': kill_user(p);
{disown}			'd': disown_user(p);
{dist list of players}		'p': dist_list;
{move where user will wakeup}	'm': move_asleep;
{add rooms}			'r': begin
					if n > 0 then begin
						addrooms(n);
					end else
						writeln('To add rooms, say R <# to add>');
				     end;
{add ints}			'i': begin
					if n > 0 then begin
						addints(n);
					end else
						writeln('To add integers, say I <# to add>');
				     end;
{add description blocks}	'b': begin
					if n > 0 then begin
						addblocks(n);
					end else
						writeln('To add description blocks, say B <# to add>');
				     end;
{add objects}			'o': begin
					if n > 0 then begin
						addobjects(n);
					end else
						writeln('To add object records, say O <# to add>');
				     end;
{add one-liners}		'l': begin
					if n > 0 then begin
						addlines(n);
					end else
						writeln('To add one liner records, say L <# to add>');
				     end;
{view current stats}		'v': begin
					system_view;
				     end;
{quit}				'q','e': done := true;
			otherwise writeln('-- bad command, type ? for a list.');
			end;
		until done;
		log_event(myslot,E_SYSDONE,0,0);
	end else
		writeln('Only the Monster Manger may enter system maintenance mode.');
end;


procedure do_version(s: string);

begin
	writeln('Monster, a multiplayer adventure game where the players create the world');
	writeln('and make the rules.');
	writeln;
	writeln('Written by Rich Skrenta at Northwestern University, 1988.');
end;


procedure rebuild_system;
var
	i,j: integer;

begin
	writeln('Creating index file 1-6');
	for i := 1 to 7 do begin
			{ 1 is blocklist
			  2 is linelist
			  3 is roomlist
			  4 is playeralloc
			  5 is player awake (playing game)
			  6 are objects
			  7 is intfile }

		locate(indexfile,i);
		for j := 1 to maxindex do
			indexfile^.free[j] := true;
		indexfile^.indexnum := i;
		indexfile^.top := 0; { none of each to start }
		indexfile^.inuse := 0;
		put(indexfile);
	end;


	writeln('Initializing roomfile with 10 rooms');
	addrooms(10);

	writeln('Initializing block file with 10 description blocks');
	addblocks(10);

	writeln('Initializing line file with 10 lines');
	addlines(10);

	writeln('Initializing object file with 10 objects');
	addobjects(10);


	writeln('Initializing namfile 1-8');
	for j := 1 to 8 do begin
		locate(namfile,j);
		namfile^.validate := j;
		namfile^.loctop := 0;
		for i := 1 to maxroom do begin
			namfile^.idents[i] := '';
		end;
		put(namfile);
	end;

	writeln('Initializing eventfile');
	for i := 1 to numevnts + 1 do begin
		locate(eventfile,i);
		eventfile^.validat := i;
		eventfile^.point := 1;
		put(eventfile);
	end;

	writeln('Initializing intfile');
	for i := 1 to 6 do begin
		locate(intfile,i);
		intfile^.intnum := i;
		put(intfile);
	end;

	getindex(I_INT);
	for i := 1 to 6 do
		indx.free[i] := false;
	indx.top := 6;
	indx.inuse := 6;
	putindex;

	{ Player log records should have all their slots initially,
	  they don't have to be allocated because they use namrec
	  and intfile for their storage; they don't have their own
	  file to allocate
	}
	getindex(I_PLAYER);
	indx.top := maxplayers;
	putindex;
	getindex(I_ASLEEP);
	indx.top := maxplayers;
	putindex;

	writeln('Creating the Great Hall');
	createroom('Great Hall');
	getroom(1);
	here.owner := '';
	putroom;
	getown;
	own.idents[1] := '';
	putown;

	writeln('Creating the Void');
	createroom('Void');			{ loc 2 }
	writeln('Creating the Pit of Fire');
	createroom('Pit of Fire');		{ loc 3 }
			{ note that these are NOT public locations }


	writeln('Use the SYSTEM command to view and add capacity to the database');
	writeln;
end;


procedure special(s: string);

begin
	if (s = 'rebuild') and (privd) then begin
		if REBUILD_OK then begin
			writeln('Do you really want to destroy the entire universe?');
			readln(s);
			if length(s) > 0 then
				if substr(lowcase(s),1,1) = 'y' then
					rebuild_system;
		end else
			writeln('REBUILD is disabled; you must recompile.');
	end else if s = 'version' then begin
		{ Don't take this out please... }
	  	writeln('Monster, written by Rich Skrenta at Northwestern University, 1988.');
	end else if s = 'quit' then
		done := true;
end;


{ put an object in this location
  if returns false, there were no more free object slots here:
  in other words, the room is too cluttered, and cannot hold any
  more objects
}
function place_obj(n: integer;silent:boolean := false): boolean;
var
	found: boolean;
	i: integer;

begin
	if here.objdrop = 0 then
		getroom
	else
		getroom(here.objdrop);
	i := 1;
	found := false;
	while (i <= maxobjs) and (not found) do begin
		if here.objs[i] = 0 then
			found := true
		else
			i := i + 1;
	end;
	place_obj := found;
	if found then begin
		here.objs[i] := n;
		here.objhide[i] := 0;
		putroom;

		gethere;


		{ if it bounced somewhere else then tell them }

		if (here.objdrop <> 0) and (here.objdest <> 0) then
			log_event(0,E_BOUNCEDIN,here.objdest,n,'',here.objdrop);


		if not(silent) then begin
			if here.objdesc <> 0 then
				print_subs(here.objdesc,obj_part(n))
			else
				writeln('Dropped.');
		end;
	end else
		freeroom;
end;


{ remove an object from this room }
function take_obj(objnum,slot: integer): boolean;

begin
	getroom;
	if here.objs[slot] = objnum then begin
		here.objs[slot] := 0;
		here.objhide[slot] := 0;
		take_obj := true;
	end else
		take_obj := false;
	putroom;
end;


function can_hold: boolean;

begin
	if find_numhold < maxhold then
		can_hold := true
	else
		can_hold := false;
end;


function can_drop: boolean;

begin
	if find_numobjs < maxobjs then
		can_drop := true
	else
		can_drop := false;
end;


function find_hold(objnum: integer;slot:integer := 0): integer;
var
	i: integer;

begin
	if slot = 0 then
		slot := myslot;
	i := 1;
	find_hold := 0;
	while i <= maxhold do begin
		if here.people[slot].holding[i] = objnum then
			find_hold := i;
		i := i + 1;
	end;
end;



{ put object number n into the player's inventory; returns false if
  he's holding too many things to carry another }

function hold_obj(n: integer): boolean;
var
	found: boolean;
	i: integer;

begin
	getroom;
	i := 1;
	found := false;
	while (i <= maxhold) and (not found) do begin
		if here.people[myslot].holding[i] = 0 then
			found := true
		else
			i := i + 1;
	end;
	hold_obj := found;
	if found then begin
		here.people[myslot].holding[i] := n;
		putroom;

		getobj(n);
		freeobj;
		hold_kind[i] := obj.kind;
	end else
		freeroom;
end;



{ remove an object (hold) from the player record, given the slot that
  the object is being held in }

procedure drop_obj(slot: integer;pslot: integer := 0);

begin
	if pslot = 0 then
		pslot := myslot;
	getroom;
	here.people[pslot].holding[slot] := 0;
	putroom;

	hold_kind[slot] := 0;
end;



{ maybe drop something I'm holding if I'm hit }

procedure maybe_drop;
var
	i: integer;
	objnum: integer;
	s: string;

begin
	i := 1 + (rnd100 mod maxhold);
	objnum := here.people[myslot].holding[i];

	if (objnum <> 0) and (mywield <> objnum) and (mywear <> objnum) then begin
		{ drop something }

		drop_obj(i);
		if place_obj(objnum,TRUE) then begin
			getobjnam;
			freeobjnam;
			writeln('The ',objnam.idents[objnum],' has slipped out of your hands.');

			
		s := objnam.idents[objnum];
			log_event(myslot,E_SLIPPED,0,0,s);
		end else
			writeln('%error in maybe_drop; unsuccessful place_obj; notify Monster Manager');

	end;
end;



{ return TRUE if the player is allowed to program the object n
  if checkpub is true then obj_owner will return true if the object in
  question is public }

function obj_owner(n: integer;checkpub: boolean := FALSE):boolean;

begin
	getobjown;
	freeobjown;
	if (objown.idents[n] = userid) or (privd) then begin
		obj_owner := true;
	end else if (objown.idents[n] = '') and (checkpub) then begin
		obj_owner := true;
	end else begin
		obj_owner := false;
	end;
end;


procedure do_duplicate(s: string);
var
	objnum: integer;

begin
   if length(s) > 0 then begin
	if not is_owner(location,TRUE) then begin
			{ only let them make things if they're on their home turf }
		writeln('You may only create objects when you are in one of your own rooms.');
	end else begin
		if lookup_obj(objnum,s) then begin
			if obj_owner(objnum,TRUE) then begin
				if not(place_obj(objnum,TRUE)) then
					{ put the new object here }
					writeln('There isn''t enough room here to make that.')
				else begin
{ keep track of how many there }	getobj(objnum);
{ are in existence }			obj.numexist := obj.numexist + 1;
					putobj;

					log_event(myslot,E_MADEOBJ,0,0,
						myname + ' has created an object here.');
					writeln('Object created.');
				end;
			end else
				writeln('Power to create that object belongs to someone else.');
		end else
			writeln('There is no object by that name.');
	end;
   end else
		writeln('To duplicate an object, type DUPLICATE <object name>.');
end;


{ make an object }
procedure do_makeobj(s: string);
var
	objnum: integer;

begin
	gethere;
	if checkhide then begin
	if not is_owner(location,TRUE) then begin
		writeln('You may only create objects when you are in one of your own rooms.');
	end else if s <> '' then begin
		if length(s) > shortlen then
			writeln('Please limit your object names to ',shortlen:1,' characters.')
		else if exact_obj(objnum,s) then begin	{ object already exits }
			writeln('That object already exits.  If you would like to make another copy of it,');
			writeln('use the DUPLICATE command.');
		end else begin
			if debug then
				writeln('%beggining to create object');
			if find_numobjs < maxobjs then begin
				if alloc_obj(objnum) then begin
					if debug then
						writeln('%alloc_obj successful');
					getobjnam;
					objnam.idents[objnum] := lowcase(s);
					putobjnam;
					if debug then
						writeln('%getobjnam completed');
					getobjown;
					objown.idents[objnum] := userid;
					putobjown;
					if debug then
						writeln('%getobjown completed');

					getobj(objnum);
						obj.onum := objnum;
						obj.oname := s;	{ name of object }
						obj.kind := 0; { bland object }
						obj.linedesc := DEFAULT_LINE;
						obj.actindx := 0;
						obj.examine := 0;
						obj.numexist := 1;
						obj.home := 0;
						obj.homedesc := 0;

						obj.sticky := false;
						obj.getobjreq := 0;
						obj.getfail := 0;
						obj.getsuccess := DEFAULT_LINE;

						obj.useobjreq := 0;
						obj.uselocreq := 0;
						obj.usefail := DEFAULT_LINE;
						obj.usesuccess := DEFAULT_LINE;

						obj.usealias := '';
						obj.reqalias := false;
						obj.reqverb := false;

			if s[1] in ['a','A','e','E','i','I','o','O','u','U'] then
						obj.particle := 2  { an }
			else
						obj.particle := 1; { a }

						obj.d1 := 0;
						obj.d2 := 0;
						obj.exp3 := 0;
						obj.exp4 := 0;
						obj.exp5 := DEFAULT_LINE;
						obj.exp6 := DEFAULT_LINE;
					putobj;


					if debug then
						writeln('putobj completed');
				end;
					{ else: alloc_obj prints errors by itself }
				if not(place_obj(objnum,TRUE)) then
					{ put the new object here }
					writeln('%error in makeobj - could not place object; notify the Monster Manager.')
				else begin
					log_event(myslot,E_MADEOBJ,0,0,
						myname + ' has created an object here.');
					writeln('Object created.');
				end;

			end else
				writeln('This place is too crowded to create any more objects.  Try somewhere else.');
		end;
	end else
		writeln('To create an object, type MAKE <object name>.');
	end;
end;

{ remove the type block for an object; all instances of the object must
  be destroyed first }

procedure do_unmake(s: string);
var
	n: integer;
	tmp: string;

begin
	if not(is_owner(location,TRUE)) then
		writeln('You must be in one of your own rooms to UNMAKE an object.')
	else if lookup_obj(n,s) then begin
		tmp := obj_part(n);
			{ this will do a getobj(n) for us }

		if obj.numexist = 0 then begin
			delete_obj(n);

			log_event(myslot,E_UNMAKE,0,0,tmp);
			writeln('Object removed.');
		end else
			writeln('You must DESTROY all instances of the object first.');
	end else
		writeln('There is no object here by that name.');
end;


{ destroy a copy of an object }

procedure do_destroy(s: string);
var
	slot,n: integer;

begin
	if length(s) = 0 then	
		writeln('To destroy an object you own, type DESTROY <object>.')
	else if not is_owner(location,TRUE) then
		writeln('You must be in one of your own rooms to destroy an object.')
	else if parse_obj(n,s) then begin
		getobjown;
		freeobjown;
		if (objown.idents[n] <> userid) and (objown.idents[n] <> '') and
		   (not privd) then
			writeln('You must be the owner of an object to destroy it.')
		else if obj_hold(n) then begin
			slot := find_hold(n);
			drop_obj(slot);

			log_event(myslot,E_DESTROY,0,0,
				myname + ' has destroyed ' + obj_part(n) + '.');
			writeln('Object destroyed.');

			getobj(n);
			obj.numexist := obj.numexist - 1;
			putobj;
		end else if obj_here(n) then begin
			slot := find_obj(n);
			if not take_obj(n,slot) then
				writeln('Someone picked it up before you could destroy it.')
			else begin
				log_event(myslot,E_DESTROY,0,0,
					myname + ' has destroyed ' + obj_part(n,FALSE) + '.');
				writeln('Object destroyed.');

				getobj(n);
				obj.numexist := obj.numexist - 1;
				putobj;
			end;
		end else
			writeln('Such a thing is not here.');
	end else
		writeln('No such thing can be seen here.');
end;


function links_possible: boolean;
var
	i: integer;

begin
	gethere;
	links_possible := false;
	if is_owner(location,TRUE) then
		links_possible := true
	else begin
		for i := 1 to maxexit do
			if (here.exits[i].toloc = 0) and (here.exits[i].kind = 5) then
				links_possible := true;
	end;
end;



{ make a room }
procedure do_form(s: string);

begin
	gethere;
	if checkhide then begin
		if links_possible then begin
			if s = '' then begin
				grab_line('Room name: ',s);
			end;
			s := slead(s);

			createroom(s);
		end else begin
			writeln('You may not create any new exits here.  Go to a place where you can create');
			writeln('an exit before FORMing a new room.');
		end;
	end;
end;


procedure xpoof; { loc: integer; forward }
var
	targslot: integer;

begin
	if put_token(loc,targslot,here.people[myslot].hiding) then begin
		if hiding then begin
			log_event(myslot,E_HPOOFOUT,0,0,myname,location);
			log_event(myslot,E_HPOOFIN,0,0,myname,loc);
		end else begin
			log_event(myslot,E_POOFOUT,0,0,myname,location);
			log_event(targslot,E_POOFIN,0,0,myname,loc);
		end;

		take_token(myslot,location);
		myslot := targslot;
		location := loc;
		setevent;
		do_look;
	end else
		writeln('There is a crackle of electricity, but the poof fails.');
end;


procedure do_poof(s: string);
var
	n,loc: integer;

begin
	if privd then begin
		gethere;
		if lookup_room(loc,s) then begin
			xpoof(loc);
		end else if parse_pers(n,s) then begin
			grab_line('What room? ',s);
			if lookup_room(loc,s) then begin
				log_event(myslot,E_POOFYOU,n,loc);
				writeln;
				writeln('You extend your arms, muster some energy, and ',here.people[n].name,' is');
				writeln('engulfed in a cloud of orange smoke.');
				writeln;
			end else
				writeln('There is no room named ',s,'.');
		end else
			writeln('There is no room named ',s,'.');
	end else
		writeln('Only the Monster Manager may poof.');
end;


procedure link_room(origdir,targdir,targroom: integer);

begin
	{ since exit creation involves the writing of two records,
	  perhaps there should be a global lock around this code,
	  such as a get to some obscure index field or something.
	  I haven't put this in because I don't believe that if this
	  routine fails it will seriously damage the database.

	  Actually, the lock should be on the test (do_link) but that
	  would be hard	}

	getroom;
	with here.exits[origdir] do begin
		toloc := targroom;
		kind := 1; { type of exit, they can customize later }
		slot := targdir; { exit it comes out in in target room }

		init_exit(origdir);
	end;
	putroom;

	log_event(myslot,E_NEWEXIT,0,0,myname,location);
	if location <> targroom then
		log_event(0,E_NEWEXIT,0,0,myname,targroom);

	getroom(targroom);
	with here.exits[targdir] do begin
		toloc := location;
		kind := 1;
		slot := origdir;

		init_exit(targdir);
	end;
	putroom;
	writeln('Exit created.  Use CUSTOM ',direct[origdir],' to customize your exit.');
end;


{
User procedure to link a room
}
procedure do_link(s: string);
var
	ok: boolean;
	orgexitnam,targnam,trgexitnam: string;
	targroom,	{ number of target room }
	targdir,	{ number of target exit direction }
	origdir: integer;{ number of exit direction here }
	firsttime: boolean;

begin

{	gethere;	! done in links_possible }

   if links_possible then begin
	log_action(link,0);
	if checkhide then begin
	writeln('Hit return alone at any prompt to terminate exit creation.');
	writeln;

	if s = '' then
		firsttime := false
	else begin
		orgexitnam := bite(s);
		firsttime := true;
	end;

	repeat
		if not(firsttime) then
			grab_line('Direction of exit? ',orgexitnam)
		else
			firsttime := false;

		ok :=lookup_dir(origdir,orgexitnam);
		if ok then
			ok := can_make(origdir);
	until (orgexitnam = '') or ok;

	if ok then begin
		if s = '' then
			firsttime := false
		else begin
			targnam := s;
			firsttime := true;
		end;

		repeat
			if not(firsttime) then
				grab_line('Room to link to? ',targnam)
			else
				firsttime := false;

			ok := lookup_room(targroom,targnam);
		until (targnam = '') or ok;
	end;

	if ok then begin
		repeat
			writeln('Exit comes out in target room');
			grab_line('from what direction? ',trgexitnam);
			ok := lookup_dir(targdir,trgexitnam);
			if ok then
				ok := can_make(targdir,targroom);
		until (trgexitnam='') or ok;
	end;

	if ok then begin { actually create the exit }
		link_room(origdir,targdir,targroom);
	end;
	end;
   end else
	writeln('No links are possible here.');
end;


procedure relink_room(origdir,targdir,targroom: integer);
var
	tmp: exit;
	copyslot,
	copyloc: integer;

begin
	gethere;
	tmp := here.exits[origdir];
	copyloc := tmp.toloc;
	copyslot := tmp.slot;

	getroom(targroom);
	here.exits[targdir] := tmp;
	putroom;

	getroom(copyloc);
	here.exits[copyslot].toloc := targroom;
	here.exits[copyslot].slot := targdir;
	putroom;

	getroom;
	here.exits[origdir].toloc := 0;
	init_exit(origdir);
	putroom;
end;


procedure do_relink(s: string);
var
	ok: boolean;
	orgexitnam,targnam,trgexitnam: string;
	targroom,	{ number of target room }
	targdir,	{ number of target exit direction }
	origdir: integer;{ number of exit direction here }
	firsttime: boolean;

begin
	log_action(c_relink,0);
	gethere;
	if checkhide then begin
	writeln('Hit return alone at any prompt to terminate exit relinking.');
	writeln;

	if s = '' then
		firsttime := false
	else begin
		orgexitnam := bite(s);
		firsttime := true;
	end;

	repeat
		if not(firsttime) then
			grab_line('Direction of exit to relink? ',orgexitnam)
		else
			firsttime := false;

		ok :=lookup_dir(origdir,orgexitnam);
		if ok then
			ok := can_alter(or