games@tekred.TEK.COM (12/01/88)
Submitted by: Richard Skrenta <skrenta@nuacc.acns.nwu.edu>
Comp.sources.games: Volume 5, Issue 92
Archive-name: monster/Part05
#! /bin/sh
# This is a shell archive. Remove anything before this line, then unpack
# it by saving it into a file and typing "sh file". To overwrite existing
# files, type "sh file -c". You can also feed this as standard input via
# unshar, or by typing "sh <file", e.g.. If this archive is complete, you
# will see the following message at the end:
# "End of archive 5 (of 6)."
# Contents: mon3.pas privusers.pas
# Wrapped by billr@saab on Wed Nov 30 11:28:59 1988
PATH=/bin:/usr/bin:/usr/ucb ; export PATH
if test -f 'mon3.pas' -a "${1}" != "-c" ; then
echo shar: Will not clobber existing file \"'mon3.pas'\"
else
echo shar: Extracting \"'mon3.pas'\" \(54281 characters\)
sed "s/^X//" >'mon3.pas' <<'END_OF_FILE'
X
X{ disown everything a player owns }
X
Xprocedure disown_user(s:string);
Xvar
X n: integer;
X i: integer;
X tmp: string;
X theuser: string;
X
Xbegin
X if length(s) > 0 then begin
X if debug then
X writeln('calling lookup_user with ',s);
X if not lookup_user(n,s) then
X writeln('User not in log info, attempting to disown anyway.');
X
X theuser := user.idents[n];
X
X { first disown all their rooms }
X
X getown;
X freeown;
X for i := 1 to maxroom do
X if own.idents[i] = theuser then begin
X getown;
X own.idents[i] := '*';
X putown;
X
X getroom(i);
X tmp := here.nicename;
X here.owner := '*';
X putroom;
X
X writeln('Disowned room ',tmp);
X end;
X writeln;
X
X getobjown;
X freeobjown;
X getobjnam;
X freeobjnam;
X for i := 1 to maxroom do
X if objown.idents[i] = theuser then begin
X getobjown;
X objown.idents[i] := '*';
X putobjown;
X
X tmp := objnam.idents[i];
X writeln('Disowned object ',tmp);
X end;
X end else
X writeln('No user specified.');
Xend;
X
Xprocedure move_asleep;
Xvar
X pname,rname:string; { player & room names }
X newroom,n: integer; { room number & player slot number }
X
Xbegin
X grab_line('Player name? ',pname);
X grab_line('Room name? ',rname);
X if lookup_user(n,pname) then begin
X if lookup_room(newroom,rname) then begin
X getindex(I_ASLEEP);
X freeindex;
X if indx.free[n] then begin
X getint(N_LOCATION);
X anint.int[n] := newroom;
X putint;
X writeln('Player moved.');
X end else
X writeln('That player is not asleep.');
X end else
X writeln('No such room found.');
X end else
X writeln('User not found.');
Xend;
X
X
Xprocedure system_help;
X
Xbegin
X writeln;
X writeln('B Add description blocks');
X writeln('D Disown <user>');
X writeln('E Exit (same as quit)');
X writeln('I Add Integer records');
X writeln('K Kill <user>');
X writeln('L Add one liner records');
X writeln('M Move a player who is asleep (not playing now)');
X writeln('O Add object records');
X writeln('P Write a distribution list of players');
X writeln('Q Quit (same as exit)');
X writeln('R Add rooms');
X writeln('V View current sizes/usage');
X writeln('? This list');
X writeln;
Xend;
X
X
X{ *************** FIX_STUFF ******************** }
X
Xprocedure fix_stuff;
X
Xbegin
Xend;
X
X
Xprocedure do_system(s: string);
Xvar
X prompt: string;
X done: boolean;
X cmd: char;
X n: integer;
X p: string;
X
Xbegin
X if privd then begin
X log_action(c_system,0);
X prompt := 'System> ';
X done := false;
X repeat
X repeat
X grab_line(prompt,s);
X s := slead(s);
X until length(s) > 0;
X s := lowcase(s);
X cmd := s[1];
X
X n := 0;
X p := '';
X if length(s) > 1 then begin
X p := slead( substr(s,2,length(s)-1) );
X n := number(p)
X end;
X if debug then begin
X writeln('p = ',p);
X end;
X
X case cmd of
X 'h','?': system_help;
X '1': fix_stuff;
X{remove a user} 'k': kill_user(p);
X{disown} 'd': disown_user(p);
X{dist list of players} 'p': dist_list;
X{move where user will wakeup} 'm': move_asleep;
X{add rooms} 'r': begin
X if n > 0 then begin
X addrooms(n);
X end else
X writeln('To add rooms, say R <# to add>');
X end;
X{add ints} 'i': begin
X if n > 0 then begin
X addints(n);
X end else
X writeln('To add integers, say I <# to add>');
X end;
X{add description blocks} 'b': begin
X if n > 0 then begin
X addblocks(n);
X end else
X writeln('To add description blocks, say B <# to add>');
X end;
X{add objects} 'o': begin
X if n > 0 then begin
X addobjects(n);
X end else
X writeln('To add object records, say O <# to add>');
X end;
X{add one-liners} 'l': begin
X if n > 0 then begin
X addlines(n);
X end else
X writeln('To add one liner records, say L <# to add>');
X end;
X{view current stats} 'v': begin
X system_view;
X end;
X{quit} 'q','e': done := true;
X otherwise writeln('-- bad command, type ? for a list.');
X end;
X until done;
X log_event(myslot,E_SYSDONE,0,0);
X end else
X writeln('Only the Monster Manger may enter system maintenance mode.');
Xend;
X
X
Xprocedure do_version(s: string);
X
Xbegin
X writeln('Monster, a multiplayer adventure game where the players create the world');
X writeln('and make the rules.');
X writeln;
X writeln('Written by Rich Skrenta at Northwestern University, 1988.');
Xend;
X
X
Xprocedure rebuild_system;
Xvar
X i,j: integer;
X
Xbegin
X writeln('Creating index file 1-6');
X for i := 1 to 7 do begin
X { 1 is blocklist
X 2 is linelist
X 3 is roomlist
X 4 is playeralloc
X 5 is player awake (playing game)
X 6 are objects
X 7 is intfile }
X
X locate(indexfile,i);
X for j := 1 to maxindex do
X indexfile^.free[j] := true;
X indexfile^.indexnum := i;
X indexfile^.top := 0; { none of each to start }
X indexfile^.inuse := 0;
X put(indexfile);
X end;
X
X
X writeln('Initializing roomfile with 10 rooms');
X addrooms(10);
X
X writeln('Initializing block file with 10 description blocks');
X addblocks(10);
X
X writeln('Initializing line file with 10 lines');
X addlines(10);
X
X writeln('Initializing object file with 10 objects');
X addobjects(10);
X
X
X writeln('Initializing namfile 1-8');
X for j := 1 to 8 do begin
X locate(namfile,j);
X namfile^.validate := j;
X namfile^.loctop := 0;
X for i := 1 to maxroom do begin
X namfile^.idents[i] := '';
X end;
X put(namfile);
X end;
X
X writeln('Initializing eventfile');
X for i := 1 to numevnts + 1 do begin
X locate(eventfile,i);
X eventfile^.validat := i;
X eventfile^.point := 1;
X put(eventfile);
X end;
X
X writeln('Initializing intfile');
X for i := 1 to 6 do begin
X locate(intfile,i);
X intfile^.intnum := i;
X put(intfile);
X end;
X
X getindex(I_INT);
X for i := 1 to 6 do
X indx.free[i] := false;
X indx.top := 6;
X indx.inuse := 6;
X putindex;
X
X { Player log records should have all their slots initially,
X they don't have to be allocated because they use namrec
X and intfile for their storage; they don't have their own
X file to allocate
X }
X getindex(I_PLAYER);
X indx.top := maxplayers;
X putindex;
X getindex(I_ASLEEP);
X indx.top := maxplayers;
X putindex;
X
X writeln('Creating the Great Hall');
X createroom('Great Hall');
X getroom(1);
X here.owner := '';
X putroom;
X getown;
X own.idents[1] := '';
X putown;
X
X writeln('Creating the Void');
X createroom('Void'); { loc 2 }
X writeln('Creating the Pit of Fire');
X createroom('Pit of Fire'); { loc 3 }
X { note that these are NOT public locations }
X
X
X writeln('Use the SYSTEM command to view and add capacity to the database');
X writeln;
Xend;
X
X
Xprocedure special(s: string);
X
Xbegin
X if (s = 'rebuild') and (privd) then begin
X if REBUILD_OK then begin
X writeln('Do you really want to destroy the entire universe?');
X readln(s);
X if length(s) > 0 then
X if substr(lowcase(s),1,1) = 'y' then
X rebuild_system;
X end else
X writeln('REBUILD is disabled; you must recompile.');
X end else if s = 'version' then begin
X { Don't take this out please... }
X writeln('Monster, written by Rich Skrenta at Northwestern University, 1988.');
X end else if s = 'quit' then
X done := true;
Xend;
X
X
X{ put an object in this location
X if returns false, there were no more free object slots here:
X in other words, the room is too cluttered, and cannot hold any
X more objects
X}
Xfunction place_obj(n: integer;silent:boolean := false): boolean;
Xvar
X found: boolean;
X i: integer;
X
Xbegin
X if here.objdrop = 0 then
X getroom
X else
X getroom(here.objdrop);
X i := 1;
X found := false;
X while (i <= maxobjs) and (not found) do begin
X if here.objs[i] = 0 then
X found := true
X else
X i := i + 1;
X end;
X place_obj := found;
X if found then begin
X here.objs[i] := n;
X here.objhide[i] := 0;
X putroom;
X
X gethere;
X
X
X { if it bounced somewhere else then tell them }
X
X if (here.objdrop <> 0) and (here.objdest <> 0) then
X log_event(0,E_BOUNCEDIN,here.objdest,n,'',here.objdrop);
X
X
X if not(silent) then begin
X if here.objdesc <> 0 then
X print_subs(here.objdesc,obj_part(n))
X else
X writeln('Dropped.');
X end;
X end else
X freeroom;
Xend;
X
X
X{ remove an object from this room }
Xfunction take_obj(objnum,slot: integer): boolean;
X
Xbegin
X getroom;
X if here.objs[slot] = objnum then begin
X here.objs[slot] := 0;
X here.objhide[slot] := 0;
X take_obj := true;
X end else
X take_obj := false;
X putroom;
Xend;
X
X
Xfunction can_hold: boolean;
X
Xbegin
X if find_numhold < maxhold then
X can_hold := true
X else
X can_hold := false;
Xend;
X
X
Xfunction can_drop: boolean;
X
Xbegin
X if find_numobjs < maxobjs then
X can_drop := true
X else
X can_drop := false;
Xend;
X
X
Xfunction find_hold(objnum: integer;slot:integer := 0): integer;
Xvar
X i: integer;
X
Xbegin
X if slot = 0 then
X slot := myslot;
X i := 1;
X find_hold := 0;
X while i <= maxhold do begin
X if here.people[slot].holding[i] = objnum then
X find_hold := i;
X i := i + 1;
X end;
Xend;
X
X
X
X{ put object number n into the player's inventory; returns false if
X he's holding too many things to carry another }
X
Xfunction hold_obj(n: integer): boolean;
Xvar
X found: boolean;
X i: integer;
X
Xbegin
X getroom;
X i := 1;
X found := false;
X while (i <= maxhold) and (not found) do begin
X if here.people[myslot].holding[i] = 0 then
X found := true
X else
X i := i + 1;
X end;
X hold_obj := found;
X if found then begin
X here.people[myslot].holding[i] := n;
X putroom;
X
X getobj(n);
X freeobj;
X hold_kind[i] := obj.kind;
X end else
X freeroom;
Xend;
X
X
X
X{ remove an object (hold) from the player record, given the slot that
X the object is being held in }
X
Xprocedure drop_obj(slot: integer;pslot: integer := 0);
X
Xbegin
X if pslot = 0 then
X pslot := myslot;
X getroom;
X here.people[pslot].holding[slot] := 0;
X putroom;
X
X hold_kind[slot] := 0;
Xend;
X
X
X
X{ maybe drop something I'm holding if I'm hit }
X
Xprocedure maybe_drop;
Xvar
X i: integer;
X objnum: integer;
X s: string;
X
Xbegin
X i := 1 + (rnd100 mod maxhold);
X objnum := here.people[myslot].holding[i];
X
X if (objnum <> 0) and (mywield <> objnum) and (mywear <> objnum) then begin
X { drop something }
X
X drop_obj(i);
X if place_obj(objnum,TRUE) then begin
X getobjnam;
X freeobjnam;
X writeln('The ',objnam.idents[objnum],' has slipped out of your hands.');
X
X
X s := objnam.idents[objnum];
X log_event(myslot,E_SLIPPED,0,0,s);
X end else
X writeln('%error in maybe_drop; unsuccessful place_obj; notify Monster Manager');
X
X end;
Xend;
X
X
X
X{ return TRUE if the player is allowed to program the object n
X if checkpub is true then obj_owner will return true if the object in
X question is public }
X
Xfunction obj_owner(n: integer;checkpub: boolean := FALSE):boolean;
X
Xbegin
X getobjown;
X freeobjown;
X if (objown.idents[n] = userid) or (privd) then begin
X obj_owner := true;
X end else if (objown.idents[n] = '') and (checkpub) then begin
X obj_owner := true;
X end else begin
X obj_owner := false;
X end;
Xend;
X
X
Xprocedure do_duplicate(s: string);
Xvar
X objnum: integer;
X
Xbegin
X if length(s) > 0 then begin
X if not is_owner(location,TRUE) then begin
X { only let them make things if they're on their home turf }
X writeln('You may only create objects when you are in one of your own rooms.');
X end else begin
X if lookup_obj(objnum,s) then begin
X if obj_owner(objnum,TRUE) then begin
X if not(place_obj(objnum,TRUE)) then
X { put the new object here }
X writeln('There isn''t enough room here to make that.')
X else begin
X{ keep track of how many there } getobj(objnum);
X{ are in existence } obj.numexist := obj.numexist + 1;
X putobj;
X
X log_event(myslot,E_MADEOBJ,0,0,
X myname + ' has created an object here.');
X writeln('Object created.');
X end;
X end else
X writeln('Power to create that object belongs to someone else.');
X end else
X writeln('There is no object by that name.');
X end;
X end else
X writeln('To duplicate an object, type DUPLICATE <object name>.');
Xend;
X
X
X{ make an object }
Xprocedure do_makeobj(s: string);
Xvar
X objnum: integer;
X
Xbegin
X gethere;
X if checkhide then begin
X if not is_owner(location,TRUE) then begin
X writeln('You may only create objects when you are in one of your own rooms.');
X end else if s <> '' then begin
X if length(s) > shortlen then
X writeln('Please limit your object names to ',shortlen:1,' characters.')
X else if exact_obj(objnum,s) then begin { object already exits }
X writeln('That object already exits. If you would like to make another copy of it,');
X writeln('use the DUPLICATE command.');
X end else begin
X if debug then
X writeln('%beggining to create object');
X if find_numobjs < maxobjs then begin
X if alloc_obj(objnum) then begin
X if debug then
X writeln('%alloc_obj successful');
X getobjnam;
X objnam.idents[objnum] := lowcase(s);
X putobjnam;
X if debug then
X writeln('%getobjnam completed');
X getobjown;
X objown.idents[objnum] := userid;
X putobjown;
X if debug then
X writeln('%getobjown completed');
X
X getobj(objnum);
X obj.onum := objnum;
X obj.oname := s; { name of object }
X obj.kind := 0; { bland object }
X obj.linedesc := DEFAULT_LINE;
X obj.actindx := 0;
X obj.examine := 0;
X obj.numexist := 1;
X obj.home := 0;
X obj.homedesc := 0;
X
X obj.sticky := false;
X obj.getobjreq := 0;
X obj.getfail := 0;
X obj.getsuccess := DEFAULT_LINE;
X
X obj.useobjreq := 0;
X obj.uselocreq := 0;
X obj.usefail := DEFAULT_LINE;
X obj.usesuccess := DEFAULT_LINE;
X
X obj.usealias := '';
X obj.reqalias := false;
X obj.reqverb := false;
X
X if s[1] in ['a','A','e','E','i','I','o','O','u','U'] then
X obj.particle := 2 { an }
X else
X obj.particle := 1; { a }
X
X obj.d1 := 0;
X obj.d2 := 0;
X obj.exp3 := 0;
X obj.exp4 := 0;
X obj.exp5 := DEFAULT_LINE;
X obj.exp6 := DEFAULT_LINE;
X putobj;
X
X
X if debug then
X writeln('putobj completed');
X end;
X { else: alloc_obj prints errors by itself }
X if not(place_obj(objnum,TRUE)) then
X { put the new object here }
X writeln('%error in makeobj - could not place object; notify the Monster Manager.')
X else begin
X log_event(myslot,E_MADEOBJ,0,0,
X myname + ' has created an object here.');
X writeln('Object created.');
X end;
X
X end else
X writeln('This place is too crowded to create any more objects. Try somewhere else.');
X end;
X end else
X writeln('To create an object, type MAKE <object name>.');
X end;
Xend;
X
X{ remove the type block for an object; all instances of the object must
X be destroyed first }
X
Xprocedure do_unmake(s: string);
Xvar
X n: integer;
X tmp: string;
X
Xbegin
X if not(is_owner(location,TRUE)) then
X writeln('You must be in one of your own rooms to UNMAKE an object.')
X else if lookup_obj(n,s) then begin
X tmp := obj_part(n);
X { this will do a getobj(n) for us }
X
X if obj.numexist = 0 then begin
X delete_obj(n);
X
X log_event(myslot,E_UNMAKE,0,0,tmp);
X writeln('Object removed.');
X end else
X writeln('You must DESTROY all instances of the object first.');
X end else
X writeln('There is no object here by that name.');
Xend;
X
X
X{ destroy a copy of an object }
X
Xprocedure do_destroy(s: string);
Xvar
X slot,n: integer;
X
Xbegin
X if length(s) = 0 then
X writeln('To destroy an object you own, type DESTROY <object>.')
X else if not is_owner(location,TRUE) then
X writeln('You must be in one of your own rooms to destroy an object.')
X else if parse_obj(n,s) then begin
X getobjown;
X freeobjown;
X if (objown.idents[n] <> userid) and (objown.idents[n] <> '') and
X (not privd) then
X writeln('You must be the owner of an object to destroy it.')
X else if obj_hold(n) then begin
X slot := find_hold(n);
X drop_obj(slot);
X
X log_event(myslot,E_DESTROY,0,0,
X myname + ' has destroyed ' + obj_part(n) + '.');
X writeln('Object destroyed.');
X
X getobj(n);
X obj.numexist := obj.numexist - 1;
X putobj;
X end else if obj_here(n) then begin
X slot := find_obj(n);
X if not take_obj(n,slot) then
X writeln('Someone picked it up before you could destroy it.')
X else begin
X log_event(myslot,E_DESTROY,0,0,
X myname + ' has destroyed ' + obj_part(n,FALSE) + '.');
X writeln('Object destroyed.');
X
X getobj(n);
X obj.numexist := obj.numexist - 1;
X putobj;
X end;
X end else
X writeln('Such a thing is not here.');
X end else
X writeln('No such thing can be seen here.');
Xend;
X
X
Xfunction links_possible: boolean;
Xvar
X i: integer;
X
Xbegin
X gethere;
X links_possible := false;
X if is_owner(location,TRUE) then
X links_possible := true
X else begin
X for i := 1 to maxexit do
X if (here.exits[i].toloc = 0) and (here.exits[i].kind = 5) then
X links_possible := true;
X end;
Xend;
X
X
X
X{ make a room }
Xprocedure do_form(s: string);
X
Xbegin
X gethere;
X if checkhide then begin
X if links_possible then begin
X if s = '' then begin
X grab_line('Room name: ',s);
X end;
X s := slead(s);
X
X createroom(s);
X end else begin
X writeln('You may not create any new exits here. Go to a place where you can create');
X writeln('an exit before FORMing a new room.');
X end;
X end;
Xend;
X
X
Xprocedure xpoof; { loc: integer; forward }
Xvar
X targslot: integer;
X
Xbegin
X if put_token(loc,targslot,here.people[myslot].hiding) then begin
X if hiding then begin
X log_event(myslot,E_HPOOFOUT,0,0,myname,location);
X log_event(myslot,E_HPOOFIN,0,0,myname,loc);
X end else begin
X log_event(myslot,E_POOFOUT,0,0,myname,location);
X log_event(targslot,E_POOFIN,0,0,myname,loc);
X end;
X
X take_token(myslot,location);
X myslot := targslot;
X location := loc;
X setevent;
X do_look;
X end else
X writeln('There is a crackle of electricity, but the poof fails.');
Xend;
X
X
Xprocedure do_poof(s: string);
Xvar
X n,loc: integer;
X
Xbegin
X if privd then begin
X gethere;
X if lookup_room(loc,s) then begin
X xpoof(loc);
X end else if parse_pers(n,s) then begin
X grab_line('What room? ',s);
X if lookup_room(loc,s) then begin
X log_event(myslot,E_POOFYOU,n,loc);
X writeln;
X writeln('You extend your arms, muster some energy, and ',here.people[n].name,' is');
X writeln('engulfed in a cloud of orange smoke.');
X writeln;
X end else
X writeln('There is no room named ',s,'.');
X end else
X writeln('There is no room named ',s,'.');
X end else
X writeln('Only the Monster Manager may poof.');
Xend;
X
X
Xprocedure link_room(origdir,targdir,targroom: integer);
X
Xbegin
X { since exit creation involves the writing of two records,
X perhaps there should be a global lock around this code,
X such as a get to some obscure index field or something.
X I haven't put this in because I don't believe that if this
X routine fails it will seriously damage the database.
X
X Actually, the lock should be on the test (do_link) but that
X would be hard }
X
X getroom;
X with here.exits[origdir] do begin
X toloc := targroom;
X kind := 1; { type of exit, they can customize later }
X slot := targdir; { exit it comes out in in target room }
X
X init_exit(origdir);
X end;
X putroom;
X
X log_event(myslot,E_NEWEXIT,0,0,myname,location);
X if location <> targroom then
X log_event(0,E_NEWEXIT,0,0,myname,targroom);
X
X getroom(targroom);
X with here.exits[targdir] do begin
X toloc := location;
X kind := 1;
X slot := origdir;
X
X init_exit(targdir);
X end;
X putroom;
X writeln('Exit created. Use CUSTOM ',direct[origdir],' to customize your exit.');
Xend;
X
X
X{
XUser procedure to link a room
X}
Xprocedure do_link(s: string);
Xvar
X ok: boolean;
X orgexitnam,targnam,trgexitnam: string;
X targroom, { number of target room }
X targdir, { number of target exit direction }
X origdir: integer;{ number of exit direction here }
X firsttime: boolean;
X
Xbegin
X
X{ gethere; ! done in links_possible }
X
X if links_possible then begin
X log_action(link,0);
X if checkhide then begin
X writeln('Hit return alone at any prompt to terminate exit creation.');
X writeln;
X
X if s = '' then
X firsttime := false
X else begin
X orgexitnam := bite(s);
X firsttime := true;
X end;
X
X repeat
X if not(firsttime) then
X grab_line('Direction of exit? ',orgexitnam)
X else
X firsttime := false;
X
X ok :=lookup_dir(origdir,orgexitnam);
X if ok then
X ok := can_make(origdir);
X until (orgexitnam = '') or ok;
X
X if ok then begin
X if s = '' then
X firsttime := false
X else begin
X targnam := s;
X firsttime := true;
X end;
X
X repeat
X if not(firsttime) then
X grab_line('Room to link to? ',targnam)
X else
X firsttime := false;
X
X ok := lookup_room(targroom,targnam);
X until (targnam = '') or ok;
X end;
X
X if ok then begin
X repeat
X writeln('Exit comes out in target room');
X grab_line('from what direction? ',trgexitnam);
X ok := lookup_dir(targdir,trgexitnam);
X if ok then
X ok := can_make(targdir,targroom);
X until (trgexitnam='') or ok;
X end;
X
X if ok then begin { actually create the exit }
X link_room(origdir,targdir,targroom);
X end;
X end;
X end else
X writeln('No links are possible here.');
Xend;
X
X
Xprocedure relink_room(origdir,targdir,targroom: integer);
Xvar
X tmp: exit;
X copyslot,
X copyloc: integer;
X
Xbegin
X gethere;
X tmp := here.exits[origdir];
X copyloc := tmp.toloc;
X copyslot := tmp.slot;
X
X getroom(targroom);
X here.exits[targdir] := tmp;
X putroom;
X
X getroom(copyloc);
X here.exits[copyslot].toloc := targroom;
X here.exits[copyslot].slot := targdir;
X putroom;
X
X getroom;
X here.exits[origdir].toloc := 0;
X init_exit(origdir);
X putroom;
Xend;
X
X
Xprocedure do_relink(s: string);
Xvar
X ok: boolean;
X orgexitnam,targnam,trgexitnam: string;
X targroom, { number of target room }
X targdir, { number of target exit direction }
X origdir: integer;{ number of exit direction here }
X firsttime: boolean;
X
Xbegin
X log_action(c_relink,0);
X gethere;
X if checkhide then begin
X writeln('Hit return alone at any prompt to terminate exit relinking.');
X writeln;
X
X if s = '' then
X firsttime := false
X else begin
X orgexitnam := bite(s);
X firsttime := true;
X end;
X
X repeat
X if not(firsttime) then
X grab_line('Direction of exit to relink? ',orgexitnam)
X else
X firsttime := false;
X
X ok :=lookup_dir(origdir,orgexitnam);
X if ok then
X ok := can_alter(origdir);
X until (orgexitnam = '') or ok;
X
X if ok then begin
X if s = '' then
X firsttime := false
X else begin
X targnam := s;
X firsttime := true;
X end;
X
X repeat
X if not(firsttime) then
X grab_line('Room to relink exit into? ',targnam)
X else
X firsttime := false;
X
X ok := lookup_room(targroom,targnam);
X until (targnam = '') or ok;
X end;
X
X if ok then begin
X repeat
X writeln('New exit comes out in target room');
X grab_line('from what direction? ',trgexitnam);
X ok := lookup_dir(targdir,trgexitnam);
X if ok then
X ok := can_make(targdir,targroom);
X until (trgexitnam='') or ok;
X end;
X
X if ok then begin { actually create the exit }
X relink_room(origdir,targdir,targroom);
X end;
X end;
Xend;
X
X
X{ print the room default no-go message if there is one;
X otherwise supply the generic "you can't go that way" }
X
Xprocedure default_fail;
X
Xbegin
X if (here.exitfail <> 0) and (here.exitfail <> DEFAULT_LINE) then
X print_desc(here.exitfail)
X else
X writeln('You can''t go that way.');
Xend;
X
Xprocedure exit_fail(dir: integer);
Xvar
X tmp: string;
X
Xbegin
X if (dir < 1) or (dir > maxexit) then
X default_fail
X else if (here.exits[dir].fail = DEFAULT_LINE) then begin
X case here.exits[dir].kind of
X 5: writeln('There isn''t an exit there yet.');
X 6: writeln('You don''t have the power to go there.');
X otherwise default_fail;
X end;
X end else if here.exits[dir].fail <> 0 then
X block_subs(here.exits[dir].fail,myname);
X
X
X{ now print the exit failure message for everyone else in the room:
X if they tried to go through a valid exit,
X and the exit has an other-person failure desc, then
X substitute that one & use;
X
X if there is a room default other-person failure desc, then
X print that;
X
X if they tried to go through a valid exit,
X and the exit has no required alias, then
X print default exit fail
X else
X print generic "didn't leave room" message
X
Xcases:
X1) valid/alias exit and specific fail message
X2) valid/alias exit and blanket fail message
X3) valid exit (no specific or blanket) "x fails to go [direct]"
X4) alias exit and blanket fail
X5) blanket fail
X6) generic fail
X}
X
X if dir <> 0 then
X log_event(myslot,E_FAILGO,dir,0);
Xend;
X
X
X
Xprocedure do_exit; { (exit_slot: integer)-- declared forward }
Xvar
X orig_slot,
X targ_slot,
X orig_room,
X enter_slot,
X targ_room: integer;
X doalook: boolean;
X
Xbegin
X if (exit_slot < 1) or (exit_slot > 6) then
X exit_fail(exit_slot)
X else if here.exits[exit_slot].toloc > 0 then begin
X block_subs(here.exits[exit_slot].success,myname);
X
X orig_slot := myslot;
X orig_room := location;
X targ_room := here.exits[exit_slot].toloc;
X enter_slot := here.exits[exit_slot].slot;
X doalook := here.exits[exit_slot].autolook;
X
X { optimization for exit that goes nowhere;
X why go nowhere? For special effects, we
X don't want it to take too much time,
X the logs are important because they force the
X exit descriptions, but actually moving the
X player is unnecessary }
X
X if orig_room = targ_room then begin
X log_exit(exit_slot,orig_room,orig_slot);
X log_entry(enter_slot,targ_room,orig_slot);
X { orig_slot in log_entry 'cause we're not
X really going anwhere }
X if doalook then
X do_look;
X end else begin
X take_token(orig_slot,orig_room);
X if not put_token(targ_room,targ_slot) then begin
X { no room in room! }
X{ put them back! Quick! } if not put_token(orig_room,myslot) then begin
X writeln('%Oh no!');
X halt;
X end;
X end else begin
X log_exit(exit_slot,orig_room,orig_slot);
X log_entry(enter_slot,targ_room,targ_slot);
X
X myslot := targ_slot;
X location := targ_room;
X setevent;
X
X if doalook then
X do_look;
X end;
X end;
X end else
X exit_fail(exit_slot);
Xend;
X
X
X
Xfunction cycle_open: boolean;
Xvar
X ch: char;
X s: string;
X
Xbegin
X s := systime;
X ch := s[5];
X if ch in ['1','3','5','7','9'] then
X cycle_open := true
X else
X cycle_open := false;
Xend;
X
X
Xfunction which_dir(var dir:integer;s: string): boolean;
Xvar
X aliasdir, exitdir: integer;
X aliasmatch,exitmatch,
X aliasexact,exitexact: boolean;
X exitreq: boolean;
X
Xbegin
X s := lowcase(s);
X if lookup_alias(aliasdir,s) then
X aliasmatch := true
X else
X aliasmatch := false;
X if lookup_dir(exitdir,s) then
X exitmatch := true
X else
X exitmatch := false;
X if aliasmatch then begin
X if s = here.exits[aliasdir].alias then
X aliasexact := true
X else
X aliasexact := false;
X end else
X aliasexact := false;
X if exitmatch then begin
X if (s = direct[exitdir]) or (s = substr(direct[exitdir],1,1)) then
X exitexact := true
X else
X exitexact := false;
X end else
X exitexact := false;
X if exitmatch then
X exitreq := here.exits[exitdir].reqalias
X else
X exitreq := false;
X
X dir := 0;
X which_dir := true;
X if aliasexact and exitexact then
X dir := aliasdir
X else if aliasexact then
X dir := aliasdir
X else if exitexact and not exitreq then
X dir := exitdir
X else if aliasmatch then
X dir := aliasdir
X else if exitmatch and not exitreq then
X dir := exitdir
X else if exitmatch and exitreq then begin
X dir := exitdir;
X which_dir := false;
X end else begin
X which_dir := false;
X end;
Xend;
X
X
Xprocedure exit_case(dir: integer);
X
Xbegin
X case here.exits[dir].kind of
X 0: exit_fail(dir);
X 1: do_exit(dir); { more checking goes here }
X
X 3: if obj_hold(here.exits[dir].objreq) then
X exit_fail(dir)
X else
X do_exit(dir);
X 4: if rnd100 < 34 then
X do_exit(dir)
X else
X exit_fail(dir);
X
X 2: begin
X if obj_hold(here.exits[dir].objreq) then
X do_exit(dir)
X else
X exit_fail(dir);
X end;
X 6: if obj_hold(here.exits[dir].objreq) then
X do_exit(dir)
X else
X exit_fail(dir);
X 7: if cycle_open then
X do_exit(dir)
X else
X exit_fail(dir);
X end;
Xend;
X
X{
XPlayer wants to go to s
XHandle everthing, this is the top level procedure
X
XCheck that he can go to s
XPut him through the exit ( in do_exit )
XDo a look for him ( in do_exit )
X}
Xprocedure do_go(s: string;verb:boolean := true);
Xvar
X dir: integer;
X
Xbegin
X gethere;
X if checkhide then begin
X if length(s) = 0 then
X writeln('You must give the direction you wish to travel.')
X else begin
X if which_dir(dir,s) then begin
X if (dir >= 1) and (dir <= maxexit) then begin
X if here.exits[dir].toloc = 0 then begin
X exit_fail(dir);
X end else begin
X exit_case(dir);
X end;
X end else
X exit_fail(dir);
X end else
X exit_fail(dir);
X end;
X end;
Xend;
X
X
Xprocedure nice_say(var s: string);
X
Xbegin
X { capitalize the first letter of their sentence }
X
X if s[1] in ['a'..'z'] then
X s[1] := chr( ord('A') + (ord(s[1]) - ord('a')) );
X
X { put a period on the end of their sentence if
X they don't use any punctuation. }
X
X if s[length(s)] in ['a'..'z','A'..'Z'] then
X s := s + '.';
Xend;
X
X
Xprocedure do_say(s:string);
X
Xbegin
X if length(s) > 0 then begin
X
X{ if length(s) + length(myname) > 79 then begin
X s := substr(s,1,75-length(myname));
X writeln('Your message was truncated:');
X writeln('-- ',s);
X end; }
X
X nice_say(s);
X if hiding then
X log_event(myslot,E_HIDESAY,0,0,s)
X else
X log_event(myslot,E_SAY,0,0,s);
X end else
X writeln('To talk to others in the room, type SAY <message>.');
Xend;
X
Xprocedure do_setname(s: string);
Xvar
X notice: string;
X ok: boolean;
X dummy: integer;
X sprime: string;
X
Xbegin
X gethere;
X if s <> '' then begin
X if length(s) <= shortlen then begin
X sprime := lowcase(s);
X if (sprime = 'monster manager') and (userid <> MM_userid) then begin
X writeln('Only the Monster Manager can have that personal name.');
X ok := false;
X end else if (sprime = 'vice manager') and (userid <> MVM_userid) then begin
X writeln('Only the Vice Manager can have that name.');
X ok := false;
X end else if (sprime = 'faust') and (userid <> FAUST_userid) then begin
X writeln('You are not Faust! You may not have that name.');
X ok := false;
X end else
X ok := true;
X
X if ok then
X if exact_pers(dummy,sprime) then begin
X if dummy = myslot then
X ok := true
X else begin
X writeln('Someone already has that name. Your personal name must be unique.');
X ok := false;
X end;
X end;
X
X if ok then begin
X myname := s;
X getroom;
X notice := here.people[myslot].name;
X here.people[myslot].name := s;
X putroom;
X notice := notice + ' is now known as ' + s;
X
X if not(hiding) then
X log_event(0,E_SETNAM,0,0,notice);
X { slot 0 means notify this player also }
X
X getpers; { note the new personal name in the logfile }
X pers.idents[mylog] := s; { don't lowcase it }
X putpers;
X end;
X end else
X writeln('Please limit your personal name to ',shortlen:1,' characters.');
X end else
X writeln('You are known to others as ',myname);
Xend;
X
Xfunction sysdate:string;
Xvar
X thedate: packed array[1..11] of char;
X
Xbegin
X date(thedate);
X sysdate := thedate;
Xend;
X
X
X{
X1234567890123456789012345678901234567890
Xexample display for alignment:
X
X Monster Status
X 19-MAR-1988 08:59pm
X
X}
X
Xprocedure do_who;
Xvar
X i,j: integer;
X ok: boolean;
X metaok: boolean;
X roomown: veryshortstring;
X
Xbegin
X log_event(myslot,E_WHO,0,(rnd100 mod 4));
X
X { we need just about everything to print this list:
X player alloc index, userids, personal names,
X room names, room owners, and the log record }
X
X getindex(I_ASLEEP); { Get index of people who are playing now }
X freeindex;
X getuser;
X freeuser;
X getpers;
X freepers;
X getnam;
X freenam;
X getown;
X freeown;
X getint(N_LOCATION); { get where they are }
X freeint;
X writeln(' Monster Status');
X writeln(' ',sysdate,' ',systime);
X writeln;
X writeln('Username Game Name Where');
X
X if (privd) { or has_kind(O_ALLSEEING) } then
X metaok := true
X else
X metaok := false;
X
X for i := 1 to indx.top do begin
X if not(indx.free[i]) then begin
X write(user.idents[i]);
X j := length(user.idents[i]);
X while j < 16 do begin
X write(' ');
X j := j + 1;
X end;
X
X write(pers.idents[i]);
X j := length(pers.idents[i]);
X while j <= 25 do begin
X write(' ');
X j := j + 1;
X end;
X
X if not(metaok) then begin
X roomown := own.idents[anint.int[i]];
X
X{ if a person is in a public or disowned room, or
X if they are in the domain of the WHOer, then the player should know
X where they are }
X
X if (roomown = '') or (roomown = '*') or
X (roomown = userid) then
X ok := true
X else
X ok := false;
X
X
X{ the player obviously knows where he is }
X if i = mylog then
X ok := true;
X end;
X
X
X if ok or metaok then begin
X writeln(nam.idents[anint.int[i]]);
X end else
X writeln('n/a');
X end;
X end;
Xend;
X
Xfunction own_trans(s: string): string;
X
Xbegin
X if s = '' then
X own_trans := '<public>'
X else if s = '*' then
X own_trans := '<disowned>'
X else
X own_trans := s;
Xend;
X
X
Xprocedure list_rooms(s: shortstring);
Xvar
X first: boolean;
X i,j,posit: integer;
X
Xbegin
X first := true;
X posit := 0;
X for i := 1 to indx.top do begin
X if (not indx.free[i]) and (own.idents[i] = s) then begin
X if posit = 3 then begin
X posit := 1;
X writeln;
X end else
X posit := posit + 1;
X if first then begin
X first := false;
X writeln(own_trans(s),':');
X end;
X write(' ',nam.idents[i]);
X for j := length(nam.idents[i]) to 21 do
X write(' ');
X end;
X end;
X if posit <> 3 then
X writeln;
X if first then
X writeln('No rooms owned by ',own_trans(s))
X else
X writeln;
Xend;
X
X
Xprocedure list_all_rooms;
Xvar
X i,j: integer;
X tmp: packed array[1..maxroom] of boolean;
X
Xbegin
X tmp := zero;
X list_rooms(''); { public rooms first }
X list_rooms('*'); { disowned rooms next }
X for i := 1 to indx.top do begin
X if not(indx.free[i]) and not(tmp[i]) and
X (own.idents[i] <> '') and (own.idents[i] <> '*') then begin
X list_rooms(own.idents[i]); { player rooms }
X for j := 1 to indx.top do
X if own.idents[j] = own.idents[i] then
X tmp[j] := TRUE;
X end;
X end;
Xend;
X
Xprocedure do_rooms(s: string);
Xvar
X cmd: string;
X id: veryshortstring;
X listall: boolean;
X
Xbegin
X getnam;
X freenam;
X getown;
X freeown;
X getindex(I_ROOM);
X freeindex;
X
X listall := false;
X s := lowcase(s);
X cmd := bite(s);
X if cmd = '' then
X id := userid
X else if cmd = 'public' then
X id := ''
X else if cmd = 'disowned' then
X id := '*'
X else if cmd = '<public>' then
X id := ''
X else if cmd = '<disowned>' then
X id := '*'
X else if cmd = '*' then
X listall := true
X else if length(cmd) > veryshortlen then
X id := substr(cmd,1,veryshortlen)
X else
X id := cmd;
X
X if listall then begin
X if privd then
X list_all_rooms
X else
X writeln('You may not obtain a list of all the rooms.');
X end else begin
X if privd or (userid = id) or (id = '') or (id = '*') then
X list_rooms(id)
X else
X writeln('You may not list rooms that belong to another player.');
X end;
Xend;
X
X
X
Xprocedure do_objects;
Xvar
X i: integer;
X total,public,disowned,private: integer;
X
Xbegin
X getobjnam;
X freeobjnam;
X getobjown;
X freeobjown;
X getindex(I_OBJECT);
X freeindex;
X
X total := 0;
X public := 0;
X disowned := 0;
X private := 0;
X
X writeln;
X for i := 1 to indx.top do begin
X if not(indx.free[i]) then begin
X total := total + 1;
X if objown.idents[i]='' then begin
X writeln(i:4,' ','<public>':12,' ',objnam.idents[i]);
X public := public + 1
X end else if objown.idents[i]='*' then begin
X writeln(i:4,' ','<disowned>':12,' ',objnam.idents[i]);
X disowned := disowned + 1
X end else begin
X private := private + 1;
X
X if (objown.idents[i] = userid) or
X (privd) then begin
X{ >>>>>> } writeln(i:4,' ',objown.idents[i]:12,' ',objnam.idents[i]);
X end;
X end;
X end;
X end;
X writeln;
X writeln('Public: ',public:4);
X writeln('Disowned: ',disowned:4);
X writeln('Private: ',private:4);
X writeln(' ----');
X writeln('Total: ',total:4);
Xend;
X
X
Xprocedure do_claim(s: string);
Xvar
X n: integer;
X ok: boolean;
X tmp: string;
X
Xbegin
X if length(s) = 0 then begin { claim this room }
X getroom;
X if (here.owner = '*') or (privd) then begin
X here.owner := userid;
X putroom;
X getown;
X own.idents[location] := userid;
X putown;
X log_event(myslot,E_CLAIM,0,0);
X writeln('You are now the owner of this room.');
X end else begin
X freeroom;
X if here.owner = '' then
X writeln('This is a public room. You may not claim it.')
X else
X writeln('This room has an owner.');
X end;
X end else if lookup_obj(n,s) then begin
X getobjown;
X freeobjown;
X if objown.idents[n] = '' then
X writeln('That is a public object. You may DUPLICATE it, but may not CLAIM it.')
X else if objown.idents[n] <> '*' then
X writeln('That object has an owner.')
X else begin
X getobj(n);
X freeobj;
X if obj.numexist = 0 then
X ok := true
X else begin
X if obj_hold(n) or obj_here(n) then
X ok := true
X else
X ok := false;
X end;
X
X if ok then begin
X getobjown;
X objown.idents[n] := userid;
X putobjown;
X tmp := obj.oname;
X log_event(myslot,E_OBJCLAIM,0,0,tmp);
X writeln('You are now the owner the ',tmp,'.');
X end else
X writeln('You must have one to claim it.');
X end;
X end else
X writeln('There is nothing here by that name to claim.');
Xend;
X
Xprocedure do_disown(s: string);
Xvar
X n: integer;
X tmp: string;
X
Xbegin
X if length(s) = 0 then begin { claim this room }
X getroom;
X if (here.owner = userid) or (privd) then begin
X getroom;
X here.owner := '*';
X putroom;
X getown;
X own.idents[location] := '*';
X putown;
X log_event(myslot,E_DISOWN,0,0);
X writeln('You have disowned this room.');
X end else begin
X freeroom;
X writeln('You are not the owner of this room.');
X end;
X end else begin { disown an object }
X if lookup_obj(n,s) then begin
X getobj(n);
X freeobj;
X tmp := obj.oname;
X
X getobjown;
X if objown.idents[n] = userid then begin
X objown.idents[n] := '*';
X putobjown;
X log_event(myslot,E_OBJDISOWN,0,0,tmp);
X writeln('You are no longer the owner of the ',tmp,'.');
X end else begin
X freeobjown;
X writeln('You are not the owner of any such thing.');
X end;
X end else
X writeln('You are not the owner of any such thing.');
X end;
Xend;
X
X
Xprocedure do_public(s: string);
Xvar
X ok: boolean;
X tmp: string;
X n: integer;
X
Xbegin
X if privd then begin
X if length(s) = 0 then begin
X getroom;
X here.owner := '';
X putroom;
X getown;
X own.idents[location] := '';
X putown;
X end else if lookup_obj(n,s) then begin
X getobjown;
X freeobjown;
X if objown.idents[n] = '' then
X writeln('That is already public.')
X else begin
X getobj(n);
X freeobj;
X if obj.numexist = 0 then
X ok := true
X else begin
X if obj_hold(n) or obj_here(n) then
X ok := true
X else
X ok := false;
X end;
X
X if ok then begin
X getobjown;
X objown.idents[n] := '';
X putobjown;
X
X tmp := obj.oname;
X log_event(myslot,E_OBJPUBLIC,0,0,tmp);
X writeln('The ',tmp,' is now public.');
X end else
X writeln('You must have one to claim it.');
X end;
X end else
X writeln('There is nothing here by that name to claim.');
X end else
X writeln('Only the Monster Manager may make things public.');
Xend;
X
X
X
X{ sum up the number of real exits in this room }
X
Xfunction find_numexits: integer;
Xvar
X i: integer;
X sum: integer;
X
Xbegin
X sum := 0;
X for i := 1 to maxexit do
X if here.exits[i].toloc <> 0 then
X sum := sum + 1;
X find_numexits := sum;
Xend;
X
X
X
X{ clear all people who have played monster and quit in this location
X out of the room so that when they start up again they won't be here,
X because we are destroying this room }
X
Xprocedure clear_people(loc: integer);
Xvar
X i: integer;
X
Xbegin
X getint(N_LOCATION);
X for i := 1 to maxplayers do
X if anint.int[i] = loc then
X anint.int[i] := 1;
X putint;
Xend;
X
X
Xprocedure do_zap(s: string);
Xvar
X loc: integer;
X
Xbegin
X gethere;
X if checkhide then begin
X if lookup_room(loc,s) then begin
X gethere(loc);
X if (here.owner = userid) or (privd) then begin
X clear_people(loc);
X if find_numpeople = 0 then begin
X if find_numexits = 0 then begin
X if find_numobjs = 0 then begin
X del_room(loc);
X writeln('Room deleted.');
X end else
X writeln('You must remove all of the objects from that room first.');
X end else
X writeln('You must delete all of the exits from that room first.');
X end else
X writeln('Sorry, you cannot destroy a room if people are still in it.');
X end else
X writeln('You are not the owner of that room.');
X end else
X writeln('There is no room named ',s,'.');
X end;
Xend;
X
X
Xfunction room_nameinuse(num: integer; newname: string): boolean;
Xvar
X dummy: integer;
X
Xbegin
X if exact_obj(dummy,newname) then begin
X if dummy = num then
X room_nameinuse := false
X else
X room_nameinuse := true;
X end else
X room_nameinuse := false;
Xend;
X
X
X
Xprocedure do_rename;
Xvar
X dummy: integer;
X newname: string;
X s: string;
X
Xbegin
X gethere;
X writeln('This room is named ',here.nicename);
X writeln;
X grab_line('New name: ',newname);
X if (newname = '') or (newname = '**') then
X writeln('No changes.')
X else if length(newname) > shortlen then
X writeln('Please limit your room name to ',shortlen:1,' characters.')
X else if room_nameinuse(location,newname) then
X writeln(newname,' is not a unique room name.')
X else begin
X getroom;
X here.nicename := newname;
X putroom;
X
X getnam;
X nam.idents[location] := lowcase(newname);
X putnam;
X writeln('Room name updated.');
X end;
Xend;
X
X
Xfunction obj_nameinuse(objnum: integer; newname: string): boolean;
Xvar
X dummy: integer;
X
Xbegin
X if exact_obj(dummy,newname) then begin
X if dummy = objnum then
X obj_nameinuse := false
X else
X obj_nameinuse := true;
X end else
X obj_nameinuse := false;
Xend;
X
X
Xprocedure do_objrename(objnum: integer);
Xvar
X newname: string;
X s: string;
X
Xbegin
X getobj(objnum);
X freeobj;
X
X writeln('This object is named ',obj.oname);
X writeln;
X grab_line('New name: ',newname);
X if (newname = '') or (newname = '**') then
X writeln('No changes.')
X else if length(newname) > shortlen then
X writeln('Please limit your object name to ',shortlen:1,' characters.')
X else if obj_nameinuse(objnum,newname) then
X writeln(newname,' is not a unique object name.')
X else begin
X getobj(objnum);
X obj.oname := newname;
X putobj;
X
X getobjnam;
X objnam.idents[objnum] := lowcase(newname);
X putobjnam;
X writeln('Object name updated.');
X end;
Xend;
X
X
X
Xprocedure view_room;
Xvar
X s: string;
X i: integer;
X
Xbegin
X writeln;
X getnam;
X freenam;
X getobjnam;
X freeobjnam;
X
X with here do begin
X writeln('Room: ',nicename);
X case nameprint of
X 0: writeln('Room name not printed');
X 1: writeln('"You''re in" precedes room name');
X 2: writeln('"You''re at" precedes room name');
X otherwise writeln('Room name printing is damaged.');
X end;
X
X write('Room owner: ');
X if owner = '' then
X writeln('<public>')
X else if owner = '*' then
X writeln('<disowned>')
X else
X writeln(owner);
X
X if primary = 0 then
X writeln('There is no primary description')
X else
X writeln('There is a primary description');
X
X if secondary = 0 then
X writeln('There is no secondary description')
X else
X writeln('There is a secondary description');
X
X case which of
X 0: writeln('Only the primary description will print');
X 1: writeln('Only the secondary description will print');
X 2: writeln('Both the primary and secondary descriptions will print');
X 3: begin
X writeln('The primary description will print, followed by the seconary description');
X writeln('if the player is holding the magic object');
X end;
X 4: begin
X writeln('If the player is holding the magic object, the secondary description will print');
X writeln('Otherwise, the primary description will print');
X end;
X otherwise writeln('The way the room description prints is damaged');
X end;
X
X writeln;
X if magicobj = 0 then
X writeln('There is no magic object for this room')
X else
X writeln('The magic object for this room is the ',objnam.idents[magicobj],'.');
X
X if objdrop = 0 then
X writeln('Dropped objects remain here')
X else begin
X writeln('Dropped objects go to ',nam.idents[objdrop],'.');
X if objdesc = 0 then
X writeln('Dropped.')
X else
X print_line(objdesc);
X if objdest = 0 then
X writeln('Nothing is printed when object "bounces in" to target room')
X else
X print_line(objdest);
X end;
X writeln;
X if trapto = 0 then
X writeln('There is no trapdoor set')
X else
X writeln('The trapdoor sends players ',direct[trapto],
X ' with a chance factor of ',trapchance:1,'%');
X
X for i := 1 to maxdetail do begin
X if length(detail[i]) > 0 then begin
X write('Detail "',detail[i],'" ');
X if detaildesc[i] > 0 then
X writeln('has a description')
X else
X writeln('has no description');
X end;
X end;
X writeln;
X end;
Xend;
X
X
Xprocedure room_help;
X
Xbegin
X writeln;
X writeln('D Alter the way the room description prints');
X writeln('N Change how the room Name prints');
X writeln('P Edit the Primary room description [the default one] (same as desc)');
X writeln('S Edit the Secondary room description');
X writeln('X Define a mystery message');
X writeln;
X writeln('G Set the location that a dropped object really Goes to');
X writeln('O Edit the object drop description (for drop effects)');
X writeln('B Edit the target room (G) "bounced in" description');
X writeln;
X writeln('T Set the direction that the Trapdoor goes to');
X writeln('C Set the Chance of the trapdoor functioning');
X writeln;
X writeln('M Define the magic object for this room');
X writeln('R Rename the room');
X writeln;
X writeln('V View settings on this room');
X writeln('E Exit (same as quit)');
X writeln('Q Quit (same as exit)');
X writeln('? This list');
X writeln;
Xend;
X
X
X
Xprocedure custom_room;
Xvar
X done: boolean;
X prompt: string;
X n: integer;
X s: string;
X newdsc: integer;
X bool: boolean;
X
Xbegin
X log_action(e_custroom,0);
X writeln;
X writeln('Customizing this room');
X writeln('If you would rather be customizing an exit, type CUSTOM <direction of exit>');
X writeln('If you would rather be customizing an object, type CUSTOM <object name>');
X writeln;
X done := false;
X prompt := 'Custom> ';
X
X repeat
X repeat
X grab_line(prompt,s);
X s := slead(s);
X until length(s) > 0;
X s := lowcase(s);
X case s[1] of
X
X 'e','q': done := true;
X '?','h': room_help;
X 'r': do_rename;
X 'v': view_room;
X{dir trapdoor goes} 't': begin
X grab_line('What direction does the trapdoor exit through? ',s);
X if length(s) > 0 then begin
X if lookup_dir(n,s) then begin
X getroom;
X here.trapto := n;
X putroom;
X writeln('Room updated.');
X end else
X writeln('No such direction.');
X end else
X writeln('No changes.');
X end;
X{chance} 'c': begin
X writeln('Enter the chance that in any given minute the player will fall through');
X writeln('the trapdoor (0-100) :');
X writeln;
X grab_line('? ',s);
X if isnum(s) then begin
X n := number(s);
X if n in [0..100] then begin
X getroom;
X here.trapchance := n;
X putroom;
X end else
X writeln('Out of range.');
X end else
X writeln('No changes.');
X end;
X 's': begin
X newdsc := here.secondary;
X writeln('[ Editing the secondary room description ]');
X if edit_desc(newdsc) then begin
X getroom;
X here.secondary := newdsc;
X putroom;
X end;
X end;
X 'p': begin
X{ same as desc } newdsc := here.primary;
X writeln('[ Editing the primary room description ]');
X if edit_desc(newdsc) then begin
X getroom;
X here.primary := newdsc;
X putroom;
X end;
X end;
X 'o': begin
X writeln('Enter the line that will be printed when someone drops an object here:');
X writeln('If dropped objects do not stay here, you may use a # for the object name.');
X writeln('Right now it says:');
X if here.objdesc = 0 then
X writeln('Dropped. [default]')
X else
X print_line(here.objdesc);
X
X n := here.objdesc;
X make_line(n);
X getroom;
X here.objdesc := n;
X putroom;
X end;
X 'x': begin
X writeln('Enter a line that will be randomly shown.');
X writeln('Right now it says:');
X if here.objdesc = 0 then
X writeln('[none defined]')
X else
X print_line(here.rndmsg);
X
X n := here.rndmsg;
X make_line(n);
X getroom;
X here.rndmsg := n;
X putroom;
X end;
X{bounced in desc} 'b': begin
X writeln('Enter the line that will be displayed in the room where an object really');
X writeln('goes when an object dropped here "bounces" there:');
X writeln('Place a # where the object name should go.');
X writeln;
X writeln('Right now it says:');
X if here.objdest = 0 then
X writeln('Something has bounced into the room.')
X else
X print_line(here.objdest);
X
X n := here.objdest;
X make_line(n);
X getroom;
X here.objdest := n;
X putroom;
X end;
X 'm': begin
X getobjnam;
X freeobjnam;
X if here.magicobj = 0 then
X writeln('There is currently no magic object for this room.')
X else
X writeln(objnam.idents[here.magicobj],
X ' is currently the magic object for this room.');
X writeln;
X grab_line('New magic object? ',s);
X if s = '' then
X writeln('No changes.')
X else if lookup_obj(n,s) then begin
X getroom;
X here.magicobj := n;
X putroom;
X writeln('Room updated.');
X end else
X writeln('No such object found.');
X end;
X 'g': begin
X getnam;
X freenam;
X if here.objdrop = 0 then
X writeln('Objects dropped fall here.')
X else
X writeln('Objects dropped fall in ',nam.idents[here.objdrop],'.');
X writeln;
X writeln('Enter * for [this room]:');
X grab_line('Room dropped objects go to? ',s);
X if s = '' then
X writeln('No changes.')
X else if s = '*' then begin
X getroom;
X here.objdrop := 0;
X putroom;
X writeln('Room updated.');
X end else if lookup_room(n,s) then begin
X getroom;
X here.objdrop := n;
X putroom;
X writeln('Room updated.');
X end else
X writeln('No such room found.');
X end;
X 'd': begin
X writeln('Print room descriptions how?');
X writeln;
X writeln('0) Print primary (main) description only [default]');
X writeln('1) Print only secondary description.');
X writeln('2) Print both primary and secondary descriptions togther.');
X writeln('3) Print primary description first; then print secondary description only if');
X writeln(' the player is holding the magic object for this room.');
X writeln('4) Print secondary if holding the magic obj; print primary otherwise');
X writeln;
X grab_line('? ',s);
X if isnum(s) then begin
X n := number(s);
X if n in [0..4] then begin
X getroom;
X here.which := n;
X putroom;
X writeln('Room updated.');
X end else
X writeln('Out of range.');
X end else
X writeln('No changes.');
X
X end;
X 'n': begin
X writeln('How would you like the room name to print?');
X writeln;
X writeln('0) No room name is shown');
X writeln('1) "You''re in ..."');
X writeln('2) "You''re at ..."');
X writeln;
X grab_line('? ',s);
X if isnum(s) then begin
X n := number(s);
X if n in [0..2] then begin
X getroom;
X here.nameprint := n;
X putroom;
X end else
X writeln('Out of range.');
X end else
X writeln('No changes.');
X end;
X otherwise writeln('Bad command, type ? for a list');
X end;
X until done;
X log_event(myslot,E_ROOMDONE,0,0);
Xend;
X
Xprocedure analyze_exit(dir: integer);
Xvar
X s: string;
X
Xbegin
X writeln;
X getnam;
X freenam;
X getobjnam;
X freeobjnam;
X with here.exits[dir] do begin
X s := alias;
X if s = '' then
X s := '(no alias)'
X else
X s := '(alias ' + s + ')';
X if here.exits[dir].reqalias then
X s := s + ' (required)'
X else
X s := s + ' (not required)';
X
X if toloc <> 0 then
X writeln('The ',direct[dir],' exit ',s,' goes to ',nam.idents[toloc])
X else
X writeln('The ',direct[dir],' exit goes nowhere.');
X if hidden <> 0 then
X writeln('Concealed.');
X write('Exit type: ');
X case kind of
X 0: writeln('no exit.');
X 1: writeln('Open passage.');
X 2: writeln('Door, object required to pass.');
X 3: writeln('No passage if holding object.');
X 4: writeln('Randomly fails');
X 5: writeln('Potential exit.');
X 6: writeln('Only exists while holding the required object.');
X 7: writeln('Timed exit');
X end;
X if objreq = 0 then
X writeln('No required object.')
X else
X writeln('Required object is: ',objnam.idents[objreq]);
X
X
X writeln;
X if exitdesc = DEFAULT_LINE then
X exit_default(dir,kind)
X else
X print_line(exitdesc);
X
X if success = 0 then
X writeln('(no success message)')
X else
X print_desc(success);
X
X if fail = DEFAULT_LINE then begin
X if kind = 5 then
X writeln('There isn'' an exit there yet.')
X else
X writeln('You can''t go that way.');
X end else
X print_desc(fail);
X
X if comeout = DEFAULT_LINE then
X writeln('# has come into the room from: ',direct[dir])
X else
X print_desc(comeout);
X if goin = DEFAULT_LINE then
X writeln('# has gone ',direct[dir])
X else
X print_desc(goin);
X
X writeln;
X if autolook then
X writeln('LOOK automatically done after exit used')
X else
X writeln('LOOK supressed on exit use');
X if reqverb then
X writeln('The alias is required to be a verb for exit use')
X else
X writeln('The exit can be used with GO or as a verb');
X end;
X writeln;
Xend;
X
Xprocedure custom_help;
X
Xbegin
X writeln;
X writeln('A Set an Alias for the exit');
X writeln('C Conceal an exit');
X writeln('D Edit the exit''s main Description');
X writeln('E EXIT custom (saves changes)');
X writeln('F Edit the exit''s failure line');
X writeln('I Edit the line that others see when a player goes Into an exit');
X writeln('K Set the object that is the Key to this exit');
X writeln('L Automatically look [default] / don''t look on exit');
X writeln('O Edit the line that people see when a player comes Out of an exit');
X writeln('Q QUIT Custom (saves changes)');
X writeln('R Require/don''t require alias for exit; ignore direction');
X writeln('S Edit the success line');
X writeln('T Alter Type of exit (passage, door, etc)');
X writeln('V View exit information');
X writeln('X Require/don''t require exit name to be a verb');
X writeln('? This list');
X writeln;
Xend;
X
X
Xprocedure get_key(dir: integer);
Xvar
X s: string;
X n: integer;
X
Xbegin
X getobjnam;
X freeobjnam;
X if here.exits[dir].objreq = 0 then
X writeln('Currently there is no key set for this exit.')
X else
X writeln(objnam.idents[here.exits[dir].objreq],' is the current key for this exit.');
X writeln('Enter * for [no key]');
X writeln;
X
X grab_line('What object is the door key? ',s);
X if length(s) > 0 then begin
X if s = '*' then begin
X getroom;
X here.exits[dir].objreq := 0;
X putroom;
X writeln('Exit updated.');
X end else if lookup_obj(n,s) then begin
X getroom;
X here.exits[dir].objreq := n;
X putroom;
X writeln('Exit updated.');
X end else
X writeln('There is no object by that name.');
X end else
X writeln('No changes.');
Xend;
X
END_OF_FILE
if test 54281 -ne `wc -c <'mon3.pas'`; then
echo shar: \"'mon3.pas'\" unpacked with wrong size!
fi
# end of 'mon3.pas'
fi
if test -f 'privusers.pas' -a "${1}" != "-c" ; then
echo shar: Will not clobber existing file \"'privusers.pas'\"
else
echo shar: Extracting \"'privusers.pas'\" \(880 characters\)
sed "s/^X//" >'privusers.pas' <<'END_OF_FILE'
X{ These are PRIVILEDGED users. The Monster Manager has the most power;
X this should be the game administrator. The Monster Vice Manager can help
X the MM in his adminstrative duties. Faust is another person who can do
X anything but is generally incognito. }
X
XMM_userid = 'dolpher'; { Monster Manager }
XMVM_userid = 'gary'; { Monster Vice Manager }
XFAUST_userid = 'skrenta'; { Dr. Faustus }
X
XREBUILD_OK = TRUE; { if this is TRUE, the MM can blow away
X and reformat the entire universe. It's
X a good idea to set this to FALSE and
X recompile after you've got your world
X going }
X
X
Xroot = 'USERC:[ISP00475.CRA01453.DSYS]';
X { this is where the Monster database goes
X This directory and the datafiles Monster
X creates in it must be world:rw for
X people to be able to play. This sucks,
X but we don't have setgid to games on VMS }
END_OF_FILE
if test 880 -ne `wc -c <'privusers.pas'`; then
echo shar: \"'privusers.pas'\" unpacked with wrong size!
fi
# end of 'privusers.pas'
fi
echo shar: End of archive 5 \(of 6\).
cp /dev/null ark5isdone
MISSING=""
for I in 1 2 3 4 5 6 ; do
if test ! -f ark${I}isdone ; then
MISSING="${MISSING} ${I}"
fi
done
if test "${MISSING}" = "" ; then
echo You have unpacked all 6 archives.
rm -f ark[1-9]isdone
./fixup.sh
else
echo You still need to unpack the following archives:
echo " " ${MISSING}
fi
## End of shell archive.
exit 0