games@tekred.TEK.COM (12/01/88)
Submitted by: Richard Skrenta <skrenta@nuacc.acns.nwu.edu>
Comp.sources.games: Volume 5, Issue 90
Archive-name: monster/Part03
#! /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 3 (of 6)."
# Contents: mon2.pas readme.txt
# Wrapped by billr@saab on Wed Nov 30 11:28:57 1988
PATH=/bin:/usr/bin:/usr/ucb ; export PATH
if test -f 'mon2.pas' -a "${1}" != "-c" ; then
echo shar: Will not clobber existing file \"'mon2.pas'\"
else
echo shar: Extracting \"'mon2.pas'\" \(54730 characters\)
sed "s/^X//" >'mon2.pas' <<'END_OF_FILE'
X
X{ substitute a parameter string for the # sign in the source string }
Xfunction subs_parm(s,parm: string): string;
Xvar
X right,left: string;
X i: integer; { i is point to break at }
X
Xbegin
X i := index(s,'#');
X if (i > 0) and ((length(s) + length(parm)) <= 80) then begin
X if i >= length(s) then begin
X right := '';
X left := s;
X end else if i < 1 then begin
X right := s;
X left := '';
X end else begin
X right := substr(s,i+1,length(s)-i);
X left := substr(s,1,i);
X end;
X if length(left) <= 1 then
X left := ''
X else
X left := substr(left,1,length(left)-1);
X
X subs_parm := left + parm + right;
X end else begin
X subs_parm := s;
X end;
Xend;
X
X
Xprocedure time_health;
X
Xbegin
X if healthcycle > 0 then begin { how quickly they heal }
X if myhealth < 7 then begin { heal a little bit }
X myhealth := myhealth + 1;
X
X getroom;
X here.people[myslot].health := myhealth;
X putroom;
X
X {show new health rating }
X case myhealth of
X 9: writeln('You are now in exceptional health.');
X 8: writeln('You feel much stronger. You are in better than average condition.');
X 7: writeln('You are now in perfect health.');
X 6: writeln('You only feel a little bit dazed now.');
X 5: begin
X writeln('You only have some minor cuts and abrasions now. Most of your serious wounds');
X writeln('have healed.');
X end;
X 4: writeln('You are only suffering from some minor wounds now.');
X 3: writeln('Your most serious wounds have healed, but you are still in bad shape.');
X 2: writeln('You have healed somewhat, but are still very badly wounded.');
X 1: writeln('You are in critical condition, but there may be hope.');
X 0: writeln('are still dead.');
X otherwise writeln('You don''t seem to be in any condition at all.');
X end;
X
X putchars(chr(10)+old_prompt+line);
X
X end;
X healthcycle := 0;
X end else
X healthcycle := healthcycle + 1;
Xend;
X
X
Xprocedure time_noises;
Xvar
X n: integer;
X
Xbegin
X if rnd100 <= 2 then begin
X n := rnd100;
X if n in [0..40] then
X log_event(0,E_NOISES,rnd100,0)
X else if n in [41..60] then
X log_event(0,E_ALTNOISE,rnd100,0);
X end;
Xend;
X
X
Xprocedure time_trapdoor(silent: boolean);
Xvar
X fall: boolean;
X
Xbegin
X if rnd100 < here.trapchance then begin
X { trapdoor fires! }
X
X if here.trapto > 0 then begin
X { logged action should cover {protected) }
X if {(protected) or} (logged_act) then
X fall := false
X else if here.magicobj = 0 then
X fall := true
X else if obj_hold(here.magicobj) then
X fall := false
X else
X fall := true;
X end else
X fall := false;
X
X if fall then begin
X do_exit(here.trapto);
X if not(silent) then
X putchars(chr(10)+old_prompt+line);
X end;
X end;
Xend;
X
X
Xprocedure time_midnight;
X
Xbegin
X if systime = '12:00am' then
X log_event(0,E_MIDNIGHT,rnd100,0);
Xend;
X
X
X{ cause random events to occurr (ha ha ha) }
X
Xprocedure rnd_event(silent: boolean := false);
Xvar
X n: integer;
X
Xbegin
X if rndcycle = 200 then begin { inside here 3 times/min }
X
X time_noises;
X time_health;
X time_trapdoor(silent);
X time_midnight;
X
X rndcycle := 0;
X end else
X rndcycle := rndcycle + 1;
Xend;
X
X
Xprocedure do_die;
Xvar
X some: boolean;
X
Xbegin
X writeln;
X writeln(' *** You have died ***');
X writeln;
X some := drop_everything;
X myhealth := 7;
X take_token(myslot,location);
X log_event(0,E_DIED,0,0,myname);
X if put_token(2,myslot) then begin
X location := 2;
X inmem := false;
X setevent;
X{ log entry to death loc }
X{ perhaps turn off refs to other people }
X end else begin
X writeln('The Monster universe regrets to inform you that you cannot be ressurected at');
X writeln('the moment.');
X halt;
X end;
Xend;
X
X
Xprocedure poor_health(p: integer);
Xvar
X some: boolean;
X
Xbegin
X if myhealth > p then begin
X myhealth := myhealth - 1;
X getroom;
X here.people[myslot].health := myhealth;
X putroom;
X log_event(myslot,E_WEAKER,myhealth,0);
X
X { show new health rating }
X write('You ');
X case here.people[myslot].health of
X 9: writeln('are still in exceptional health.');
X 8: writeln('feel weaker, but are in better than average condition.');
X 7: writeln('are somewhat weaker, but 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;
X end else begin { they died }
X do_die;
X end;
Xend;
X
X
X
X{ count objects here }
X
Xfunction find_numobjs: integer;
Xvar
X sum,i: integer;
X
Xbegin
X sum := 0;
X for i := 1 to maxobjs do
X if here.objs[i] <> 0 then
X sum := sum + 1;
X find_numobjs := sum;
Xend;
X
X
X
X{ optional parameter is slot of player's objects to count }
X
Xfunction find_numhold(player: integer := 0): integer;
Xvar
X sum,i: integer;
X
Xbegin
X if player = 0 then
X player := myslot;
X
X sum := 0;
X for i := 1 to maxhold do
X if here.people[player].holding[i] <> 0 then
X sum := sum + 1;
X find_numhold := sum;
Xend;
X
X
X
X
Xprocedure take_hit(p: integer);
Xvar
X i: integer;
X
Xbegin
X if p > 0 then begin
X if rnd100 < (55 + (p-1) * 30) then { chance that they're hit }
X poor_health(p);
X
X if find_numobjs < maxobjs + 1 then begin
X { maybe they drop something if they're hit }
X for i := 1 to p do
X maybe_drop;
X end;
X end;
Xend;
X
X
Xfunction punch_force(sock: integer): integer;
Xvar
X p: integer;
X
Xbegin
X if sock in [2,3,6,7,8,11,12] then { no punch or a graze }
X p := 0
X else if sock in [4,9,10] then { hard punches }
X p := 2
X else { 1,5,13,14,15 }
X p := 1; { all others are medium punches }
X punch_force := p;
Xend;
X
Xprocedure put_punch(sock: integer;s: string);
X
Xbegin
X case sock of
X 1: writeln('You deliver a quick jab to ',s,'''s jaw.');
X 2: writeln('You swing at ',s,' and miss.');
X 3: writeln('A quick punch, but it only grazes ',s,'.');
X 4: writeln(s,' doubles over after your jab to the stomach.');
X 5: writeln('Your punch lands square on ',s,'''s face!');
X 6: writeln('You swing wild and miss.');
X 7: writeln('A good swing, but it misses ',s,' by a mile!');
X 8: writeln('Your punch is blocked by ',s,'.');
X 9: writeln('Your roundhouse blow sends ',s,' reeling.');
X 10:writeln('You land a solid uppercut on ',s,'''s chin.');
X 11:writeln(s,' fends off your blow.');
X 12:writeln(s,' ducks and avoids your punch.');
X 13:writeln('You thump ',s,' in the ribs.');
X 14:writeln('You catch ',s,'''s face on your elbow.');
X 15:writeln('You knock the wind out of ',s,' with a punch to the chest.');
X end;
Xend;
X
X
Xprocedure get_punch(sock: integer;s: string);
X
Xbegin
X case sock of
X 1: writeln(s,' delivers a quick jab to your jaw!');
X 2: writeln(s,' swings at you but misses.');
X 3: writeln(s,'''s fist grazes you.');
X 4: writeln('You double over after ',s,' lands a mean jab to your stomach!');
X 5: writeln('You see stars as ',s,' bashes you in the face.');
X 6: writeln('You only feel the breeze as ',s,' swings wildly.');
X 7: writeln(s,'''s swing misses you by a yard.');
X 8: writeln('With lightning reflexes you block ',s,'''s punch.');
X 9: writeln(s,'''s blow sends you reeling.');
X 10:writeln('Your head snaps back from ',s,'''s uppercut!');
X 11:writeln('You parry ',s,'''s attack.');
X 12:writeln('You duck in time to avoid ',s,'''s punch.');
X 13:writeln(s,' thumps you hard in the ribs.');
X 14:writeln('Your vision blurs as ',s,' elbows you in the head.');
X 15:writeln(s,' knocks the wind out of you with a punch to your chest.');
X end;
Xend;
X
Xprocedure view_punch(a,b: string;p: integer);
X
Xbegin
X case p of
X 1: writeln(a,' jabs ',b,' in the jaw.');
X 2: writeln(a,' throws a wild punch at the air.');
X 3: writeln(a,'''s fist barely grazes ',b,'.');
X 4: writeln(b,' doubles over in pain with ',a,'''s punch');
X 5: writeln(a,' bashes ',b,' in the face.');
X 6: writeln(a,' takes a wild swing at ',b,' and misses.');
X 7: writeln(a,' swings at ',b,' and misses by a yard.');
X 8: writeln(b,'''s punch is blocked by ',a,'''s quick reflexes.');
X 9: writeln(b,' is sent reeling from a punch by ',a,'.');
X 10:writeln(a,' lands an uppercut on ',b,'''s head.');
X 11:writeln(b,' parrys ',a,'''s attack.');
X 12:writeln(b,' ducks to avoid ',a,'''s punch.');
X 13:writeln(a,' thumps ',b,' hard in the ribs.');
X 14:writeln(a,'''s elbow connects with ',b,'''s head.');
X 15:writeln(a,' knocks the wind out of ',b,'.');
X end;
Xend;
X
X
X
X
Xprocedure desc_health(n: integer;header:shortstring := '');
X
Xbegin
X if header = '' then
X write(here.people[n].name,' ')
X else
X write(header);
X
X case here.people[n].health of
X 9: writeln('is in exceptional health, and looks very strong.');
X 8: writeln('is in better than average condition.');
X 7: writeln('is in perfect health.');
X 6: writeln('looks a little dazed.');
X 5: writeln('has some minor cuts and abrasions.');
X 4: writeln('has some minor wounds.');
X 3: writeln('is suffering from some serious wounds.');
X 2: writeln('is very badly wounded.');
X 1: writeln('has many serious wounds, and is near death.');
X 0: writeln('is dead.');
X otherwise writeln('doesn''t seem to be in any condition at all.');
X end;
Xend;
X
X
Xfunction obj_part(objnum: integer;doread: boolean := TRUE): string;
Xvar
X s: string;
X
Xbegin
X if doread then begin
X getobj(objnum);
X freeobj;
X end;
X s := obj.oname;
X case obj.particle of
X 0:;
X 1: s := 'a ' + s;
X 2: s := 'an ' + s;
X 3: s := 'some ' + s;
X 4: s := 'the ' + s;
X end;
X obj_part := s;
Xend;
X
X
Xprocedure print_subs(n: integer;s: string);
X
Xbegin
X if (n > 0) and (n <> DEFAULT_LINE) then begin
X getline(n);
X freeline;
X writeln(subs_parm(oneliner.theline,s));
X end else if n = DEFAULT_LINE then
X writeln('%<default line> in print_subs');
Xend;
X
X
X
X{ print out a (up to) 10 line description block, substituting string s for
X up to one occurance of # per line }
X
Xprocedure block_subs(n: integer;s: string);
Xvar
X p,i: integer;
X
Xbegin
X if n < 0 then
X print_subs(abs(n),s)
X else if (n > 0) and (n <> DEFAULT_LINE) then begin
X getblock(n);
X freeblock;
X i := 1;
X while i <= block.desclen do begin
X p := index(block.lines[i],'#');
X if (p > 0) then
X writeln(subs_parm(block.lines[i],s))
X else
X writeln(block.lines[i]);
X i := i + 1;
X end;
X end;
Xend;
X
X
Xprocedure show_noises(n: integer);
X
Xbegin
X if n < 33 then
X writeln('There are strange noises coming from behind you.')
X else if n < 66 then
X writeln('You hear strange rustling noises behind you.')
X else
X writeln('There are faint noises coming from behind you.');
Xend;
X
X
Xprocedure show_altnoise(n: integer);
X
Xbegin
X if n < 33 then
X writeln('A chill wind blows, ruffling your clothes and chilling your bones.')
X else if n < 66 then
X writeln('Muffled scuffling sounds can be heard behind you.')
X else
X writeln('A loud crash can be heard in the distance.');
Xend;
X
X
Xprocedure show_midnight(n: integer;var printed: boolean);
X
Xbegin
X if midnight_notyet then begin
X if n < 50 then begin
X writeln('A voice booms out of the air from all around you!');
X writeln('The voice says, " It is now midnight. "');
X end else begin
X writeln('You hear a clock chiming in the distance.');
X writeln('It rings twelve times for midnight.');
X end;
X midnight_notyet := false;
X end else
X printed := false;
Xend;
X
X
X
X
Xprocedure handle_event(var printed: boolean);
Xvar
X n,send,act,targ,p: integer;
X s: string;
X sendname: string;
X
Xbegin
X printed := true;
X if debug then
X writeln('%handling event ',myevent);
X with event.evnt[myevent] do begin
X send := sender;
X act := action;
X targ := target;
X p := parm;
X s := msg;
X end;
X if send <> 0 then
X sendname := here.people[send].name
X else
X sendname := '<Unknown>';
X
X case act of
X E_EXIT: begin
X if here.exits[targ].goin = DEFAULT_LINE then
X writeln(s,' has gone ',direct[targ],'.')
X else if (here.exits[targ].goin <> 0) and
X (here.exits[targ].goin <> DEFAULT_LINE) then begin
X block_subs(here.exits[targ].goin,s);
X end else
X printed := false;
X end;
X E_ENTER: begin
X if here.exits[targ].comeout = DEFAULT_LINE then
X writeln(s,' has come into the room from: ',direct[targ])
X else if (here.exits[targ].comeout <> 0) and
X (here.exits[targ].comeout <> DEFAULT_LINE) then begin
X block_subs(here.exits[targ].comeout,s);
X end else
X printed := false;
X end;
X E_BEGIN:writeln(s,' appears in a brilliant burst of multicolored light.');
X E_QUIT:writeln(s,' vanishes in a brilliant burst of multicolored light.');
X E_SAY: begin
X if length(s) + length(sendname) > 73 then begin
X writeln(sendname,' says,');
X writeln('"',s,'"');
X end else begin
X if (rnd100 < 50) or (length(s) > 50) then
X writeln(sendname,': "',s,'"')
X else
X writeln(sendname,' says, "',s,'"');
X end;
X end;
X E_HIDESAY: begin
X writeln('An unidentified voice speaks to you:');
X writeln('"',s,'"');
X end;
X E_SETNAM: writeln(s);
X E_POOFIN: writeln('In an explosion of orange smoke ',s,' poofs into the room.');
X E_POOFOUT: writeln(s,' vanishes from the room in a cloud of orange smoke.');
X E_DETACH: begin
X writeln(s,' has destroyed the exit ',direct[targ],'.');
X end;
X E_EDITDONE:begin
X writeln(sendname,' is done editing the room description.');
X end;
X E_NEWEXIT: begin
X writeln(s,' has created an exit here.');
X end;
X E_CUSTDONE:begin
X writeln(sendname,' is done customizing an exit here.');
X end;
X E_SEARCH: writeln(sendname,' seems to be looking for something.');
X E_FOUND: writeln(sendname,' appears to have found something.');
X E_DONEDET:begin
X writeln(sendname,' is done adding details to the room.');
X end;
X E_ROOMDONE: begin
X writeln(sendname,' is finished customizing this room.');
X end;
X E_OBJDONE: begin
X writeln(sendname,' is finished customizing an object.');
X end;
X E_UNHIDE:writeln(sendname,' has stepped out of the shadows.');
X E_FOUNDYOU: begin
X if targ = myslot then begin { found me! }
X writeln('You''ve been discovered by ',sendname,'!');
X hiding := false;
X getroom;
X{ they're not hidden anymore } here.people[myslot].hiding := 0;
X putroom;
X end else
X writeln(sendname,' has found ',here.people[targ].name,' hiding in the shadows!');
X end;
X E_PUNCH: begin
X if targ = myslot then begin { punched me! }
X get_punch(p,sendname);
X take_hit( punch_force(p) );
X{ relic, but not harmful } ping_answered := true;
X healthcycle := 0;
X end else
X view_punch(sendname,here.people[targ].name,p);
X end;
X E_MADEOBJ: writeln(s);
X E_GET: writeln(s);
X E_DROP: begin
X writeln(s);
X if here.objdesc <> 0 then
X print_subs(here.objdesc,obj_part(p));
X end;
X E_BOUNCEDIN: begin
X if (targ = 0) or (targ = DEFAULT_LINE) then
X writeln(obj_part(p),' has bounced into the room.')
X else begin
X print_subs(targ,obj_part(p));
X end;
X end;
X E_DROPALL: writeln('Some objects drop to the ground.');
X E_EXAMINE: writeln(s);
X E_IHID: writeln(sendname,' has hidden in the shadows.');
X E_NOISES: begin
X if (here.rndmsg = 0) or
X (here.rndmsg = DEFAULT_LINE) then begin
X show_noises(targ);
X end else
X print_line(here.rndmsg);
X end;
X E_ALTNOISE: begin
X if (here.xmsg2 = 0) or
X (here.xmsg2 = DEFAULT_LINE) then
X show_altnoise(targ)
X else
X block_subs(here.xmsg2,myname);
X end;
X E_REALNOISE: show_noises(targ);
X E_HIDOBJ: writeln(sendname,' has hidden the ',s,'.');
X E_PING: begin
X if targ = myslot then begin
X writeln(sendname,' is trying to ping you.');
X log_event(myslot,E_PONG,send,0);
X end else
X writeln(sendname,' is pinging ',here.people[targ].name,'.');
X end;
X E_PONG: begin
X ping_answered := true;
X end;
X E_HIDEPUNCH: begin
X if targ = myslot then begin
X writeln(sendname,' pounces on you from the shadows!');
X take_hit(2);
X end else begin
X writeln(sendname,' jumps out of the shadows and attacks ',here.people[targ].name,'.');
X end;
X end;
X E_SLIPPED: begin
X writeln('The ',s,' has slipped from ',
X sendname,'''s hands.');
X end;
X E_HPOOFOUT:begin
X if rnd100 > 50 then
X writeln('Great wisps of orange smoke drift out of the shadows.')
X else
X printed := false;
X end;
X E_HPOOFIN:begin
X if rnd100 > 50 then
X writeln('Some wisps of orange smoke drift about in the shadows.')
X else
X printed := false;
X end;
X E_FAILGO: begin
X if targ > 0 then begin
X write(sendname,' has failed to go ');
X writeln(direct[targ],'.');
X end;
X end;
X E_TRYPUNCH: begin
X if targ = myslot then
X writeln(sendname,' fails to punch you.')
X else
X writeln(sendname,' fails to punch ',here.people[targ].name,'.');
X end;
X E_PINGONE:begin
X if targ = myslot then begin { ohoh---pinged away }
X writeln('The Monster program regrets to inform you that a destructive ping has');
X writeln('destroyed your existence. Please accept our apologies.');
X halt; { ugggg }
X end else
X writeln(s,' shimmers and vanishes from sight.');
X end;
X E_CLAIM: writeln(sendname,' has claimed this room.');
X E_DISOWN: writeln(sendname,' has disowned this room.');
X E_WEAKER: begin
X{ inmem := false;
X gethere; }
X
X here.people[send].health := targ;
X
X{ This is a hack for efficiency so we don't read the room record twice;
X we need the current data now for desc_health, but checkevents, our caller,
X is about to re-read it anyway; we make an incremental fix here so desc_health
X is happy, then checkevents will do the real read later }
X
X desc_health(send);
X end;
X E_OBJCLAIM: writeln(sendname,' is now the owner of the ',s,'.');
X E_OBJDISOWN: writeln(sendname,' has disowned the object ',s,'.');
X E_SELFDONE: writeln(sendname,'''s self-description is finished.');
X E_WHISPER: begin
X if targ = myslot then begin
X if length(s) < 39 then
X writeln(sendname,' whispers to you, "',s,'"')
X else begin
X writeln(sendname,' whispers something to you:');
X write(sendname,' whispers, ');
X if length(s) > 50 then
X writeln;
X writeln('"',s,'"');
X end;
X end else if (privd) or (rnd100 > 85) then begin
X writeln('You overhear ',sendname,' whispering to ',here.people[targ].name,'!');
X write(sendname,' whispers, ');
X if length(s) > 50 then
X writeln;
X writeln('"',s,'"');
X end else
X writeln(sendname,' is whispering to ',here.people[targ].name,'.');
X end;
X E_WIELD: writeln(sendname,' is now wielding the ',s,'.');
X E_UNWIELD: writeln(sendname,' is no longer wielding the ',s,'.');
X E_WEAR: writeln(sendname,' is now wearing the ',s,'.');
X E_UNWEAR: writeln(sendname,' has taken off the ',s,'.');
X E_DONECRYSTALUSE: begin
X writeln(sendname,' emerges from the glow of the crystal.');
X writeln('The orb becomes dark.');
X end;
X E_DESTROY: writeln(s);
X E_OBJPUBLIC: writeln('The object ',s,' is now public.');
X E_SYSDONE: writeln(sendname,' is no longer in system maintenance mode.');
X E_UNMAKE: writeln(sendname,' has unmade ',s,'.');
X E_LOOKDETAIL: writeln(sendname,' is looking at the ',s,'.');
X E_ACCEPT: writeln(sendname,' has accepted an exit here.');
X E_REFUSE: writeln(sendname,' has refused an Accept here.');
X E_DIED: writeln(s,' expires and vanishes in a cloud of greasy black smoke.');
X E_LOOKYOU: begin
X if targ = myslot then begin
X writeln(sendname,' is looking at you.')
X end else
X writeln(sendname,' looks at ',here.people[targ].name,'.');
X end;
X E_LOOKSELF: writeln(sendname,' is making a self-appraisal.');
X E_FAILGET: writeln(sendname,' fails to get ',obj_part(targ),'.');
X E_FAILUSE: writeln(sendname,' fails to use ',obj_part(targ),'.');
X E_CHILL: if (targ = 0) or (targ = DEFAULT_LINE) then
X writeln('A chill wind blows over you.')
X else
X print_desc(targ);
X E_NOISE2:begin
X case targ of
X 1: writeln('Strange, gutteral noises sound from everywhere.');
X 2: writeln('A chill wind blows past you, almost whispering as it ruffles your clothes.');
X 3: writeln('Muffled voices speak to you from the air!');
X otherwise writeln('The air vibrates with a chill shudder.');
X end;
X end;
X E_INVENT: writeln(sendname,' is taking inventory.');
X E_POOFYOU: begin
X if targ = myslot then begin
X writeln;
X writeln(sendname,' directs a firey burst of bluish energy at you!');
X writeln('Suddenly, you find yourself hurtling downwards through misty orange clouds.');
X writeln('Your descent slows, the smoke clears, and you find yourself in a new place...');
X xpoof(p);
X writeln;
X end else begin
X writeln(sendname,' directs a firey burst of energy at ',here.people[targ].name,'!');
X writeln('A thick burst of orange smoke results, and when it clears, you see');
X writeln('that ',here.people[targ].name,' is gone.');
X end;
X end;
X E_WHO: begin
X case p of
X 0: writeln(sendname,' produces a "who" list and reads it.');
X 1: writeln(sendname,' is seeing who''s playing Monster.');
X otherwise writeln(sendname,' checks the "who" list.');
X end;
X end;
X E_PLAYERS:begin
X writeln(sendname,' checks the "players" list.');
X end;
X E_VIEWSELF: writeln(sendname,' is reading ',s,'''s self-description.');
X E_MIDNIGHT: show_midnight(targ,printed);
X
X E_ACTION:writeln(sendname,' is',desc_action(p,targ));
X otherwise writeln('*** Bad Event ***');
X end;
Xend;
X
X
X[global]
Xprocedure checkevents(silent: boolean := false);
Xvar
X gotone: boolean;
X tmp,printed: boolean;
X
Xbegin
X getevent;
X freeevent;
X
X event := eventfile^;
X gotone := false;
X printed := false;
X while myevent <> event.point do begin
X myevent := myevent + 1;
X if myevent > maxevent then
X myevent := 1;
X
X if debug then begin
X writeln('%checking event ',myevent);
X if event.evnt[myevent].loc = location then
X writeln(' - event here')
X else
X writeln(' - event elsewhere');
X writeln(' - event number = ',event.evnt[myevent].action:1);
X end;
X
X if (event.evnt[myevent].loc = location) then begin
X if (event.evnt[myevent].sender <> myslot) then begin
X
X { if sent by me don't look at it }
X { will use global record event }
X handle_event(tmp);
X if tmp then
X printed := true;
X
X inmem := false; { re-read important data that }
X gethere; { may have been altered }
X
X gotone := true;
X end;
X end;
X end;
X if (printed) and (gotone) and not(silent) then begin
X putchars(chr(10)+chr(13)+old_prompt+line);
X end;
X
X rnd_event(silent);
Xend;
X
X
X
X{ count the number of people in this room; assumes a gethere has been done }
X
Xfunction find_numpeople: integer;
Xvar
X sum,i: integer;
X
Xbegin
X sum := 0;
X for i := 1 to maxpeople do
X if here.people[i].kind > 0 then
X{ if here.people[i].username <> '' then }
X sum := sum + 1;
X find_numpeople := sum;
Xend;
X
X
X
X{ don't give them away, but make noise--maybe
X percent is percentage chance that they WON'T make any noise }
X
Xprocedure noisehide(percent: integer);
X
Xbegin
X { assumed gethere; }
X if (hiding) and (find_numpeople > 1) then begin
X if rnd100 > percent then
X log_event(myslot,E_REALNOISE,rnd100,0);
X { myslot: don't tell them they made noise }
X end;
Xend;
X
X
X
Xfunction checkhide: boolean;
X
Xbegin
X if (hiding) then begin
X checkhide := false;
X noisehide(50);
X writeln('You can''t do that while you''re hiding.');
X end else
X checkhide := true;
Xend;
X
X
X
Xprocedure clear_command;
X
Xbegin
X if logged_act then begin
X getroom;
X here.people[myslot].act := 0;
X putroom;
X logged_act := false;
X end;
Xend;
X
X{ forward procedure take_token(aslot, roomno: integer); }
Xprocedure take_token;
X { remove self from a room's people list }
X
Xbegin
X getroom(roomno);
X with here.people[aslot] do begin
X kind := 0;
X username:= '';
X name := '';
X end;
X putroom;
Xend;
X
X
X{ fowrard function put_token(room: integer;var aslot:integer;
X hidelev:integer := 0):boolean;
X put a person in a room's people list
X returns myslot }
Xfunction put_token;
Xvar
X i,j: integer;
X found: boolean;
X savehold: array[1..maxhold] of integer;
X
Xbegin
X if first_puttoken then begin
X for i := 1 to maxhold do
X savehold[i] := 0;
X first_puttoken := false;
X end else begin
X gethere;
X for i := 1 to maxhold do
X savehold[i] := here.people[myslot].holding[i];
X end;
X
X getroom(room);
X i := 1;
X found := false;
X while (i <= maxpeople) and (not found) do begin
X if here.people[i].name = '' then
X found := true
X else
X i := i + 1;
X end;
X put_token := found;
X if found then begin
X here.people[i].kind := 1; { I'm a real player }
X here.people[i].name := myname;
X here.people[i].username := userid;
X here.people[i].hiding := hidelev;
X { hidelev is zero for most everyone
X unless you want to poof in and remain hidden }
X
X here.people[i].wearing := mywear;
X here.people[i].wielding := mywield;
X here.people[i].health := myhealth;
X here.people[i].self := myself;
X
X here.people[i].act := 0;
X
X for j := 1 to maxhold do
X here.people[i].holding[j] := savehold[j];
X putroom;
X
X aslot := i;
X for j := 1 to maxexit do { haven't found any exits in }
X found_exit[j] := false; { the new room }
X
X { note the user's new location in the logfile }
X getint(N_LOCATION);
X anint.int[mylog] := room;
X putint;
X end else
X freeroom;
Xend;
X
Xprocedure log_exit(direction,room,sender_slot: integer);
X
Xbegin
X log_event(sender_slot,E_EXIT,direction,0,myname,room);
Xend;
X
Xprocedure log_entry(direction,room,sender_slot: integer);
X
Xbegin
X log_event(sender_slot,E_ENTER,direction,0,myname,room);
Xend;
X
Xprocedure log_begin(room:integer := 1);
X
Xbegin
X log_event(0,E_BEGIN,0,0,myname,room);
Xend;
X
Xprocedure log_quit(room:integer;dropped:boolean);
X
Xbegin
X log_event(0,E_QUIT,0,0,myname,room);
X if dropped then
X log_event(0,E_DROPALL,0,0,myname,room);
Xend;
X
X
X
X
X{ return the number of people you can see here }
X
Xfunction n_can_see: integer;
Xvar
X sum: integer;
X i: integer;
X selfslot: integer;
X
Xbegin
X if here.locnum = location then
X selfslot := myslot
X else
X selfslot := 0;
X
X sum := 0;
X for i := 1 to maxpeople do
X if ( i <> selfslot ) and
X ( length(here.people[i].name) > 0 ) and
X ( here.people[i].hiding = 0 ) then
X sum := sum + 1;
X n_can_see := sum;
X if debug then
X writeln('%n_can_see = ',sum:1);
Xend;
X
X
X
Xfunction next_can_see(var point: integer): string;
Xvar
X found: boolean;
X selfslot: integer;
X
Xbegin
X if here.locnum <> location then
X selfslot := 0
X else
X selfslot := myslot;
X found := false;
X while (not found) and (point <= maxpeople) do begin
X if (point <> selfslot) and
X (length(here.people[point].name) > 0) and
X (here.people[point].hiding = 0) then
X found := true
X else
X point := point + 1;
X end;
X
X if found then begin
X next_can_see := here.people[point].name;
X point := point + 1;
X end else begin
X next_can_see := myname; { error! error! }
X writeln('%searching error in next_can_see; notify the Monster Manager');
X end;
Xend;
X
X
Xprocedure niceprint(var len: integer; s: string);
X
Xbegin
X if len + length(s) > 78 then begin
X len := 0;
X writeln;
X end else begin
X len := len + length(s);
X end;
X write(s);
Xend;
X
X
Xprocedure people_header(where: shortstring);
Xvar
X point: integer;
X tmp: string;
X i: integer;
X n: integer;
X len: integer;
X
Xbegin
X point := 1;
X n := n_can_see;
X case n of
X 0:;
X 1: begin
X writeln(next_can_see(point),' is ',where);
X end;
X 2: begin
X writeln(next_can_see(point),' and ',next_can_see(point),
X ' are ',where);
X end;
X otherwise begin
X len := 0;
X for i := 1 to n - 1 do begin { at least 1 to 2 }
X tmp := next_can_see(point);
X if i <> n - 1 then
X tmp := tmp + ', ';
X niceprint(len,tmp);
X end;
X
X niceprint(len,' and ');
X niceprint(len,next_can_see(point));
X niceprint(len,' are ' + where);
X writeln;
X end;
X end;
Xend;
X
X
Xprocedure desc_person(i: integer);
Xvar
X pname: shortstring;
X
Xbegin
X pname := here.people[i].name;
X
X if here.people[i].act <> 0 then begin
X write(pname,' is');
X writeln(desc_action(here.people[i].act,
X here.people[i].targ));
X { describes what person last did }
X end;
X
X if here.people[i].health <> GOODHEALTH then
X desc_health(i);
X
X if here.people[i].wielding > 0 then
X writeln(pname,' is wielding ',obj_part(here.people[i].wielding),'.');
X
Xend;
X
X
Xprocedure show_people;
Xvar
X i: integer;
X
Xbegin
X people_header('here.');
X for i := 1 to maxpeople do begin
X if (here.people[i].name <> '') and
X (i <> myslot) and
X (here.people[i].hiding = 0) then
X desc_person(i);
X end;
Xend;
X
X
Xprocedure show_group;
Xvar
X gloc1,gloc2: integer;
X gnam1,gnam2: shortstring;
X
Xbegin
X gloc1 := here.grploc1;
X gloc2 := here.grploc2;
X gnam1 := here.grpnam1;
X gnam2 := here.grpnam2;
X
X if gloc1 <> 0 then begin
X gethere(gloc1);
X people_header(gnam1);
X end;
X if gloc2 <> 0 then begin
X gethere(gloc2);
X people_header(gnam2);
X end;
X gethere;
Xend;
X
X
Xprocedure desc_obj(n: integer);
X
Xbegin
X if n <> 0 then begin
X getobj(n);
X freeobj;
X if (obj.linedesc = DEFAULT_LINE) then begin
X writeln('On the ground here is ',obj_part(n,FALSE),'.');
X
X { the FALSE means obj_part shouldn't do its
X own getobj, cause we already did one }
X end else
X print_line(obj.linedesc);
X end;
Xend;
X
X
Xprocedure show_objects;
X
Xvar
X i: integer;
X
Xbegin
X for i := 1 to maxobjs do begin
X if (here.objs[i] <> 0) and (here.objhide[i] = 0) then
X desc_obj(here.objs[i]);
X end;
Xend;
X
X
Xfunction lookup_detail(var n: integer;s:string): boolean;
Xvar
X i,poss,maybe,num: integer;
X
Xbegin
X n := 0;
X s := lowcase(s);
X i := 1;
X maybe := 0;
X num := 0;
X for i := 1 to maxdetail do begin
X if s = here.detail[i] then
X num := i
X else if index(here.detail[i],s) = 1 then begin
X maybe := maybe + 1;
X poss := i;
X end;
X end;
X if num <> 0 then begin
X n := num;
X lookup_detail := true;
X end else if maybe = 1 then begin
X n := poss;
X lookup_detail := true;
X end else if maybe > 1 then begin
X lookup_detail := false;
X end else begin
X lookup_detail := false;
X end;
Xend;
X
X
Xfunction look_detail(s: string): boolean;
Xvar
X n: integer;
X
Xbegin
X if lookup_detail(n,s) then begin
X if here.detaildesc[n] = 0 then
X look_detail := false
X else begin
X print_desc(here.detaildesc[n]);
X log_event(myslot,E_LOOKDETAIL,0,0,here.detail[n]);
X look_detail := true;
X end;
X end else
X look_detail := false;
Xend;
X
X
Xfunction look_person(s: string): boolean;
Xvar
X objnum,i,n: integer;
X first: boolean;
X
Xbegin
X if parse_pers(n,s) then begin
X if n = myslot then begin
X log_event(myslot,E_LOOKSELF,n,0);
X writeln('You step outside of yourself for a moment to get an objective self-appraisal:');
X writeln;
X end else
X log_event(myslot,E_LOOKYOU,n,0);
X if here.people[n].self <> 0 then begin
X print_desc(here.people[n].self);
X writeln;
X end;
X
X desc_health(n);
X
X { Do an inventory of person S }
X first := true;
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(' ',obj_part(objnum));
X end;
X end;
X if first then
X writeln(here.people[n].name,' is empty handed.');
X
X look_person := true;
X end else
X look_person := false;
Xend;
X
X
X
Xprocedure do_examine(s: string;var three: boolean;silent:boolean := false);
Xvar
X n: integer;
X msg: string;
X
Xbegin
X three := false;
X if parse_obj(n,s) then begin
X if obj_here(n) or obj_hold(n) then begin
X three := true;
X
X getobj(n);
X freeobj;
X msg := myname + ' is examining ' + obj_part(n) + '.';
X log_event(myslot,E_EXAMINE,0,0,msg);
X if obj.examine = 0 then
X writeln('You see nothing special about the ',
X objnam.idents[n],'.')
X else
X print_desc(obj.examine);
X end else
X if not(silent) then
X writeln('That object cannot be seen here.');
X end else
X if not(silent) then
X writeln('That object cannot be seen here.');
Xend;
X
X
X
Xprocedure print_room;
X
Xbegin
X case here.nameprint of
X 0:; { don't print name }
X 1: writeln('You''re in ',here.nicename);
X 2: writeln('You''re at ',here.nicename);
X end;
X
X if not(brief) then begin
X case here.which of
X 0: print_desc(here.primary);
X 1: print_desc(here.secondary);
X 2: begin
X print_desc(here.primary);
X print_desc(here.secondary);
X end;
X 3: begin
X print_desc(here.primary);
X if here.magicobj <> 0 then
X if obj_hold(here.magicobj) then
X print_desc(here.secondary);
X end;
X 4: begin
X if here.magicobj <> 0 then begin
X if obj_hold(here.magicobj) then
X print_desc(here.secondary)
X else
X print_desc(here.primary);
X end else
X print_desc(here.primary);
X end;
X end;
X writeln;
X end; { if not(brief) }
Xend;
X
X
X
Xprocedure do_look(s: string := '');
Xvar
X n: integer;
X one,two,three: boolean;
X
Xbegin
X gethere;
X if s = '' then begin { do an ordinary top-level room look }
X
X if hiding then begin
X writeln('You can''t get a very good view of the details of the room from where');
X writeln('you are hiding.');
X noisehide(67);
X end else begin
X print_room;
X show_exits;
X end; { end of what you can't see when you're hiding }
X show_people;
X show_group;
X show_objects;
X end else begin { look at a detail in the room }
X one := look_detail(s);
X two := look_person(s);
X do_examine(s,three,TRUE);
X if not(one or two or three) then
X writeln('There isn''t anything here by that name to look at.');
X end;
Xend;
X
X
Xprocedure init_exit(dir: integer);
X
Xbegin
X with here.exits[dir] do begin
X exitdesc := DEFAULT_LINE;
X fail := DEFAULT_LINE; { default descriptions }
X success := 0; { until they customize }
X comeout := DEFAULT_LINE;
X goin := DEFAULT_LINE;
X closed := DEFAULT_LINE;
X
X objreq := 0; { not a door (yet) }
X hidden := 0; { not hidden }
X reqalias := false; { don't require alias (i.e. can use
X direction of exit North, east, etc. }
X reqverb := false;
X autolook := true;
X alias := '';
X end;
Xend;
X
X
X
Xprocedure remove_exit(dir: integer);
Xvar
X targroom,targslot: integer;
X hereacc,targacc: boolean;
X
Xbegin
X { Leave residual accepts if player is not the owner of
X the room that the exit he is deleting is in }
X
X getroom;
X targroom := here.exits[dir].toloc;
X targslot := here.exits[dir].slot;
X here.exits[dir].toloc := 0;
X init_exit(dir);
X
X if (here.owner = userid) or (privd) then
X hereacc := false
X else
X hereacc := true;
X
X if hereacc then
X here.exits[dir].kind := 5 { put an "accept" in its place }
X else
X here.exits[dir].kind := 0;
X
X putroom;
X log_event(myslot,E_DETACH,dir,0,myname,location);
X
X getroom(targroom);
X here.exits[targslot].toloc := 0;
X
X if (here.owner = userid) or (privd) then
X targacc := false
X else
X targacc := true;
X
X if targacc then
X here.exits[targslot].kind := 5 { put an "accept" in its place }
X else
X here.exits[targslot].kind := 0;
X
X putroom;
X
X if targroom <> location then
X log_event(0,E_DETACH,targslot,0,myname,targroom);
X writeln('Exit destroyed.');
Xend;
X
X
X{
XUser procedure to unlink a room
X}
Xprocedure do_unlink(s: string);
Xvar
X dir: integer;
X
Xbegin
X gethere;
X if checkhide then begin
X if lookup_dir(dir,s) then begin
X if can_alter(dir) then begin
X if here.exits[dir].toloc = 0 then
X writeln('There is no exit there to unlink.')
X else
X remove_exit(dir);
X end else
X writeln('You are not allowed to remove that exit.');
X end else
X writeln('To remove an exit, type UNLINK <direction of exit>.');
X end;
Xend;
X
X
X
Xfunction desc_allowed: boolean;
X
Xbegin
X if (here.owner = userid) or
X (privd) then
X desc_allowed := true
X else begin
X writeln('Sorry, you are not allowed to alter the descriptions in this room.');
X desc_allowed := false;
X end;
Xend;
X
X
X
Xfunction slead(s: string):string;
Xvar
X i: integer;
X going: boolean;
X
Xbegin
X if length(s) = 0 then
X slead := ''
X else begin
X i := 1;
X going := true;
X while going do begin
X if i > length(s) then
X going := false
X else if (s[i]=' ') or (s[i]=chr(9)) then
X i := i + 1
X else
X going := false;
X end;
X
X if i > length(s) then
X slead := ''
X else
X slead := substr(s,i,length(s)+1-i);
X end;
Xend;
X
X
Xfunction bite(var s: string): string;
Xvar
X i: integer;
X
Xbegin
X if length(s) = 0 then
X bite := ''
X else begin
X i := index(s,' ');
X if i = 0 then begin
X bite := s;
X s := '';
X end else begin
X bite := substr(s,1,i-1);
X s := slead(substr(s,i+1,length(s)-i));
X end;
X end;
Xend;
X
Xprocedure edit_help;
X
Xbegin
X writeln;
X writeln('A Append text to end');
X writeln('C Check text for correct length with parameter substitution (#)');
X writeln('D # Delete line #');
X writeln('E Exit & save changes');
X writeln('I # Insert lines before line #');
X writeln('P Print out description');
X writeln('Q Quit: THROWS AWAY CHANGES');
X writeln('R # Replace text of line #');
X writeln('Z Zap all text');
X writeln('@ Throw away text & exit with the default description');
X writeln('? This list');
X writeln;
Xend;
X
Xprocedure edit_replace(n: integer);
Xvar
X prompt: string;
X s: string;
X
Xbegin
X if (n > heredsc.desclen) or (n < 1) then
X writeln('-- Bad line number')
X else begin
X writev(prompt,n:2,': ');
X grab_line(prompt,s);
X if s <> '**' then
X heredsc.lines[n] := s;
X end;
Xend;
X
Xprocedure edit_insert(n: integer);
Xvar
X i: integer;
X
Xbegin
X if heredsc.desclen = descmax then
X writeln('You have already used all ',descmax:1,' lines of text.')
X else if (n < 1) or (n > heredsc.desclen) then begin
X writeln('Invalid line #; valid lines are between 1 and ',heredsc.desclen:1);
X writeln('Use A (add) to add text to the end of your description.');
X end else begin
X for i := heredsc.desclen+1 downto n + 1 do
X heredsc.lines[i] := heredsc.lines[i-1];
X heredsc.desclen := heredsc.desclen + 1;
X heredsc.lines[n] := '';
X end;
Xend;
X
Xprocedure edit_doinsert(n: integer);
Xvar
X s: string;
X prompt: string;
X
Xbegin
X if heredsc.desclen = descmax then
X writeln('You have already used all ',descmax:1,' lines of text.')
X else if (n < 1) or (n > heredsc.desclen) then begin
X writeln('Invalid line #; valid lines are between 1 and ',heredsc.desclen:1);
X writeln('Use A (add) to add text to the end of your description.');
X end else repeat
X writev(prompt,n:1,': ');
X grab_line(prompt,s);
X if s <> '**' then begin
X edit_insert(n); { put the blank line in }
X heredsc.lines[n] := s; { copy this line onto it }
X n := n + 1;
X end;
X until (heredsc.desclen = descmax) or (s = '**');
Xend;
X
Xprocedure edit_show;
Xvar
X i: integer;
X
Xbegin
X writeln;
X if heredsc.desclen = 0 then
X writeln('[no text]')
X else begin
X i := 1;
X while i <= heredsc.desclen do begin
X writeln(i:2,': ',heredsc.lines[i]);
X i := i + 1;
X end;
X end;
Xend;
X
Xprocedure edit_append;
Xvar
X prompt,s: string;
X stilladding: boolean;
X
Xbegin
X if heredsc.desclen = descmax then
X writeln('You have already used all ',descmax:1,' lines of text.')
X else begin
X stilladding := true;
X writeln('Enter text. Terminate with ** at the beginning of a line.');
X writeln('You have ',descmax:1,' lines maximum.');
X writeln;
X while (heredsc.desclen < descmax) and (stilladding) do begin
X writev(prompt,heredsc.desclen+1:2,': ');
X grab_line(prompt,s);
X if s = '**' then
X stilladding := false
X else begin
X heredsc.desclen := heredsc.desclen + 1;
X heredsc.lines[heredsc.desclen] := s;
X end;
X end;
X end;
Xend;
X
Xprocedure edit_delete(n: integer);
Xvar
X i: integer;
X
Xbegin
X if heredsc.desclen = 0 then
X writeln('-- No lines to delete')
X else if (n > heredsc.desclen) or (n < 1) then
X writeln('-- Bad line number')
X else if (n = 1) and (heredsc.desclen = 1) then
X heredsc.desclen := 0
X else begin
X for i := n to heredsc.desclen-1 do
X heredsc.lines[i] := heredsc.lines[i + 1];
X heredsc.desclen := heredsc.desclen - 1;
X end;
Xend;
X
X
Xprocedure check_subst;
Xvar
X i: integer;
X
Xbegin
X if heredsc.desclen > 0 then begin
X for i := 1 to heredsc.desclen do
X if (index(heredsc.lines[i],'#') > 0) and
X (length(heredsc.lines[i]) > 59) then
X writeln('Warning: line ',i:1,' is too long for correct parameter substitution.');
X end;
Xend;
X
X
Xfunction edit_desc(var dsc: integer):boolean;
Xvar
X cmd: char;
X s: string;
X done: boolean;
X n: integer;
X
Xbegin
X if dsc = DEFAULT_LINE then begin
X heredsc.desclen := 0;
X end else if dsc > 0 then begin
X getblock(dsc);
X freeblock;
X heredsc := block;
X end else if dsc < 0 then begin
X n := (- dsc);
X getline(n);
X freeline;
X heredsc.lines[1] := oneliner.theline;
X heredsc.desclen := 1;
X end else begin
X heredsc.desclen := 0;
X end;
X
X edit_desc := true;
X done := false;
X if heredsc.desclen = 0 then
X edit_append;
X repeat
X writeln;
X repeat
X grab_line('* ',s);
X s := slead(s);
X until length(s) > 0;
X s := lowcase(s);
X cmd := s[1];
X
X if length(s)>1 then begin
X n := number(slead(substr(s,2,length(s)-1)))
X end else
X n := 0;
X
X case cmd of
X 'h','?': edit_help;
X 'a': edit_append;
X 'z': heredsc.desclen := 0;
X 'c': check_subst;
X 'p','l','t': edit_show;
X 'd': edit_delete(n);
X 'e': begin
X check_subst;
X if debug then
X writeln('edit_desc: dsc is ',dsc:1);
X
X
X{ what I do here may require some explanation:
X
X dsc is a pointer to some text structure:
X dsc = 0 : no text
X dsc > 0 : dsc refers to a description block (descmax lines)
X dsc < 0 : dsc refers to a description "one liner". abs(dsc)
X is the actual pointer
X
X If there are no lines of text to be written out (heredsc.desclen = 0)
X then we deallocate whatever dsc is when edit_desc was invoked, if
X it was pointing to something;
X
X if there is one line of text to be written out, allocate a one liner
X record, assign the string to it, and return dsc as negative;
X
X if there is mmore than one line of text, allocate a description block,
X store the lines in it, and return dsc as positive.
X
X In all cases if there was already a record allocated to dsc then
X use it and don't reallocate a new record.
X}
X
X{ kill the default } if (heredsc.desclen > 0) and
X{ if we're gonna put real } (dsc = DEFAULT_LINE) then
X{ texty in here } dsc := 0;
X
X{ no lines, delete existing } if heredsc.desclen = 0 then
X{ desc, if any } delete_block(dsc)
X else if heredsc.desclen = 1 then begin
X if (dsc = 0) then begin
X if alloc_line(dsc) then;
X dsc := (- dsc);
X end else if dsc > 0 then begin
X delete_block(dsc);
X if alloc_line(dsc) then;
X dsc := (- dsc);
X end;
X
X if dsc < 0 then begin
X getline( abs(dsc) );
X oneliner.theline := heredsc.lines[1];
X putline;
X end;
X{ more than 1 lines } end else begin
X if dsc = 0 then begin
X if alloc_block(dsc) then;
X end else if dsc < 0 then begin
X delete_line(dsc);
X if alloc_block(dsc) then;
X end;
X
X if dsc > 0 then begin
X getblock(dsc);
X block := heredsc;
X{ This is a fudge } block.descrinum := dsc;
X putblock;
X end;
X end;
X done := true;
X end;
X 'r': edit_replace(n);
X '@': begin
X delete_block(dsc);
X dsc := DEFAULT_LINE;
X done := true;
X end;
X 'i': edit_doinsert(n);
X 'q': begin
X grab_line('Throw away changes, are you sure? ',s);
X s := lowcase(s);
X if (s = 'y') or (s = 'yes') then begin
X done := true;
X edit_desc := false; { signal caller not to save }
X end;
X end;
X otherwise writeln('-- Invalid command, type ? for a list.');
X end;
X until done;
Xend;
X
X
X
X
Xfunction alloc_detail(var n: integer;s: string): boolean;
Xvar
X found: boolean;
X
Xbegin
X n := 1;
X found := false;
X while (n <= maxdetail) and (not found) do begin
X if here.detaildesc[n] = 0 then
X found := true
X else
X n := n + 1;
X end;
X alloc_detail := found;
X if not(found) then
X n := 0
X else begin
X getroom;
X here.detail[n] := lowcase(s);
X putroom;
X end;
Xend;
X
X
X{
XUser describe procedure. If no s then describe the room
X
XKnown problem: if two people edit the description to the same room one of their
X description blocks could be lost.
XThis is unlikely to happen unless the Monster Manager tries to edit a
Xdescription while the room's owner is also editing it.
X}
Xprocedure do_describe(s: string);
Xvar
X i: integer;
X newdsc: integer;
X
Xbegin
X gethere;
X if checkhide then begin
X if s = '' then begin { describe this room }
X if desc_allowed then begin
X log_action(desc,0);
X writeln('[ Editing the primary room description ]');
X newdsc := here.primary;
X if edit_desc(newdsc) then begin
X getroom;
X here.primary := newdsc;
X putroom;
X end;
X log_event(myslot,E_EDITDONE,0,0);
X end;
X end else begin{ describe a detail of this room }
X if length(s) > veryshortlen then
X writeln('Your detail keyword can only be ',veryshortlen:1,' characters.')
X else if desc_allowed then begin
X if not(lookup_detail(i,s)) then
X if not(alloc_detail(i,s)) then begin
X writeln('You have used all ',maxdetail:1,' details.');
X writeln('To delete a detail, DESCRIBE <the detail> and delete all the text.');
X end;
X if i <> 0 then begin
X log_action(e_detail,0);
X writeln('[ Editing detail "',here.detail[i],'" of this room ]');
X newdsc := here.detaildesc[i];
X if edit_desc(newdsc) then begin
X getroom;
X here.detaildesc[i] := newdsc;
X putroom;
X end;
X log_event(myslot,E_DONEDET,0,0);
X end;
X end;
X end;
X{ clear_command; }
X end;
Xend;
X
X
X
X
Xprocedure del_room(n: integer);
Xvar
X i: integer;
X
Xbegin
X getnam;
X nam.idents[n] := ''; { blank out name }
X putnam;
X
X getown;
X own.idents[n] := ''; { blank out owner }
X putown;
X
X getroom(n);
X for i := 1 to maxexit do begin
X with here.exits[i] do begin
X delete_line(exitdesc);
X delete_line(fail);
X delete_line(success);
X delete_line(comeout);
X delete_line(goin);
X end;
X end;
X delete_block(here.primary);
X delete_block(here.secondary);
X putroom;
X delete_room(n); { return room to free list }
Xend;
X
X
X
Xprocedure createroom(s: string); { create a room with name s }
Xvar
X roomno: integer;
X dummy: integer;
X i:integer;
X rand_accept: integer;
X
Xbegin
X if length(s) = 0 then begin
X writeln('Please specify the name of the room you wish to create as a parameter to FORM.');
X end else if length(s) > shortlen then begin
X writeln('Please limit your room name to a maximum of ',shortlen:1,' characters.');
X end else if exact_room(dummy,s) then begin
X writeln('That room name has already been used. Please give a unique room name.');
X end else if alloc_room(roomno) then begin
X log_action(form,0);
X
X getnam;
X nam.idents[roomno] := lowcase(s); { assign room name }
X putnam; { case insensitivity }
X
X getown;
X own.idents[roomno] := userid; { assign room owner }
X putown;
X
X getroom(roomno);
X
X here.primary := 0;
X here.secondary := 0;
X here.which := 0; { print primary desc only by default }
X here.magicobj := 0;
X
X here.owner := userid; { owner and name are stored here too }
X here.nicename := s;
X here.nameprint := 1; { You're in ... }
X here.objdrop := 0; { objects dropped stay here }
X here.objdesc := 0; { nothing printed when they drop }
X here.magicobj := 0; { no magic object default }
X here.trapto := 0; { no trapdoor }
X here.trapchance := 0; { no chance }
X here.rndmsg := DEFAULT_LINE; { bland noises message }
X here.pile := 0;
X here.grploc1 := 0;
X here.grploc2 := 0;
X here.grpnam1 := '';
X here.grpnam2 := '';
X
X here.effects := 0;
X here.parm := 0;
X
X here.xmsg2 := 0;
X here.exp2 := 0;
X here.exp3 := 0;
X here.exp4 := 0;
X here.exitfail := DEFAULT_LINE;
X here.ofail := DEFAULT_LINE;
X
X for i := 1 to maxpeople do
X here.people[i].kind := 0;
X
X for i := 1 to maxpeople do
X here.people[i].name := '';
X
X for i := 1 to maxobjs do
X here.objs[i] := 0;
X
X for i := 1 to maxdetail do
X here.detail[i] := '';
X for i := 1 to maxdetail do
X here.detaildesc[i] := 0;
X
X for i := 1 to maxobjs do
X here.objhide[i] := 0;
X
X for i := 1 to maxexit do
X with here.exits[i] do begin
X toloc := 0;
X kind := 0;
X slot := 0;
X exitdesc := DEFAULT_LINE;
X fail := DEFAULT_LINE;
X success := 0; { no success desc by default }
X goin := DEFAULT_LINE;
X comeout := DEFAULT_LINE;
X closed := DEFAULT_LINE;
X
X objreq := 0;
X hidden := 0;
X alias := '';
X
X reqverb := false;
X reqalias := false;
X autolook := true;
X end;
X
X{ here.exits := zero; }
X
X { random accept for this room }
X rand_accept := 1 + (rnd100 mod 6);
X here.exits[rand_accept].kind := 5;
X
X putroom;
X end;
Xend;
X
X
X
Xprocedure show_help;
Xvar
X i: integer;
X s: string;
X
Xbegin
X writeln;
X writeln('Accept/Refuse # Allow others to Link an exit here at direction # | Undo Accept');
X writeln('Brief Toggle printing of room descriptions');
X writeln('Customize [#] Customize this room | Customize exit # | Customize object #');
X writeln('Describe [#] Describe this room | Describe a feature (#) in detail');
X writeln('Destroy # Destroy an instance of object # (you must be holding it)');
X writeln('Duplicate # Make a duplicate of an already-created object.');
X writeln('Form/Zap # Form a new room with name # | Destroy room named #');
X writeln('Get/Drop # Get/Drop an object');
X writeln('#,Go # Go towards # (Some: N/North S/South E/East W/West U/Up D/Down)');
X writeln('Health Show how healthy you are');
X writeln('Hide/Reveal [#] Hide/Reveal yoursef | Hide object (#)');
X writeln('I,Inventory See what you or someone else is carrying');
X writeln('Link/Unlink # Link/Unlink this room to/from another via exit at direction #');
X writeln('Look,L [#] Look here | Look at something or someone (#) closely');
X writeln('Make # Make a new object named #');
X writeln('Name # Set your game name to #');
X writeln('Players List people who have played Monster');
X writeln('Punch # Punch person #');
X writeln('Quit Leave the game');
X writeln('Relink Move an exit');
X writeln;
X grab_line('-more-',s);
X writeln;
X writeln('Rooms Show information about rooms you have made');
X writeln('Say, '' (quote) Say line of text following command to others in the room');
X writeln('Search Look around the room for anything hidden');
X writeln('Self # Edit a description of yourself | View #''s self-description');
X writeln('Show # Show option # (type SHOW ? for a list)');
X writeln('Unmake # Remove the form definition of object #');
X writeln('Use # Use object #');
X writeln('Wear # Wear the object #');
X writeln('Wield # Wield the weapon #; you must be holding it first');
X writeln('Whisper # Whisper something (prompted for) to person #');
X writeln('Who List of people playing Monster now');
X writeln('Whois # What is a player''s username');
X writeln('?,Help This list');
X writeln('. (period) Repeat last command');
X writeln;
Xend;
X
X
Xfunction lookup_cmd(s: string):integer;
Xvar
X i, { index for loop }
X poss, { a possible match -- only for partial matches }
X maybe, { number of possible matches we have: > 2 is ambig. }
X num { the definite match }
X : integer;
X
X
Xbegin
X s := lowcase(s);
X i := 1;
X maybe := 0;
X num := 0;
X for i := 1 to numcmds do begin
X if s = cmds[i] then
X num := i
X else if index(cmds[i],s) = 1 then begin
X maybe := maybe + 1;
X poss := i;
X end;
X end;
X if num <> 0 then begin
X lookup_cmd := num;
X end else if maybe = 1 then begin
X lookup_cmd := poss;
X end else if maybe > 1 then
X lookup_cmd := error { "Ambiguous" }
X else
X lookup_cmd := error; { "Command not found " }
Xend;
X
X
Xprocedure addrooms(n: integer);
Xvar
X i: integer;
X
Xbegin
X getindex(I_ROOM);
X for i := indx.top+1 to indx.top+n do begin
X locate(roomfile,i);
X roomfile^.valid := i;
X roomfile^.locnum := i;
X roomfile^.primary := 0;
X roomfile^.secondary := 0;
X roomfile^.which := 0;
X put(roomfile);
X end;
X indx.top := indx.top + n;
X putindex;
Xend;
X
X
X
Xprocedure addints(n: integer);
Xvar
X i: integer;
X
Xbegin
X getindex(I_INT);
X for i := indx.top+1 to indx.top+n do begin
X locate(intfile,i);
X intfile^.intnum := i;
X put(intfile);
X end;
X indx.top := indx.top + n;
X putindex;
Xend;
X
X
X
Xprocedure addlines(n: integer);
Xvar
X i: integer;
X
Xbegin
X getindex(I_LINE);
X for i := indx.top+1 to indx.top+n do begin
X locate(linefile,i);
X linefile^.linenum := i;
X put(linefile);
X end;
X indx.top := indx.top + n;
X putindex;
Xend;
X
Xprocedure addblocks(n: integer);
Xvar
X i: integer;
X
Xbegin
X getindex(I_BLOCK);
X for i := indx.top+1 to indx.top+n do begin
X locate(descfile,i);
X descfile^.descrinum := i;
X put(descfile);
X end;
X indx.top := indx.top + n;
X putindex;
Xend;
X
X
Xprocedure addobjects(n: integer);
Xvar
X i: integer;
X
Xbegin
X getindex(I_OBJECT);
X for i := indx.top+1 to indx.top+n do begin
X locate(objfile,i);
X objfile^.objnum := i;
X put(objfile);
X end;
X indx.top := indx.top + n;
X putindex;
Xend;
X
X
Xprocedure dist_list;
Xvar
X i,j: integer;
X f: text;
X where_they_are: intrec;
X
Xbegin
X writeln('Writing distribution list . . .');
X open(f,'monsters.dis',history := new);
X rewrite(f);
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 for i := 1 to maxplayers do begin
X if not(indx.free[i]) then begin
X write(f,user.idents[i]);
X for j := length(user.idents[i]) to 15 do
X write(f,' ');
X write(f,'! ',pers.idents[i]);
X for j := length(pers.idents[i]) to 21 do
X write(f,' ');
X
X write(f,adate.idents[i]);
X if length(adate.idents[i]) < 19 then
X for j := length(adate.idents[i]) to 18 do
X write(f,' ');
X if anint.int[i] <> 0 then
X write(f,' * ')
X else
X write(f,' ');
X
X if privd then begin
X write(f,nam.idents[ where_they_are.int[i] ]);
X end;
X writeln(f);
X
X end;
X end;
X writeln('Done.');
Xend;
X
X
Xprocedure system_view;
Xvar
X used,free,total: integer;
X
Xbegin
X writeln;
X getindex(I_BLOCK);
X freeindex;
X used := indx.inuse;
X total := indx.top;
X free := total - used;
X
X writeln(' used free total');
X writeln('Block file ',used:5,' ',free:5,' ',total:5);
X
X getindex(I_LINE);
X freeindex;
X used := indx.inuse;
X total := indx.top;
X free := total - used;
X writeln('Line file ',used:5,' ',free:5,' ',total:5);
X
X getindex(I_ROOM);
X freeindex;
X used := indx.inuse;
X total := indx.top;
X free := total - used;
X writeln('Room file ',used:5,' ',free:5,' ',total:5);
X
X getindex(I_OBJECT);
X freeindex;
X used := indx.inuse;
X total := indx.top;
X free := total - used;
X writeln('Object file ',used:5,' ',free:5,' ',total:5);
X
X getindex(I_INT);
X freeindex;
X used := indx.inuse;
X total := indx.top;
X free := total - used;
X writeln('Integer file ',used:5,' ',free:5,' ',total:5);
X
X writeln;
Xend;
X
X
X{ remove a user from the log records (does not handle ownership) }
X
Xprocedure kill_user(s:string);
Xvar
X n: integer;
X
Xbegin
X if length(s) = 0 then
X writeln('No user specified')
X else begin
X if lookup_user(n,s) then begin
X getindex(I_ASLEEP);
X freeindex;
X if indx.free[n] then begin
X delete_log(n);
X writeln('Player deleted.');
X end else
X writeln('That person is playing now.');
X end else
X writeln('No such userid found in log information.');
X end;
Xend;
X
END_OF_FILE
if test 54730 -ne `wc -c <'mon2.pas'`; then
echo shar: \"'mon2.pas'\" unpacked with wrong size!
fi
# end of 'mon2.pas'
fi
if test -f 'readme.txt' -a "${1}" != "-c" ; then
echo shar: Will not clobber existing file \"'readme.txt'\"
else
echo shar: Extracting \"'readme.txt'\" \(1476 characters\)
sed "s/^X//" >'readme.txt' <<'END_OF_FILE'
XThis is README.TXT for Monster, a multiplayer adventure game for VMS.
XMonster was written by Rich Skrenta at Northwestern University.
X
XYou may freely copy, distribute and change Monster as you wish. Let me
Xknow if you get it up and running, and if you change it, just because I'm
Xinterested. Send mail to
X
X skrenta@nuacc.acns.nwu.edu or
X skrenta@nuacc.bitnet
X
XMonster was written in VMS Pascal under VMS 4.6. It uses file sharing and
Xrecord locking for communication. Outside of that, it doesn't do anything
Xtricky. However, after playing around with a VMS 4.2 system, I have
Xdoubts if it will work on a system that old. If you've got a reasonably
Xrecent version of VMS and a Pascal compiler, you shouldn't have any problems.
X
XThe Monster source is in two files: a short one, approx 300 lines, called
Xguts.pas, and a big one, mon.pas, approx 10,000 lines. The compiled program
Xcontains everything necessary to create and maintain the Monster universe.
XThere is no separate maintenance program. Instead, a specific person in
Xthe game has privileges, and is known as the "Monster Manager". The MM
Xcan do system maintenance while playing, and other players can even observe
Xhis work.
X
XCredit for the work to convert GUTS.PAS to a more portable form goes to
X
X Michael "the spide" Young MCY1580@RITVAX.BITNET
X Chris "siouxane" Meck CLM4346@RITVAX.BITNET
X
XMany thanks to them for solving this sticky problem!
X
XRich Skrenta
XNovember, 1988.
END_OF_FILE
if test 1476 -ne `wc -c <'readme.txt'`; then
echo shar: \"'readme.txt'\" unpacked with wrong size!
fi
# end of 'readme.txt'
fi
echo shar: End of archive 3 \(of 6\).
cp /dev/null ark3isdone
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