games@tekred.TEK.COM (12/01/88)
Submitted by: Richard Skrenta <skrenta@nuacc.acns.nwu.edu>
Comp.sources.games: Volume 5, Issue 89
Archive-name: monster/Part02
#! /bin/sh
# This is a shell archive. Remove anything before this line, then unpack
# it by saving it into a file and typing "sh file". To overwrite existing
# files, type "sh file -c". You can also feed this as standard input via
# unshar, or by typing "sh <file", e.g.. If this archive is complete, you
# will see the following message at the end:
# "End of archive 2 (of 6)."
# Contents: manifest.txt mon4.pas
# Wrapped by billr@saab on Wed Nov 30 11:28:56 1988
PATH=/bin:/usr/bin:/usr/ucb ; export PATH
if test -f 'manifest.txt' -a "${1}" != "-c" ; then
echo shar: Will not clobber existing file \"'manifest.txt'\"
else
echo shar: Extracting \"'manifest.txt'\" \(588 characters\)
sed "s/^X//" >'manifest.txt' <<'END_OF_FILE'
XWelcome, new Monster Manager!
X
XHere are the files you will need to install Monster:
X----------------------------------------------------
X
Xreadme.txt - Credits and a brief introduction
Xguts.pas - Small pascal file; handles system calls for mon.pas
Xmon.pas - Monster, the code
Xprivusers.pas - Edit this for local stuff
Xinstall.txt - Brief installation instructions
Xannounce.txt - Fun announcement for Monster we used here
X (credit to the author: Jeff Orrok)
Xmonster.doc - Document about Monster
X
XSend questions and comments to
X
X skrenta@nuacc.acns.nwu.edu
X skrenta@nuacc.bitnet
END_OF_FILE
if test 588 -ne `wc -c <'manifest.txt'`; then
echo shar: \"'manifest.txt'\" unpacked with wrong size!
fi
# end of 'manifest.txt'
fi
if test -f 'mon4.pas' -a "${1}" != "-c" ; then
echo shar: Will not clobber existing file \"'mon4.pas'\"
else
echo shar: Extracting \"'mon4.pas'\" \(55833 characters\)
sed "s/^X//" >'mon4.pas' <<'END_OF_FILE'
X
Xprocedure do_custom(dirnam: string);
Xvar
X prompt: string;
X done : boolean;
X s: string;
X dir: integer;
X n: integer;
X
Xbegin
X gethere;
X if checkhide then begin
X if length(dirnam) = 0 then begin
X if is_owner(location,TRUE) then
X custom_room
X else begin
X writeln('You are not the owner of this room; you cannot customize it.');
X writeln('However, you may be able to customize some of the exits. To customize an');
X writeln('exit, type CUSTOM <direction of exit>');
X end;
X end else if lookup_dir(dir,dirnam) then begin
X if can_alter(dir) then begin
X log_action(c_custom,0);
X
X writeln('Customizing ',direct[dir],' exit');
X writeln('If you would rather be customizing this room, type CUSTOM with no arguments');
X writeln('If you would rather be customizing an object, type CUSTOM <object name>');
X writeln;
X writeln('Type ** for any line to leave it unchanged.');
X writeln('Type return for any line to select the default.');
X writeln;
X writev(prompt,'Custom ',direct[dir],'> ');
X done := false;
X repeat
X repeat
X grab_line(prompt,s);
X s := slead(s);
X until length(s) > 0;
X s := lowcase(s);
X case s[1] of
X '?','h': custom_help;
X 'q','e': done := true;
X 'k': get_key(dir);
X 'c': begin
X writeln('Type the description that a player will see when the exit is found.');
X writeln('Make no text for description to unconceal the exit.');
X writeln;
X writeln('[ Editing the "hidden exit found" description ]');
X n := here.exits[dir].hidden;
X if edit_desc(n) then begin
X getroom;
X here.exits[dir].hidden := n;
X putroom;
X end;
X end;
X{req alias} 'r': begin
X getroom;
X here.exits[dir].reqalias :=
X not(here.exits[dir].reqalias);
X putroom;
X
X if here.exits[dir].reqalias then
X writeln('The alias for this exit will be required to reference it.')
X else
X writeln('The alias will not be required to reference this exit.');
X end;
X{req verb} 'x': begin
X getroom;
X here.exits[dir].reqverb :=
X not(here.exits[dir].reqverb);
X putroom;
X
X if here.exits[dir].reqverb then
X writeln('The exit name will be required to be used as a verb to use the exit')
X else
X writeln('The exit name may be used with GO or as a verb to use the exit');
X end;
X{autolook} 'l': begin
X getroom;
X here.exits[dir].autolook :=
X not(here.exits[dir].autolook);
X putroom;
X
X if here.exits[dir].autolook then
X writeln('A LOOK will be done after the player travels through this exit.')
X else
X writeln('The automatic LOOK will not be done when a player uses this exit.');
X end;
X 'a': begin
X grab_line('Alternate name for the exit? ',s);
X if length(s) > veryshortlen then
X writeln('Your alias must be less than ',veryshortlen:1,' characters.')
X else begin
X getroom;
X here.exits[dir].alias := lowcase(s);
X putroom;
X end;
X end;
X 'v': analyze_exit(dir);
X 't': begin
X writeln;
X writeln('Select the type of your exit:');
X writeln;
X writeln('0) No exit');
X writeln('1) Open passage');
X writeln('2) Door (object required to pass)');
X writeln('3) No passage if holding key');
X if privd then
X writeln('4) exit randomly fails');
X writeln('6) Exit exists only when holding object');
X if privd then
X writeln('7) exit opens/closes invisibly every minute');
X writeln;
X grab_line('Which type? ',s);
X if isnum(s) then begin
X n := number(s);
X if n in [0..4,6..7] then begin
X getroom;
X here.exits[dir].kind := n;
X putroom;
X writeln('Exit type updated.');
X writeln;
X if n in [2,6] then
X get_key(dir);
X end else
X writeln('Bad exit type.');
X end else
X writeln('Exit type not changed.');
X end;
X 'f': begin
X writeln('The failure description will print if the player attempts to go through the');
X writeln('the exit but cannot for any reason.');
X writeln;
X writeln('[ Editing the exit failure description ]');
X
X n := here.exits[dir].fail;
X if edit_desc(n) then begin
X getroom;
X here.exits[dir].fail := n;
X putroom;
X end;
X end;
X 'i': begin
X writeln('Edit the description that other players see when someone goes into');
X writeln('the exit. Place a # where the player''s name should appear.');
X writeln;
X writeln('[ Editing the exit "go in" description ]');
X n := here.exits[dir].goin;
X if edit_desc(n) then begin
X getroom;
X here.exits[dir].goin := n;
X putroom;
X end;
X end;
X 'o': begin
X writeln('Edit the description that other players see when someone comes out of');
X writeln('the exit. Place a # where the player''s name should appear.');
X writeln;
X writeln('[ Editing the exit "come out of" description ]');
X n := here.exits[dir].comeout;
X if edit_desc(n) then begin
X getroom;
X here.exits[dir].comeout := n;
X putroom;
X end;
X end;
X{ main exit desc } 'd': begin
X writeln('Enter a one line description of the exit.');
X writeln;
X n := here.exits[dir].exitdesc;
X make_line(n);
X getroom;
X here.exits[dir].exitdesc := n;
X putroom;
X end;
X 's': begin
X writeln('The success description will print when the player goes through the exit.');
X writeln;
X writeln('[ Editing the exit success description ]');
X
X n := here.exits[dir].success;
X if edit_desc(n) then begin
X getroom;
X here.exits[dir].success := n;
X putroom;
X end;
X end;
X otherwise writeln('-- Bad command, type ? for a list');
X end;
X until done;
X
X
X log_event(myslot,E_CUSTDONE,0,0);
X end else
X writeln('You are not allowed to alter that exit.');
X end else if lookup_obj(n,dirnam) then
X{ if lookup_obj returns TRUE then dirnam is name of object to custom }
X do_program(dirnam) { customize the object }
X else begin
X writeln('To customize this room, type CUSTOM');
X writeln('To customize an exits, type CUSTOM <direction>');
X writeln('To customize an object, type CUSTOM <object name>');
X end;
X{ clear_command; }
X end;
Xend;
X
X
X
Xprocedure reveal_people(var three: boolean);
Xvar
X retry,i: integer;
X
Xbegin
X if debug then
X writeln('%revealing people');
X three := false;
X retry := 1;
X
X repeat
X retry := retry + 1;
X i := (rnd100 mod maxpeople) + 1;
X if (here.people[i].hiding > 0) and
X (i <> myslot) then begin
X three := true;
X writeln('You''ve found ',here.people[i].name,' hiding in the shadows!');
X log_event(myslot,E_FOUNDYOU,i,0);
X end;
X until (retry > 7) or three;
Xend;
X
X
X
Xprocedure reveal_objects(var two: boolean);
Xvar
X tmp: string;
X i: integer;
X
Xbegin
X if debug then
X writeln('%revealing objects');
X two := false;
X for i := 1 to maxobjs do begin
X if here.objs[i] <> 0 then { if there is an object here }
X if (here.objhide[i] <> 0) then begin
X two := true;
X
X if here.objhide[i] = DEFAULT_LINE then
X writeln('You''ve found ',obj_part(here.objs[i]),'.')
X else begin
X print_desc(here.objhide[i]);
X delete_block(here.objhide[i]);
X end;
X end;
X end;
Xend;
X
X
Xprocedure reveal_exits(var one: boolean);
Xvar
X retry,i: integer;
X
Xbegin
X if debug then
X writeln('%revealing exits');
X one := false;
X retry := 1;
X
X repeat
X retry := retry + 1;
X i := (rnd100 mod maxexit) + 1; { a random exit }
X if (here.exits[i].hidden <> 0) and (not found_exit[i]) then begin
X one := true;
X found_exit[i] := true; { mark exit as found }
X
X if here.exits[i].hidden = DEFAULT_LINE then begin
X if here.exits[i].alias = '' then
X writeln('You''ve found a hidden exit: ',direct[i],'.')
X else
X writeln('You''ve found a hidden exit: ',here.exits[i].alias,'.');
X end else
X print_desc(here.exits[i].hidden);
X end;
X until (retry > 4) or (one);
Xend;
X
X
Xprocedure do_search(s: string);
Xvar
X chance: integer;
X found,dummy: boolean;
X
Xbegin
X if checkhide then begin
X chance := rnd100;
X found := false;
X dummy := false;
X
X if chance in [1..20] then
X reveal_objects(found)
X else if chance in [21..40] then
X reveal_exits(found)
X else if chance in [41..60] then
X reveal_people(dummy);
X
X if found then begin
X log_event(myslot,E_FOUND,0,0);
X end else if not(dummy) then begin
X log_event(myslot,E_SEARCH,0,0);
X writeln('You haven''t found anything.');
X end;
X end;
Xend;
X
Xprocedure do_unhide(s: string);
X
Xbegin
X if s = '' then begin
X if hiding then begin
X hiding := false;
X log_event(myslot,E_UNHIDE,0,0);
X getroom;
X here.people[myslot].hiding := 0;
X putroom;
X writeln('You are no longer hiding.');
X end else
X writeln('You were not hiding.');
X end;
Xend;
X
X
Xprocedure do_hide(s: string);
Xvar
X slot,n: integer;
X founddsc: integer;
X tmp: string;
X
Xbegin
X gethere;
X if s = '' then begin { hide yourself }
X
X { don't let them hide (or hide better) if people
X that they can see are in the room. Note that the
X use of n_can_see instead of find_numpeople will
X let them hide if other people are hidden in the
X room that they have not seen. The previously hidden
X people will see them hide }
X
X if n_can_see > 0 then begin
X if hiding then
X writeln('You can''t hide any better with people in the room.')
X else
X writeln('You can''t hide when people are watching you.');
X end else if (rnd100 > 25) then begin
X if here.people[myslot].hiding >= 4 then
X writeln('You''re pretty well hidden now. I don''t think you could be any less visible.')
X else begin
X getroom;
X here.people[myslot].hiding :=
X here.people[myslot].hiding + 1;
X putroom;
X if hiding then begin
X log_event(myslot,E_NOISES,rnd100,0);
X writeln('You''ve managed to hide yourself a little better.');
X end else begin
X log_event(myslot,E_IHID,0,0);
X writeln('You''ve hidden yourself from view.');
X hiding := true;
X end;
X end;
X end else begin { unsuccessful }
X if hiding then
X writeln('You could not find a better hiding place.')
X else
X writeln('You could not find a good hiding place.');
X end;
X end else begin { Hide an object }
X if parse_obj(n,s) then begin
X if obj_here(n) then begin
X writeln('Enter the description the player will see when the object is found:');
X writeln('(if no description is given a default will be supplied)');
X writeln;
X writeln('[ Editing the "object found" description ]');
X founddsc := 0;
X if edit_desc(founddsc) then ;
X if founddsc = 0 then
X founddsc := DEFAULT_LINE;
X
X getroom;
X slot := find_obj(n);
X here.objhide[slot] := founddsc;
X putroom;
X
X tmp := obj_part(n);
X log_event(myslot,E_HIDOBJ,0,0,tmp);
X writeln('You have hidden ',tmp,'.');
X end else if obj_hold(n) then begin
X writeln('You''ll have to put it down before it can be hidden.');
X end else
X writeln('I see no such object here.');
X end else
X writeln('I see no such object here.');
X end;
Xend;
X
X
Xprocedure do_punch(s: string);
Xvar
X sock,n: integer;
X
Xbegin
X if s <> '' then begin
X if parse_pers(n,s) then begin
X if n = myslot then
X writeln('Self-abuse will not be tolerated in the Monster universe.')
X else if protected(n) then begin
X log_event(myslot,E_TRYPUNCH,n,0);
X writeln('A mystic shield of force prevents you from attacking.');
X end else if here.people[n].username = MM_userid then begin
X log_event(myslot,E_TRYPUNCH,n,0);
X writeln('You can''t punch the Monster Manager.');
X end else begin
X if hiding then begin
X hiding := false;
X
X getroom;
X here.people[myslot].hiding := 0;
X putroom;
X
X log_event(myslot,E_HIDEPUNCH,n,0);
X writeln('You pounce unexpectedly on ',here.people[n].name,'!');
X end else begin
X sock := (rnd100 mod numpunches)+1;
X log_event(myslot,E_PUNCH,n,sock);
X put_punch(sock,here.people[n].name);
X end;
X wait(1+random*3); { Ha ha ha }
X end;
X end else
X writeln('That person cannot be seen in this room.');
X end else
X writeln('To punch somebody, type PUNCH <personal name>.');
Xend;
X
X
X{ support for do_program (custom an object)
X Give the player a list of kinds of object he's allowed to make his object
X and update it }
X
Xprocedure prog_kind(objnum: integer);
Xvar
X n: integer;
X s: string;
X
Xbegin
X writeln('Select the type of your object:');
X writeln;
X writeln('0 Ordinary object (good for door keys)');
X writeln('1 Weapon');
X writeln('2 Armor');
X writeln('3 Exit thruster');
X
X if privd then begin
X writeln;
X writeln('100 Bag');
X writeln('101 Crystal Ball');
X writeln('102 Wand of Power');
X writeln('103 Hand of Glory');
X end;
X writeln;
X grab_line('Which kind? ',s);
X
X if isnum(s) then begin
X n := number(s);
X if (n > 100) and (privd) then
X writeln('Out of range.')
X else if n in [0..3,100..103] then begin
X getobj(objnum);
X obj.kind := n;
X putobj;
X writeln('Object updated.');
X end else
X writeln('Out of range.');
X end;
Xend;
X
X
X
X{ support for do_program (custom an object)
X Based on the kind it is allow the
X user to set the various parameters for the effects associated with that
X kind }
X
Xprocedure prog_obj(objnum: integer);
X
Xbegin
Xend;
X
X
Xprocedure show_kind(p: integer);
X
Xbegin
X case p of
X 0: writeln('Ordinary object');
X 1: writeln('Weapon');
X 2: writeln('Armor');
X 100: writeln('Bag');
X 101: writeln('Crystal Ball');
X 102: writeln('Wand of Power');
X 103: writeln('Hand of Glory');
X otherwise writeln('Bad object type');
X end;
Xend;
X
X
Xprocedure obj_view(objnum: integer);
X
Xbegin
X writeln;
X getobj(objnum);
X freeobj;
X getobjown;
X freeobjown;
X writeln('Object name: ',obj.oname);
X writeln('Owner: ',objown.idents[objnum]);
X writeln;
X show_kind(obj.kind);
X writeln;
X
X if obj.linedesc = 0 then
X writeln('There is a(n) # here')
X else
X print_line(obj.linedesc);
X
X if obj.examine = 0 then
X writeln('No inspection description set')
X else
X print_desc(obj.examine);
X
X{ writeln('Worth (in points) of this object: ',obj.worth:1); }
X writeln('Number in existence: ',obj.numexist:1);
X writeln;
Xend;
X
X
Xprocedure program_help;
X
Xbegin
X writeln;
X writeln('A "a", "an", "some", etc.');
X writeln('D Edit a Description of the object');
X writeln('F Edit the GET failure message');
X writeln('G Set the object required to pick up this object');
X writeln('1 Set the get success message');
X writeln('K Set the Kind of object this is');
X writeln('L Edit the label description ("There is a ... here.")');
X writeln('P Program the object based on the kind it is');
X writeln('R Rename the object');
X writeln('S Toggle the sticky bit');
X writeln;
X writeln('U Set the object required for use');
X writeln('2 Set the place required for use');
X writeln('3 Edit the use failure description');
X writeln('4 Edit the use success description');
X writeln('V View attributes of this object');
X writeln;
X writeln('X Edit the extra description');
X writeln('5 Edit extra desc #2');
X writeln('E Exit (same as Quit)');
X writeln('Q Quit (same as Exit)');
X writeln('? This list');
X writeln;
Xend;
X
X
Xprocedure do_program; { (objnam: string); declared forward }
Xvar
X prompt: string;
X done : boolean;
X s: string;
X objnum: integer;
X n: integer;
X newdsc: integer;
X
Xbegin
X gethere;
X if checkhide then begin
X if length(objnam) = 0 then begin
X writeln('To program an object, type PROGRAM <object name>.');
X end else if lookup_obj(objnum,objnam) then begin
X if not is_owner(location,TRUE) then begin
X writeln('You may only work on your objects when you are in one of your own rooms.');
X end else if obj_owner(objnum) then begin
X log_action(e_program,0);
X writeln;
X writeln('Customizing object');
X writeln('If you would rather be customizing an EXIT, type CUSTOM <direction of exit>');
X writeln('If you would rather be customizing this room, type CUSTOM');
X writeln;
X getobj(objnum);
X freeobj;
X prompt := 'Custom object> ';
X done := false;
X repeat
X repeat
X grab_line(prompt,s);
X s := slead(s);
X until length(s) > 0;
X s := lowcase(s);
X case s[1] of
X '?','h': program_help;
X 'q','e': done := true;
X 'v': obj_view(objnum);
X 'r': do_objrename(objnum);
X 'g': begin
X writeln('Enter * for no object');
X grab_line('Object required for GET? ',s);
X if s = '*' then begin
X getobj(objnum);
X obj.getobjreq := 0;
X putobj;
X end else if lookup_obj(n,s) then begin
X getobj(objnum);
X obj.getobjreq := n;
X putobj;
X writeln('Object modified.');
X end else
X writeln('No such object.');
X end;
X 'u': begin
X writeln('Enter * for no object');
X grab_line('Object required for USE? ',s);
X if s = '*' then begin
X getobj(objnum);
X obj.useobjreq := 0;
X putobj;
X end else if lookup_obj(n,s) then begin
X getobj(objnum);
X obj.useobjreq := n;
X putobj;
X writeln('Object modified.');
X end else
X writeln('No such object.');
X end;
X '2': begin
X writeln('Enter * for no special place');
X grab_line('Place required for USE? ',s);
X if s = '*' then begin
X getobj(objnum);
X obj.uselocreq := 0;
X putobj;
X end else if lookup_room(n,s) then begin
X getobj(objnum);
X obj.uselocreq := n;
X putobj;
X writeln('Object modified.');
X end else
X writeln('No such object.');
X end;
X 's': begin
X getobj(objnum);
X obj.sticky := not(obj.sticky);
X putobj;
X if obj.sticky then
X writeln('The object will not be takeable.')
X else
X writeln('The object will be takeable.');
X end;
X 'a': begin
X writeln;
X writeln('Select the article for your object:');
X writeln;
X writeln('0) None ex: " You have taken Excalibur "');
X writeln('1) "a" ex: " You have taken a small box "');
X writeln('2) "an" ex: " You have taken an empty bottle "');
X writeln('3) "some" ex: " You have picked up some jelly beans "');
X writeln('4) "the" ex: " You have picked up the Scepter of Power"');
X writeln;
X grab_line('? ',s);
X if isnum(s) then begin
X n := number(s);
X if n in [0..4] then begin
X getobj(objnum);
X obj.particle := n;
X putobj;
X end else
X writeln('Out of range.');
X end else
X writeln('No changes.');
X end;
X 'k': begin
X prog_kind(objnum);
X end;
X 'p': begin
X prog_obj(objnum);
X end;
X 'd': begin
X newdsc := obj.examine;
X writeln('[ Editing the description of the object ]');
X if edit_desc(newdsc) then begin
X getobj(objnum);
X obj.examine := newdsc;
X putobj;
X end;
X end;
X 'x': begin
X newdsc := obj.d1;
X writeln('[ Editing extra description #1 ]');
X if edit_desc(newdsc) then begin
X getobj(objnum);
X obj.d1 := newdsc;
X putobj;
X end;
X end;
X '5': begin
X newdsc := obj.d2;
X writeln('[ Editing extra description #2 ]');
X if edit_desc(newdsc) then begin
X getobj(objnum);
X obj.d2 := newdsc;
X putobj;
X end;
X end;
X 'f': begin
X newdsc := obj.getfail;
X writeln('[ Editing the get failure description ]');
X if edit_desc(newdsc) then begin
X getobj(objnum);
X obj.getfail := newdsc;
X putobj;
X end;
X end;
X '1': begin
X newdsc := obj.getsuccess;
X writeln('[ Editing the get success description ]');
X if edit_desc(newdsc) then begin
X getobj(objnum);
X obj.getsuccess := newdsc;
X putobj;
X end;
X end;
X '3': begin
X newdsc := obj.usefail;
X writeln('[ Editing the use failure description ]');
X if edit_desc(newdsc) then begin
X getobj(objnum);
X obj.usefail := newdsc;
X putobj;
X end;
X end;
X '4': begin
X newdsc := obj.usesuccess;
X writeln('[ Editing the use success description ]');
X if edit_desc(newdsc) then begin
X getobj(objnum);
X obj.usesuccess := newdsc;
X putobj;
X end;
X end;
X 'l': begin
X writeln('Enter a one line description of what the object will look like in any room.');
X writeln('Example: "There is an as unyet described object here."');
X writeln;
X getobj(objnum);
X freeobj;
X n := obj.linedesc;
X make_line(n);
X getobj(objnum);
X obj.linedesc := n;
X putobj;
X end;
X otherwise writeln('-- Bad command, type ? for a list');
X end;
X until done;
X log_event(myslot,E_OBJDONE,objnum,0);
X
X end else
X writeln('You are not allowed to program that object.');
X end else
X writeln('There is no object by that name.');
X end;
Xend;
X
X
X{ returns TRUE if anything was actually dropped }
Xfunction drop_everything;
X{ forward function drop_everything(pslot: integer := 0): boolean; }
Xvar
X i: integer;
X slot: integer;
X didone: boolean;
X theobj: integer;
X tmp: string;
X
Xbegin
X if pslot = 0 then
X pslot := myslot;
X
X gethere;
X didone := false;
X
X mywield := 0;
X mywear := 0;
X
X for i := 1 to maxhold do begin
X if here.people[pslot].holding[i] <> 0 then begin
X didone := true;
X theobj := here.people[pslot].holding[i];
X slot := find_hold(theobj,pslot);
X if place_obj(theobj,TRUE) then begin
X drop_obj(slot,pslot);
X end else begin { no place to put it, it's lost .... }
X getobj(theobj);
X obj.numexist := obj.numexist - 1;
X putobj;
X tmp := obj.oname;
X writeln('The ',tmp,' was lost.');
X end;
X end;
X end;
X
X drop_everything := didone;
Xend;
X
Xprocedure do_endplay(lognum: integer;ping:boolean := FALSE);
X
X{ If update is true do_endplay will update the "last play" date & time
X we don't want to do this if this endplay is called from a ping }
X
Xbegin
X if not(ping) then begin
X { Set the "last date & time of play" }
X getdate;
X adate.idents[lognum] := sysdate + ' ' + systime;
X putdate;
X end;
X
X
X { Put the player to sleep. Don't delete his information,
X so it can be restored the next time they play. }
X
X getindex(I_ASLEEP);
X indx.free[lognum] := true; { Yes, I'm asleep }
X putindex;
Xend;
X
X
Xfunction check_person(n: integer;id: string):boolean;
X
Xbegin
X inmem := false;
X gethere;
X if here.people[n].username = id then
X check_person := true
X else
X check_person := false;
Xend;
X
X
Xfunction nuke_person(n: integer;id: string): boolean;
Xvar
X lognum: integer;
X tmp: string;
X
Xbegin
X getroom;
X if here.people[n].username = id then begin
X
X { drop everything they're carrying }
X drop_everything(n);
X
X tmp := here.people[n].username;
X { we'll need this for do_endplay }
X
X { Remove the person from the room }
X here.people[n].kind := 0;
X here.people[n].username := '';
X here.people[n].name := '';
X putroom;
X
X { update the log entries for them }
X { but first we have to find their log number
X (mylog for them). We can do this with a lookup_user
X give the userid we got above }
X
X if lookup_user(lognum,tmp) then begin
X do_endplay(lognum,TRUE);
X { TRUE tells do_endplay not to update the
X "time of last play" information 'cause we
X don't know how long the "zombie" has been
X there. }
X end else
X writeln('%error in nuke_person; can''t fing their log number; notify the Monster Manager');
X
X nuke_person := true;
X end else begin
X freeroom;
X nuke_person := false;
X end;
Xend;
X
X
Xfunction ping_player(n:integer;silent: boolean := false): boolean;
Xvar
X retry: integer;
X id: string;
X idname: string;
X
Xbegin
X ping_player := false;
X
X id := here.people[n].username;
X idname := here.people[n].name;
X
X retry := 0;
X ping_answered := false;
X
X repeat
X retry := retry + 1;
X if not(silent) then
X writeln('Sending ping # ',retry:1,' to ',idname,' . . .');
X
X log_event(myslot,E_PING,n,0,myname);
X wait(1);
X checkevents(TRUE);
X { TRUE = don't reprint prompt }
X
X if not(ping_answered) then
X if check_person(n,id) then begin
X wait(1);
X checkevents(TRUE);
X end else
X ping_answered := true;
X
X if not(ping_answered) then
X if check_person(n,id) then begin
X wait(1);
X checkevents(TRUE);
X end else
X ping_answered := true;
X
X until (retry >= 3) or ping_answered;
X
X if not(ping_answered) then begin
X if not(silent) then
X writeln('That person is not responding to your pings . . .');
X
X if nuke_person(n,id) then begin
X ping_player := true;
X if not(silent) then
X writeln(idname,' shimmers and vanishes from sight.');
X log_event(myslot,E_PINGONE,n,0,idname);
X end else
X if not(silent) then
X writeln('That person is not a zombie after all.');
X end else
X if not(silent) then
X writeln('That person is alive and well.');
Xend;
X
X
Xprocedure do_ping(s: string);
Xvar
X n: integer;
X dummy: boolean;
X
Xbegin
X if s <> '' then begin
X if parse_pers(n,s) then begin
X if n = myslot then
X writeln('Don''t ping yourself.')
X else
X dummy := ping_player(n);
X end else
X writeln('You see no person here by that name.');
X end else
X writeln('To see if someone is really alive, type PING <personal name>.');
Xend;
X
Xprocedure list_get;
Xvar
X first: boolean;
X i: integer;
X
Xbegin
X first := true;
X for i := 1 to maxobjs do begin
X if (here.objs[i] <> 0) and
X (here.objhide[i] = 0) then begin
X if first then begin
X writeln('Objects that you see here:');
X first := false;
X end;
X writeln(' ',obj_part(here.objs[i]));
X end;
X end;
X if first then
X writeln('There is nothing you see here that you can get.');
Xend;
X
X
X
X{ print the get success message for object number n }
X
Xprocedure p_getsucc(n: integer);
X
Xbegin
X { we assume getobj has already been done }
X if (obj.getsuccess = 0) or (obj.getsuccess = DEFAULT_LINE) then
X writeln('Taken.')
X else
X print_desc(obj.getsuccess);
Xend;
X
X
Xprocedure do_meta_get(n: integer);
Xvar
X slot: integer;
X
Xbegin
X if obj_here(n) then begin
X if can_hold then begin
X slot := find_obj(n);
X if take_obj(n,slot) then begin
X hold_obj(n);
X log_event(myslot,E_GET,0,0,
X{ >>> } myname + ' has picked up ' + obj_part(n) + '.');
X p_getsucc(n);
X end else
X writeln('Someone got to it before you did.');
X end else
X writeln('Your hands are full. You''ll have to drop something you''re carrying first.');
X end else if obj_hold(n) then
X writeln('You''re already holding that item.')
X else
X writeln('That item isn''t in an obvious place.');
Xend;
X
X
Xprocedure do_get(s: string);
Xvar
X n: integer;
X ok: boolean;
X
Xbegin
X if s = '' then begin
X list_get;
X end else if parse_obj(n,s,TRUE) then begin
X getobj(n);
X freeobj;
X ok := true;
X
X if obj.sticky then begin
X ok := false;
X log_event(myslot,E_FAILGET,n,0);
X if (obj.getfail = 0) or (obj.getfail = DEFAULT_LINE) then
X writeln('You can''t take ',obj_part(n,FALSE),'.')
X else
X print_desc(obj.getfail);
X end else if obj.getobjreq > 0 then begin
X if not(obj_hold(obj.getobjreq)) then begin
X ok := false;
X log_event(myslot,E_FAILGET,n,0);
X if (obj.getfail = 0) or (obj.getfail = DEFAULT_LINE) then
X writeln('You''ll need something first to get the ',obj_part(n,FALSE),'.')
X else
X print_desc(obj.getfail);
X end;
X end;
X
X if ok then
X do_meta_get(n); { get the object }
X
X end else if lookup_detail(n,s) then begin
X writeln('That detail of this room is here for the enjoyment of all Monster players,');
X writeln('and may not be taken.');
X end else
X writeln('There is no object here by that name.');
Xend;
X
X
Xprocedure do_drop(s: string);
Xvar
X slot,n: integer;
X
Xbegin
X if s = '' then begin
X writeln('To drop an object, type DROP <object name>.');
X writeln('To see what you are carrying, type INV (inventory).');
X end else if parse_obj(n,s) then begin
X if obj_hold(n) then begin
X getobj(n);
X freeobj;
X if obj.sticky then
X writeln('You can''t drop sticky objects.')
X else if can_drop then begin
X slot := find_hold(n);
X if place_obj(n) then begin
X drop_obj(slot);
X log_event(myslot,E_DROP,0,n,
X myname + ' has dropped '+obj_part(n) + '.');
X
X if mywield = n then begin
X mywield := 0;
X getroom;
X here.people[myslot].wielding := 0;
X putroom;
X end;
X if mywear = n then begin
X mywear := 0;
X getroom;
X here.people[myslot].wearing := 0;
X putroom;
X end;
X end else
X writeln('Someone took the spot where your were going to drop it.');
X end else
X writeln('It is too cluttered here. Find somewhere else to drop your things.');
X end else begin
X writeln('You''re not holding that item. To see what you''re holding, type INV.');
X end;
X end else
X writeln('You''re not holding that item. To see what you''re holding, type INVENTORY.');
Xend;
X
X
Xprocedure do_inv(s: string);
Xvar
X first: boolean;
X i,n: integer;
X objnum: integer;
X
Xbegin
X gethere;
X if s = '' then begin
X noisehide(50);
X first := true;
X log_event(myslot,E_INVENT,0,0);
X for i := 1 to maxhold do begin
X objnum := here.people[myslot].holding[i];
X if objnum <> 0 then begin
X if first then begin
X writeln('You are holding:');
X first := false;
X end;
X writeln(' ',obj_part(objnum));
X end;
X end;
X if first then
X writeln('You are empty handed.');
X end else if parse_pers(n,s) then begin
X first := true;
X log_event(myslot,E_LOOKYOU,n,0);
X for i := 1 to maxhold do begin
X objnum := here.people[n].holding[i];
X if objnum <> 0 then begin
X if first then begin
X writeln(here.people[n].name,' is holding:');
X first := false;
X end;
X writeln(' ',objnam.idents[ objnum ]);
X end;
X end;
X if first then
X writeln(here.people[n].name,' is empty handed.');
X end else
X writeln('To see what someone else is carrying, type INV <personal name>.');
Xend;
X
X
X{ translate a personal name into a real userid on request }
X
Xprocedure do_whois(s: string);
Xvar
X n: integer;
X
Xbegin
X if lookup_pers(n,s) then begin
X getuser;
X freeuser;
X{ getpers;
X freepers; ! Already done in lookup_pers ! }
X
X writeln(pers.idents[n],' is ',user.idents[n],'.');
X end else
X writeln('There is no one playing with that personal name.');
Xend;
X
X
Xprocedure do_players(s: string);
Xvar
X i,j: integer;
X tmpasleep: indexrec;
X where_they_are: intrec;
X
Xbegin
X log_event(myslot,E_PLAYERS,0,0);
X getindex(I_ASLEEP); { Rec of bool; False if playing now }
X freeindex;
X tmpasleep := indx;
X
X getindex(I_PLAYER); { Rec of valid player log records }
X freeindex; { False if a valid player log }
X
X getuser; { Corresponding userids of players }
X freeuser;
X
X getpers; { Personal names of players }
X freepers;
X
X getdate; { date of last play }
X freedate;
X
X if privd then begin
X getint(N_LOCATION);
X freeint;
X where_they_are := anint;
X
X getnam;
X freenam;
X end;
X
X getint(N_SELF);
X freeint;
X
X writeln;
X writeln('Userid Personal Name Last Play');
X for i := 1 to maxplayers do begin
X if not(indx.free[i]) then begin
X write(user.idents[i]);
X for j := length(user.idents[i]) to 15 do
X write(' ');
X write(pers.idents[i]);
X for j := length(pers.idents[i]) to 21 do
X write(' ');
X
X if tmpasleep.free[i] then begin
X write(adate.idents[i]);
X if length(adate.idents[i]) < 19 then
X for j := length(adate.idents[i]) to 18 do
X write(' ');
X end else
X write(' -playing now- ');
X
X if (anint.int[i] <> 0) and (anint.int[i] <> DEFAULT_LINE) then
X write(' * ')
X else
X write(' ');
X
X if privd then begin
X write(nam.idents[ where_they_are.int[i] ]);
X end;
X writeln;
X end;
X end;
X writeln;
Xend;
X
X
Xprocedure do_self(s: string);
Xvar
X n: integer;
X
Xbegin
X if length(s) = 0 then begin
X log_action(c_self,0);
X writeln('[ Editing your self description ]');
X if edit_desc(myself) then begin
X getroom;
X here.people[myslot].self := myself;
X putroom;
X getint(N_SELF);
X anint.int[mylog] := myself;
X putint;
X log_event(myslot,E_SELFDONE,0,0);
X end;
X end else if lookup_pers(n,s) then begin
X getint(N_SELF);
X freeint;
X if (anint.int[n] = 0) or (anint.int[n] = DEFAULT_LINE) then
X writeln('That person has not made a self-description.')
X else begin
X print_desc(anint.int[n]);
X log_event(myslot,E_VIEWSELF,0,0,pers.idents[n]);
X end;
X end else
X writeln('There is no person by that name.');
Xend;
X
X
Xprocedure do_health(s: string);
X
Xbegin
X write('You ');
X case myhealth of
X 9: writeln('are in exceptional health.');
X 8: writeln('are in better than average condition.');
X 7: writeln('are in perfect health.');
X 6: writeln('feel a little bit dazed.');
X 5: writeln('have some minor cuts and abrasions.');
X 4: writeln('have some wounds, but are still fairly strong.');
X 3: writeln('are suffering from some serious wounds.');
X 2: writeln('are very badly wounded.');
X 1: writeln('have many serious wounds, and are near death.');
X 0: writeln('are dead.');
X otherwise writeln('don''t seem to be in any condition at all.');
X end;
Xend;
X
X
Xprocedure crystal_look(chill_msg: integer);
Xvar
X numobj,numppl,numsee: integer;
X i: integer;
X yes: boolean;
X
Xbegin
X writeln;
X print_desc(here.primary);
X log_event(0,E_CHILL,chill_msg,0,'',here.locnum);
X numppl := find_numpeople;
X numsee := n_can_see + 1;
X
X if numppl > numsee then
X writeln('Someone is hiding here.')
X else if numppl = 0 then begin
X writeln('Strange, empty shadows swirl before your eyes.');
X end;
X if rnd100 > 50 then
X people_header('at this place.')
X else case numppl of
X 0: writeln('Vague empty forms drift through your view.');
X 1: writeln('You can make out a shadowy figure here.');
X 2: writeln('There are two dark figures here.');
X 3: writeln('You can see the silhouettes of three people.');
X otherwise
X writeln('Many dark figures can be seen here.');
X end;
X
X numobj := find_numobjs;
X if rnd100 > 50 then begin
X if rnd100 > 50 then
X show_objects
X else if numobj > 0 then
X writeln('Some objects are here.')
X else
X writeln('There are no objects here.');
X end else begin
X yes := false;
X for i := 1 to maxobjs do
X if here.objhide[i] <> 0 then
X yes := true;
X if yes then
X writeln('Something is hidden here.');
X end;
X writeln;
Xend;
X
X
Xprocedure use_crystal(objnum: integer);
Xvar
X done: boolean;
X s: string;
X n: integer;
X done_msg,chill_msg: integer;
X tmp: string;
X i: integer;
X
Xbegin
X if obj_hold(objnum) then begin
X log_action(e_usecrystal,0);
X getobj(objnum);
X freeobj;
X done_msg := obj.d1;
X chill_msg := obj.d2;
X
X grab_line('',s);
X if lookup_room(n,s) then begin
X gethere(n);
X crystal_look(chill_msg);
X done := false;
X end else
X done := true;
X
X while not(done) do begin
X grab_line('',s);
X if lookup_dir(n,s) then begin
X if here.exits[n].toloc > 0 then begin
X gethere(here.exits[n].toloc);
X crystal_look(chill_msg);
X end;
X end else begin
X s := lowcase(s);
X tmp := bite(s);
X if tmp = 'poof' then begin
X if lookup_room(n,s) then begin
X gethere(n);
X crystal_look(chill_msg);
X end else
X done := true;
X end else if tmp = 'say' then begin
X i := (rnd100 mod 4) + 1;
X log_event(0,E_NOISE2,i,0,'',n);
X end else
X done := true;
X end;
X end;
X
X gethere;
X log_event(myslot,E_DONECRYSTALUSE,0,0);
X print_desc(done_msg);
X end else
X writeln('You must be holding it first.');
Xend;
X
X
X
Xprocedure p_usefail(n: integer);
X
Xbegin
X { we assume getobj has already been done }
X if (obj.usefail = 0) or (obj.usefail = DEFAULT_LINE) then
X writeln('It doesn''t work for some reason.')
X else
X print_desc(obj.usefail);
Xend;
X
X
Xprocedure p_usesucc(n: integer);
X
Xbegin
X { we assume getobj has already been done }
X if (obj.usesuccess = 0) or (obj.usesuccess = DEFAULT_LINE) then
X writeln('It seems to work, but nothing appears to happen.')
X else
X print_desc(obj.usesuccess);
Xend;
X
X
Xprocedure do_use(s: string);
Xvar
X n: integer;
X
Xbegin
X if length(s) = 0 then
X writeln('To use an object, type USE <object name>')
X else if parse_obj(n,s) then begin
X getobj(n);
X freeobj;
X
X if (obj.useobjreq > 0) and not(obj_hold(obj.useobjreq)) then begin
X log_event(myslot,E_FAILUSE,n,0);
X p_usefail(n);
X end else if (obj.uselocreq > 0) and (location <> obj.uselocreq) then begin
X log_event(myslot,E_FAILUSE,n,0);
X p_usefail(n);
X end else begin
X p_usesucc(n);
X case obj.kind of
X O_BLAND:;
X O_CRYSTAL: use_crystal(n);
X otherwise ;
X end;
X end;
X end else
X writeln('There is no such object here.');
Xend;
X
X
Xprocedure do_whisper(s: string);
Xvar
X n: integer;
X
Xbegin
X if length(s) = 0 then begin
X writeln('To whisper to someone, type WHISPER <personal name>.');
X end else if parse_pers(n,s) then begin
X if n = myslot then
X writeln('You can''t whisper to yourself.')
X else begin
X grab_line('>> ',s);
X if length(s) > 0 then begin
X nice_say(s);
X log_event(myslot,E_WHISPER,n,0,s);
X end else
X writeln('Nothing whispered.');
X end;
X end else
X writeln('No such person can be seen here.');
Xend;
X
X
Xprocedure do_wield(s: string);
Xvar
X tmp: string;
X slot,n: integer;
X
Xbegin
X if length(s) = 0 then begin { no parms means unwield }
X if mywield = 0 then
X writeln('You are not wielding anything.')
X else begin
X getobj(mywield);
X freeobj;
X tmp := obj.oname;
X log_event(myslot,E_UNWIELD,0,0,tmp);
X writeln('You are no longer wielding the ',tmp,'.');
X
X mywield := 0;
X getroom;
X here.people[mylog].wielding := 0;
X putroom;
X end;
X end else if parse_obj(n,s) then begin
X if mywield <> 0 then begin
X writeln('You are already wielding ',obj_part(mywield),'.');
X end else begin
X getobj(n);
X freeobj;
X tmp := obj.oname;
X if obj.kind = O_WEAPON then begin
X if obj_hold(n) then begin
X mywield := n;
X getroom;
X here.people[myslot].wielding := n;
X putroom;
X
X log_event(myslot,E_WIELD,0,0,tmp);
X writeln('You are now wielding the ',tmp,'.');
X end else
X writeln('You must be holding it first.');
X end else
X writeln('That is not a weapon.');
X end;
X end else
X writeln('No such weapon can be seen here.');
Xend;
X
X
Xprocedure do_wear(s: string);
Xvar
X tmp: string;
X slot,n: integer;
X
Xbegin
X if length(s) = 0 then begin { no parms means unwield }
X if mywear = 0 then
X writeln('You are not wearing anything.')
X else begin
X getobj(mywear);
X freeobj;
X tmp := obj.oname;
X log_event(myslot,E_UNWEAR,0,0,tmp);
X writeln('You are no longer wearing the ',tmp,'.');
X
X mywear := 0;
X getroom;
X here.people[mylog].wearing := 0;
X putroom;
X end;
X end else if parse_obj(n,s) then begin
X getobj(n);
X freeobj;
X tmp := obj.oname;
X if (obj.kind = O_ARMOR) or (obj.kind = O_CLOAK) then begin
X if obj_hold(n) then begin
X mywear := n;
X getroom;
X here.people[mylog].wearing := n;
X putroom;
X
X log_event(myslot,E_WEAR,0,0,tmp);
X writeln('You are now wearing the ',tmp,'.');
X end else
X writeln('You must be holding it first.');
X end else
X writeln('That cannot be worn.');
X end else
X writeln('No such thing can be seen here.');
Xend;
X
X
Xprocedure do_brief;
X
Xbegin
X brief := not(brief);
X if brief then
X writeln('Brief descriptions.')
X else
X writeln('Verbose descriptions.');
Xend;
X
X
Xfunction p_door_key(n: integer): string;
X
Xbegin
X if n = 0 then
X p_door_key := '<none>'
X else
X p_door_key := objnam.idents[n];
Xend;
X
X
X
Xprocedure anal_exit(dir: integer);
X
Xbegin
X if (here.exits[dir].toloc = 0) and (here.exits[dir].kind <> 5) then
X { no exit here, don't print anything }
X else with here.exits[dir] do begin
X write(direct[dir]);
X if length(alias) > 0 then begin
X write('(',alias);
X if reqalias then
X write(' required): ')
X else
X write('): ');
X end else
X write(': ');
X
X if (toloc = 0) and (kind = 5) then
X write('accept, no exit yet')
X else if toloc > 0 then begin
X write('to ',nam.idents[toloc],', ');
X case kind of
X 0: write('no exit');
X 1: write('open passage');
X 2: write('door, key=',p_door_key(objreq));
X 3: write('~door, ~key=',p_door_key(objreq));
X 4: write('exit open randomly');
X 5: write('potential exit');
X 6: write('xdoor, key=',p_door_key(objreq));
X 7: begin
X write('timed exit, now ');
X if cycle_open then
X write('open')
X else
X write('closed');
X end;
X end;
X if hidden <> 0 then
X write(', hidden');
X if reqverb then
X write(', reqverb');
X if not(autolook) then
X write(', autolook off');
X if here.trapto = dir then
X write(', trapdoor (',here.trapchance:1,'%)');
X end;
X writeln;
X end;
Xend;
X
X
Xprocedure do_s_exits;
Xvar
X i: integer;
X accept,one: boolean; { accept is true if the particular exit is
X an "accept" (other players may link there)
X one means at least one exit was shown }
X
Xbegin
X one := false;
X gethere;
X
X for i := 1 to maxexit do begin
X if (here.exits[i].toloc = 0) and (here.exits[i].kind = 5) then
X accept := true
X else
X accept := false;
X
X if (can_alter(i)) or (accept) then begin
X if not(one) then begin { first time we do this then }
X getnam; { read room name list in }
X freenam;
X getobjnam;
X freeobjnam;
X end;
X one := true;
X anal_exit(i);
X end;
X end;
X
X if not(one) then
X writeln('There are no exits here which you may inspect.');
Xend;
X
X
Xprocedure do_s_object(s: string);
Xvar
X n: integer;
X x: objectrec;
X
Xbegin
X if length(s) = 0 then begin
X grab_line('Object? ',s);
X end;
X
X if lookup_obj(n,s) then begin
X if obj_owner(n,TRUE) then begin
X write(obj_part(n),': ');
X write(objown.idents[n],' is owner');
X x := obj;
X
X if x.sticky then
X write(', sticky');
X if x.getobjreq > 0 then
X write(', ',obj_part(x.getobjreq),' required to get');
X if x.useobjreq > 0 then
X write(', ',obj_part(x.useobjreq),' required to use');
X if x.uselocreq > 0 then begin
X getnam;
X freenam;
X write(', used only in ',nam.idents[x.uselocreq]);
X end;
X if x.usealias <> '' then begin
X write(', use="',x.usealias,'"');
X if x.reqalias then
X write(' (required)');
X end;
X
X writeln;
X end else
X writeln('You are not allowed to see the internals of that object.');
X end else
X writeln('There is no such object.');
Xend;
X
X
Xprocedure do_s_details;
Xvar
X i: integer;
X one: boolean;
X
Xbegin
X gethere;
X one := false;
X for i := 1 to maxdetail do
X if (here.detail[i] <> '') and (here.detaildesc[i] <> 0) then begin
X if not(one) then begin
X one := true;
X writeln('Details here that you may inspect:');
X end;
X writeln(' ',here.detail[i]);
X end;
X if not(one) then
X writeln('There are no details of this room that you can inspect.');
Xend;
X
Xprocedure do_s_help;
X
Xbegin
X writeln;
X writeln('Exits Lists exits you can inspect here');
X writeln('Object Show internals of an object');
X writeln('Details Show details you can look at in this room');
X writeln;
Xend;
X
X
Xprocedure s_show(n: integer;s: string);
X
Xbegin
X case n of
X s_exits: do_s_exits;
X s_object: do_s_object(s);
X s_quest: do_s_help;
X s_details: do_s_details;
X end;
Xend;
X
X
Xprocedure do_y_altmsg;
Xvar
X newdsc: integer;
X
Xbegin
X if is_owner then begin
X gethere;
X newdsc := here.xmsg2;
X writeln('[ Editing the alternate mystery message for this room ]');
X if edit_desc(newdsc) then begin
X getroom;
X here.xmsg2 := newdsc;
X putroom;
X end;
X end;
Xend;
X
X
Xprocedure do_y_help;
X
Xbegin
X writeln;
X writeln('Altmsg Set the alternate mystery message block');
X writeln;
Xend;
X
X
Xprocedure do_group1;
Xvar
X grpnam: string;
X loc: integer;
X tmp: string;
X
Xbegin
X if is_owner then begin
X gethere;
X if here.grploc1 = 0 then
X writeln('No primary group location set')
X else begin
X getnam;
X freenam;
X writeln('The primary group location is ',nam.idents[here.grploc1],'.');
X writeln('Descriptor string: [',here.grpnam1,']');
X end;
X writeln;
X writeln('Type * to turn off the primary group location');
X grab_line('Room name of primary group? ',grpnam);
X if length(grpnam) = 0 then
X writeln('No changes.')
X else if grpnam = '*' then begin
X getroom;
X here.grploc1 := 0;
X putroom;
X end else if lookup_room(loc,grpnam) then begin
X writeln('Enter the descriptive string. It will be placed after player names.');
X writeln('Example: Monster Manager is [descriptive string, instead of "here."]');
X writeln;
X grab_line('Enter string? ',tmp);
X if length(tmp) > shortlen then begin
X writeln('Your string was truncated to ',shortlen:1,' characters.');
X tmp := substr(tmp,1,shortlen);
X end;
X getroom;
X here.grploc1 := loc;
X here.grpnam1 := tmp;
X putroom;
X end else
X writeln('No such room.');
X end;
Xend;
X
X
X
Xprocedure do_group2;
Xvar
X grpnam: string;
X loc: integer;
X tmp: string;
X
Xbegin
X if is_owner then begin
X gethere;
X if here.grploc2 = 0 then
X writeln('No secondary group location set')
X else begin
X getnam;
X freenam;
X writeln('The secondary group location is ',nam.idents[here.grploc1],'.');
X writeln('Descriptor string: [',here.grpnam1,']');
X end;
X writeln;
X writeln('Type * to turn off the secondary group location');
X grab_line('Room name of secondary group? ',grpnam);
X if length(grpnam) = 0 then
X writeln('No changes.')
X else if grpnam = '*' then begin
X getroom;
X here.grploc2 := 0;
X putroom;
X end else if lookup_room(loc,grpnam) then begin
X writeln('Enter the descriptive string. It will be placed after player names.');
X writeln('Example: Monster Manager is [descriptive string, instead of "here."]');
X writeln;
X grab_line('Enter string? ',tmp);
X if length(tmp) > shortlen then begin
X writeln('Your string was truncated to ',shortlen:1,' characters.');
X tmp := substr(tmp,1,shortlen);
X end;
X getroom;
X here.grploc2 := loc;
X here.grpnam2 := tmp;
X putroom;
X end else
X writeln('No such room.');
X end;
Xend;
X
X
Xprocedure s_set(n: integer;s: string);
X
Xbegin
X case n of
X y_quest: do_y_help;
X y_altmsg: do_y_altmsg;
X y_group1: do_group1;
X y_group2: do_group2;
X end;
Xend;
X
X
Xprocedure do_show(s: string);
Xvar
X n: integer;
X cmd: string;
X
Xbegin
X cmd := bite(s);
X if length(cmd) = 0 then
X grab_line('Show what attribute? (type ? for a list) ',cmd);
X
X if length(cmd) = 0 then
X else if lookup_show(n,cmd) then
X s_show(n,s)
X else
X writeln('Invalid show option, type SHOW ? for a list.');
Xend;
X
X
Xprocedure do_set(s: string);
Xvar
X n: integer;
X cmd: string;
X
Xbegin
X cmd := bite(s);
X if length(cmd) = 0 then
X grab_line('Set what attribute? (type ? for a list) ',cmd);
X
X if length(cmd) = 0 then
X else if lookup_set(n,cmd) then
X s_set(n,s)
X else
X writeln('Invalid set option, type SET ? for a list.');
Xend;
X
X
Xprocedure parser;
Xvar
X s: string;
X cmd: string;
X n: integer;
X dummybool: boolean;
X
Xbegin
X repeat
X grab_line('> ',s);
X s := slead(s);
X until length(s) > 0;
X
X if s = '.' then
X s := oldcmd
X else
X oldcmd := s;
X
X if (s[1]='''') and (length(s) > 1) then
X do_say(substr(s,2,length(s)-1))
X else begin
X cmd := bite(s);
X case lookup_cmd(cmd) of
X{ try exit alias } error:begin
X if (lookup_alias(n,cmd)) or
X (lookup_dir(n,cmd)) then begin
X do_go(cmd);
X end else
X writeln('Bad command, type ? for a list.');
X end;
X
X setnam: do_setname(s);
X help,quest: show_help;
X quit: done := true;
X c_l,look: do_look(s);
X go: do_go(s,FALSE); { FALSE = dir not a verb }
X form: do_form(s);
X link: do_link(s);
X unlink: do_unlink(s);
X poof: do_poof(s);
X desc: do_describe(s);
X say: do_say(s);
X c_rooms: do_rooms(s);
X c_claim: do_claim(s);
X c_disown: do_disown(s);
X c_public: do_public(s);
X c_accept: do_accept(s);
X c_refuse: do_refuse(s);
X c_zap: do_zap(s);
X
X c_north,c_n,
X c_south,c_s,
X c_east,c_e,
X c_west,c_w,
X c_up,c_u,
X c_down,c_d: do_go(cmd);
X
X c_who: do_who;
X c_custom: do_custom(s);
X c_search: do_search(s);
X c_system: do_system(s);
X c_hide: do_hide(s);
X c_unhide: do_unhide(s);
X c_punch: do_punch(s);
X c_ping: do_ping(s);
X c_create: do_makeobj(s);
X c_get: do_get(s);
X c_drop: do_drop(s);
X c_i,c_inv: do_inv(s);
X c_whois: do_whois(s);
X c_players: do_players(s);
X c_health: do_health(s);
X c_duplicate: do_duplicate(s);
X c_version: do_version(s);
X c_objects: do_objects;
X c_self: do_self(s);
X c_use: do_use(s);
X c_whisper: do_whisper(s);
X c_wield: do_wield(s);
X c_brief: do_brief;
X c_wear: do_wear(s);
X c_destroy: do_destroy(s);
X c_relink: do_relink(s);
X c_unmake: do_unmake(s);
X c_show: do_show(s);
X c_set: do_set(s);
X
X dbg: begin
X debug := not(debug);
X if debug then
X writeln('Debugging is on.')
X else
X writeln('Debugging is off.');
X end;
X otherwise begin
X writeln('%Parser error, bad return from lookup');
X end;
X end;
X clear_command;
X end;
Xend;
X
X
X
Xprocedure init;
Xvar
X i: integer;
X
Xbegin
X rndcycle := 0;
X location := 1; { Great Hall }
X
X mywield := 0; { not initially wearing or weilding any weapon }
X mywear := 0;
X myhealth := 7; { how healthy they are to start }
X healthcycle := 0; { pretty much meaningless at the start }
X
X userid := lowcase(get_userid);
X if (userid = MM_userid) then begin
X myname := 'Monster Manager';
X privd := true;
X end else if (userid = MVM_userid) then begin
X privd := true;
X myname := 'Vice Manager';
X end else if (userid = FAUST_userid) then begin
X privd := true;
X end else begin
X myname := lowcase(userid);
X myname[1] := chr( ord('A') + (ord(myname[1]) - ord('a')) );
X privd := false;
X end;
X
X numcmds:= 66;
X
X show[s_exits] := 'exits';
X show[s_object] := 'object';
X show[s_quest] := '?';
X show[s_details] := 'details';
X numshow := 4;
X
X setkey[y_quest] := '?';
X setkey[y_altmsg] := 'altmsg';
X setkey[y_group1] := 'group1';
X setkey[y_group2] := 'group2';
X numset := 4;
X
X numspells := 0;
X
X open(roomfile,root+'ROOMS.MON',access_method := direct,
X sharing := readwrite,
X history := unknown);
X open(namfile,root+'NAMS.MON',access_method := direct,
X sharing := readwrite,
X history := unknown);
X open(eventfile,root+'EVENTS.MON',access_method := direct,
X sharing := readwrite,
X history := unknown);
X open(descfile,root+'DESC.MON',access_method := direct,
X sharing := readwrite,
X history := unknown);
X open(indexfile,root+'INDEX.MON',access_method := direct,
X sharing := readwrite,
X history := unknown);
X open(linefile,root+'LINE.MON',access_method := direct,
X sharing := readwrite,
X history := unknown);
X open(intfile,root+'INTFILE.MON',access_method := direct,
X sharing := readwrite,
X history := unknown);
X open(objfile,root+'OBJECTS.MON',access_method := direct,
X sharing := readwrite,
X history := unknown);
X open(spellfile,root+'SPELLS.MON',access_method := direct,
X sharing := readwrite,
X history := unknown);
Xend;
X
X
Xprocedure prestart;
Xvar
X s: string;
X
Xbegin
X write('Welcome to Monster! Hit return to start: ');
X readln(s);
X writeln;
X writeln;
X if length(s) > 0 then
X special(lowcase(s));
Xend;
X
X
Xprocedure welcome_back(var mylog: integer);
Xvar
X tmp: string;
X sdate,stime: shortstring;
X
Xbegin
X getdate;
X freedate;
X
X write('Welcome back, ',myname,'.');
X if length(myname) > 18 then
X writeln;
X
X write(' Your last play was on');
X
X if length(adate.idents[mylog]) < 11 then begin
X writeln(' ???');
X end else begin
X sdate := substr(adate.idents[mylog],1,11); { extract the date }
X if length(adate.idents[mylog]) = 19 then
X stime := substr(adate.idents[mylog],13,7)
X else
X stime := '???';
X
X if sdate[1] = ' ' then
X tmp := sdate
X else
X tmp := ' ' + sdate;
X
X if stime[1] = ' ' then
X tmp := tmp + ' at' + stime
X else
X tmp := tmp + ' at ' + stime;
X writeln(tmp,'.');
X end;
X writeln;
Xend;
X
X
Xfunction loc_ping:boolean;
Xvar
X i: integer;
X found: boolean;
X
Xbegin
X inmem := false;
X gethere;
X
X i := 1;
X found := false;
X
X { first get the slot that the supposed "zombie" is in }
X while (not found) and (i <= maxpeople) do begin
X if here.people[i].name = myname then
X found := true
X else
X i := i + 1;
X end;
X
X myslot := 0; { setup for ping_player }
X
X if found then begin
X setevent;
X loc_ping := ping_player(i,TRUE); { TRUE = silent operation }
X end else
X loc_ping := true;
X { well, if we can't find them, let's assume
X that they're not in any room records, so they're
X ok . . . Let's hope... }
Xend;
X
X
X
X{ attempt to fix the player using loc_ping if the database incorrectly
X shows someone playing who isn' playing }
X
Xfunction fix_player:boolean;
Xvar
X ok: boolean;
X
Xbegin
X writeln('There may have been some trouble the last time you played.');
X writeln('Trying to fix it . . .');
X if loc_ping then begin
X writeln('All should be fixed now.');
X writeln;
X fix_player := true;
X end else begin
X writeln('Either someone else is playing Monster on your account, or something is');
X writeln('very wrong with the database.');
X writeln;
X fix_player := false;
X end;
Xend;
X
X
Xfunction revive_player(var mylog: integer): boolean;
Xvar
X ok: boolean;
X i,n: integer;
X
Xbegin
X if exact_user(mylog,userid) then begin { player has played before }
X getint(N_LOCATION);
X freeint;
X location := anint.int[mylog]; { Retrieve their old loc }
X
X getpers;
X freepers;
X myname := pers.idents[mylog]; { Retrieve old personal name }
X
X getint(N_EXPERIENCE);
X freeint;
X myexperience := anint.int[mylog];
X
X getint(N_SELF);
X freeint;
X myself := anint.int[mylog];
X
X getindex(I_ASLEEP);
X freeindex;
X
X if indx.free[mylog] then begin
X { if player is asleep, all is well }
X ok := true;
X end else begin
X { otherwise, there is one of two possibilities:
X 1) someone on the same account is
X playing Monster
X 2) his last play terminated abnormally
X }
X ok := fix_player;
X end;
X
X if ok then
X welcome_back(mylog);
X
X end else begin { must allocate a log block for the player }
X if alloc_log(mylog) then begin
X
X writeln('Welcome to Monster, ',myname,'!');
X writeln('You will start in the Great Hall.');
X writeln;
X
X { Store their userid }
X getuser;
X user.idents[mylog] := lowcase(userid);
X putuser;
X
X { Set their initial location }
X getint(N_LOCATION);
X anint.int[mylog] := 1; { Start out in Great Hall }
X putint;
X location := 1;
X
X getint(N_EXPERIENCE);
X anint.int[mylog] := 0;
X putint;
X myexperience := 0;
X
X getint(N_SELF);
X anint.int[mylog] := 0;
X putint;
X myself := 0;
X
X { initialize the record containing the
X level of each spell they have to start;
X all start at zero; since the spellfile is
X directly parallel with mylog, we can hack
X init it here without dealing with SYSTEM }
X
X locate(spellfile,mylog);
X for i := 1 to maxspells do
X spellfile^.level[i] := 0;
X spellfile^.recnum := mylog;
X put(spellfile);
X
X ok := true;
X end else
X ok := false;
X end;
X
X if ok then begin { Successful, MYLOG is my log slot }
X
X { Wake up the player }
X getindex(I_ASLEEP);
X indx.free[mylog] := false; { I'm NOT asleep now }
X putindex;
X
X { Set the "last date of play" }
X getdate;
X adate.idents[mylog] := sysdate + ' ' + systime;
X putdate;
X end else
X writeln('There is no place for you in Monster. Contact the Monster Manager.');
X revive_player := ok;
Xend;
X
X
Xfunction enter_universe:boolean;
Xvar
X orignam: string;
X dummy,i: integer;
X ok: boolean;
X
Xbegin
X
X
X { take MYNAME given to us by init or revive_player and make
X sure it's unique. If it isn't tack _1, _2, etc onto it
X until it is. Code must come before alloc_log, or there
X will be an invalid pers record in there cause we aren't in yet
X }
X orignam := myname;
X i := 0;
X repeat { tack _n onto pers name until a unique one is found }
X ok := true;
X
X{*** Should this use exact_pers instead? Is this a copy of exact_pers code? }
X
X if lookup_pers(dummy,myname) then
X if lowcase(pers.idents[dummy]) = lowcase(myname) then begin
X ok := false;
X i := i + 1;
X writev(myname,orignam,'_',i:1);
X end;
X until ok;
X
X
X
X if revive_player(mylog) then begin
X if put_token(location,myslot) then begin
X getpers;
X pers.idents[mylog] := myname;
X putpers;
X
X enter_universe := true;
X log_begin(location);
X setevent;
X do_look;
X end else begin
X writeln('put_token failed.');
X enter_universe := false;
X end;
X end else begin
X writeln('revive_player failed.');
X enter_universe := false;
X end;
Xend;
X
Xprocedure leave_universe;
Xvar
X diddrop: boolean;
X
Xbegin
X diddrop := drop_everything;
X take_token(myslot,location);
X log_quit(location,diddrop);
X do_endplay(mylog);
X
X writeln('You vanish in a brilliant burst of multicolored light.');
X if diddrop then
X writeln('All of your belongings drop to the ground.');
Xend;
X
X
Xbegin
X done := false;
X setup_guts;
X init;
X prestart;
X if not(done) then begin
X if enter_universe then begin
X repeat
X parser;
X until done;
X leave_universe;
X end else
X writeln('You attempt to enter the Monster universe, but a strange force repels you.');
X end;
X finish_guts;
Xend.
END_OF_FILE
if test 55833 -ne `wc -c <'mon4.pas'`; then
echo shar: \"'mon4.pas'\" unpacked with wrong size!
fi
# end of 'mon4.pas'
fi
echo shar: End of archive 2 \(of 6\).
cp /dev/null ark2isdone
MISSING=""
for I in 1 2 3 4 5 6 ; do
if test ! -f ark${I}isdone ; then
MISSING="${MISSING} ${I}"
fi
done
if test "${MISSING}" = "" ; then
echo You have unpacked all 6 archives.
rm -f ark[1-9]isdone
./fixup.sh
else
echo You still need to unpack the following archives:
echo " " ${MISSING}
fi
## End of shell archive.
exit 0