Usenet 1994 January/usenetsourcesnewsgroupsinfomagicjanuary1994.iso/sources/games/volume5/monster/part05/mon3.pas

Pascal/Delphi Source File | 1988-11-30 | 54KB | 2,434 lines

{ 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(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 relink exit into? ',targnam)
            else
                firsttime := false;

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

    if ok then begin
        repeat
            writeln('New 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 }
        relink_room(origdir,targdir,targroom);
    end;
    end;
end;


{ print the room default no-go message if there is one;
  otherwise supply the generic "you can't go that way" }

procedure default_fail;

begin
    if (here.exitfail <> 0) and (here.exitfail <> DEFAULT_LINE) then
        print_desc(here.exitfail)
    else
        writeln('You can''t go that way.');
end;

procedure  exit_fail(dir: integer);
var
    tmp: string;

begin
    if (dir < 1) or (dir > maxexit) then
        default_fail
    else if (here.exits[dir].fail = DEFAULT_LINE) then begin
        case here.exits[dir].kind of
            5: writeln('There isn''t an exit there yet.');
            6: writeln('You don''t have the power to go there.');
            otherwise default_fail;
        end;
    end else if here.exits[dir].fail <> 0 then
        block_subs(here.exits[dir].fail,myname);


{ now print the exit failure message for everyone else in the room:
    if they tried to go through a valid exit,
      and the exit has an other-person failure desc, then
        substitute that one & use;

    if there is a room default other-person failure desc, then
        print that;

    if they tried to go through a valid exit,
      and the exit has no required alias, then
        print default exit fail
    else
        print generic "didn't leave room" message

cases:
1) valid/alias exit and specific fail message
2) valid/alias exit and blanket fail message
3) valid exit (no specific or blanket) "x fails to go [direct]"
4) alias exit and blanket fail
5) blanket fail
6) generic fail
}

    if dir <> 0 then
        log_event(myslot,E_FAILGO,dir,0);
end;



procedure do_exit; { (exit_slot: integer)-- declared forward }
var
    orig_slot,
    targ_slot,
    orig_room,
    enter_slot,
    targ_room: integer;
    doalook: boolean;

begin
    if (exit_slot < 1) or (exit_slot > 6) then
        exit_fail(exit_slot)
    else if here.exits[exit_slot].toloc > 0 then begin
        block_subs(here.exits[exit_slot].success,myname);

        orig_slot := myslot;
        orig_room := location;
        targ_room := here.exits[exit_slot].toloc;
        enter_slot := here.exits[exit_slot].slot;
        doalook := here.exits[exit_slot].autolook;

                { optimization for exit that goes nowhere;
                  why go nowhere?  For special effects, we
                  don't want it to take too much time,
                  the logs are important because they force the
                  exit descriptions, but actually moving the
                  player is unnecessary }

        if orig_room = targ_room then begin
            log_exit(exit_slot,orig_room,orig_slot);
            log_entry(enter_slot,targ_room,orig_slot);
                { orig_slot in log_entry 'cause we're not
                  really going anwhere }
            if doalook then
                do_look;
        end else begin
            take_token(orig_slot,orig_room);
            if not put_token(targ_room,targ_slot) then begin
                    { no room in room! }
{ put them back! Quick! }    if not put_token(orig_room,myslot) then begin
                    writeln('%Oh no!');
                    halt;
                end;
            end else begin
                log_exit(exit_slot,orig_room,orig_slot);
                log_entry(enter_slot,targ_room,targ_slot);

                myslot := targ_slot;
                location := targ_room;
                setevent;

                if doalook then
                    do_look;
            end;
        end;
    end else
        exit_fail(exit_slot);
end;



function cycle_open: boolean;
var
    ch: char;
    s: string;

begin
    s := systime;
    ch := s[5];
    if ch in ['1','3','5','7','9'] then
        cycle_open := true
    else
        cycle_open := false;
end;


function which_dir(var dir:integer;s: string): boolean;
var
    aliasdir, exitdir: integer;
    aliasmatch,exitmatch,
    aliasexact,exitexact: boolean;
    exitreq: boolean;

begin
    s := lowcase(s);
    if lookup_alias(aliasdir,s) then
        aliasmatch := true
    else
        aliasmatch := false;
    if lookup_dir(exitdir,s) then
        exitmatch := true
    else
        exitmatch := false;
    if aliasmatch then begin
        if s = here.exits[aliasdir].alias then
            aliasexact := true
        else
            aliasexact := false;
    end else
        aliasexact := false;
    if exitmatch then begin
        if (s = direct[exitdir]) or (s = substr(direct[exitdir],1,1)) then
            exitexact := true
        else
            exitexact := false;
    end else
        exitexact := false;
    if exitmatch then
        exitreq := here.exits[exitdir].reqalias
    else
        exitreq := false;

    dir := 0;
    which_dir := true;
    if aliasexact and exitexact then
        dir := aliasdir
    else if aliasexact then
        dir := aliasdir
    else if exitexact and not exitreq then
        dir := exitdir
    else if aliasmatch then
        dir := aliasdir
    else if exitmatch and not exitreq then
        dir := exitdir
    else if exitmatch and exitreq then begin
        dir := exitdir;
        which_dir := false;
    end else begin
        which_dir := false;
    end;
end;


procedure exit_case(dir: integer);

begin
    case here.exits[dir].kind of
        0: exit_fail(dir);
        1: do_exit(dir);  { more checking goes here }

        3: if obj_hold(here.exits[dir].objreq) then
            exit_fail(dir)
           else
            do_exit(dir);
        4: if rnd100 < 34 then
            do_exit(dir)
           else
            exit_fail(dir);

        2: begin
            if obj_hold(here.exits[dir].objreq) then
                do_exit(dir)
            else
                exit_fail(dir);
           end;
        6: if obj_hold(here.exits[dir].objreq) then
            do_exit(dir)
             else
            exit_fail(dir);
        7: if cycle_open then
            do_exit(dir)
           else
        exit_fail(dir);
    end;
end;

{
Player wants to go to s
Handle everthing, this is the top level procedure

Check that he can go to s
Put him through the exit    ( in do_exit )
Do a look for him        ( in do_exit )
}
procedure do_go(s: string;verb:boolean := true);
var
    dir: integer;

begin
    gethere;
    if checkhide then begin
        if length(s) = 0 then
            writeln('You must give the direction you wish to travel.')
        else begin
            if which_dir(dir,s) then begin
                if (dir >= 1) and (dir <= maxexit) then begin
                    if here.exits[dir].toloc = 0 then begin
                        exit_fail(dir);
                    end else begin
                        exit_case(dir);
                    end;
                end else
                    exit_fail(dir);
            end else
                exit_fail(dir);
        end;
    end;
end;


procedure nice_say(var s: string);

begin
        { capitalize the first letter of their sentence }

    if s[1] in ['a'..'z'] then
        s[1] := chr( ord('A') + (ord(s[1]) - ord('a')) );

            { put a period on the end of their sentence if
              they don't use any punctuation. }

    if s[length(s)] in ['a'..'z','A'..'Z'] then
        s := s + '.';
end;


procedure do_say(s:string);

begin
    if length(s) > 0 then begin

{        if length(s) + length(myname) > 79 then begin
            s := substr(s,1,75-length(myname));
            writeln('Your message was truncated:');
            writeln('-- ',s);
        end;                    }

        nice_say(s);
        if hiding then
            log_event(myslot,E_HIDESAY,0,0,s)
        else
            log_event(myslot,E_SAY,0,0,s);
    end else
        writeln('To talk to others in the room, type SAY <message>.');
end;

procedure do_setname(s: string);
var
    notice: string;
    ok: boolean;
    dummy: integer;
    sprime: string;

begin
    gethere;
    if s <> '' then begin
    if length(s) <= shortlen then begin
        sprime := lowcase(s);
        if (sprime = 'monster manager') and (userid <> MM_userid) then begin
            writeln('Only the Monster Manager can have that personal name.');
            ok := false;
        end else if (sprime = 'vice manager') and (userid <> MVM_userid) then begin
            writeln('Only the Vice Manager can have that name.');
            ok := false;
        end else if (sprime = 'faust') and (userid <> FAUST_userid) then begin
            writeln('You are not Faust!  You may not have that name.');
            ok := false;
        end else
            ok := true;

        if ok then
            if exact_pers(dummy,sprime) then begin
                if dummy = myslot then
                    ok := true
                else begin
                    writeln('Someone already has that name.  Your personal name must be unique.');
                    ok := false;
                end;
            end;

        if ok then begin
            myname := s;
            getroom;
            notice := here.people[myslot].name;
            here.people[myslot].name := s;
            putroom;
            notice := notice + ' is now known as ' + s;

            if not(hiding) then
                log_event(0,E_SETNAM,0,0,notice);
                    { slot 0 means notify this player also }

            getpers;    { note the new personal name in the logfile }
            pers.idents[mylog] := s; { don't lowcase it }
            putpers;
        end;
    end else
        writeln('Please limit your personal name to ',shortlen:1,' characters.');
    end else
        writeln('You are known to others as ',myname);
end;

function sysdate:string;
var
    thedate: packed array[1..11] of char;

begin
    date(thedate);
    sysdate := thedate;
end;


{
1234567890123456789012345678901234567890
example display for alignment:

       Monster Status
    19-MAR-1988 08:59pm

}

procedure do_who;
var
    i,j: integer;
    ok: boolean;
    metaok: boolean;
    roomown: veryshortstring;

begin
    log_event(myslot,E_WHO,0,(rnd100 mod 4));

    { we need just about everything to print this list:
        player alloc index, userids, personal names,
        room names, room owners, and the log record    }

    getindex(I_ASLEEP);    { Get index of people who are playing now }
    freeindex;
    getuser;
    freeuser;
    getpers;
    freepers;
    getnam;
    freenam;
    getown;
    freeown;
    getint(N_LOCATION);    { get where they are }
    freeint;
    writeln('                   Monster Status');
    writeln('                ',sysdate,' ',systime);
    writeln;
    writeln('Username        Game Name                 Where');

    if (privd) { or has_kind(O_ALLSEEING) } then
        metaok := true
    else
        metaok := false;

    for i := 1 to indx.top do begin
        if not(indx.free[i]) then begin
            write(user.idents[i]);
            j := length(user.idents[i]);
            while j < 16 do begin
                write(' ');
                j := j + 1;
            end;

            write(pers.idents[i]);
            j := length(pers.idents[i]);
            while j <= 25 do begin
                write(' ');
                j := j + 1;
            end;

            if not(metaok) then begin
                roomown := own.idents[anint.int[i]];

{ if a person is in a public or disowned room, or
  if they are in the domain of the WHOer, then the player should know
  where they are  }

                if (roomown = '') or (roomown = '*') or
                    (roomown = userid) then
                    ok := true
                else
                    ok := false;


{ the player obviously knows where he is }
                if i = mylog then
                    ok := true;
            end;


            if ok or metaok then begin
                writeln(nam.idents[anint.int[i]]);
            end else
                writeln('n/a');
        end;
    end;
end;

function own_trans(s: string): string;

begin
    if s = '' then
        own_trans := '<public>'
    else if s = '*' then
        own_trans := '<disowned>'
    else
        own_trans := s;
end;


procedure list_rooms(s: shortstring);
var
    first: boolean;
    i,j,posit: integer;

begin
    first := true;
    posit := 0;
    for i := 1 to indx.top do begin
        if (not indx.free[i]) and (own.idents[i] = s) then begin
            if posit = 3 then begin
                posit := 1;
                writeln;
            end else
                posit := posit + 1;
            if first then begin
                first := false;
                writeln(own_trans(s),':');
            end;
            write('    ',nam.idents[i]);
            for j := length(nam.idents[i]) to 21 do
                write(' ');
        end;
    end;
    if posit <> 3 then
        writeln;
    if first then
        writeln('No rooms owned by ',own_trans(s))
    else
        writeln;
end;


procedure list_all_rooms;
var
    i,j: integer;
    tmp: packed array[1..maxroom] of boolean;

begin
    tmp := zero;
    list_rooms('');        { public rooms first }
    list_rooms('*');    { disowned rooms next }
    for i := 1 to indx.top do begin
        if not(indx.free[i]) and not(tmp[i]) and
           (own.idents[i] <> '') and (own.idents[i] <> '*') then begin
                list_rooms(own.idents[i]);    { player rooms }
                for j := 1 to indx.top do
                    if own.idents[j] = own.idents[i] then
                        tmp[j] := TRUE;
        end;
    end;
end;

procedure do_rooms(s: string);
var
    cmd: string;
    id: veryshortstring;
    listall: boolean;

begin
    getnam;
    freenam;
    getown;
    freeown;
    getindex(I_ROOM);
    freeindex;

    listall := false;
    s := lowcase(s);
    cmd := bite(s);
    if cmd = '' then
        id := userid
    else if cmd = 'public' then
        id := ''
    else if cmd = 'disowned' then
        id := '*'
    else if cmd = '<public>' then
        id := ''
    else if cmd = '<disowned>' then
        id := '*'
    else if cmd = '*' then
        listall := true
    else if length(cmd) > veryshortlen then
        id := substr(cmd,1,veryshortlen)
    else
        id := cmd;

    if listall then begin
        if privd then
            list_all_rooms
        else
            writeln('You may not obtain a list of all the rooms.');
    end else begin
        if privd or (userid = id) or (id = '') or (id = '*') then
            list_rooms(id)
        else
            writeln('You may not list rooms that belong to another player.');
    end;
end;



procedure do_objects;
var
    i: integer;
    total,public,disowned,private: integer;

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

    total := 0;
    public := 0;
    disowned := 0;
    private := 0;

    writeln;
    for i := 1 to indx.top do begin
        if not(indx.free[i]) then begin
            total := total + 1;
            if objown.idents[i]='' then begin
                writeln(i:4,'    ','<public>':12,'    ',objnam.idents[i]);
                public := public + 1
            end else if objown.idents[i]='*' then begin
                writeln(i:4,'    ','<disowned>':12,'    ',objnam.idents[i]);
                disowned := disowned + 1
            end else begin
                private := private + 1;

                if (objown.idents[i] = userid) or
                 (privd) then begin
{ >>>>>> }    writeln(i:4,'    ',objown.idents[i]:12,'    ',objnam.idents[i]);
                end;
            end;
        end;
    end;
    writeln;
    writeln('Public:      ',public:4);
    writeln('Disowned:    ',disowned:4);
    writeln('Private:     ',private:4);
    writeln('             ----');
    writeln('Total:       ',total:4);
end;


procedure do_claim(s: string);
var
    n: integer;
    ok: boolean;
    tmp: string;

begin
    if length(s) = 0 then begin    { claim this room }
        getroom;
        if (here.owner = '*') or (privd) then begin
            here.owner := userid;
            putroom;
            getown;
            own.idents[location] := userid;
            putown;
            log_event(myslot,E_CLAIM,0,0);
            writeln('You are now the owner of this room.');
        end else begin
            freeroom;
            if here.owner = '' then
                writeln('This is a public room.  You may not claim it.')
            else
                writeln('This room has an owner.');
        end;
    end else if lookup_obj(n,s) then begin
        getobjown;
        freeobjown;
        if objown.idents[n] = '' then
            writeln('That is a public object.  You may DUPLICATE it, but may not CLAIM it.')
        else if objown.idents[n] <> '*' then
            writeln('That object has an owner.')
        else begin
            getobj(n);
            freeobj;
            if obj.numexist = 0 then
                ok := true
            else begin
                if obj_hold(n) or obj_here(n) then
                    ok := true
                else
                    ok := false;
            end;

            if ok then begin
                getobjown;
                objown.idents[n] := userid;
                putobjown;
                tmp := obj.oname;
                log_event(myslot,E_OBJCLAIM,0,0,tmp);
                writeln('You are now the owner the ',tmp,'.');
            end else
                writeln('You must have one to claim it.');
        end;
    end else
        writeln('There is nothing here by that name to claim.');
end;

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

begin
    if length(s) = 0 then begin    { claim this room }
        getroom;
        if (here.owner = userid) or (privd) then begin
            getroom;
            here.owner := '*';
            putroom;
            getown;
            own.idents[location] := '*';
            putown;
            log_event(myslot,E_DISOWN,0,0);
            writeln('You have disowned this room.');
        end else begin
            freeroom;
            writeln('You are not the owner of this room.');
        end;
    end else begin    { disown an object }
        if lookup_obj(n,s) then begin
            getobj(n);
            freeobj;
            tmp := obj.oname;

            getobjown;
            if objown.idents[n] = userid then begin
                objown.idents[n] := '*';
                putobjown;
                log_event(myslot,E_OBJDISOWN,0,0,tmp);
                writeln('You are no longer the owner of the ',tmp,'.');
            end else begin
                freeobjown;
                writeln('You are not the owner of any such thing.');
            end;
        end else
            writeln('You are not the owner of any such thing.');
    end;
end;


procedure do_public(s: string);
var
    ok: boolean;
    tmp: string;
    n: integer;

begin
    if privd then begin
        if length(s) = 0 then begin
            getroom;
            here.owner := '';
            putroom;
            getown;
            own.idents[location] := '';
            putown;
        end else if lookup_obj(n,s) then begin
            getobjown;
            freeobjown;
            if objown.idents[n] = '' then
                writeln('That is already public.')
            else begin
                getobj(n);
                freeobj;
                if obj.numexist = 0 then
                    ok := true
                else begin
                    if obj_hold(n) or obj_here(n) then
                        ok := true
                    else
                        ok := false;
                end;

                if ok then begin
                    getobjown;
                    objown.idents[n] := '';
                    putobjown;

                    tmp := obj.oname;
                    log_event(myslot,E_OBJPUBLIC,0,0,tmp);
                    writeln('The ',tmp,' is now public.');
                end else
                    writeln('You must have one to claim it.');
            end;
        end else
            writeln('There is nothing here by that name to claim.');
    end else
        writeln('Only the Monster Manager may make things public.');
end;



{ sum up the number of real exits in this room }

function find_numexits: integer;
var
    i: integer;
    sum: integer;

begin
    sum := 0;
    for i := 1 to maxexit do
        if here.exits[i].toloc <> 0 then
            sum := sum + 1;
    find_numexits := sum;
end;



{ clear all people who have played monster and quit in this location
  out of the room so that when they start up again they won't be here,
  because we are destroying this room }

procedure clear_people(loc: integer);
var
    i: integer;

begin
    getint(N_LOCATION);
    for i := 1 to maxplayers do
        if anint.int[i] = loc then
            anint.int[i] := 1;
    putint;
end;


procedure do_zap(s: string);
var
    loc: integer;

begin
    gethere;
    if checkhide then begin
    if lookup_room(loc,s) then begin
        gethere(loc);
        if (here.owner = userid) or (privd) then begin
            clear_people(loc);
            if find_numpeople = 0 then begin
                if find_numexits = 0 then begin
                    if find_numobjs = 0 then begin
                        del_room(loc);
                        writeln('Room deleted.');
                    end else
                        writeln('You must remove all of the objects from that room first.');
                end else
                    writeln('You must delete all of the exits from that room first.');
            end else
                writeln('Sorry, you cannot destroy a room if people are still in it.');
        end else
            writeln('You are not the owner of that room.');
    end else
        writeln('There is no room named ',s,'.');
    end;
end;


function room_nameinuse(num: integer; newname: string): boolean;
var
    dummy: integer;

begin
    if exact_obj(dummy,newname) then begin
        if dummy = num then
            room_nameinuse := false
        else
            room_nameinuse := true;
    end else
        room_nameinuse := false;
end;



procedure do_rename;
var
    dummy: integer;
    newname: string;
    s: string;

begin
    gethere;
    writeln('This room is named ',here.nicename);
    writeln;
    grab_line('New name: ',newname);
    if (newname = '') or (newname = '**') then
        writeln('No changes.')
    else if length(newname) > shortlen then
        writeln('Please limit your room name to ',shortlen:1,' characters.')
    else if room_nameinuse(location,newname) then
        writeln(newname,' is not a unique room name.')
    else begin
        getroom;
        here.nicename := newname;
        putroom;

        getnam;
        nam.idents[location] := lowcase(newname);
        putnam;
        writeln('Room name updated.');
    end;
end;


function obj_nameinuse(objnum: integer; newname: string): boolean;
var
    dummy: integer;

begin
    if exact_obj(dummy,newname) then begin
        if dummy = objnum then
            obj_nameinuse := false
        else
            obj_nameinuse := true;
    end else
        obj_nameinuse := false;
end;


procedure do_objrename(objnum: integer);
var
    newname: string;
    s: string;

begin
    getobj(objnum);
    freeobj;

    writeln('This object is named ',obj.oname);
    writeln;
    grab_line('New name: ',newname);
    if (newname = '') or (newname = '**') then
        writeln('No changes.')
    else if length(newname) > shortlen then
        writeln('Please limit your object name to ',shortlen:1,' characters.')
    else if obj_nameinuse(objnum,newname) then
        writeln(newname,' is not a unique object name.')
    else begin
        getobj(objnum);
        obj.oname := newname;
        putobj;

        getobjnam;
        objnam.idents[objnum] := lowcase(newname);
        putobjnam;
        writeln('Object name updated.');
    end;
end;



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

begin
    writeln;
    getnam;
    freenam;
    getobjnam;
    freeobjnam;

    with here do begin
        writeln('Room:        ',nicename);
        case nameprint of
            0: writeln('Room name not printed');
            1: writeln('"You''re in" precedes room name');
            2: writeln('"You''re at" precedes room name');
            otherwise writeln('Room name printing is damaged.');
        end;

        write('Room owner:    ');
        if owner = '' then
            writeln('<public>')
        else if owner = '*' then
            writeln('<disowned>')
        else
            writeln(owner);

        if primary = 0 then
            writeln('There is no primary description')
        else
            writeln('There is a primary description');

        if secondary = 0 then
            writeln('There is no secondary description')
        else
            writeln('There is a secondary description');

        case which of
            0: writeln('Only the primary description will print');
            1: writeln('Only the secondary description will print');
            2: writeln('Both the primary and secondary descriptions will print');
            3: begin
                writeln('The primary description will print, followed by the seconary description');
                writeln('if the player is holding the magic object');
               end;
            4: begin
                writeln('If the player is holding the magic object, the secondary description will print');
                writeln('Otherwise, the primary description will print');
               end;
            otherwise writeln('The way the room description prints is damaged');
        end;

        writeln;
        if magicobj = 0 then
            writeln('There is no magic object for this room')
        else
            writeln('The magic object for this room is the ',objnam.idents[magicobj],'.');

        if objdrop = 0 then
            writeln('Dropped objects remain here')
        else begin
            writeln('Dropped objects go to ',nam.idents[objdrop],'.');
            if objdesc = 0 then
                writeln('Dropped.')
            else
                print_line(objdesc);
            if objdest = 0 then
                writeln('Nothing is printed when object "bounces in" to target room')
            else
                print_line(objdest);
        end;
        writeln;
        if trapto = 0 then
            writeln('There is no trapdoor set')
        else
            writeln('The trapdoor sends players ',direct[trapto],
                ' with a chance factor of ',trapchance:1,'%');

        for i := 1 to maxdetail do begin
            if length(detail[i]) > 0 then begin
                write('Detail "',detail[i],'" ');
                if detaildesc[i] > 0 then
                    writeln('has a description')
                else
                    writeln('has no description');
            end;
        end;
        writeln;
    end;
end;


procedure room_help;

begin
    writeln;
    writeln('D    Alter the way the room description prints');
    writeln('N    Change how the room Name prints');
    writeln('P    Edit the Primary room description [the default one] (same as desc)');
    writeln('S    Edit the Secondary room description');
    writeln('X    Define a mystery message');
    writeln;
    writeln('G    Set the location that a dropped object really Goes to');
    writeln('O    Edit the object drop description (for drop effects)');
    writeln('B    Edit the target room (G) "bounced in" description');
    writeln;
    writeln('T    Set the direction that the Trapdoor goes to');
    writeln('C    Set the Chance of the trapdoor functioning');
    writeln;
    writeln('M    Define the magic object for this room');
    writeln('R    Rename the room');
    writeln;
    writeln('V    View settings on this room');
    writeln('E    Exit (same as quit)');
    writeln('Q    Quit (same as exit)');
    writeln('?    This list');
    writeln;
end;



procedure custom_room;
var
    done: boolean;
    prompt: string;
    n: integer;
    s: string;
    newdsc: integer;
    bool: boolean;

begin
    log_action(e_custroom,0);
    writeln;
    writeln('Customizing this room');
    writeln('If you would rather be customizing an exit, type CUSTOM <direction of exit>');
    writeln('If you would rather be customizing an object, type CUSTOM <object name>');
    writeln;
    done := false;
    prompt := 'Custom> ';

    repeat
        repeat
            grab_line(prompt,s);
            s := slead(s);
        until length(s) > 0;
        s := lowcase(s);
        case s[1] of

            'e','q': done := true;
            '?','h': room_help;
            'r': do_rename;
            'v': view_room;
{dir trapdoor goes}    't': begin
                grab_line('What direction does the trapdoor exit through? ',s);
                if length(s) > 0 then begin
                    if lookup_dir(n,s) then begin
                        getroom;
                        here.trapto := n;
                        putroom;
                        writeln('Room updated.');
                    end else
                        writeln('No such direction.');
                end else
                    writeln('No changes.');
                 end;
{chance}        'c': begin
                writeln('Enter the chance that in any given minute the player will fall through');
                writeln('the trapdoor (0-100) :');
                writeln;
                grab_line('? ',s);
                if isnum(s) then begin
                    n := number(s);
                    if n in [0..100] then begin
                        getroom;
                        here.trapchance := n;
                        putroom;
                    end else
                        writeln('Out of range.');
                end else
                    writeln('No changes.');
                 end;
            's': begin
                newdsc := here.secondary;
                writeln('[ Editing the secondary room description ]');
                if edit_desc(newdsc) then begin
                    getroom;
                    here.secondary := newdsc;
                    putroom;
                end;
                 end;
            'p': begin
{ same as desc }        newdsc := here.primary;
                writeln('[ Editing the primary room description ]');
                if edit_desc(newdsc) then begin
                    getroom;
                    here.primary := newdsc;
                    putroom;
                end;
                 end;
            'o': begin
                writeln('Enter the line that will be printed when someone drops an object here:');
                writeln('If dropped objects do not stay here, you may use a # for the object name.');
                writeln('Right now it says:');
                if here.objdesc = 0 then
                    writeln('Dropped. [default]')
                else
                    print_line(here.objdesc);

                n := here.objdesc;
                make_line(n);
                getroom;
                here.objdesc := n;
                putroom;
                 end;
            'x': begin
                writeln('Enter a line that will be randomly shown.');
                writeln('Right now it says:');
                if here.objdesc = 0 then
                    writeln('[none defined]')
                else
                    print_line(here.rndmsg);

                n := here.rndmsg;
                make_line(n);
                getroom;
                here.rndmsg := n;
                putroom;
                 end;
{bounced in desc}    'b': begin
                writeln('Enter the line that will be displayed in the room where an object really');
                writeln('goes when an object dropped here "bounces" there:');
                writeln('Place a # where the object name should go.');
                writeln;
                writeln('Right now it says:');
                if here.objdest = 0 then
                    writeln('Something has bounced into the room.')
                else
                    print_line(here.objdest);

                n := here.objdest;
                make_line(n);
                getroom;
                here.objdest := n;
                putroom;
                 end;
            'm': begin
                getobjnam;
                freeobjnam;
                if here.magicobj = 0 then
                    writeln('There is currently no magic object for this room.')
                else
                    writeln(objnam.idents[here.magicobj],
                        ' is currently the magic object for this room.');
                writeln;
                grab_line('New magic object? ',s);
                if s = '' then
                    writeln('No changes.')
                else if lookup_obj(n,s) then begin
                    getroom;
                    here.magicobj := n;
                    putroom;
                    writeln('Room updated.');
                end else
                    writeln('No such object found.');
                 end;
            'g': begin
                getnam;
                freenam;
                if here.objdrop = 0 then
                    writeln('Objects dropped fall here.')
                else
                    writeln('Objects dropped fall in ',nam.idents[here.objdrop],'.');
                writeln;
                writeln('Enter * for [this room]:');
                grab_line('Room dropped objects go to? ',s);
                if s = '' then
                    writeln('No changes.')
                else if s = '*' then begin
                    getroom;
                    here.objdrop := 0;
                    putroom;
                    writeln('Room updated.');
                end else if lookup_room(n,s) then begin
                    getroom;
                    here.objdrop := n;
                    putroom;
                    writeln('Room updated.');
                end else
                    writeln('No such room found.');
                 end;
            'd': begin
                writeln('Print room descriptions how?');
                writeln;
                writeln('0)  Print primary (main) description only [default]');
                writeln('1)  Print only secondary description.');
                writeln('2)  Print both primary and secondary descriptions togther.');
                writeln('3)  Print primary description first; then print secondary description only if');
                writeln('    the player is holding the magic object for this room.');
                writeln('4)  Print secondary if holding the magic obj; print primary otherwise');
                writeln;
                grab_line('? ',s);
                if isnum(s) then begin
                    n := number(s);
                    if n in [0..4] then begin
                        getroom;
                        here.which := n;
                        putroom;
                        writeln('Room updated.');
                    end else
                        writeln('Out of range.');
                end else
                    writeln('No changes.');

                 end;
            'n': begin
                writeln('How would you like the room name to print?');
                writeln;
                writeln('0) No room name is shown');
                writeln('1) "You''re in ..."');
                writeln('2) "You''re at ..."');
                writeln;
                grab_line('? ',s);
                if isnum(s) then begin
                    n := number(s);
                    if n in [0..2] then begin
                        getroom;
                        here.nameprint := n;
                        putroom;
                    end else
                        writeln('Out of range.');
                end else
                    writeln('No changes.');
                 end;
            otherwise writeln('Bad command, type ? for a list');
        end;
    until done;
    log_event(myslot,E_ROOMDONE,0,0);
end;

procedure analyze_exit(dir: integer);
var
    s: string;

begin
    writeln;
    getnam;
    freenam;
    getobjnam;
    freeobjnam;
    with here.exits[dir] do begin
        s := alias;
        if s = '' then
            s := '(no alias)'
        else
            s := '(alias ' + s + ')';
        if here.exits[dir].reqalias then
            s := s + ' (required)'
        else
            s := s + ' (not required)';

        if toloc <> 0 then
            writeln('The ',direct[dir],' exit ',s,' goes to ',nam.idents[toloc])
        else
            writeln('The ',direct[dir],' exit goes nowhere.');
        if hidden <> 0 then
            writeln('Concealed.');
        write('Exit type: ');
        case kind of
            0: writeln('no exit.');
            1: writeln('Open passage.');
            2: writeln('Door, object required to pass.');
            3: writeln('No passage if holding object.');
            4: writeln('Randomly fails');
            5: writeln('Potential exit.');
            6: writeln('Only exists while holding the required object.');
            7: writeln('Timed exit');
        end;
        if objreq = 0 then
            writeln('No required object.')
        else
            writeln('Required object is: ',objnam.idents[objreq]);


        writeln;
        if exitdesc = DEFAULT_LINE then
            exit_default(dir,kind)
        else
            print_line(exitdesc);

        if success = 0 then
            writeln('(no success message)')
        else
            print_desc(success);

        if fail = DEFAULT_LINE then begin
            if kind = 5 then
                writeln('There isn'' an exit there yet.')
            else
                writeln('You can''t go that way.');
        end else
            print_desc(fail);

        if comeout = DEFAULT_LINE then
            writeln('# has come into the room from: ',direct[dir])
        else
            print_desc(comeout);
        if goin = DEFAULT_LINE then
            writeln('# has gone ',direct[dir])
        else
            print_desc(goin);

        writeln;
        if autolook then
            writeln('LOOK automatically done after exit used')
        else
            writeln('LOOK supressed on exit use');
        if reqverb then
            writeln('The alias is required to be a verb for exit use')
        else
            writeln('The exit can be used with GO or as a verb');
    end;
    writeln;
end;

procedure custom_help;

begin
    writeln;
    writeln('A    Set an Alias for the exit');
    writeln('C    Conceal an exit');
    writeln('D    Edit the exit''s main Description');
    writeln('E    EXIT custom (saves changes)');
    writeln('F    Edit the exit''s failure line');
    writeln('I    Edit the line that others see when a player goes Into an exit');
    writeln('K    Set the object that is the Key to this exit');
    writeln('L    Automatically look [default] / don''t look on exit');
    writeln('O    Edit the line that people see when a player comes Out of an exit');
    writeln('Q    QUIT Custom (saves changes)');
    writeln('R    Require/don''t require alias for exit; ignore direction');
    writeln('S    Edit the success line');
    writeln('T    Alter Type of exit (passage, door, etc)');
    writeln('V    View exit information');
    writeln('X    Require/don''t require exit name to be a verb');
    writeln('?    This list');
    writeln;
end;


procedure get_key(dir: integer);
var
    s: string;
    n: integer;

begin
    getobjnam;
    freeobjnam;
    if here.exits[dir].objreq = 0 then
        writeln('Currently there is no key set for this exit.')
    else
        writeln(objnam.idents[here.exits[dir].objreq],' is the current key for this exit.');
    writeln('Enter * for [no key]');
    writeln;

    grab_line('What object is the door key? ',s);
    if length(s) > 0 then begin
        if s = '*' then begin
            getroom;
            here.exits[dir].objreq := 0;
            putroom;
            writeln('Exit updated.');
        end else if lookup_obj(n,s) then begin
            getroom;
            here.exits[dir].objreq := n;
            putroom;
            writeln('Exit updated.');
        end else
            writeln('There is no object by that name.');
    end else
        writeln('No changes.');
end;