Source Code 1994 March/Source_Code_CD-ROM_Walnut_Creek_March_1994.iso/compsrcs/games/vmsnet/monhl104/part20

Internet Message Format | 1992-08-02 | 42.7 KB

Path: uunet!mcsun!news.funet.fi!hydra!klaava!hurtta
From: [e-mail] (Kari E. Hurtta)
Newsgroups: vmsnet.sources.games
Subject: Monster Helsinki V 1.04 - part 20/32
Keywords: Monster, a multiplayer adventure game
Message-ID: <[e-mail]>
Date: 14 Jun 92 05:48:53 GMT
Sender: [e-mail] (Kari Hurtta)
Followup-To: vmsnet.sources.d
Organization: University of Helsinki
Lines: 1432

Archieve-name: monster_helsinki_104/part20
Author: [e-mail]
Product: Monster Helsinki V 1.04
Environment: VMS, Pascal
Part: 20/32

-+-+-+-+-+-+-+-+ START OF PART 20 -+-+-+-+-+-+-+-+
X               real_user.idents`091i`093 := '';
X               putreal_user;
X            end;
X        end;
X        writeln ('Ready.');
X     end
Xend; `123 fix_clear_password `125
X
Xprocedure fix_clear_quotas(batch: boolean);
Xvar numrooms,allow,accept: intrec;
X    room,exit,player,acp,i: integer;`032
X    roomindx: indexrec;
Xbegin
X    writeln('Scanning rooms....');
X    for i := 1 to maxplayers do numrooms.int`091i`093 := 0;
X    numrooms.intnum := N_NUMROOMS;
X    for i := 1 to maxplayers do allow.int`091i`093 := default_allow;
X    allow.intnum := N_ALLOW;
X    for i := 1 to maxplayers do accept.int`091i`093 := 0;
X    accept.intnum := N_ACCEPT;
X    getindex(I_ROOM);
X    freeindex;
X    roomindx := indx;
X    for room := 1 to roomindx.top do if not roomindx.free`091room`093 then b
Vegin
X`009gethere(room);
X`009if exact_user(player,here.owner) then begin
X`009    acp := 0;
X`009    for exit := 1 to maxexit do`032
X`009`009if here.exits`091exit`093.kind = 5 then acp := acp +1;
X`009    numrooms.int`091player`093 := numrooms.int`091player`093 +1;
X`009    accept.int`091player`093 := accept.int`091player`093     +acp;
X`009end;
X    end;
X    writeln('Clearing quota database and writing results to it...');
X    int_in_use(N_NUMROOMS);
X    int_in_use(N_ALLOW);
X    int_in_use(N_ACCEPT);
X
X    getint(N_NUMROOMS);
X    anint := numrooms;
X    putint;
X
X    getint(N_ALLOW);
X    anint := allow;
X    putint;
X
X    getint(N_ACCEPT);
X    anint := accept;
X    putint;
X
X    writeln('OK.');
Xend;
X
X
Xprocedure fix_repair_location(batch: boolean);
Xvar id,loc,slot,code,room,true_loc,found_counter: integer;
Xvar ex_indx,sleep_indx,room_indx,header_indx: indexrec;
X    locs: intrec;
X    temp: namrec;
Xbegin
X    writeln('Scanning monsters...');
X    getpers;
X    freepers;
X    getuser;
X    freeuser;
X    getindex(I_PLAYER);
X    freeindex;
X    ex_indx := indx;
X    getindex(I_ASLEEP);
X    freeindex;
X    sleep_indx := indx;
X    getindex(I_ROOM);
X    freeindex;
X    room_indx := indx;
X    getindex(I_HEADER);
X    freeindex;
X    header_indx := indx;
X    getint(N_LOCATION);
X    freeint;
X    locs := anint;
X    for id := 1 to ex_indx.top do if not ex_indx.free`091id`093 then`032
X`009if user.idents`091id`093 = '' then begin
X`009    writeln('Bad player username record #',id:1);
X`009    writeln('    player name: ',pers.idents`091id`093);
X`009end else if user.idents`091id`093`0911`093 = ':' then begin`032
X`009    found_counter := 0;
X`009    true_loc := 0;
X`009    loc := locs.int`091id`093;
X`009    for room := 1 to room_indx.top do if not room_indx.free`091room`093
V then begin
X`009`009gethere(room);
X`009`009for slot := 1 to maxpeople do begin
X`009`009    if (here.people`091slot`093.username = user.idents`091id`093) an
Vd`032
X`009`009`009(here.people`091slot`093.kind = P_MONSTER) then begin
X`009`009`009found_counter := found_counter +1;
X`009`009`009true_loc := room;
X`009`009    end;
X`009`009end;
X`009    end;
X`009    if (found_counter = 1) and (true_loc = loc) then
X`009`009writeln(pers.idents`091id`093,': ok')
X`009    else if found_counter = 0 then begin
X`009`009writeln(pers.idents`091id`093,': not found from any room - deleted '
V,
X`009`009    '- can''t update code database.');
X`009`009ex_indx.free`091id`093 := true;
X`009`009ex_indx.inuse := ex_indx.inuse - 1;
X`009`009if not sleep_indx.free`091id`093 then begin
X`009`009    sleep_indx.free`091id`093 := true;
X`009`009    sleep_indx.inuse := sleep_indx.inuse - 1;`032
X`009`009`009`123 onkohan tarpeelista ? `125
X`009`009end;
X`009`009pers.idents`091id`093 := '';
X`009`009user.idents`091id`093 := '';
X`009`009getint(N_SELF);`009`009`123 destroy self description `125
X`009`009delete_block(anint.int`091id`093);
X`009`009putint;
X`009    end else if (found_counter = 1) and ( loc <> true_loc) then begin
X`009`009writeln(pers.idents`091id`093,': found from wrong location - updated
V.');
X`009`009locs.int`091id`093 := true_loc;
X`009    end else if (found_counter > 1) then begin
X`009`009writeln(pers.idents`091id`093,': duplicated monster - deleted.');
X`009`009for room := 1 to room_indx.top do if not room_indx.free`091room`093
V then begin
X`009`009    code := 0;
X`009`009    getroom(room); `123 locking `125
X`009`009    for slot := 1 to maxpeople do begin
X`009`009`009if (here.people`091slot`093.username = user.idents`091id`093) an
Vd`032
X`009`009`009(here.people`091slot`093.kind = P_MONSTER) then begin
X`009`009`009    code := here.people`091slot`093.parm;
X`009`009`009    here.people`091slot`093.username := '';
X`009`009`009    here.people`091slot`093.kind     := 0;
X`009`009`009    here.people`091slot`093.parm     := 0;
X`009`009`009end;
X`009`009    end;
X`009`009    putroom;`009    `123 unlocking `125
X`009`009    if code > 0 then begin
X`009`009`009if not header_indx.free`091code`093 then begin
X`009`009`009    header_indx.free`091code`093 := true;
X`009`009`009    header_indx.inuse := sleep_indx.inuse - 1;`032
X`009`009`009    delete_program(code);`009`009`009
X`009`009`009end;
X`009`009    end;
X`009`009end; `123 end of room loop `125
X`009`009ex_indx.free`091id`093 := true;
X`009`009ex_indx.inuse := ex_indx.inuse - 1;
X`009`009if not sleep_indx.free`091id`093 then begin
X`009`009    sleep_indx.free`091id`093 := true;
X`009`009    sleep_indx.inuse := sleep_indx.inuse - 1;`032
X`009`009`009`123 onkohan tarpeelista ? `125
X`009`009end;
X`009`009pers.idents`091id`093 := '';
X`009`009user.idents`091id`093 := '';
X`009`009getint(N_SELF);`009`009`123 destroy self description `125
X`009`009delete_block(anint.int`091id`093);
X`009`009putint;
X    `009    end else writeln('%',pers.idents`091id`093,': bad software error
V.');
X`009end;
X    writeln('Updating database...');
X
X    temp := pers;
X    getpers;
X    pers := temp;
X    putpers;
X   `032
X    temp := user;
X    getuser;
X    user := temp;
X    putuser;
X   `032
X    getindex(I_PLAYER);
X    indx := ex_indx;
X    putindex;
X    getindex(I_ASLEEP);
X    indx := sleep_indx;
X    putindex;
X    getindex(I_ROOM);
X    indx := room_indx;
X    putindex;
X    getindex(I_HEADER);
X    indx := header_indx;
X    freeindex;
X    getint(N_LOCATION);
X    anint := locs;
X    putint;
X    writeln('Ready.');
Xend; `123 fix_repair_location `125
X
Xprocedure fix_calculate_existence(batch: boolean);
Xvar table: array `0911 .. maxroom `093 of integer;
X    i,room,slot,object,old_value,pslot,inv: integer;
Xbegin
X    writeln ('Calculate objects'' number in existence');
X    for i := 1 to maxroom do table`091i`093 := 0;
X    getindex(I_ROOM);
X    freeindex;
X    writeln ('Scan room file');
X    for room := 1 to indx.top do if not indx.free`091room`093 then begin
X`009gethere (room);
X`009for slot := 1 to maxobjs do begin
X`009    i := here.objs`091slot`093;
X`009    if (i < 0) or (i > maxroom) then
X`009`009writeln('Invalid object #',i:1,' entry #',slot:1,
X`009`009    ' at room ',here.nicename)
X`009    else if i > 0 then table`091i`093 := table`091i`093 +1;
X`009end;
X`009for pslot := 1 to maxpeople do begin
X`009    if here.people`091pslot`093.kind > 0 then begin
X`009`009for inv := 1 to maxhold do begin
X`009`009    i := here.people`091pslot`093.holding`091inv`093;
X`009`009    if (i < 0) or (i > maxroom) then
X`009`009`009writeln('Invalid object #',i:1,' entry #',inv:1,
X`009`009`009    ' at monster ',here.people`091pslot`093.name)
X`009`009    else if i > 0 then table`091i`093 := table`091i`093 +1;
X`009`009end;
X`009    end;
X`009end;
X    end;
X    writeln('Write result to object file');
X    getindex(I_OBJECT);
X    freeindex;
X    for object := 1 to maxroom do begin
X`009if (object > indx.top) or indx.free`091object`093 then begin
X`009    if table`091object`093 > 0 then begin
X`009`009writeln('Object #',object:1,' not exist but here is');
X`009`009writeln('  ',table`091object`093,' entries in room file.');
X`009    end;
X`009end else begin
X`009    getobj(object);
X`009    old_value := obj.numexist;
X`009    obj.numexist := table`091object`093;
X`009    putobj;
X`009    if old_value <> table`091object`093 then writeln(obj.oname,' fixed.'
V);
X`009end;
X    end;
X    writeln ('Ready.');
Xend;`009`123 fix_calculate_existence `125
X
X
Xprocedure fix_repair_paths(batch: boolean);
Xvar room,exit,room_to,second_exit,exit2: integer;
X
X    procedure delete_exit(room,exit: integer);
X    begin
X`009getroom(room);
X`009writeln('  Removing exit from ',here.nicename,
X`009    ' to ',direct`091exit`093,'.');
X`009here.exits`091exit`093.kind  := 0;
X`009here.exits`091exit`093.toloc := 0;
X`009here.exits`091exit`093.slot  := 0;
X`009putroom;
X    end; `123 delete_exit `125
X`009
Xbegin
X    writeln('Repairing paths...');
X   `032
X    getindex(I_ROOM);
X    freeindex;
X    for room := 1 to indx.top do if not indx.free`091room`093 then begin
X`009for exit := 1 to maxexit do begin
X
X`009    gethere(room);`009`123 reread here `125
X`009    if not (here.exits`091exit`093.kind in `0910,5`093) then begin
X`009`009room_to := here.exits`091exit`093.toloc;
X`009`009second_exit := here.exits`091exit`093.slot;
X
X`009`009if (second_exit < 0) or (second_exit > maxexit) then begin
X`009`009    writeln('Exit from ',here.nicename,' to ',direct`091exit`093,
X`009`009`009' is bad: target slot is out of range');
X`009`009    delete_exit(room,exit);
X`009`009
X`009`009end else if room_to = 0 then begin
X`009`009    writeln('Exit from ',here.nicename,' to ',direct`091exit`093,
X`009`009`009' is nowhere.');
X
X`009`009end else if (room_to < 1) or (room_to > indx.top) then begin
X`009`009    writeln('Exit from ',here.nicename,' to ',direct`091exit`093,
X`009`009`009' is bad: target room is out of range.');
X`009`009    delete_exit(room,exit);
X
X`009`009end else if indx.free`091room_to`093 then begin
X`009`009    writeln('Exit from ',here.nicename,' to ',direct`091exit`093,
X`009`009`009' is bad: target room isn''t in use');
X`009`009    delete_exit(room,exit);
X
X`009`009end else begin
X`009`009    if room = room_to then
X`009`009`009writeln('Exit from ',here.nicename,' to ',direct`091exit`093,
X`009`009`009    ' is loop.');
X`009`009    if second_exit = 0 then begin
X`009`009`009writeln('Exit from ',here.nicename,' to ',direct`091exit`093,
X`009`009`009    ' is bad: no target slot');
X`009`009`009delete_exit(room,exit);
X`009`009    end else begin
X`009`009`009gethere(room_to);
X`009`009`009if (here.exits`091second_exit`093.toloc <> room) or
X`009`009`009   (here.exits`091second_exit`093.slot <> exit) then begin
X`009`009`009    writeln('Exits from ',here.nicename,' to ',
X`009`009`009`009direct`091second_exit`093,
X`009`009`009`009' and');
X`009`009`009    gethere(room);
X`009`009`009    writeln(' from ',here.nicename,' to ',direct`091exit`093,
X`009`009`009`009' are bad: bad link');
X`009`009`009    delete_exit(room,exit);
X`009`009`009end;
X`009`009    end;
X`009`009end;
X`009    end else if here.exits`091exit`093.toloc <> 0 then begin
X`009`009writeln('Exit from ',here.nicename,' to ',direct`091exit`093,
X`009`009    ' isn''t exit.');
X`009    end;`032
X`009end;`009`123 exit `125
X    end;    `123 room `125
X    writeln ('Ready.');
Xend;
X
Xprocedure fix_view_global_flags;
Xbegin
X    writeln('Global flags and values:');
X    writeln;
X    writeln('Monster active: ',view_global_value(GF_ACTIVE,TRUE));
X    writeln('Database valid: ',view_global_value(GF_VALID));
X    writeln('Wartime:        ',view_global_value(GF_WARTIME));
X    writeln('Welcome text:   ',view_global_value(GF_STARTGAME));
X    writeln('NewPlayer text: ',view_global_value(GF_NEWPLAYER));
X    writeln('Global Hook:    ',view_global_value(GF_CODE));
Xend;
X
X`091global`093
Xfunction fix_system
X`009(batch: string := ''):  `123 in this procedure you not have logged in `1
V25
X`009`009`009`009`123 system ! `125
X`009boolean;
Xvar s: string;
X    done: boolean;
X    batch_mode: boolean;
Xbegin            `009
X   done := batch > '';
X   fix_system := true;
X   repeat
X      if batch > '' then begin
X`009    s := batch;
X`009    `123 writeln('Batch mode: ',s); `125
X`009    batch_mode := true;
X      end else begin
X`009    write ('fix> '); readln (s); writeln;
X`009    batch_mode := false;
X      end;
X      s := lowcase(s);
X      if s = '' then writeln ('Enter h for help.')
X      else case s`0911`093 of `032
X`009'a'`009: fix_clear_privileges`009    (batch_mode);
X`009'b'`009: fix_clear_health`009    (batch_mode);
X        'c'`009: fix_initialize_event`009    (batch_mode);
X        'd'     : fix_descriptions`009    (batch_mode);
X        'f'     : fix_clear_experience`009    (batch_mode);
X`009'g'`009:`032
X`009begin
X`009`009if s = 'g' then`009`009fix_calculate_existence`009(batch_mode)
X`009`009else if s = 'gl' then`009fix_clear_global`009(batch_mode)
X`009`009else if s = 'gs' then`009set_global_flag(GF_ACTIVE,FALSE)
X`009`009else if s = 'gu' then   set_global_flag(GF_ACTIVE,TRUE)
X`009`009else if s = 'g-' then`009set_global_flag(GF_VALID,FALSE)
X`009`009else if s = 'g+' then   set_global_flag(GF_VALID,TRUE)
X`009`009else if s = 'gv' then   fix_view_global_flags
X`009`009else writeln ('Enter ? for help.');
X`009end;
X        'i'     : fix_repair_index`009    (batch_mode);
X`009'j'`009: fix_repair_paths`009    (batch_mode);
X`009'k'`009: fix_codes`009`009    (batch_mode);
X`009'l'`009: fix_repair_location`009    (batch_mode);
X        'm'     : fix_clear_monster`009    (batch_mode);
X`009'n'`009: fix_clear_quotas`009    (batch_mode);
X        'o'     :`032
X`009begin
X`009    if s = 'o' then fix_clear_object(batch_mode)
X`009    else if s = 'ow' then fix_owner (batch_mode)
X`009    else writeln('Enter ? for help.');
X`009end;
X        'p'     : fix_clear_player`009    (batch_mode);
X        'r'     : fix_clear_room`009    (batch_mode);
X        's'     :`032
X`009begin
X`009    if s = 's' then fix_clear_password`009    (batch_mode)
X`009    else if s = 'sp' then fix_clear_spell   (batch_mode)
X`009    else writeln('Enter ? for help.');
X`009end;
X        'v'     : system_view;
X        'h','?' : fix_help;
X        'e'     : done := true;
X        'q'     : begin
X`009`009`009fix_system := false;
X`009`009`009done := true;
X`009`009end;
X        otherwise writeln ('Use ? for help');
X      end; `123 case `125
X   until done
Xend;
X
X`123 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`125
Xfunction place_obj(n: integer;silent:boolean := false): boolean;
Xvar
X`009found: boolean;
X`009i: integer;
Xbegin
X`009if here.objdrop = 0 then getroom
X`009else getroom(here.objdrop);
X`009i := 1;
X`009found := false;
X`009while (i <= maxobjs) and (not found) do begin
X`009`009if here.objs`091i`093 = 0 then found := true
X`009`009else i := i + 1;
X`009end;
X`009place_obj := found;
X`009if found then begin
X`009`009here.objs`091i`093 := n;
X`009`009here.objhide`091i`093 := 0;
X`009`009putroom;
X
X`009`009gethere;
X
X
X`009`009`123 if it bounced somewhere else then tell them `125
X
X`009`009if (here.objdrop <> 0) and (here.objdest <> 0) then
X`009`009`009log_event(0,E_BOUNCEDIN,here.objdest,n,'',here.objdrop);
X
X
X`009`009if not(silent) then begin
X`009`009`009if here.objdesc <> 0 then
X`009`009`009`009print_subs(here.objdesc,obj_part(n))
X`009`009`009else
X`009`009`009`009writeln('Dropped ',obj_part(n),'.');
X`009`009end;
X`009end else
X`009`009freeroom;
Xend;
X
X
X`123 remove an object from this room `125
Xfunction take_obj(objnum,slot: integer): boolean;
Xbegin
X`009getroom;
X`009if here.objs`091slot`093 = objnum then begin
X`009`009here.objs`091slot`093 := 0;
X`009`009here.objhide`091slot`093 := 0;
X`009`009take_obj := true;
X`009end else
X`009`009take_obj := false;
X`009putroom;
Xend;
X
X
Xfunction can_hold: boolean;
X
Xbegin
X`009if find_numhold < maxhold then
X`009`009can_hold := true
X`009else
X`009`009can_hold := false;
Xend;
X
X
Xfunction can_drop: boolean;
X
Xbegin
X`009if find_numobjs < maxobjs then
X`009`009can_drop := true
X`009else
X`009`009can_drop := false;
Xend;
X
X
Xfunction find_hold(objnum: integer;slot:integer := 0): integer;
Xvar
X`009i: integer;
X
Xbegin
X`009if slot = 0 then
X`009`009slot := myslot;
X`009i := 1;
X`009find_hold := 0;
X`009while i <= maxhold do begin
X`009`009if here.people`091slot`093.holding`091i`093 = objnum then
X`009`009`009find_hold := i;
X`009`009i := i + 1;
X`009end;
Xend;
X
X
X
X`123 put object number n into the player's inventory; returns false if
X  he's holding too many things to carry another `125
X
Xfunction hold_obj(n: integer): boolean;
Xvar
X`009found: boolean;
X`009i: integer;
X
Xbegin
X`009getroom;
X`009i := 1;
X`009found := false;
X`009while (i <= maxhold) and (not found) do begin
X`009`009if here.people`091myslot`093.holding`091i`093 = 0 then
X`009`009`009found := true
X`009`009else
X`009`009`009i := i + 1;
X`009end;
X`009hold_obj := found;
X`009if found then begin
X`009`009here.people`091myslot`093.holding`091i`093 := n;
X`009`009putroom;
X
X`009`009getobj(n);
X`009`009freeobj;
X`009`009hold_kind`091i`093 := obj.kind;
X`009end else
X`009`009freeroom;
Xend;
X
X
X
X`123 remove an object (hold) from the player record, given the slot that
X  the object is being held in `125
X
Xprocedure drop_obj(slot: integer;pslot: integer := 0);
X
Xbegin
X`009if pslot = 0 then
X`009`009pslot := myslot;
X`009getroom;
X`009here.people`091pslot`093.holding`091slot`093 := 0;
X`009putroom;
X
X`009hold_kind`091slot`093 := 0;
Xend;
X
X
X
X`123 maybe drop something I'm holding if I'm hit `125
X
Xprocedure maybe_drop;
Xvar
X`009i: integer;
X`009objnum: integer;
X`009s: string;
X
Xbegin
X`009i := 1 + (rnd100 mod maxhold);
X`009objnum := here.people`091myslot`093.holding`091i`093;
X
X`009if (objnum <> 0) and (mywield <> objnum) and (mywear <> objnum) then beg
Vin
X`009`009`123 drop something `125
X
X`009`009drop_obj(i);
X`009`009if place_obj(objnum,TRUE) then begin
X`009`009    getobj(objnum);
X`009`009    freeobj;
X
X`009`009    writeln('The ',obj.oname,' has slipped out of your hands.');
X`009`009`009
X`009`009    log_event(myslot,E_SLIPPED,0,0,obj.oname);
X
X`009`009    if obj.actindx > 0 then
X`009`009`009run_monster('',obj.actindx,'drop you','','',
X`009`009`009    sysdate+' '+systime);
X
X`009`009end else
X`009`009    writeln('%error in maybe_drop; unsuccessful place_obj; notify Mo
Vnster Manager');
X
X`009end;
Xend;
X
X`123 function obj_owner moved to module CUSTOM `125
X
Xprocedure do_duplicate(s: string);
Xlabel 0; `123 for panic `125
Xvar
X`009objnum,oldloc: integer;
X
X    function action(s: shortstring; objnum: integer): boolean;
X    begin
X`009if obj_owner(objnum,TRUE) then begin
X`009    if not(place_obj(objnum,TRUE)) then begin
X`009`009`009`123 put the new object here `125
X`009`009writeln('There isn''t enough room here to make that.');
X`009`009goto 0; `123 leave loop `125
X`009    end else begin
X`123 keep track of how many there `125`009getobj(objnum);
X`123 are in existence `125`009`009`009obj.numexist := obj.numexist + 1;
X`009`009`009`009`009putobj;
X
X`009`009log_event(myslot,E_MADEOBJ,0,0,log_name + ' has created an object he
Vre.');
X`009`009writeln('Object ',s,' created.');
X`009    end;
X`009end else
X`009    writeln('Power to create ',s,' belongs to someone else.');
X`009action := true;
X`009checkevents(true);
X`009if oldloc <> location then goto 0; `123 panic `125
X    end;
X   `032
X    function restriction (n: integer): boolean;
X`009begin
X`009`009restriction := true;
X`009end;
X
X    procedure leave;
X    begin
X`009writeln('EXIT - no changes.');
X`009goto 0;
X    end;
X
X
Xbegin
X    if s = '' then grab_line('Object? ',s,eof_handler := leave);
X    oldloc := location;
X    if length(s) > 0 then begin
X`009if not is_owner(location,TRUE) then begin
X`009    `123 only let them make things if they're on their home turf `125
X`009    writeln('You may only create objects when you are in one of your own
V rooms.');
X`009end else begin
X`009    if scan_obj(action,s,,restriction) then begin
X`009    end else
X`009`009writeln('There is no object by that name.');
X`009end;
X   end else
X`009writeln('To duplicate an object, type DUPLICATE <object name>.');
X    0: `123 for panic `125
Xend;
X
X
X`123 make an object `125
Xprocedure do_makeobj(s: string);
Xlabel exit_label;
Xvar
X`009objnum: integer;
X
X    procedure leave;
X    begin
X`009writeln('EXIT - no changes.');
X`009goto exit_label;
X    end;
X
X
Xbegin
X`009if s = '' then grab_line('Object? ',s,eof_handler := leave);
X
X`009gethere;
X`009if checkhide then begin
X`009if not is_owner(location,TRUE) then begin
X`009`009writeln('You may only create objects when you are in one of your own
V rooms.');
X`009end else if s <> '' then begin
X`009`009if length(s) > shortlen then
X`009`009`009writeln('Please limit your object names to ',shortlen:1,' charac
Vters.')
X`009`009else if exact_obj(objnum,s) then begin`009`123 object already exits
V `125
X`009`009`009writeln('That object already exits.  If you would like to make a
Vnother copy of it,');
X`009`009`009writeln('use the DUPLICATE command.');
X`009`009end else begin
X`009`009`009if debug then
X`009`009`009`009writeln('%beggining to create object');
X`009`009`009if find_numobjs < maxobjs then begin
X`009`009`009`009if alloc_obj(objnum) then begin
X`009`009`009`009`009if debug then
X`009`009`009`009`009`009writeln('%alloc_obj successful');
X`009`009`009`009`009getobjnam;
X`009`009`009`009`009objnam.idents`091objnum`093 := lowcase(s);
X`009`009`009`009`009putobjnam;
X`009`009`009`009`009if debug then
X`009`009`009`009`009`009writeln('%getobjnam completed');
X`009`009`009`009`009getobjown;
X`009`009`009`009`009objown.idents`091objnum`093 := userid;
X`009`009`009`009`009putobjown;
X`009`009`009`009`009if debug then
X`009`009`009`009`009`009writeln('%getobjown completed');
X
X`009`009`009`009`009getobj(objnum);
X`009`009`009`009`009`009obj.onum := objnum;
X`009`009`009`009`009`009obj.oname := s;`009`123 name of object `125
X`009`009`009`009`009`009obj.kind := 0; `123 bland object `125
X`009`009`009`009`009`009obj.linedesc := DEFAULT_LINE;
X`009`009`009`009`009`009obj.actindx := 0;
X`009`009`009`009`009`009obj.examine := 0;
X`009`009`009`009`009`009obj.numexist := 1;
X`009`009`009`009`009`009obj.home := 0;
X`009`009`009`009`009`009obj.homedesc := 0;
X
X`009`009`009`009`009`009obj.sticky := false;
X`009`009`009`009`009`009obj.getobjreq := 0;
X`009`009`009`009`009`009obj.getfail := 0;
X`009`009`009`009`009`009obj.getsuccess := DEFAULT_LINE;
X
X`009`009`009`009`009`009obj.useobjreq := 0;
X`009`009`009`009`009`009obj.uselocreq := 0;
X`009`009`009`009`009`009obj.usefail := DEFAULT_LINE;
X`009`009`009`009`009`009obj.usesuccess := DEFAULT_LINE;
X
X`009`009`009`009`009`009obj.usealias := '';
X`009`009`009`009`009`009obj.reqalias := false;
X`009`009`009`009`009`009obj.reqverb := false;
X
X`009`009`009if s`0911`093 in `091'a','A','e','E','i','I','o','O','u','U'`093
V then
X`009`009`009`009`009`009obj.particle := 2  `123 an `125
X`009`009`009else
X`009`009`009`009`009`009obj.particle := 1; `123 a `125
X
X`009`009`009`009`009`009obj.d1 := 0;
X`009`009`009`009`009`009obj.d2 := 0;
X`009`009`009`009`009`009obj.ap := 0;
X`009`009`009`009`009`009obj.exreq := 0;
X
X`009`009`009`009`009`009obj.exp5 := DEFAULT_LINE;
X`009`009`009`009`009`009obj.exp6 := DEFAULT_LINE;
X`009`009`009`009`009putobj;
X
X
X`009`009`009`009`009if debug then
X`009`009`009`009`009`009writeln('putobj completed');
X`009`009`009`009end;
X`009`009`009`009`009`123 else: alloc_obj prints errors by itself `125
X`009`009`009`009if not(place_obj(objnum,TRUE)) then
X`009`009`009`009`009`123 put the new object here `125
X`009`009`009`009`009writeln('%error in makeobj - could not place object; not
Vify the Monster Manager.')
X`009`009`009`009else begin
X`009`009`009`009`009log_event(myslot,E_MADEOBJ,0,0,
X`009`009`009`009`009`009log_name + ' has created an object here.');
X`009`009`009`009`009writeln('Object created.');
X`009`009`009`009end;
X
X`009`009`009end else
X`009`009`009`009writeln('This place is too crowded to create any more object
Vs.  Try somewhere else.');
X`009`009end;
X`009end else
X`009`009writeln('To create an object, type MAKE <object name>.');
X`009end;
X    exit_label:
Xend;
X
Xprocedure do_summon(s: string);
Xlabel exit_label;
Xvar
X`009n: integer;
X`009sname: string;
X`009vname: string;
X
X`009sid: integer;
X`009vslot: integer;
X
X    procedure leave;
X    begin
X`009writeln('EXIT - no changes.');
X`009goto exit_label;
X    end;
X
Xbegin
X`009if s = '' then grab_line('Spell? ',s,eof_handler := leave);
X`009sname := s;
X`009grab_line('Victim? ',s,eof_handler := leave);
X`009vname := s;
X
X`009if not lookup_spell(sid,sname) then writeln('Unkown spell.')
X`009else if not parse_pers(vslot,vname) then writeln('Victim isn''t here.')
X`009else begin
X`009    getspell(mylog);
X`009    freespell;
X`009    if spell.level`091sid`093 = 0 then writeln('Unkown spell.')
X`009    else if vslot = myslot then begin
X`009`009writeln('Spell summoned.');
X`009`009log_event(myslot,E_SUMMON,vslot,sid);
X`009`009getint(N_SPELL);
X`009`009freeint;
X`009`009getspell_name;
X`009`009freespell_name;
X`009`009run_monster('',anint.int`091sid`093,
X`009`009    'summon', '','',sysdate + ' ' + systime,
X`009`009    spell_name.idents`091sid`093, here.people`091myslot`093.name);
X`009    end else begin
X`009`009log_event(myslot,E_SUMMON,vslot,sid);
X`009`009writeln('Spell summoned.');
X`009    end;
X`009end;
X    exit_label:
Xend;
X
X`123 remove the type block for an object; all instances of the object must
X  be destroyed first `125
X
Xprocedure do_unmake(s: string);
Xlabel exit_label;
Xvar
X`009n: integer;
X`009tmp: string;
X
X    procedure leave;
X    begin
X`009writeln('EXIT - no changes.');
X`009goto exit_label;
X    end;
X
Xbegin
X`009if s = '' then grab_line('Object? ',s,eof_handler := leave);
X
X`009if not(is_owner(location,TRUE)) then
X`009`009writeln('You must be in one of your own rooms to UNMAKE an object.')
X`009else if lookup_obj(n,s,true) then begin
X`009`009tmp := obj_part(n);
X`009`009`009`123 this will do a getobj(n) for us `125
X
X`009`009if obj.numexist = 0 then begin
X`009`009`009delete_obj(n);
X                        delete_line(obj.linedesc);
X                        delete_block(obj.homedesc);
X`009`009`009delete_block(obj.examine);
X                        delete_block(obj.getfail);
X                        delete_block(obj.getsuccess);
X`009`009`009delete_block(obj.usefail);
X`009`009`009delete_block(obj.usesuccess);
X                        delete_block(obj.d1);
X                        delete_block(obj.d2);
X`009`009`009if obj.actindx > 0 then begin `123 delete hook (hurtta@finuh) `1
V25
X`009`009`009`009delete_program(obj.actindx);
X`009`009`009`009delete_general(I_HEADER,obj.actindx);
X`009`009`009end;
X
X`009`009`009log_event(myslot,E_UNMAKE,0,0,tmp);
X`009`009`009writeln('Object removed.');
X`009`009end else
X`009`009`009writeln('You must DESTROY all instances of the object first.');
X`009end else
X`009`009writeln('There is no object here by that name.');
X    exit_label:
Xend;
X
X
X
X`123 destroy a copy of an object `125
X
Xprocedure do_destroy(s: string);
Xlabel 0;    `123 for panic `125
Xvar
X`009slot,n,oldloc: integer;
X`009pub: shortstring;
X
X    function action(s: shortstring; n: integer): boolean;
X    begin
X`009getobjown;
X`009freeobjown;
X`009if (objown.idents`091n`093 <> userid) and (objown.idents`091n`093 <> pub
Vlic_id) and
X       (not owner_priv) then begin `123 minor change by leino@finuha `125
X`009    writeln('You must be the owner of ',s,' or');
X`009    writeln(s,' must be public to destroy it.');
X`009    action := true;
X`009end else if obj_hold(n) then begin
X`009    if mywear = n then x_unwear;
X`009    if mywield = n then x_unwield;
X
X`009    slot := find_hold(n);
X`009    drop_obj(slot);
X
X`009    log_event(myslot,E_DESTROY,0,0,
X`009`009log_name + ' has destroyed ' + obj_part(n) + '.');
X`009    writeln('Object destroyed.');
X
X`009    getobj(n);
X`009    obj.numexist := obj.numexist - 1;
X`009    putobj;
X`009    action := true;
X`009end else if obj_here(n) then begin
X`009    slot := find_obj(n);
X`009    if not take_obj(n,slot) then
X`009`009writeln('Someone picked ',s,' up before you could destroy it.')
X`009    else begin
X`009`009log_event(myslot,E_DESTROY,0,0,
X`009`009log_name + ' has destroyed ' + obj_part(n,FALSE) + '.');
X`009`009writeln('Object ',s,', destroyed.');
X
X`009`009getobj(n);
X`009`009obj.numexist := obj.numexist - 1;
X`009`009putobj;
X`009    end;
X`009    action := true;
X`009end else action := false;
X`009checkevents(TRUE);
X`009if location <> oldloc then goto 0;  `123 panic `125
X    end; `123 action `125
X
X    function restriction (n: integer): boolean;
X`009begin
X`009    restriction := obj_here(n,true) or obj_hold(n);
X`009    `123 true = not found hidden objects `125
X`009end;
X
X    procedure leave;
X    begin
X`009writeln('EXIT - no changes.');
X`009goto 0;
X    end;
X
Xbegin
X`009if s = '' then grab_line('Object? ',s,eof_handler := leave);
X
X`009oldloc := location;
X`009if length(s) = 0 then`009
X`009`009writeln('To destroy an object you own, type DESTROY <object>.')
X`009else if not is_owner(location,TRUE) then
X`009`009writeln('You must be in one of your own rooms to destroy an object.'
V)
X`009else if scan_obj(action,s,,restriction) then begin
X`009end else
X`009`009writeln('No such thing can be seen here.');
X`0090: `123 for panic `125
Xend;
X
X
Xfunction links_possible: boolean;
Xvar
X`009i: integer;
X
Xbegin
X`009gethere;
X`009links_possible := false;
X`009if is_owner(location,TRUE) then
X`009`009links_possible := true
X`009else begin
X`009`009for i := 1 to maxexit do
X`009`009`009if (here.exits`091i`093.toloc = 0) and (here.exits`091i`093.kind
V = 5) then
X`009`009`009`009links_possible := true;
X`009end;
Xend;
X
X
X
X`123 make a room `125
Xprocedure do_form(s: string);
Xlabel exit_label;
X    procedure leave;
X    begin
X`009writeln('EXIT - no changes.');
X`009goto exit_label;
X    end;
X
Xbegin
X`009gethere;
X`009if checkhide then begin
X`009`009if (get_counter(N_NUMROOMS,mylog)`032
X`009`009    >= get_counter(N_ALLOW,mylog))
X`009`009    and not quota_priv then begin
X`009`009    writeln('Yow haven''t room quota left.');
X`009`009    writeln('Use SHOW QUOTA to check limits.');
X`009`009end else if (get_counter(N_NUMROOMS,mylog) >= min_room) and`032
X`009`009`009(get_counter(N_ACCEPT,mylog) < min_accept) and
X`009`009`009not quota_priv then begin
X`009`009    writeln('You haven''t made Accepts enaugh.');
X`009`009    writeln('Use SHOW QUOTA to check limits.');
X
X`009`009end else if links_possible then begin
X`009`009`009if s = '' then begin
X`009`009`009`009grab_line('Room name? ',s,eof_handler := leave);
X`009`009`009end;
X`009`009`009s := slead(s);
X
X`009`009`009createroom(s);
X
X`009`009end else begin
X`009`009`009writeln('You may not create any new exits here.  Go to a place w
Vhere you can create');
X`009`009`009writeln('an exit before FORMing a new room.');
X`009`009end;
X`009end;
X    exit_label:
Xend;
X
X
X
X
X
Xprocedure xpoof; `123 loc: integer; forward `125
Xlabel 0; `123 panic `125
Xvar
X`009targslot: integer;
X`009oldloc: integer;
X`009prevcode: integer;
X
Xbegin
X`009getnam;`009`009`123 rooms' names `125
X`009freenam;
X
X`009oldloc := location;
X`009prevcode := here.hook;
X        if here.hook > 0 then
X           run_monster('',here.hook,'poof out','target',nam.idents`091loc`09
V3,
X               sysdate+' '+systime);
X
X        if oldloc = location then meta_run('leave','target',nam.idents`091lo
Vc`093);
X
X`009if put_token(loc,targslot,here.people`091myslot`093.hiding) then begin
X`009`009if hiding then begin
X`009`009`009log_event(myslot,E_HPOOFOUT,0,0,log_name,location);
X`009`009`009log_event(myslot,E_HPOOFIN,0,0,log_name,loc);
X`009`009end else begin
X`009`009`009log_event(myslot,E_POOFOUT,0,0,log_name,location);
X`009`009`009log_event(targslot,E_POOFIN,0,0,log_name,loc);
X`009`009end;
X
X`009`009take_token(myslot,location);
X`009`009myslot := targslot;
X`009`009location := loc;
X`009`009setevent;
X
X`009`009`123 one trap `125
X                oldloc := location;`009`009
X`009`009if prevcode > 0 then`032
X`009`009    run_monster('',prevcode,'escaped','','',
X`009`009`009sysdate+' '+systime);
X`009`009if oldloc <> location then goto 0; `123 panic `125
X
X`009`009do_look; if oldloc <> location then goto 0;
X `032
X              if here.hook > 0 then
X`009`009`009run_monster('',here.hook,'poof in','','',
X`009`009`009`009sysdate+' '+systime);
X
X`009`009if location = oldloc then meta_run('enter','','');
X
X`009end else
X`009`009writeln('There is a crackle of electricity, but the poof fails.');
X`0090: `123 for panic `125
Xend;
X
Xprocedure poof_monster(n: integer; s: string); forward;
X
Xprocedure poof_other(n: integer);
Xlabel exit_label;
Xvar
X`009loc: integer;
X`009s: string;
X
X    procedure leave;
X    begin
X`009writeln('EXIT - no changes.');
X`009goto exit_label;
X    end;
X
Xbegin
X`009if not protected(n) then begin
X`009`009grab_line('What room? ',s,eof_handler := leave);
X`009`009if here.people`091n`093.kind <> P_PLAYER then`032
X`009`009    if here.people`091n`093.kind = P_MONSTER then
X`009`009`009poof_monster(n,s)
X`009`009    else writeln('%error in poof_other.')
X`009`009else if protected(n) then writeln ('You can''t poof ',here.people`09
V1n`093.name,' now.')
X`009`009    `123   !!! necessary double checking !! `125
X`009`009else if lookup_room(loc,s) then begin
X`009`009`009log_event(myslot,E_POOFYOU,n,loc);
X`009`009`009writeln;
X`009`009`009writeln('You extend your arms, muster some energy, and ',here.pe
Vople`091n`093.name,' is');
X`009`009`009writeln('engulfed in a cloud of orange smoke.');
X`009`009`009writeln;
X`009`009end else
X`009`009`009writeln('There is no room named ',s,'.');
X`009end else writeln ('You can''t poof ',here.people`091n`093.name,' now.');
X    exit_label:
Xend;
X
Xprocedure do_poof(s: string);
Xlabel exit_label;
Xvar
X`009n,loc: integer;
X        sown,town: veryshortstring;
X
X    procedure leave;
X    begin
X`009writeln('EXIT - no changes.');
X`009goto exit_label;
X    end;
X
Xbegin
X`009if poof_priv then begin `123 minor change by leino@finuha `125
X`009`009gethere;
X`009`009if ((lookup_room(loc,s) and parse_pers(n,s)) or (s='')) then begin
X`009`009`009grab_line('Poof who? (<RETURN> for yourself) ',s,
X`009`009`009    eof_handler := leave);
X`009`009`009if s='' then begin
X`009`009`009`009grab_line('What room? ',s,
X`009`009`009`009`009eof_handler := leave);
X`009`009`009`009if lookup_room(loc,s) then
X`009`009`009`009`009xpoof(loc);
X`009`009`009end else if parse_pers(n,s) then
X`009`009`009`009`009poof_other(n)
X`009`009`009`009else
X`009`009`009`009`009writeln('I can see no-one named ',s,' here.');
X`009`009end else if lookup_room(loc,s) then
X`009`009`009xpoof(loc)
X`009`009else if parse_pers(n,s) then
X`009`009`009poof_other(n)
X`009`009else
X`009`009`009writeln('There is no room named ',s,'.');
X
X`009end else begin `123 unprivileged poof (hurtta@finuh) `125
X            gethere;
X            sown := here.owner;
X            if s = '' then grab_line('What room? ',s,eof_handler := leave);
X            if (s = '') or (s='?') then command_help('poof')
X            else if lookup_room(loc,s) then begin
X              gethere(loc);
X              town := here.owner;
X              if (sown <> userid) or (town <> userid) then
X                 writeln ('Only Monster Manager may poof in other people''s
V rooms.')
X              else xpoof(loc);
X            end else writeln ('No such room');
X`009end;`009
X    exit_label:
Xend;
X
X
X
Xprocedure link_room(origdir,targdir,targroom: integer);
Xvar owner: integer;
Xbegin
X`009`123 since exit creation involves the writing of two records,
X`009  perhaps there should be a global lock around this code,
X`009  such as a get to some obscure index field or something.
X`009  I haven't put this in because I don't believe that if this
X`009  routine fails it will seriously damage the database.
X
X`009  Actually, the lock should be on the test (do_link) but that
X`009  would be hard`009`125
X
X`009getroom;
X`009with here.exits`091origdir`093 do begin
X
X`009`009if (kind = 5) and exact_user(owner,here.owner) then
X`009`009    sub_counter(N_ACCEPT,owner);
X
X`009`009toloc := targroom;
X`009`009kind := 1; `123 type of exit, they can customize later `125
X`009`009slot := targdir; `123 exit it comes out in in target room `125
X
X`009`009init_exit(origdir);
X`009end;
X`009putroom;
X
X`009log_event(myslot,E_NEWEXIT,0,0,log_name,location);
X`009if location <> targroom then
X`009`009log_event(0,E_NEWEXIT,0,0,log_name,targroom);
X
X`009getroom(targroom);
X`009with here.exits`091targdir`093 do begin
X
X`009`009if (kind = 5) and exact_user(owner,here.owner) then
X`009`009    sub_counter(N_ACCEPT,owner);
X
X`009`009toloc := location;
X`009`009kind := 1;
X`009`009slot := origdir;
X
X`009`009init_exit(targdir);
X`009end;
X`009putroom;
X`009writeln('Exit created.  Use CUSTOM ',direct`091origdir`093,' to customiz
Ve your exit.');
Xend;
X
X
X`123
XUser procedure to link a room
X`125
Xprocedure do_link(s: string);
Xlabel exit_label;
Xvar
X`009ok: boolean;
X`009orgexitnam,targnam,trgexitnam: string;
X`009targroom,`009`123 number of target room `125
X`009targdir,`009`123 number of target exit direction `125
X`009origdir: integer;`123 number of exit direction here `125
X`009firsttime: boolean;
X
X    procedure leave;
X    begin
X`009writeln('EXIT - no changes.');
X`009goto exit_label;
X    end;
X
X
Xbegin
X
X`123`009gethere;`009! done in links_possible `125
X
X   if links_possible then begin
X`009log_action(link,0);
X`009if checkhide then begin
X`009writeln('Hit return alone at any prompt to terminate exit creation.');
X`009writeln;
X
X`009if s = '' then
X`009`009firsttime := false
X`009else begin
X`009`009orgexitnam := bite(s);
X`009`009firsttime := true;
X`009end;
X
X`009repeat
X`009`009if not(firsttime) then
X`009`009`009grab_line('Direction of exit? ',orgexitnam,
X`009`009`009`009eof_handler := leave)
X`009`009else
X`009`009`009firsttime := false;
X
X`009`009ok :=lookup_dir(origdir,orgexitnam,true);
X`009`009if ok then
X`009`009`009ok := can_make(origdir);
X`009until (orgexitnam = '') or ok;
X
X`009if ok then begin
X`009`009if s = '' then
X`009`009`009firsttime := false
X`009`009else begin
X`009`009`009targnam := s;
X`009`009`009firsttime := true;
X`009`009end;
X
X`009`009repeat
X`009`009`009if not(firsttime) then
X`009`009`009`009grab_line('Room to link to? ',targnam,
X`009`009`009`009    eof_handler := leave)
X`009`009`009else
X`009`009`009`009firsttime := false;
X
X`009`009`009ok := lookup_room(targroom,targnam,true);
X`009`009until (targnam = '') or ok;
X`009end;
X
X`009if ok then begin
X`009`009repeat
X`009`009`009writeln('Exit comes out in target room');
X`009`009`009grab_line('from what direction? ',trgexitnam,
X`009`009`009`009eof_handler := leave);
X`009`009`009ok := lookup_dir(targdir,trgexitnam,true);
X`009`009`009if ok then
X`009`009`009`009ok := can_make(targdir,targroom);
X`009`009until (trgexitnam='') or ok;
X`009end;
X
X`009if ok then begin `123 actually create the exit `125
X`009`009link_room(origdir,targdir,targroom);
X`009end;
X`009end;
X   end else
X`009writeln('No links are possible here.');
X    exit_label:
Xend;
X
X
Xprocedure relink_room(origdir,targdir,targroom: integer);
Xvar
X`009tmp: exit;
X`009copyslot,
X`009copyloc,owner: integer;
X
Xbegin
X`009gethere;
X`009tmp := here.exits`091origdir`093;
X`009copyloc := tmp.toloc;
X`009copyslot := tmp.slot;
X
X`009getroom(targroom);
X`009here.exits`091targdir`093 := tmp;
X`009putroom;
X
X`009getroom(copyloc);
X`009here.exits`091copyslot`093.toloc := targroom;
X`009here.exits`091copyslot`093.slot := targdir;
X`009putroom;
X
X`009getroom;
X`009here.exits`091origdir`093.toloc := 0;
X`009init_exit(origdir);
X`009putroom;
Xend;
X
X
Xprocedure do_relink(s: string);
Xlabel exit_label;
Xvar
X`009ok: boolean;
X`009orgexitnam,targnam,trgexitnam: string;
X`009targroom,`009`123 number of target room `125
X`009targdir,`009`123 number of target exit direction `125
X`009origdir: integer;`123 number of exit direction here `125
X`009firsttime: boolean;
X
X    procedure leave;
X    begin
X`009writeln('EXIT - no changes.');
X`009goto exit_label;
X    end;
X
Xbegin
X`009log_action(c_relink,0);
X`009gethere;
X`009if checkhide then begin
X`009writeln('Hit return alone at any prompt to terminate exit relinking.');
X`009writeln;
X
X`009if s = '' then
X`009`009firsttime := false
X`009else begin
X`009`009orgexitnam := bite(s);
X`009`009firsttime := true;
X`009end;
X
X`009repeat
X`009`009if not(firsttime) then
X`009`009`009grab_line('Direction of exit to relink? ',orgexitnam,
X`009`009`009    eof_handler := leave)
X`009`009else
X`009`009`009firsttime := false;
X
X`009`009ok :=lookup_dir(origdir,orgexitnam,true);
X`009`009if ok then
X`009`009`009ok := can_alter(origdir);
X`009until (orgexitnam = '') or ok;
X
X`009if ok then begin
X`009`009if s = '' then
X`009`009`009firsttime := false
X`009`009else begin
X`009`009`009targnam := s;
X`009`009`009firsttime := true;
X`009`009end;
X
X`009`009repeat
X`009`009`009if not(firsttime) then
X`009`009`009`009grab_line('Room to relink exit into? ',targnam,
X`009`009`009`009    eof_handler := leave)
X`009`009`009else
X`009`009`009`009firsttime := false;
X
X`009`009`009ok := lookup_room(targroom,targnam,true);
X`009`009until (targnam = '') or ok;
X`009end;
X
X`009if ok then begin
X`009`009repeat
X`009`009`009writeln('New exit comes out in target room');
X`009`009`009grab_line('from what direction? ',trgexitnam,
X`009`009`009    eof_handler := leave);
X`009`009`009ok := lookup_dir(targdir,trgexitnam,true);
X`009`009`009if ok then
X`009`009`009`009ok := can_make(targdir,targroom);
X`009`009until (trgexitnam='') or ok;
X`009end;
X
X`009if ok then begin `123 actually create the exit `125
X`009`009relink_room(origdir,targdir,targroom);
X`009end;
X`009end;
X    exit_label:
Xend;
X
X
X`123 print the room default no-go message if there is one;
X  otherwise supply the generic "you can't do that." `125
X
Xprocedure default_fail;
X
Xbegin
X`009if (here.exitfail <> 0) and (here.exitfail <> DEFAULT_LINE) then
X`009`009print_desc(here.exitfail)
X`009else
X`009`009writeln('You can''t do that.');
Xend;
X
Xprocedure  exit_fail(dir: integer);
Xvar
X`009tmp: string;
X
Xbegin
X`009if (dir < 1) or (dir > maxexit) then
X`009`009default_fail
X`009else if (here.exits`091dir`093.fail = DEFAULT_LINE) then begin
X`009`009case here.exits`091dir`093.kind of
X`009`009`0095: writeln('There isn''t an exit there yet.');
X`009`009`0096: writeln('You don''t have the power to go there.');
X`009`009`009otherwise default_fail;
X`009`009end;
X`009end else if here.exits`091dir`093.fail <> 0 then
X`009`009block_subs(here.exits`091dir`093.fail,myname);
X
X
X`123 now print the exit failure message for everyone else in the room:
X`009if they tried to go through a valid exit,
X`009  and the exit has an other-person failure desc, then
+-+-+-+-+-+-+-+-  END  OF PART 20 +-+-+-+-+-+-+-+-