2 (*HEAL, ONUSPLAYER*):
BEGIN
PLAYER ^.HITS := MIN(PLAYER ^.MAXHITS, PLAYER ^.HITS + LEVEL * 3);
WRITELN(PLAYER ^.TRM, 'YOU NOW HAVE ', PLAYER ^.HITS: 0, ' VITALITY POINTS.');
END (*2*);
3 (*FIREBALL, ONMONPLAYER*):
IF 10 + LEVEL > RND(20) THEN DAMAGE := MIN(INTEL * 2, 3 * (LEVEL + 1));
4 (*LIGHTNING, ONMONPLAYER*):
IF 8 + LEVEL > RND(20)
THEN DAMAGE := MIN(20, 2 * (LEVEL + 1)) + RND(2 * INTEL);
5 (*HURT, ONMONPLAYER*): DAMAGE := RND(2);
6 (*CUREPOISON, ONUSPLAYER*):
BEGIN
PLAYER ^.POISONED := FALSE;
WRITELN(PLAYER ^.TRM, 'THE VENOM HAS DISAPPEARED!');
END (*6*);
7 (*DISINTEGRATE, ONMONPLAYER*): DAMAGE := RND(5 * INTEL) + LEVEL * 2;
8 (*BEFUDDLE, ONMON*):
IF PLAYER <> NIL THEN PLAYER ^.LASTATK := REALTIME + 30
ELSE
BEGIN
MONSTER ^.MREACT := 4; WRITELN(TERM, 'IT PAUSES FOR A MOMENT...');
MONSTER ^.DEFPLAYER := NIL;
END (*ELSE*);
9 (*TELEPORT, ONUSPLAYER*):
BEGIN
DELETEPLAYER(PLAYER, PLAYER ^.RMCODE); PLACEPLAYER(PLAYER, RND(570) + 30);
WRITELN(PLAYER ^.TRM, '**POOF** YOU FIND THAT YOU ARE ELSEWHERE..');
END (*9*);
10: BEGIN WDATA := TARGET; ENTRY := XWISH; END;
11 (*PASSDOOR, ONOBJ*):
IF NOT (OBJ ^.OBCLASS IN [DOOR, PORTAL])
THEN WRITELN(TERM, 'CAN''T BE DONE!')
ELSE
IF NOT OBJ ^.MAGIC
THEN
BEGIN
DELETEPLAYER(USER, USER ^.RMCODE); PLACEPLAYER(USER, OBJ ^.TOWHERE);
WRITELN(TERM, 'YOU PASS THROUGH THE PORTAL!')
END (*IF*)
ELSE WRITELN(TERM, 'A MAGIC BARRIER STOPS YOU FROM PASSING!');
12 (*ENCHANT, ONOBJ*):
IF NOT OBJ ^.CARRY THEN WRITELN(TERM, 'ENCHANTMENT FAILS!')
ELSE
BEGIN OBJ ^.MAGIC := TRUE; WRITELN(TERM, 'OK. IT STARTS TO GLOW!');
END (*ELSE*);
13 (*BLESS, ONUSPLAYER*):
IF (LVL < PLAYER^.LVL) AND (LVL < 10)
THEN WRITELN(TERM, 'YOU ARE NOT WORTHY OF BLESSING THIS GREAT PERSON!')
ELSE
BEGIN
PLAYER ^.PTY := MIN(25, PLAYER ^.PTY + 1);
WRITELN(PLAYER ^.TRM, 'YOU FEEL PURIFIED AND WHOLE.')
END (*ELSE*);
14 (*PROTECT, ONUSER*):
BEGIN
STOPUSING(USER, USARM); STOPUSING(USER, USSHIELD); AC := MAX(8, AC - 1);
WRITELN(TERM, 'YOU FEEL LIMBER AND STRONG..');
END (*14*);
15 (*CURSE,ONPLAYER*):
BEGIN
PLAYER ^.PTY := MAX(- 10, PLAYER ^.PTY - 1);
WRITELN(PLAYER ^.TRM, 'YOU''VE BEEN CURSED!');
END (*15*);
16 (*POISON,ONUSPLAYER*):
BEGIN
PLAYER ^.POISONED := TRUE; WRITELN(PLAYER ^.TRM, 'YOU''VE BEEN POISONED!')
END (*16*);
17 (*INTOXICATE,ONUSPLAYER*):
BEGIN
PLAYER ^.DRUNK := MAX(REALTIME, PLAYER ^.DRUNK) + 60;
WRITELN(PLAYER ^.TRM, '(HIC) YOU FEEL TIPSY.')
END (*17*);
END (*CASE*);
SPELLCASE := DAMAGE
END (*SPELLCASE*);
FUNCTION SPELLMON(SPELLNUM, LVL, INT: INTEGER; PLR: USERPOINT; MON: MONSTERPOINT;
OBJ: OBJECTPOINT; TARGET: ALFA): INTEGER;
BEGIN SPELLMON := SPELLCASE(SPELLNUM, LVL, INT, PLR, MON, OBJ, TARGET); END;
PROCEDURE DOCMD(VAR BUFFER: BUFTYPE; LENBUF: LENBUFTYPE; VAR ROOM: ROOMLIST; VAR
CMDLIST: CMDTYPELIST);
(* DOCMD RUNS ALL INPUT FROM THE "CMD-?" PROMPT. THIS IS THE
CRITICAL ROUTINE WHERE ALL COMMANDS ARE EVALUATED AND EXECUTED.
IF THIS WERE A NON-MULTI TASK, THE ACTUAL PROGRAM WOULD START
HERE! *)
VAR
CMD, WORD: ALFA (* INPUTTED WORDS *);
CH: CHAR;
FOLCOUNT: INTEGER;
FUNCTION SPELLCOST(USER: USERPOINT; COST, MINLVL, MININT: INTEGER): BOOLEAN;
(* SPELLCOST DEDUCTS MP FROM USERS WHO CAST SPELLS. THEY MUST
MEET THE MINIMUM LEVEL AND MINIMUM INT QUALIFICATIONS TOO. *)
BEGIN
SPELLCOST := FALSE (*DEFAULT*);
WITH USER ^ DO
IF INT < MININT
THEN WRITELN(TERM, 'YOU HAVE NOT THE INTELLIGENCE TO CAST THE SPELL!')
ELSE
BEGIN
CASE CLASS OF
FIGHTER: MINLVL := MINLVL + 4;
THIEF: MINLVL := MINLVL + 3;
CLERIC: MINLVL := MINLVL + 1;
MAGICUSER:;
OTHERWISE
MINLVL := MINLVL + 2;
END (*CASE*);
IF MINLVL > LVL
THEN WRITELN(TERM, 'YOU ARE NOT HIGH ENOUGH LEVEL TO CAST THE SPELL!')
ELSE
IF MAGIC - COST < 0
THEN WRITELN(TERM, 'YOU HAVE NOT ENOUGH MAGIC LEFT TO CAST THE SPELL!')
ELSE BEGIN MAGIC := MAGIC - COST; SPELLCOST := TRUE END
END (*ELSE*)
END (*SPELLCOST*);
PROCEDURE DISPDAY(NUM: INTEGER);
(* DUMP *NUM* RECORDS FROM THE GAME DAYFILE *)
VAR
CH: CHAR;
BEGIN
NUM := MAX(0, NUM); GETSEG(DAYFILE, - (NUM + 1));
WHILE NOT EOF(DAYFILE) DO
BEGIN
WHILE NOT EOS(DAYFILE) DO
BEGIN
WRITE(TERM);
WHILE NOT EOLN(DAYFILE) DO BEGIN READ(DAYFILE, CH); WRITE(CH) END;
READLN(DAYFILE); WRITELN;
END (*WHILE*);
GETSEG(DAYFILE)
END (*WHILE*);
ROLLCHECK(TERM); SETDAYFILE;
END (*DISPDAY*);
PROCEDURE PRINTBREG;
VAR
B4, B5, B6: INTEGER;
BEGIN
BREG(B4, B5, B6); WRITELN(TERM); WRITELN(TERM, ' B4= ', B4: 5 OCT);
WRITELN(TERM, ' B5= ', B5: 5 OCT); WRITELN(TERM, ' B6= ', B6: 5 OCT);
WRITELN(TERM);
END (*PRINTBREG*);
PROCEDURE GETOBJECT(WORD: ALFA; NUM: INTEGER; RM: RMCODETYPE);
(* *GET* WILL FETCH OBJECTS LAYING ON THE GROUND. WEIGHT IS
CUMULATIVE. MONSTERS THAT GUARD WILL PROHIBIT PICKING ANYTHING
UP. *)
VAR
OBJ2, BOX, OBTAIL, OBJECT: OBJECTPOINT;
MONSTER: MONSTERPOINT;
NUM2, ILOOP: INTEGER;
WORD2: ALFA;
WHERE:
(GROUND, CONTAINER, NOWHERE);
HELD: BOOLEAN;
FUNCTION GUARDING(MON: MONSTERPOINT): BOOLEAN;
(* GUARDING IS USED BY *MATCHMONSTER* TO CHECK FOR GUARDS *)
BEGIN GUARDING := (MON ^.GUARD AND NOT HELD) END (*GUARDING*);
BEGIN (*GETOBJECT*)
ERRLOC := ' EIGHT '; HELD := FALSE;
WITH ROOM[RM] DO
BEGIN
OBTAIL := RMOBJECTTAIL; BOX := NIL; WHERE := GROUND;
OBJECT := FINDOBJECT(WORD, NUM, OBTAIL);
GETWORD(WORD2, NUM2, BUFFER, LENBUF, LOC);
IF (WORD2 <> BLANKS)
THEN
BEGIN
BOX := FINDOBJECT(WORD2, NUM2, RMOBJECTTAIL);
IF BOX = NIL THEN
BEGIN
BOX := FINDOBJECT(WORD2, NUM2, USER ^.OBJECTTAIL);
IF BOX <> NIL THEN HELD := TRUE
END (*IF*);
IF BOX <> NIL
THEN
IF BOX ^.OBCLASS = CHEST
THEN
IF NOT BOX ^.CLOSED
THEN BEGIN OBTAIL := BOX ^.OBJECTTAIL; WHERE := CONTAINER END
ELSE
BEGIN WHERE := NOWHERE; WRITELN(TERM, 'YOU CAN''T. IT''S CLOSED.'); END
ELSE BEGIN WHERE := NOWHERE; WRITELN(TERM, 'THAT IS NOT A CONTAINER.') END
ELSE
BEGIN WHERE := NOWHERE; WRITELN(TERM, 'THAT CONTAINER ISNT HERE.'); END;
IF WHERE = CONTAINER THEN OBJECT := FINDOBJECT(WORD, NUM, OBTAIL);
END (*IF*);
(* POINTER NOW EQUALS THE OBJECT SELECTED BY THE USER *)
IF (OBJECT <> NIL) AND (WHERE <> NOWHERE)
THEN
IF NOT OBJECT ^.CARRY THEN WRITELN(TERM, 'YOU ARE NOT ABLE TO TAKE THAT!')
ELSE
BEGIN
MONSTER := MATCHMONSTER(RMMONSTERTAIL, GUARDING);
IF MONSTER <> NIL
THEN WRITELN(TERM, PM(MONSTER), 'STOPS YOU FROM GETTING IT!')
ELSE
IF (USER ^.WEIGHT + OBJECT ^.WEIGHT > USER ^.STR * 10) AND NOT HELD
THEN WRITELN(TERM, 'IT''S TOO MUCH FOR YOU TO CARRY!')
ELSE
BEGIN
IF DELETEOBJECT(OBJECT, OBTAIL) THEN OBTAIL := OBTAIL ^.NEXT;
WRITELN(TERM, 'OK'); OBJECT ^.INVISIBLE := FALSE;
FOR ILOOP := 1 TO MSGTERM(TERMLIST, LOCAL) DO
BEGIN
WRITE(TERMLIST[ILOOP], PS(USER ^.NAME), ' PICKED UP ');
PRINTOBJ(OBJECT ^, TRUE);
IF WHERE = CONTAINER
THEN BEGIN WRITE(' FROM INSIDE '); PRINTOBJ(BOX ^, TRUE) END;
WRITELN('.');
END (*FOR*);
IF OBJECT ^.OBCLASS = COINS
THEN
BEGIN
USER ^.MONEY := MIN(USER ^.MONEY + OBJECT ^.PRICE, 500000);
WRITELN(TERM, 'YOU NOW HAVE ', USER ^.MONEY: 0, ' SHILLINGS IN CASH.');
DISPOSE(OBJECT)
END (*IF*)
ELSE
BEGIN
IF NOT HELD
THEN USER ^.WEIGHT := MIN(2500, USER ^.WEIGHT + OBJECT ^.WEIGHT);
IF USER ^.OBJECTTAIL = NIL
THEN BEGIN OBJECT ^.NEXT := NIL; USER ^.OBJECTTAIL := OBJECT; END
ELSE
BEGIN
OBJ2 := USER ^.OBJECTTAIL;
WHILE OBJ2 ^.NEXT <> NIL DO OBJ2 := OBJ2 ^.NEXT;
OBJ2 ^.NEXT := OBJECT; OBJECT ^.NEXT := NIL
END (*ELSE*);
END (*ELSE*);
IF WHERE = CONTAINER
THEN
BEGIN
BOX ^.WEIGHT := MAX(0, BOX ^.WEIGHT - OBJECT ^.WEIGHT);
BOX ^.NUMINSIDE := MAX(0, BOX ^.NUMINSIDE - 1);
BOX ^.OBJECTTAIL := OBTAIL
END (*IF*)
ELSE RMOBJECTTAIL := OBTAIL;
END (*ELSE*)
END (*ELSE*)
ELSE IF WHERE <> NOWHERE THEN WRITELN(TERM, 'THAT OBJECT ISN''T HERE.')
END (* WITH *)
END (*GETOBJECT*);
PROCEDURE DROPOBJECT(WORD: ALFA; NUM: INTEGER; RM: RMCODETYPE);
VAR
BOX, OBTAIL, OBJECT: OBJECTPOINT;
NUM2, ILOOP: INTEGER;
WORD2: ALFA;
WHERE:
(GROUND, CONTAINER, NOWHERE);
HELD: BOOLEAN;
BEGIN
HELD := FALSE; ERRLOC := 'DROPOBJECT';
OBJECT := FINDOBJECT(WORD, NUM, USER ^.OBJECTTAIL);
IF OBJECT <> NIL
THEN
BEGIN
OBTAIL := ROOM[RM].RMOBJECTTAIL; BOX := NIL; WHERE := GROUND;
GETWORD(WORD2, NUM2, BUFFER, LENBUF, LOC);
BOX := FINDOBJECT(WORD2, NUM2, ROOM[RM].RMOBJECTTAIL);
IF BOX = NIL THEN
BEGIN
BOX := FINDOBJECT(WORD2, NUM2, USER ^.OBJECTTAIL);
IF BOX <> NIL THEN HELD := TRUE
END (*IF*);
IF BOX <> NIL
THEN
IF BOX ^.OBCLASS = CHEST
THEN
IF NOT BOX ^.CLOSED
THEN
BEGIN
OBTAIL := BOX ^.OBJECTTAIL;
IF (BOX^.NUMINSIDE >= 6) OR (BOX ^.WEIGHT > 200)
THEN
BEGIN
WRITE(TERM, 'THERE IS NO MORE ROOM INSIDE '); PRINTOBJ(BOX ^, TRUE);
WRITELN(' FOR MORE OBJECTS!'); WHERE := NOWHERE
END (*IF*)
ELSE
IF BOX = OBJECT
THEN
BEGIN WRITELN(TERM, 'CAN''T PUT IT INSIDE ITSELF!'); WHERE := NOWHERE
END (*IF*)
ELSE WHERE := CONTAINER
END (*IF*)
ELSE
BEGIN WHERE := NOWHERE; WRITELN(TERM, 'YOU CAN''T. IT''S CLOSED!') END
ELSE BEGIN WHERE := NOWHERE; WRITELN(TERM, 'IT WON''T FIT IN THAT!') END
ELSE
IF WORD2 <> BLANKS THEN
BEGIN WHERE := NOWHERE; WRITELN(TERM, 'THAT CONTAINER ISN''T HERE!') END;
IF WHERE <> NOWHERE
THEN
BEGIN (* DROP OBJECT INTO ROOM *)
IF DELETEOBJECT(OBJECT, USER ^.OBJECTTAIL)
THEN USER ^.OBJECTTAIL := USER ^.OBJECTTAIL ^.NEXT;
OBJECT ^.NEXT := OBTAIL; OBTAIL := OBJECT;
IF NOT HELD THEN USER ^.WEIGHT := MAX(0, USER ^.WEIGHT - OBJECT ^.WEIGHT);
STOPUSING(USER, OBJECT);
IF WHERE = CONTAINER
THEN
BEGIN
WRITELN(TERM, 'OK. YOU DROP IT.');
BOX ^.WEIGHT := MIN(1000, BOX ^.WEIGHT + OBJECT ^.WEIGHT);
BOX ^.NUMINSIDE := MIN(10, BOX ^.NUMINSIDE + 1);
BOX ^.OBJECTTAIL := OBTAIL
END (*IF*)
ELSE BEGIN ROOM[RM].RMOBJECTTAIL := OBTAIL; WRITELN(TERM, 'OK') END;
FOR ILOOP := 1 TO MSGTERM(TERMLIST, LOCAL) DO
BEGIN
WRITE(TERMLIST[ILOOP], PS(USER ^.NAME), ' DROPPED ');
PRINTOBJ(OBJECT ^, FALSE);
IF WHERE = CONTAINER
THEN BEGIN WRITE(' INTO '); PRINTOBJ(BOX ^, TRUE) END;
WRITELN('.');
END (*FOR*)
END (*IF*)
END (*IF*)
ELSE WRITELN(TERM, 'YOU AREN''T CARRYING THAT!');
END (*DROPOBJECT*);
PROCEDURE USERS;
(* USERS RETURNS A LIST OF STORED CODENAMES *)
VAR
NUM, ILOOP: INTEGER;
DM: BOOLEAN;
BEGIN
DM := USER ^.SSJ; NUM := 0; WRITE(TERM, 'LIST OF STORED USERS:');
FOR ILOOP := 1 TO CURRENTPLINDEX DO
IF PLAYERINDEX[ILOOP] <> EMPTY
THEN
IF DM OR (PLAYERINDEX[ILOOP, 1] <> '*') (* DEAD PLAYER *)
THEN
BEGIN
IF NUM MOD 4 = 0 THEN BEGIN WRITELN; WRITE(TERM) END; NUM := NUM + 1;
WRITE(PLAYERINDEX[ILOOP], ' ')
END (*IF*);
WRITELN; WRITELN(TERM)
END (*USERS*);
PROCEDURE TALK(LENBUF: LENBUFTYPE; CMDCODE: INTEGER; WORD: ALFA);
(* *TALK* PROCESSES ALL PLAYER-PLAYER COMMUNICATION. IT
EXECUTES THE "SAY", "YELL" AND "SEND" COMMANDS. "SAY" AND
"SEND" MAY HAVE OPTIONAL NAMES SPECIFIED AFTER THEM IN ORDER
TO SIMULATE FLASHING.
*SAY, *YELL AND *SEND ISSUE NO ID PREFIX *)
VAR
PLAYER: USERPOINT;
NUMHEARING, ILOOP: INTEGER;
TALKHOW: TALKHOWTYPE;
MSGSTART, MSGEND: INTEGER;
NOID: BOOLEAN;
LOGTERM: ALFA;
PROCEDURE TEXTLIMITS(VAR MESSTART, MESEND: INTEGER);
(*TEXTLIMITS RETURNS THE STARTING AND ENDING BOUNDARIES FOR
THE MESSAGE IN THE BUFFER.*)
VAR
KLOOP: INTEGER;
BEGIN
KLOOP := 1;
WHILE (KLOOP <= LENBUF) AND (BUFFER[KLOOP] <> '"') DO KLOOP := KLOOP + 1;
IF KLOOP > LENBUF THEN MESSTART := 0 (* FLAG ERROR *)
ELSE
BEGIN
KLOOP := KLOOP + 1; MESSTART := KLOOP;
WHILE (KLOOP <= LENBUF) AND (BUFFER[KLOOP] <> '"') DO
BEGIN
IF BUFFER[KLOOP] = '''' THEN BUFFER[KLOOP] := '"'; KLOOP := KLOOP + 1;
END (*WHILE*);
IF KLOOP > LENBUF THEN MESEND := LENBUF ELSE MESEND := KLOOP - 1;
IF MESEND < LENBUF - 2
THEN WRITELN(TERM, 'TEXT FOLLOWING THE SECOND QUOTATION MARK WAS IGNORED.')
END (*ELSE*)
END (*TEXTLIMITS*);
PROCEDURE SENDMSG(TM: ALFA; VERB: DYNAMIC ALFA; MSTART, MEND: INTEGER; NOID:
BOOLEAN);
(* SENDMSG PRINTS OUT THE MESSAGE IN THE BUFFER *)
VAR
LINELEN, JLOOP: INTEGER;
BEGIN
WRITE(TM);
IF NOT NOID THEN BEGIN WRITE(PS(USER ^.NAME), VERB, ' "'); LINELEN := 57 END
ELSE LINELEN := 1000 (* NO LINE LIMIT *);
FOR JLOOP := MSTART TO MIN(MEND, MSTART + LINELEN) DO
IF NOID AND (BUFFER[JLOOP] = '\') THEN BEGIN WRITELN; WRITE(TM) END
ELSE WRITE(BUFFER[JLOOP]);
IF MSTART + LINELEN < MEND
THEN (* WRITE 2ND LINE *)
BEGIN
WRITELN; WRITE(TM, ' ');
FOR JLOOP := MSTART + LINELEN + 1 TO MEND DO WRITE(BUFFER[JLOOP])
END (*IF*);
IF NOT NOID THEN WRITE('"'); WRITELN;
END (*SENDMSG*);
BEGIN (*TALK*)
ERRLOC := 'TALK '; NOID := (CMDCODE IN [36, 37, 38]) OR (CMDCODE = 82);
IF WORD = BLANKS THEN WRITELN(TERM, 'MISSING TEXT TO SEND.')
ELSE
BEGIN
USER ^.HIDDEN := FALSE; TEXTLIMITS(MSGSTART, MSGEND);
IF MSGSTART <= 0
THEN WRITELN(TERM, 'MISSING QUOTATION MARKS. SEND <WHO> "TEXT"')
ELSE
IF WORD[1] <> '"'
THEN
CASE CMDCODE OF
36, 12 (* SAY *):
BEGIN
PLAYER := FINDPLAYER(WORD, ROOM[USER ^.RMCODE].RMPLAYERTAIL);
IF PLAYER <> NIL THEN IF PLAYER ^.NONEXISTANT THEN PLAYER := NIL;
IF PLAYER <> NIL
THEN
BEGIN
IF NOTIMEOUT(PLAYER)
THEN SENDMSG(PLAYER ^.TRM, ' WHISPERS,', MSGSTART, MSGEND, NOID)
ELSE WRITELN(TERM, 'PLAYER TIMED OUT - MESSAGE NOT RECEIVED.');
IF (RND(100) <= 10) AND (CMDCODE <> 36)
THEN
FOR ILOOP := 1 TO MSGTERM(TERMLIST, LOCAL) DO
IF TERMLIST[ILOOP] <> PLAYER ^.TRM
THEN
BEGIN
WRITELN(TERMLIST[ILOOP], 'YOU OVERHEAR ', PS(USER ^.NAME),
' WHISPERING TO ', PS(PLAYER ^.NAME), '!');
SENDMSG(TERMLIST[ILOOP], ' IS WHISPERING:', MSGSTART, MSGEND, FALSE)
END (*IF*)
END (*IF*)
ELSE WRITELN(TERM, PS(WORD), ' IS NOT HERE.')
END (*12*);
37, 13 (* YELL *):
WRITELN(TERM, 'YOU CAN''T SELECTIVELY YELL TO JUST ONE PLAYER!');
82, 38, 14 (* SEND AND *LOGOFF *):
IF SPELLCOST(USER, 1, - 5, 5)
THEN
BEGIN
PLAYER := FINDUSER(WORD, USERTAIL);
IF PLAYER <> NIL THEN IF PLAYER ^.NONEXISTANT THEN PLAYER := NIL;
IF PLAYER <> NIL
THEN
BEGIN
IF CMDCODE = 82 THEN WRITELN(PLAYER ^.TRM, ' ');
IF NOTIMEOUT(PLAYER)
THEN SENDMSG(PLAYER ^.TRM, '# FLASHES:', MSGSTART, MSGEND, NOID)
ELSE WRITELN(TERM, 'PLAYER TIMED OUT - MESSAGE NOT RECEIVED.');
IF CMDCODE = 82 (*LOGOFF*)
THEN
BEGIN
DAYMSG('OFF', PLAYER, USER ^.NAME, 0); LOGTERM := PLAYER ^.TRM;
IF PLAYER = USER THEN USER := NIL; WRITELN(PLAYER ^.TRM, COL, 'D');
LOGOFF(PLAYER, TRUE); WRITECONTROL(MTLO, ZEROPARM, LOGTERM);
WRITELN; PLAYER := NIL;
END (*IF*)
END (*IF*)
ELSE WRITELN(TERM, PS(WORD), ' CANNOT BE FOUND.');
END (*IF*);
END (*CASE*)
ELSE (* ALL PLAYERS SENT *)
CASE CMDCODE OF
36, 12 (* SAY *):
BEGIN
NUMHEARING := MSGTERM(TERMLIST, LOCAL);
IF NUMHEARING > 0
THEN
BEGIN
IF USER ^.ECHO THEN
BEGIN
NUMHEARING := NUMHEARING + 1; TERMLIST[NUMHEARING] := USER ^.TRM
END (*IF*);
FOR ILOOP := 1 TO NUMHEARING DO
SENDMSG(TERMLIST[ILOOP], ' SAYS,', MSGSTART, MSGEND, NOID)
END (*IF*)
ELSE WRITELN(TERM, 'NOBODY IS HERE TO HEAR YOU.')
END (*36*);
37, 13 (* YELL *):
BEGIN
NUMHEARING := MSGTERM(TERMLIST, YELL);
IF NUMHEARING > 0
THEN
BEGIN
IF USER ^.ECHO THEN
BEGIN
NUMHEARING := NUMHEARING + 1; TERMLIST[NUMHEARING] := USER ^.TRM
END (*IF*);
FOR ILOOP := 1 TO NUMHEARING DO
SENDMSG(TERMLIST[ILOOP], ' YELLS,', MSGSTART, MSGEND, NOID);
END (*IF*)
ELSE WRITELN(TERM, 'NO ONE HEARS YOU.')
END (*37*);
38, 14 (* SEND *):
IF (USER ^.SENDDAY >= MAX(5, USER ^.LVL)) AND NOT NOID
THEN
WRITELN(TERM, 'YOU HAVE NO TELEPATHIC POWERS LEFT FOR BROACASTING TODAY!')
ELSE
IF SPELLCOST(USER, 2, - 5, 7)
THEN
BEGIN
IF NOID THEN TALKHOW := OTHERS
ELSE
BEGIN TALKHOW := NOBLOCK; USER ^.SENDDAY := USER ^.SENDDAY + 1 END;
FOR ILOOP := 1 TO MSGTERM(TERMLIST, TALKHOW) DO
SENDMSG(TERMLIST[ILOOP], ': ', MSGSTART, MSGEND, NOID);
END (*IF*);
END (*CASE*)
END (*ELSE*)
END (*TALK*);
PROCEDURE LOSE(WORD: ALFA);
(* LOSE A FOLLOWING PLAYER *)
VAR
FOLLOWPLYR: USERPOINT;
BEGIN
FOLLOWPLYR := FINDPLAYER(WORD, ROOM[USER ^.RMCODE].RMPLAYERTAIL);
IF FOLLOWPLYR = NIL THEN WRITELN(TERM, 'PLAYER NOT HERE.')
ELSE
IF FOLLOWPLYR ^.FOLLOW <> USER
THEN WRITELN(TERM, 'PLAYER NOT FOLLOWING YOU ANYWAY.')
ELSE
IF NOT (FOLLOWPLYR ^.CLASS = RANGER) AND ((RND(3) = 1) OR (USER ^.WEIGHT <
FOLLOWPLYR ^.WEIGHT))
THEN
BEGIN
FOLLOWPLYR ^.FOLLOW := NIL;
WRITELN(TERM, 'YOU LOSE ', PRO[FOLLOWPLYR ^.SEX], '!');
WRITELN(FOLLOWPLYR ^.TRM, PS(USER ^.NAME), ' LOSES YOU!')
END (*IF*)
ELSE WRITELN(TERM, 'DIDN''T WORK!')
END (*LOSE*);
PROCEDURE FOLLOWPLYR(WORD: ALFA);
(* FOLLOW ANOTHER PLAYER *)
VAR
LEADER: USERPOINT;
BEGIN
LEADER := FINDPLAYER(WORD, ROOM[USER ^.RMCODE].RMPLAYERTAIL);
IF LEADER = NIL THEN WRITELN(TERM, 'PLAYER NOT HERE.')
ELSE
BEGIN
IF LEADER ^.NAME = USER ^.NAME
THEN WRITELN(TERM, 'YOU CAN''T FOLLOW YOUSELF!')
ELSE
BEGIN
USER ^.FOLLOW := LEADER; WRITELN(TERM, 'OK');
IF NOT (USER ^.HIDDEN OR USER ^.INVISIBLE)
THEN WRITELN(LEADER ^.TRM, PS(USER ^.NAME), ' FOLLOWS YOU!');
END (*ELSE*);
END (*IF*)
END (*FOLLOWPLYR*);
PROCEDURE HIDE(WORD: ALFA; NUM: INTEGER);
(* HIDE PLAYERS AND OBJECTS *)
VAR
ILOOP: INTEGER;
OBJ: OBJECTPOINT;
CHANCE: INTEGER;
BEGIN
IF WORD = BLANKS
THEN (* HIDE PLAYER*)
BEGIN
CHANCE := USER ^.LVL * 20 + USER ^.DEX;
IF USER ^.AGUILD OR (USER ^.CLASS = THIEF) THEN CHANCE := CHANCE * 2;
IF ROOM[USER ^.RMCODE].RMMONSTERTAIL <> NIL THEN CHANCE := CHANCE DIV 2;
IF RND(100) <= MIN(66, CHANCE) THEN USER ^.HIDDEN := TRUE
ELSE
FOR ILOOP := 1 TO MSGTERM(TERMLIST, LOCAL) DO
WRITELN(TERMLIST[ILOOP], 'YOU SPOT ', PS(USER ^.NAME),
' TRYING TO HIDE IN THE SHADOWS!');
WRITELN(TERM, 'YOU HIDE IN THE SHADOWS.');
END (*IF*)
ELSE
BEGIN
OBJ := FINDOBJECT(WORD, NUM, USER ^.OBJECTTAIL);
IF OBJ = NIL THEN WRITELN(TERM, 'YOU AREN''T HOLDING THAT!')
ELSE
BEGIN
STOPUSING(USER, OBJ);
IF DELETEOBJECT(OBJ, USER ^.OBJECTTAIL)
THEN USER ^.OBJECTTAIL := USER ^.OBJECTTAIL ^.NEXT;
USER ^.WEIGHT := USER ^.WEIGHT - OBJ ^.WEIGHT;
OBJ ^.NEXT := ROOM[USER ^.RMCODE].RMOBJECTTAIL;
ROOM[USER ^.RMCODE].RMOBJECTTAIL := OBJ; OBJ ^.INVISIBLE := TRUE;
WRITE(TERM, 'YOU CAREFULLY HIDE '); PRINTOBJ(OBJ ^, TRUE);
WRITELN(' IN THE ROOM.');
IF RND(4) = 1
THEN
FOR ILOOP := 1 TO MSGTERM(TERMLIST, LOCAL) DO
BEGIN
WRITE(TERMLIST[ILOOP], 'YOU SEE ', PS(USER ^.NAME), ' TRYING TO HIDE ');
PRINTOBJ(OBJ ^, FALSE); WRITELN(' IN THE ROOM.');
END (*FOR*)
END (*ELSE*)
END (*ELSE*)
END (*HIDE*);
PROCEDURE SEARCH;
(* SEARCH FOR HIDDEN PLAYERS AND OBJECTS *)
VAR
FIND: BOOLEAN;
HIDPLYR: USERPOINT;
HIDOBJ: OBJECTPOINT;
FACTOR, RM: INTEGER;
FUNCTION PHID(PLYR: USERPOINT): BOOLEAN;
BEGIN PHID := (PLYR ^.HIDDEN) END;
FUNCTION OHID(OBJ: OBJECTPOINT): BOOLEAN;
BEGIN OHID := (OBJ ^.INVISIBLE) END;
BEGIN (*SEARCH*)
FIND := FALSE; RM := USER ^.RMCODE; FACTOR := 50;
IF USER ^.CLASS IN [THIEF, RANGER] THEN FACTOR := FACTOR + 25;
IF READYCHECK(USER ^.LASTATK)
THEN
BEGIN
USER ^.LASTATK := REALTIME + 10;
HIDPLYR := MATCHPLAYER(ROOM[RM].RMPLAYERTAIL, PHID);
WHILE HIDPLYR <> NIL DO
BEGIN
IF (HIDPLYR <> USER) AND (RND(100) <= FACTOR)
THEN
BEGIN
HIDPLYR ^.HIDDEN := FALSE; FIND := TRUE;
WRITELN(TERM, 'YOU SPOT ', PS(HIDPLYR ^.NAME), ' HIDING IN THE SHADOWS!');
END (*IF*);
HIDPLYR := MATCHPLAYER(HIDPLYR ^.NEXT, PHID)
END (*WHILE*);
HIDOBJ := MATCHOBJECT(ROOM[RM].RMOBJECTTAIL, OHID);
WHILE HIDOBJ <> NIL DO
BEGIN
IF RND(100) <= FACTOR THEN
BEGIN
FIND := TRUE; WRITE(TERM, 'WHILE SEARCHING YOU DISCOVER ');
PRINTOBJ(HIDOBJ ^, FALSE); WRITELN('!')
END (*IF*);
HIDOBJ := MATCHOBJECT(HIDOBJ ^.NEXT, OHID)
END (*WHILE*);
IF NOT FIND THEN WRITELN(TERM, 'YOU DIDN''T FIND ANYTHING.');
END (*IF*)
END (*SEARCH*);
PROCEDURE GODIRECTION(WORD: ALFA; NUM: INTEGER; CMDCODE: INTEGER);
(* GODIRECTION LETS PLAYERS MOVE FROM ROOM TO ROOM. IT MOVES
PLAYERS N,S,E,W,U,D; OR IT CAN MOVE THEM THROUGH A "PORTAL" CLASS
OBJECT, SUCH AS A DOOR. MOVEMENT IS PROHIBITED IF A MONSTER BLOCKS
EXIT. MONSTERS WHO HAVE THE *FOLLOW* BIT SET WILL FOLLOW
THE PLAYER INTO THE NEXT ROOM. (66 CHANCE) APPROPRIATE MESSAGES
ARE SENT ANNOUNCING ENTRANCE AND EXIT TO OTHER NEARBY PLAYERS. *)
VAR
FACTOR, I: INTEGER;
RM, NEWRM: RMCODETYPE;
DM, TEMP, FOLLOWPLYR: USERPOINT;
NEXTMON, MONSTER: MONSTERPOINT;
OBJECT: OBJECTPOINT;
FOLLOWING, LEAVE, BLOCKED, FOLLOWED: BOOLEAN;
FUNCTION LOCDM(DMUSR: USERPOINT): BOOLEAN;
BEGIN LOCDM := (DMUSR ^.SSJ) END;
FUNCTION MBLOCKING(MON: MONSTERPOINT): BOOLEAN;
BEGIN MBLOCKING := (MON ^.BLOCK) END;
FUNCTION MFOLLOW(MON: MONSTERPOINT): BOOLEAN;
BEGIN MFOLLOW := (MON ^.FOLLOW AND (MON ^.DEFPLAYER = USER)) END (*MFOLLOW*);
FUNCTION PFOLLOW(USR: USERPOINT): BOOLEAN;
BEGIN PFOLLOW := (USR ^.FOLLOW = USER) END;
BEGIN (*GODIRECTION*)
ERRLOC := ' TWELVE '; BLOCKED := FALSE; FOLLOWED := FALSE; LEAVE := FALSE;
RM := USER ^.RMCODE (* CURRENT ROOM *);
IF NOT USER ^.ENCOUNTSTOP
THEN
BEGIN
IF CMDCODE <= 6
THEN (* N,S,E,W,U,D,OUT *)
IF ROOM[RM].ADJOIN[CMDCODE] <= 0
THEN WRITELN(TERM, 'THERE IS NO WAY TO GO IN THAT DIRECTION.')
ELSE
BEGIN
IF CMDCODE IN ROOM[RM].THOUSANDS THEN FACTOR := 1000 ELSE FACTOR := 0;
LEAVE := TRUE; NEWRM := ROOM[RM].ADJOIN[CMDCODE] + FACTOR
END (*ELSE*)
ELSE
IF CMDCODE = 7 (* OUT *)
THEN
IF ROOM[RM].OUT > 0 THEN BEGIN LEAVE := TRUE; NEWRM := ROOM[RM].OUT END
ELSE WRITELN(TERM, 'THERE IS NO OBVIOUS EXIT FROM HERE.')
ELSE (* CMDCODE = 9. GO THRU DOOR OR PASSAGE *)
BEGIN
OBJECT := FINDOBJECT(WORD, NUM, ROOM[RM].RMOBJECTTAIL);
IF OBJECT = NIL THEN WRITELN(TERM, 'THAT OBJECT ISN''T HERE!')
ELSE
IF NOT (OBJECT ^.OBCLASS IN [PORTAL, DOOR])
THEN WRITELN(TERM, 'YOU CAN''T GO IN THAT DIRECTION.')
ELSE
IF (OBJECT ^.OBCLASS = DOOR) AND OBJECT ^.DCLOSED
THEN
BEGIN
WRITE(TERM, 'CLUNK! YOU BANG YOUR NOSE AGAINST ');
PRINTOBJ(OBJECT ^, TRUE); WRITELN('.')
END (*IF*)
ELSE BEGIN LEAVE := TRUE; NEWRM := OBJECT ^.TOWHERE END
END (* PASSAGES *);
IF LEAVE
THEN
BEGIN
MONSTER := ROOM[RM].RMMONSTERTAIL;
REPEAT (* IF MORE THAN 1 BLOCKING MONSTER *)
MONSTER := MATCHMONSTER(MONSTER, MBLOCKING);
IF MONSTER <> NIL
THEN
BEGIN
IF (CMDCODE > 7) OR (MONSTER ^.DEFPLAYER = USER)
THEN
IF (RND(100) < 50) OR (CMDCODE > 7) THEN
BEGIN (* BLOCKS *)
WRITELN(TERM, PM(MONSTER), 'BLOCKS YOUR WAY!'); BLOCKED := TRUE;
END (*IF*);
MONSTER := MONSTER ^.NEXT;
END (*IF*)
UNTIL (MONSTER = NIL) OR BLOCKED;
IF NOT BLOCKED
THEN
BEGIN (* CHECK FOR FOLLOWING MONSTERS *)
MONSTER := ROOM[RM].RMMONSTERTAIL; I := S(NEWRM);
IF NOT ROOM[I].SAFE
THEN
REPEAT
MONSTER := MATCHMONSTER(MONSTER, MFOLLOW);
IF MONSTER <> NIL
THEN
IF RND(100) < 70
THEN
BEGIN
NEXTMON := MONSTER ^.NEXT;
WRITELN(TERM, PM(MONSTER), 'FOLLOWS YOU!'); FOLLOWED := TRUE;
DELETEMONSTER(MONSTER, RM); INSERTMONSTER(MONSTER, I);
MONSTER ^.DEFPLAYER := USER (* CONTINUE MONSTER'S ATTACK*);
MONSTER := NEXTMON;
END (*IF*)
ELSE MONSTER := MONSTER ^.NEXT;
UNTIL MONSTER = NIL
END (*IF*);
IF RND(100) > 50 THEN USER ^.HIDDEN := FALSE;
FOLLOWPLYR := MATCHPLAYER(ROOM[RM].RMPLAYERTAIL, PFOLLOW);
IF NOT USER ^.HIDDEN AND ((FOLCOUNT = 0) OR FOLLOWED OR BLOCKED)
THEN
FOR I := 1 TO MSGTERM(TERMLIST, LOCAL) DO
BEGIN
WRITE(TERMLIST[I], PS(USER ^.NAME));
IF FOLLOWPLYR <> NIL THEN WRITE('''S GROUP');
IF USER ^.DRUNK - REALTIME > 30 THEN WRITE(' JUST STAGGERED')
ELSE WRITE(' JUST WENT');
IF CMDCODE = 9 THEN BEGIN WRITE(' TO '); PRINTOBJ(OBJECT ^, TRUE) END
ELSE WRITE(' ', PS(DIRLIST[CMDCODE]));
IF FOLLOWED THEN WRITELN(', AND SOMETHING FOLLOWED ', PRO[USER^.SEX], '!')
ELSE
IF BLOCKED
THEN WRITELN(', BUT THEN SOMETHING STOPPED ', PRO[USER^.SEX], '!')
ELSE WRITELN('.')
END (* MSG *);
IF NOT BLOCKED
THEN
BEGIN
DELETEPLAYER(USER, RM); PLACEPLAYER(USER, NEWRM);
IF CMDCODE <= 7 THEN ROOM[RM].LASTDIR := CMDCODE
ELSE ROOM[RM].LASTDIR := 8;
IF NOT USER ^.HIDDEN AND (FOLCOUNT = 0)
THEN
FOR I := 1 TO MSGTERM(TERMLIST, LOCAL) DO
BEGIN
WRITE(TERMLIST[I], PS(USER ^.NAME));
IF FOLLOWPLYR <> NIL THEN WRITE('''S GROUP');
WRITELN(' JUST ARRIVED.')
END (*FOR*);
IF ROOM[USER ^.RMCODE].NOTIFYDM
THEN
BEGIN
DM := MATCHUSER(USERTAIL, LOCDM);
WHILE DM <> NIL DO
BEGIN
WRITELN(DM ^.TRM, '*** ', PS(USER ^.NAME), ' ENTERED ROOM ', NEWRM: 0,
'.');
DM := MATCHUSER(DM ^.NEXTUSER, LOCDM);
END (*WHILE*)
END (*IF*);
FOLLOWING := (FOLCOUNT > 0);
IF (USER ^.RMCODE <> RM) AND (FOLCOUNT < 8)
THEN
BEGIN
WHILE (FOLLOWPLYR <> NIL) AND (FOLCOUNT < 8) DO
BEGIN
FOLCOUNT := FOLCOUNT + 1;
IF FOLCOUNT >= 8
THEN WRITELN(TERM, 'MIL432 - FOLLOW TABLE OVERFLOW!');
TEMP := USER; TERM := FOLLOWPLYR ^.TRM; USER := FOLLOWPLYR;
GODIRECTION(WORD, NUM, CMDCODE);
IF USER ^.RMCODE = TEMP ^.RMCODE THEN USER ^.FOLLOW := TEMP;
USER := TEMP; TERM := USER ^.TRM;
FOLLOWPLYR := MATCHPLAYER(ROOM[RM].RMPLAYERTAIL, PFOLLOW);
END (*WHILE*)
END (*IF*);
WITH USER ^ DO
IF NOT FOLLOWING THEN ROOMDISPLAY(RMCODE, BRIEF)
ELSE
IF NOTIMEOUT(USER) THEN
BEGIN
WRITE(TERM, 'YOU''RE ');
PRINTDESC(ROOM[RMCODE].DESCREC, ROOM[RMCODE].DESCCODE, 0, BRIEF);
WRITELN;
END (*DISPLAY ROOM*);
CASE NEWRM OF
3: WRITELN(TERM, 'BARTENDER SAYS "BUY A DRINK, MAC?"');
4: WRITELN(TERM, 'PAPERBOY SAYS, "EXTRA! EXTRA! READ ALL ABOUT IT!"');
8: WRITELN(TERM, 'APPRAISOR ASKS, "WHAT WOULD YOU LIKE TO SELL?"');
10: WRITELN(TERM, 'MERCHANT ASKS WHAT YOU WOULD LIKE TO BUY.');
18:
WRITELN(TERM,
'"HEE HEE, SO MATEY, YOUR GEAR DONT LOOK TOO GOOD. NEED FIXIN?"');
OTHERWISE
END (*CASE*);
END (* MOVE *)
END (* LEAVE *)
END (*IF*)
END (*GODIRECTION*);
PROCEDURE TRACK;
VAR
DIR: 0..8;
OBJ: OBJECTPOINT;
FUNCTION PORTL(OB: OBJECTPOINT): BOOLEAN;
BEGIN PORTL := (OB ^.OBCLASS IN [DOOR, PORTAL]) END;
BEGIN (*TRACK*)
IF READYCHECK(USER ^.LASTATK)
THEN
BEGIN
DIR := ROOM[USER ^.RMCODE].LASTDIR;
IF USER ^.CLASS <> RANGER THEN IF RND(2) > 1 THEN DIR := 0;
USER ^.LASTATK := REALTIME + 7;
CASE DIR OF
0: WRITELN(TERM, 'YOU DONT FIND ANY TRACKS.');
1, 2, 3, 4, 5, 6:
BEGIN
WRITE(TERM, 'YOU SEE SOME TRACKS LEADING ', PS(DIRLIST[DIR]));
WRITELN('.')
END (*1*);
7: WRITELN(TERM, 'YOU SEE SOME TRACKS LEADING OUT.');
8:
BEGIN
OBJ := MATCHOBJECT(ROOM[USER ^.RMCODE].RMOBJECTTAIL, PORTL);
IF OBJ = NIL THEN WRITELN(TERM, 'YOU DONT FIND ANY TRACKS.')
ELSE
BEGIN
WRITE(TERM, 'YOU SEE SOME TRACKS LEADING TO '); PRINTOBJ(OBJ ^, TRUE);
WRITELN('.')
END (*ELSE*)
END (*8*);
END (*CASE*)
END (*IF*)
END (*TRACK*);
PROCEDURE TRAPCHECK(VAR OBJ: OBJECTPOINT; TRAP: INTEGER);
VAR
DMG: INTEGER;
BEGIN
DMG := 0;
IF TRAP > 0
THEN
IF USER ^.DEX - RND(6) < TRAP
THEN
BEGIN
WRITE(TERM);
CASE TRAP OF
1, 2, 3: WRITE('SPLINTERS ON YOUR HAND!');
4, 5: WRITE('SPRING DART!');
6: WRITE('SMALL KNIFE FLIES AT YOU!');
7: BEGIN USER ^.POISONED := TRUE; WRITE('POISON DART!') END;
8: WRITE('SPEAR SHOOTS OUT OF GROUND AT YOU!');
9: WRITE('DUST SPRAYS IN YOUR EYES!');
10: WRITE('GRUBS BITE YOU!');
11: WRITE('STEEL WIRE CUTS YOUR HAND!');
12: WRITE('NEEDLES STAB YOUR TOES!');
13: BEGIN USER ^.POISONED := TRUE; WRITE('POISON NEEDLES!') END;
14: BEGIN USER ^.POISONED := TRUE; WRITE('COBRA LUNGES AT YOU!') END;
15: BEGIN USER ^.POISONED := TRUE; WRITE('GAS SPORES EXPLODE!'); END;
16: WRITE('ROCKS FALL FROM THE CEILING!');
17: WRITE('BLAM! EXPLOSION IN YOUR FACE!');
18: WRITE('ACID SPLASHES IN YOUR FACE!');
19: WRITE('FLAMES SHOOT OUT AT YOU!');
20, 21, 22, 23, 24, 25:
BEGIN USER ^.FATIGUE := 0; WRITE('SPEAR IMPALES YOUR STOMACH!') END;
26, 27, 28, 29, 30: WRITE('BOOOOOOOOOOM!');
31, 32, 33, 34, 35: WRITE('A RACK OF KNIVES FALLS AND CRUSHES YOU!');
OTHERWISE
USER ^.FATIGUE := 0; WRITE('TONS OF ROCK TUMBLE DOWN UPON YOU!');
END (*CASE*);
DMG := MAX(0, TRAP + USER ^.AC - 10); WRITELN;
WRITE(TERM, 'IT HITS YOU FOR '); PRINTDMG(USER, DMG, USER ^.BRIEF);
IF USER ^.HITS + USER ^.FATIGUE <= DMG
THEN
BEGIN
USER^.DEAD := TRUE;
USER ^.FATIGUE := 0; USER ^.HITS := 0; DAYMSG('TRP', USER, BLANKS, 0);
FOR ILOOP := 1 TO MSGTERM(TERMLIST, ALL) DO
WRITELN(TERMLIST[ILOOP], '### ', PS(USER ^.NAME),
' WAS JUST KILLED BY A DEADLY TRAP.');
END (*IF*)
ELSE
BEGIN
IF DMG > USER ^.FATIGUE
THEN USER ^.HITS := USER ^.HITS - DMG + USER ^.FATIGUE;
USER ^.FATIGUE := MAX(0, USER ^.FATIGUE - DMG)
END (*ELSE*)
END (*IF*)
END (*TRAPCHECK*);
PROCEDURE OPENCLOSE(CMDCODE: INTEGER; WORD: ALFA; NUM: INTEGER);
VAR
OTHRDOOR, KEY, OBJ: OBJECTPOINT;
OBTRAP: 0..50;
OBCLOSED: BOOLEAN;
OBLOCKED: 0..1000;
NUM2, ILOOP: INTEGER;
OBTYPE:
(PORTL, BOX, NEITHER);
FUNCTION SAMEDOOR(OB: OBJECTPOINT): BOOLEAN;
BEGIN SAMEDOOR := (OB ^.NAME = OBJ ^.NAME) END;
BEGIN (*OPENCLOSE*)
OBTYPE := NEITHER; OBJ := FINDOBJECT(WORD, NUM, USER ^.OBJECTTAIL);
IF OBJ = NIL
THEN OBJ := FINDOBJECT(WORD, NUM, ROOM[USER ^.RMCODE].RMOBJECTTAIL);
IF OBJ = NIL THEN WRITELN(TERM, 'THAT OBJECT ISN''T HERE!')
ELSE
IF OBJ ^.OBCLASS = CHEST
THEN
BEGIN
OBTRAP := OBJ ^.TRAP; OBLOCKED := OBJ ^.LOCKED; OBTYPE := BOX;
OBCLOSED := OBJ ^.CLOSED
END (*IF*)
ELSE
IF OBJ ^.OBCLASS = DOOR
THEN
BEGIN
OBTRAP := OBJ ^.DTRAP; OBLOCKED := OBJ ^.DLOCKED; OBTYPE := PORTL;
OBCLOSED := OBJ ^.DCLOSED
END (*IF*)
ELSE WRITELN(TERM, 'I DON''T KNOW HOW TO DO SUCH A THING.');
IF OBTYPE <> NEITHER
THEN
BEGIN
IF CMDCODE = 66 (*CLOSE*)
THEN
IF OBCLOSED THEN WRITELN(TERM, 'IT''S ALREADY CLOSED!')
ELSE
BEGIN
OBCLOSED := TRUE;
FOR ILOOP := 1 TO MSGTERM(TERMLIST, LOCAL) DO
BEGIN
WRITE(TERMLIST[ILOOP], PS(USER ^.NAME), ' JUST CLOSED ');
PRINTOBJ(OBJ ^, TRUE); WRITELN('.')
END (*FOR*);
WRITELN(TERM, 'OK')
END (*ELSE*)
ELSE
IF (CMDCODE = 67) OR (CMDCODE = 68) (*LOCK/UNLOCK*)
THEN
BEGIN
GETWORD(WORD, NUM2, BUFFER, LENBUF, LOC);
KEY := FINDOBJECT(WORD, NUM2, USER ^.OBJECTTAIL);
IF WORD = BLANKS THEN WRITELN(TERM, 'WITH WHAT?')
ELSE
IF KEY = NIL THEN WRITELN(TERM, 'YOU DON''T HAVE THE RIGHT KEY.')
ELSE
IF KEY ^.OBCLASS <> KEYS
THEN WRITELN(TERM, 'THAT WONT LOCK OR UNLOCK ANYTHING!')
ELSE
IF ((KEY ^.UNLOCK MOD 10 = 0) AND (KEY ^.UNLOCK <> OBLOCKED - OBLOCKED
MOD 10) OR (KEY ^.UNLOCK MOD 10 <> 0) AND (KEY ^.UNLOCK <> OBLOCKED))
AND (KEY ^.UNLOCK <> 1000)
THEN
BEGIN WRITE(TERM); PRINTOBJ(KEY ^, TRUE); WRITELN(' DOESN''T WORK!')
END (*IF*)
ELSE
BEGIN
IF KEY ^.UNLOCK = 1000
THEN DAYMSG('KEY', USER, BLANKS, W(USER ^.RMCODE));
IF CMDCODE = 67 THEN OBCLOSED := TRUE ELSE OBCLOSED := FALSE;
FOR ILOOP := 1 TO MSGTERM(TERMLIST, LOCAL) DO
BEGIN
WRITE(TERMLIST[ILOOP], PS(USER ^.NAME), ' JUST ');
IF CMDCODE = 67 THEN WRITE('LOCKED ') ELSE WRITE('UNLOCKED ');
PRINTOBJ(OBJ ^, TRUE); WRITE(' WITH '); PRINTOBJ(KEY ^, FALSE);
WRITELN('.')
END (*FOR*);
WRITELN(TERM, 'OK');
END (*ELSE*)
END (*IF*)
ELSE
IF CMDCODE = 65 (*OPEN*)
THEN
IF NOT OBCLOSED THEN WRITELN(TERM, 'IT''S ALREADY OPEN!')
ELSE
IF OBLOCKED > 0 THEN WRITELN(TERM, 'YOU CAN''T, IT''S LOCKED!')
ELSE
BEGIN
OBCLOSED := FALSE;
FOR ILOOP := 1 TO MSGTERM(TERMLIST, LOCAL) DO
BEGIN
WRITE(TERMLIST[ILOOP], PS(USER ^.NAME), ' JUST OPENED ');
PRINTOBJ(OBJ ^, TRUE); WRITELN('.')
END (*FOR*);
WRITELN(TERM, 'OK'); TRAPCHECK(OBJ, OBTRAP)
END (*ELSE*)
ELSE
IF CMDCODE = 69 (*PICKLOCK*)
THEN
BEGIN
IF USER ^.CLASS <> THIEF
THEN ILOOP := -10 ELSE ILOOP := 3;
IF NOT READYCHECK(USER ^.LASTATK) THEN
ELSE
IF ((USER ^.LVL + USER ^.DEX DIV 2 + ILOOP) DIV 3 < OBLOCKED MOD 10) OR (OBLOCKED
MOD 10 = 0)
THEN
BEGIN
USER ^.LASTATK := REALTIME + 15;
WRITELN(TERM, 'YOU FAIL TO PICK THE LOCK!')
END (*IF*)
ELSE
BEGIN
OBCLOSED := FALSE;
FOR ILOOP := 1 TO MSGTERM(TERMLIST, LOCAL) DO
BEGIN
WRITE(TERMLIST[ILOOP], PS(USER ^.NAME), ' PICKS THE LOCK ON ');
PRINTOBJ(OBJ ^, TRUE); WRITELN('!')
END (*FOR*);
WRITELN(TERM, 'YOU PICKED THE LOCK OPEN!'); TRAPCHECK(OBJ, OBTRAP)
END (*ELSE*)
END
ELSE
IF CMDCODE = 70 (*SMASH*)
THEN
IF NOT READYCHECK(USER ^.LASTATK) THEN
ELSE
IF NOT OBCLOSED THEN WRITELN(TERM, 'IT''S ALREADY OPEN!')
ELSE
IF (RND(3) <> 1) OR (USER ^.STR * 10 < OBJ ^.WEIGHT)
THEN
BEGIN
USER ^.LASTATK := REALTIME + 15;
FOR ILOOP := 1 TO MSGTERM(TERMLIST, LOCAL) DO
BEGIN
WRITE(TERMLIST[ILOOP], PS(USER ^.NAME), ' FAILS TO SMASH ');
PRINTOBJ(OBJ ^, TRUE); WRITELN(' OPEN!')
END (*FOR*);
WRITELN(TERM, 'BANG! YOU FAIL TO SMASH IT OPEN!')
END (*IF*)
ELSE
BEGIN
FOR ILOOP := 1 TO MSGTERM(TERMLIST, LOCAL) DO
BEGIN
WRITE(TERMLIST[ILOOP], PS(USER ^.NAME), ' SMASHES ');
PRINTOBJ(OBJ ^, TRUE); WRITELN(' OPEN!')
END (*FOR*);
OBCLOSED := FALSE; WRITELN(TERM, 'YOU SMASH IT OPEN!');
TRAPCHECK(OBJ, OBTRAP)
END (*ELSE*);
IF OBTYPE = BOX
THEN
BEGIN
OBJ ^.CLOSED := OBCLOSED; OBJ ^.TRAP := OBTRAP; OBJ ^.LOCKED := OBLOCKED
END (*IF*)
ELSE
IF OBTYPE = PORTL
THEN
BEGIN
OBJ ^.DCLOSED := OBCLOSED; OBJ ^.DTRAP := OBTRAP;
OBJ ^.DLOCKED := OBLOCKED;
OTHRDOOR := MATCHOBJECT(ROOM[S(OBJ ^.TOWHERE)].RMOBJECTTAIL, SAMEDOOR);
IF OTHRDOOR <> NIL THEN
BEGIN
OTHRDOOR ^.DCLOSED := OBCLOSED; OTHRDOOR ^.DTRAP := OBTRAP;
OTHRDOOR ^.DLOCKED := OBLOCKED
END (*IF*)
END (*IF*);
END (*IF*)
END (*OPENCLOSE*);
PROCEDURE SAVECHAR;
(* SAVECHAR WILL UPDATE A PLAYER'S FILE ENTRY TO PROTECT AGAINST PTA. *)
VAR
DUMUSR: USERPOINT;
BEGIN
IF USER ^.LVL < 2
THEN
WRITELN(TERM, 'SORRY, YOU MUST BE AT LEAST 2ND LEVEL TO SAVE YOUR CHARACTER.')
ELSE
IF (FINDOPENLOC < 0) AND (SEARCHPLINDEX(USER ^.NAME) <= 0)
THEN WRITELN(TERM, 'SORRY, FILE FULL. PLAYER CANNOT BE SAVED.')
ELSE
BEGIN
USER ^.USWEAP := NIL; STOPUSING(USER, USER ^.USARM);
STOPUSING(USER, USER ^.USSHIELD); NEW(DUMUSR); DUMUSR ^ := USER ^;
DUMUSR ^.RMCODE := W(USER ^.RMCODE); WRITEPLAYER(DUMUSR, DUMUSR ^.NAME);
NEW(DUMUSR); DUMUSR ^ := PROTOUSER; READPLAYER(DUMUSR, USER ^.NAME);
USER ^.WEIGHT := DUMUSR ^.WEIGHT; USER ^.OBJECTTAIL := DUMUSR ^.OBJECTTAIL;
DISPOSE(DUMUSR)
END (*ELSE*);
END (*SAVECHAR*);
PROCEDURE KILL;
(* *KILL* WILL REMOVE A PLAYER'S FILE ENTRY, IF IT EXISTS.
HIS *USER* DATA RECORD IS ALSO DESTROYED. *)
VAR
NAM: ALFA;
BEGIN
DELETEUSER(USER, USERTAIL);
IF SEARCHPLINDEX(USER ^.NAME) > 0
THEN
BEGIN
WRITELN(TERM, 'PLAYER FILE SPACE RELEASED.'); NAM := USER ^.NAME;
IF USER ^.LVL < 4 THEN USER ^.NAME := EMPTY ELSE USER ^.NAME[1] := '*';
USER ^.LASTACCESS := (31 + TODAY - 9) MOD 31;
(* SET PLAYER TIMEOUT TO 9 DAYS AGO. PLAYER WILL BE ERASED AT 10 DAYS *)
WRITEPLAYER(USER, NAM);
END (*IF*)
ELSE WRITEUSR(USER, FALSE) (* DESTROY USER REC *);
NUSERS := NUSERS - 1; IF NUMQUEUED > 0 THEN NEXTLIMBO;
END (*KILL*);
PROCEDURE QUIT(CMDCODE: INTEGER);
(* QUIT LOGS OFF THE PLAYER, ISSUSES MSGS, AND ATTEMPTS TO SAVE
HIS FILE *)
VAR
WORD: ALFA;
NUM: INTEGER;
DELAY, ILOOP: INTEGER;
BEGIN
ERRLOC := 'QUIT '; DELAY := REALTIME - USER ^.HITATTIME;
GETWORD(WORD, NUM, BUFFER, LENBUF, LOC); USER ^.ENTRY := XCMD;
IF WORD[1] = 'Y'
THEN
IF DELAY = 0 THEN WRITELN(TERM, 'NOT WHILE YOU ARE BEING ATTACKED!')
ELSE
IF DELAY < QUITWAIT
THEN
WRITELN(TERM, 'SORRY, YOU MUST WAIT AT LEAST ', QUITWAIT - DELAY: 0,
' MORE SECONDS BEFORE QUITTING.')
ELSE
BEGIN
FOR ILOOP := 1 TO MSGTERM(TERMLIST, ALL) DO
BEGIN
WRITE(TERMLIST[ILOOP], '### ', PS(USER ^.NAME));
IF CMDCODE = 39
THEN
WRITELN(' JUST KILLED ', PRO[USER^.SEX], 'SELF.', ' WE SHALL ALL MISS ',
PRO[USER^.SEX], ' DEARLY.')
ELSE WRITELN(' HAS QUIT ADVENTURING.');
END (*FOR*);
IF CMDCODE = 39
THEN
BEGIN IF USER ^.LVL >= 5 THEN DAYMSG('SUI', USER, BLANKS, 0); KILL END
ELSE LOGOFF(USER, TRUE);
WRITELN(TERM, 'END MILIEU.'); WRITECONTROL(MTLO, ZEROPARM, TERM); WRITELN;
USER := NIL (* BYE BYE*);
END (*ELSE*)
END (*QUIT*);
PROCEDURE APPEAL;
VAR
DM: USERPOINT;
EXIT, ILOOP: INTEGER;
FUNCTION FINDDM(DMUSR: USERPOINT): BOOLEAN;
BEGIN FINDDM := (DMUSR ^.SSJ) AND (DMUSR ^.STATUS = SNORMAL) END;
BEGIN (*APPEAL*)
ERRLOC := 'APPEAL ';
IF NOT SPELLIMIT
THEN
BEGIN
DM := MATCHUSER(USERTAIL, FINDDM);
IF DM <> NIL THEN WRITELN(TERM, 'DING DONG! YOU WAKE UP THE DM.')
ELSE WRITELN(TERM, 'SORRY, THE DM IS NOT HERE RIGHT NOW. TRY AGAIN LATER.');
EXIT := 0;
FOR ILOOP := 1 TO 6 DO EXIT := EXIT + ROOM[USER ^.RMCODE].ADJOIN[ILOOP];
EXIT := EXIT + ROOM[USER ^.RMCODE].OUT;
IF DM = NIL
THEN
IF (EXIT = 0) AND (ROOM[USER ^.RMCODE].RMOBJECTTAIL = NIL)
THEN
BEGIN
WRITELN(TERM, 'SIGH, VERY WELL....'); DELETEPLAYER(USER, USER ^.RMCODE);
PLACEPLAYER(USER, 1); WRITELN(TERM, '***POOF*** YOU ARE ELSEWHERE..');
END (*IF*);
WHILE DM <> NIL DO
BEGIN
IF NOT DM^.NONEXISTANT THEN
BEGIN
WRITELN(DM ^.TRM, '*** ', PS(USER ^.NAME), ' SUMMONS YOUR ASSISTANCE.');
WRITELN(DM ^.TRM, '*** PIETY RATING = ', USER ^.PTY: 0);
WRITE(DM ^.TRM, '*** RECOMMENDED REACTION:');
CASE USER ^.PTY OF
- 10, - 9, - 8, - 7, - 6, - 5, - 4, - 3:
WRITELN(' PUT THEM IN A LOT OF TROUBLE.');
- 2, - 1, 0, 1, 2: WRITELN(' LAUGH IN HIS/HER FACE.');
3, 4, 5: WRITELN(' MAKE THE SITUATION EVEN WORSE FOR THEM.');
6, 7, 8: WRITELN(' NEUTRAL. ASK WHAT IS WRONG. DO NOT REACT.');
9, 10, 11: WRITELN(' TEPID. HELP PLAYER, BUT NOT TOO MUCH.');
12, 13, 14: WRITELN(' POSITIVE. HELP PLAYER OUT OF SITUATION.');
15, 16, 17, 18: WRITELN(' VERY POSITIVE. INTERVENE IMMEDIATELY.');
19, 20, 21, 22, 23, 24, 25:
WRITELN(' SAVE PLAYER AND THEN SEND HIM ON A QUEST.');
END (*CASE*);
END;
DM := MATCHUSER(DM ^.NEXTUSER, FINDDM)
END (*WHILE*);
USER ^.PTY := MAX(- 10, USER ^.PTY - 1);
END (*IF*)
END (*APPEAL*);
PROCEDURE ENTERSPELL(WORD: ALFA; NUM: INTEGER);
VAR
DUMMY: ALFA;
BEGIN
IF READYCHECK(USER ^.LASTATK)
THEN
BEGIN
IF WORDMATCH(WORD, SPELLEN, SPELLIST) > 0
THEN GETWORD(WORD, NUM, BUFFER, LENBUF, LOC);
IF NUM = 0 THEN GETWORD(DUMMY, NUM, BUFFER, LENBUF, LOC);
USER ^.WDATA := WORD; USER ^.DATA := NUM; USER ^.ENTRY := XSPELL;
END (*IF*)
END (*ENTERSPELL*);
PROCEDURE RETURNOBJ(WORD: ALFA; NUM: INTEGER);
VAR
OBJECT: OBJECTPOINT;
BEGIN
OBJECT := FINDOBJECT(WORD, NUM, USER ^.OBJECTTAIL);
IF OBJECT = NIL THEN WRITELN(TERM, 'OBJECT NOT FOUND.')
ELSE BEGIN STOPUSING(USER, OBJECT); WRITELN(TERM, 'OK') END
END (*RETURNOBJ*);
PROCEDURE STEALOBJ(WORD: ALFA; NUM: INTEGER);
VAR
NOTICE: BOOLEAN;
WORD2: ALFA;
STEALCHANCE, WGHT, NUM2: INTEGER;
STEAL: BOOLEAN;
PLYR: USERPOINT;
OBJ: OBJECTPOINT;
BEGIN
WITH USER ^ DO
IF NOT (CLASS IN [DM, THIEF])
THEN WRITELN(TERM, 'ONLY THIEVES CAN STEAL OBJECTS!')
ELSE
IF READYCHECK(LASTATK)
THEN
BEGIN
GETWORD(WORD2, NUM2, BUFFER, LENBUF, LOC);
PLYR := FINDPLAYER(WORD2, ROOM[RMCODE].RMPLAYERTAIL);
IF WORD2 = BLANKS
THEN WRITELN(TERM, 'FORMAT IS STEAL <OBJECT> FROM <PLAYER>')
ELSE
IF PLYR = NIL THEN WRITELN(TERM, 'THAT PLAYER IS NOT HERE!')
ELSE
IF ROOM[RMCODE].SAFE THEN WRITELN(TERM,'THIS IS A SAFE HAVEN!')
ELSE
BEGIN
LASTATK := REALTIME + 15;
OBJ := FINDOBJECT(WORD, NUM, PLYR ^.OBJECTTAIL);
IF OBJ = NIL THEN WGHT := 0 ELSE WGHT := OBJ ^.WEIGHT;
STEALCHANCE := 4 * (LVL - PLYR ^.LVL + DEX DIV 2 - 6) - WGHT;
IF PLYR ^.CLASS = THIEF THEN STEALCHANCE := STEALCHANCE - 16;
IF HIDDEN THEN STEALCHANCE := STEALCHANCE + 16;
IF PLYR ^.SSJ THEN STEALCHANCE := - 1;
NOTICE := RND(100) >= STEALCHANCE;
IF OBJ = NIL THEN STEAL := FALSE ELSE STEAL := RND(100) < STEALCHANCE;
IF OBJ <> NIL THEN
WITH PLYR ^ DO
IF (OBJ = USWEAP) OR (OBJ = USARM) OR (OBJ = USSHIELD)
THEN BEGIN STEAL := FALSE; NOTICE := TRUE END;
DEFPLAYER := PLYR; DEFMON := NIL;
IF NOTICE
THEN
BEGIN
WRITE(PLYR ^.TRM, PS(NAME));
IF STEAL THEN WRITE(' STEALS ') ELSE WRITE(' FAILS TO STEAL ');
IF OBJ <> NIL THEN PRINTOBJ(OBJ ^, TRUE); WRITELN(' FROM YOU!')
END (*IF*);
IF NOTICE AND (RND(2) = 1) THEN WRITELN(TERM, 'YOU WERE DISCOVERED!');
IF NOT STEAL THEN WRITELN(TERM, 'YOU FAIL TO STEAL IT!')
ELSE
BEGIN
WRITELN(TERM, 'YOU STEAL IT!'); STOPUSING(PLYR, OBJ);
IF DELETEOBJECT(OBJ, PLYR ^.OBJECTTAIL)
THEN PLYR ^.OBJECTTAIL := PLYR ^.OBJECTTAIL ^.NEXT;
PLYR ^.WEIGHT := MAX(0, PLYR ^.WEIGHT - OBJ ^.WEIGHT);
IF WEIGHT + OBJ ^.WEIGHT > STR * 10
THEN
BEGIN
WRITELN(TERM, 'IT IS TOO HEAVY TO CARRY! YOU DROP IT.');
OBJ ^.NEXT := ROOM[RMCODE].RMOBJECTTAIL;
ROOM[RMCODE].RMOBJECTTAIL := OBJ;
END (*IF*)
ELSE
BEGIN
OBJ ^.INVISIBLE := FALSE; WEIGHT := MIN(2500, WEIGHT + OBJ ^.WEIGHT);
OBJ ^.NEXT := OBJECTTAIL; OBJECTTAIL := OBJ;
END (*ELSE*)
END (* STOLE IT*)
END (*ELSE*)
END (*ELSE*)
END (*STEALOBJ*);
PROCEDURE PARLEY(WORD: ALFA; NUM: INTEGER);
(* PARLEY, OR TALK WITH, A MONSTER *)
VAR
OPT, ILOOP, N1, N2: INTEGER;
OBJ: OBJECTPOINT;
MON: MONSTERPOINT;
BEGIN
MON := FINDMONSTER(WORD, NUM, ROOM[USER ^.RMCODE].RMMONSTERTAIL);
IF MON = NIL THEN WRITELN(TERM, 'THAT NON-PLAYER CHARACTER IS NOT HERE.')
ELSE
WITH MON ^ DO
BEGIN
OPT := MPARLEY; IF OPT = 9 THEN OPT := RND(8);
FOR ILOOP := 1 TO MSGTERM(TERMLIST, LOCAL) DO
WRITELN(TERMLIST[ILOOP], PS(USER ^.NAME), ' TALKS WITH ', PM(MON), '.');
CASE OPT OF
1:
BEGIN
N1 := 0; MPARLEY := 3 (* NO MORE TO SELL *);
IF WHICHOBJ > 0 THEN N1 := OBJINDEX[WHICHOBJ, RND(6)];
IF N1 = 0 THEN WRITELN(TERM, 'I HAVE NOTHING TO SELL YOU, GOOD SIR.')
ELSE
BEGIN
USER^.DATA := TRUNC(RANOBJLIST[N1].PRICE * 1.5) - RND(RANOBJLIST[N1].PRICE);
USER ^.LASTATK := N1;
(* THIS IS A KLUDGE PATCH. LAST HOLDS THE NUMBER OF THE OBJECT FOR SALE. *)
WRITE(TERM, PM(MON), 'SAYS, I WILL SELL YOU ');
PRINTOBJ(RANOBJLIST[N1], FALSE);
WRITELN(' FOR A MERE ', USER ^.DATA: 0, ' SHILLINGS.');
USER ^.ENTRY := XPARLEY;
END (*ELSE*)
END (*1*);
2, 3, 4:
BEGIN
IF OPT = 2 THEN N1 := 19 + RND(11) (* BAD MESSAGES 20-30 *)
ELSE
IF OPT = 3 THEN N1 := 10 + RND(10) (* GOOD MESSAGES 11-20 *)
ELSE N1 := 10 + RND(20) (* EITHER MESSAGES 11-30 *);
WRITE(TERM, PM(MON), ' SAYS, '); PRINTDESC(1, N1, 0, FALSE); WRITELN;
END (*2*);
5, 8:
IF USER ^.LVL < 5 + LVL THEN WRITELN(TERM, PM(MON), ' STANDS ITS GROUND!')
ELSE
BEGIN
N1 := 0;
IF OPT = 8
THEN
BEGIN
MPARLEY := 5 (* NO MORE TREASURE *);
IF WHICHOBJ > 0 THEN N1 := OBJINDEX[WHICHOBJ, RND(6)];
IF N1 > 0
THEN
BEGIN
NEW(OBJ); OBJ ^ := RANOBJLIST[N1];
OBJ ^.NEXT := ROOM[USER ^.RMCODE].RMOBJECTTAIL;
ROOM[USER ^.RMCODE].RMOBJECTTAIL := OBJ; N1 := 1;
END (*IF*)
END (*IF*);
N2 := RND(2) (* MERCY OR RUN? *); WRITE(TERM, PM(MON), ' ');
IF N1 > 0 THEN
BEGIN WRITE('THROWS DOWN '); PRINTOBJ(OBJ ^, FALSE); WRITE(' AND ');
END (*IF*);
IF N2 = 1 THEN WRITELN('BEGS FOR MERCY!')
ELSE WRITELN('FLEES FROM YOUR SIGHT!');
FOR ILOOP := 1 TO MSGTERM(TERMLIST, LOCAL) DO
BEGIN
WRITE(TERMLIST[ILOOP], PM(MON), ' ');
IF N1 > 0 THEN
BEGIN WRITE('THROWS DOWN '); PRINTOBJ(OBJ ^, FALSE); WRITE(' AND ')
END (*IF*);
IF N2 = 1 THEN WRITELN('BEGS FOR MERCY!')
ELSE WRITELN('FLEES FROM ', PS(USER ^.NAME), '''S SIGHT!')
END (*FOR*);
IF N2 = 2 (* RUN *)
THEN BEGIN DELETEMONSTER(MON, USER ^.RMCODE); DESTROY(MON) END;
END (*ELSE*);
6:
IF RND(2) = 2
THEN WRITELN(TERM, PM(MON), ' SAYS SOMETHING IN A STRANGE TONGUE.')
ELSE WRITELN(TERM, PM(MON), ' MAKES NO APPARENT RESPONSE.');
7:
BEGIN
DEFPLAYER := USER; WRITELN(TERM, PM(MON), ' ATTACKS YOU!');
FOR ILOOP := 1 TO MSGTERM(TERMLIST, LOCAL) DO
WRITELN(TERMLIST[ILOOP], PM(MON), ' ATTACKS ', PS(USER ^.NAME), '!');
END (*7*);
10:
BEGIN
WRITELN(TERM, '** ZAP ** ', PM(MON), ' TELEPORTS YOU ELSEWHERE!');
FOR ILOOP := 1 TO MSGTERM(TERMLIST, LOCAL) DO
WRITELN(TERMLIST[ILOOP], PM(MON), ' MAKES ', PS(USER ^.NAME),
' VANISH IN A CLOUD OF SMOKE!');
DELETEPLAYER(USER, USER ^.RMCODE); PLACEPLAYER(USER, 30 + RND(570))
END (*10*);
11, 12, 13, 14, 15:
BEGIN
WRITE(TERM, PM(MON), ' SAYS, '); PRINTDESC(1, OPT + 20, 0, FALSE);
WRITELN
END (*11*);
OTHERWISE
WRITELN(TERM, PM(MON), ' MAKES NO APPARENT RESPONSE.')
END (*CASE*);
END (*WITH*)
END (*PARLEY*);
PROCEDURE BUY(WORD: ALFA; NUM, RM: INTEGER);
VAR
ILOOP, SECSDK: INTEGER;
OBJECT: OBJECTPOINT;
BEGIN
ERRLOC := ' FIFTEEN ';
WITH USER ^ DO
BEGIN
CASE W(RM) OF
3:
BEGIN
IF MONEY >= 1
THEN
BEGIN
MONEY := MONEY - 1; IF DRUNK < REALTIME THEN DRUNK := REALTIME;
DRUNK := DRUNK + 30; SECSDK := DRUNK - REALTIME; WRITE(TERM);
IF SECSDK <= 60 THEN WRITELN('THAT WAS GOOD!')
ELSE
IF SECSDK <= 120 THEN WRITELN('THAT''S GOOD! (HIC)')
ELSE
IF SECSDK <= 180 THEN WRITELN('THASH GUD!')
ELSE
BEGIN
DELETEPLAYER(USER, RM); RM := RND(10); PLACEPLAYER(USER, RM);
WRITELN('YOU SEEM TO HAVE STAGGERED OFF SOMEWHERE... YOU FIND');
ROOMDISPLAY(RMCODE, FALSE)
END (*ELSE*)
END (*IF*)
ELSE WRITELN(TERM, 'BARTENDER SAYS, "YOUR CREDIT IS NO GOOD HERE!"');
END (*3*);
4: (* BUY NEWSPAPER *)
IF MONEY < 1 THEN WRITELN(TERM, '"SORRY BUDDY, YOU GOT NO MONEY."')
ELSE
BEGIN
MONEY := MONEY - 1; WRITELN(TERM);
WRITELN(TERM, '((( THE COUNTY PRESS. ISSUE # ', NUMRUN: 0, '. DAY ', PN
(TODAY), ' )))');
WRITELN(TERM);
FOR ILOOP := 1 TO 5 DO
IF NEWSBUF[ILOOP, 1] <> COL THEN WRITELN(TERM, PO(NEWSBUF[ILOOP]));
WRITELN(TERM);
FOR ILOOP := 1 TO 3 DO
IF YLVL[ILOOP] > 0
THEN
BEGIN
WRITE(TERM, PS(YNAME[ILOOP]), ', THE ', PNTH(YLVL[ILOOP]), ' LEVEL ', PS
(YCLASS[ILOOP]), ', WAS ');
CASE RND(5) OF
1: WRITE('UNEXPECTEDLY ');
2: WRITE('SUDDENLY ');
3: WRITE('MYSTERIOUSLY ');
4: WRITE('HORRIBLY ');
5: WRITE('VICIOUSLY ');
END (*CASE*);
CASE RND(5) OF
1: WRITE('MURDERED ');
2: WRITE('KILLED ');
3: WRITE('SLAIN ');
4: WRITE('BUTCHERED ');
5: WRITE('"TERMINATED" ');
END (*CASE*);
WRITELN('YESTERDAY.');
IF YBUF[ILOOP, 1] <> COL THEN WRITELN(TERM, PO(YBUF[ILOOP]));
WRITELN(TERM);
END (*IF*);
END (*ELSE*);
10: (* BUY ARMAMENTS *)
BEGIN
IF (NUM < 1) OR (NUM > MIN(RANOBJLEN, 20))
THEN WRITELN(TERM, 'ITEM # OUT OF BOUNDS.')
ELSE
IF RANOBJLIST[NUM].PRICE > USER ^.MONEY
THEN WRITELN(TERM, 'YOU DON''T HAVE ENOUGH CASH TO BUY THAT.')
ELSE
BEGIN
USER ^.MONEY := USER ^.MONEY - RANOBJLIST[NUM].PRICE; NEW(OBJECT);
OBJECT ^ := RANOBJLIST[NUM]; OBJECT ^.NEXT := ROOM[RMCODE].RMOBJECTTAIL;
ROOM[RMCODE].RMOBJECTTAIL := OBJECT;
WRITELN(TERM, '"HERE YOU ARE, SIR. THANK YOU!');
WRITELN(TERM, 'OH, BE SURE TO TAKE IT WITH YOU AS YOU LEAVE!"');
END (*ELSE*)
END (*10*);
OTHERWISE
WRITELN(TERM, 'NOTHING HERE TO PURCHASE.')
END (*CASE*)
END (*WITH*)
END (*BUY*);
PROCEDURE CATALOG;
(* OBTAIN A LIST OF ARMAMENTS FOR SALE FROM ARMORY *)
VAR
ILOOP: INTEGER;
BEGIN
ERRLOC := ' SIXTEEN ';
IF W(USER ^.RMCODE) <> 10 THEN WRITELN(TERM, 'I DON''T UNDERSTAND.')
ELSE
BEGIN
WRITELN(TERM, 'INVENTORY OF ARMAMENTS FOR SALE'); WRITELN(TERM);
WRITELN(TERM, 'TO PURCHASE ENTER: BUY <ITEM NUMBER>'); WRITELN(TERM);
WRITELN(TERM, '# TYPE COST WEIGHT NAME');
FOR ILOOP := 1 TO MIN(RANOBJLEN, 20) DO
WITH RANOBJLIST[ILOOP] DO
BEGIN
WRITE(TERM, ILOOP: 2, ' ');
CASE OBCLASS OF
WEAP: WRITE('WEAPON ');
SHIELD: WRITE('SHIELD ');
ARMOR: WRITE('ARMOR ');
OTHERWISE
WRITE('OTHER ');
END (*CASE*);
WRITE(PRICE: 8, ' '); WRITE(WEIGHT: 5, ' ');
PRINTOBJ(RANOBJLIST[ILOOP], FALSE);
IF OBCLASS = WEAP THEN WRITELN(', ', MINHP: 0, '-', MAXHP: 0, ' HITS.')
ELSE WRITELN('.');
END (*WITH*)
END (*ELSE*)
END (*CATALOG*);
PROCEDURE RUN;
(* RUN AWAY LIKE HELL. WEAPON AND SHIELD DROPPED. *)
VAR
DIR: 0..7;
ROOMNUM, ILOOP: INTEGER;
GOODIR, DRWEAP, DRSHIELD: BOOLEAN;
BEGIN
WITH USER ^ DO
BEGIN
ILOOP := 4; GOODIR := FALSE; DRWEAP := FALSE; DRSHIELD := FALSE; DIR := 0;
REPEAT
DIR := RND(7);
IF DIR < 7 THEN GOODIR := (ROOM[RMCODE].ADJOIN[DIR] > 0)
ELSE GOODIR := (ROOM[RMCODE].OUT > 0);
ILOOP := ILOOP - 1;
UNTIL GOODIR OR (ILOOP = 0);
IF NOT GOODIR THEN WRITELN(TERM, 'YOU FAIL TO ESCAPE!')
ELSE
BEGIN
IF USWEAP <> NIL
THEN
BEGIN
IF DELETEOBJECT(USWEAP, OBJECTTAIL) THEN OBJECTTAIL := OBJECTTAIL ^.NEXT;
WEIGHT := WEIGHT - USWEAP ^.WEIGHT;
USWEAP ^.NEXT := ROOM[RMCODE].RMOBJECTTAIL;
ROOM[RMCODE].RMOBJECTTAIL := USWEAP; USWEAP := NIL; DRWEAP := TRUE
END (*IF*);
IF USSHIELD <> NIL
THEN
BEGIN
IF DELETEOBJECT(USSHIELD, OBJECTTAIL)
THEN OBJECTTAIL := OBJECTTAIL ^.NEXT;
WEIGHT := WEIGHT - USSHIELD ^.WEIGHT;
USSHIELD ^.NEXT := ROOM[RMCODE].RMOBJECTTAIL;
ROOM[RMCODE].RMOBJECTTAIL := USSHIELD; STOPUSING(USER, USSHIELD);
DRSHIELD := TRUE;
END (*IF*);
FOR ILOOP := 1 TO MSGTERM(TERMLIST, LOCAL) DO
BEGIN
WRITE(TERMLIST[ILOOP], PS(NAME), ' ');
IF DRWEAP OR DRSHIELD THEN WRITE('DROPS HIS ');
IF DRWEAP THEN WRITE('WEAPON AND ');
IF DRSHIELD THEN WRITE('SHIELD AND ');
WRITELN('RUNS AWAY LIKE A BLITHERING IDIOT!')
END (*FOR*);
WRITELN(TERM, 'AARGGHH!! YOU RUN LIKE CRAZY!'); DELETEPLAYER(USER, RMCODE);
ROOM[RMCODE].LASTDIR := DIR;
IF DIR < 7
THEN
BEGIN
ROOMNUM := ROOM[RMCODE].ADJOIN[DIR];
IF DIR IN ROOM[RMCODE].THOUSANDS THEN ROOMNUM := ROOMNUM + 1000;
PLACEPLAYER(USER, ROOMNUM)
END (*IF*)
ELSE PLACEPLAYER(USER, ROOM[RMCODE].OUT);
ROOMDISPLAY(RMCODE, FALSE)
END (*ELSE*)
END (*WITH*)
END (*RUN*);
PROCEDURE PRINTEXP;
BEGIN
WITH USER ^ DO
BEGIN
WRITELN(TERM, 'YOU NEED ', MAX(0, EXPR(LVL + 1) - EXPR(LVL) - EXPERIENCE): 0,
' MORE EXPERIENCE POINTS TO REACH THE NEXT LEVEL.');
WRITELN(TERM, 'YOU HAVE ', MONEY: 0, ' SHILLINGS IN CASH.')
END (*WITH*)
END (*PRINTEXP*);
PROCEDURE PAWN(WORD: ALFA; NUM: INTEGER);
(* CASH IN AN OBJECT FOR MONEY AND EXP *)
VAR
AMOUNT: INTEGER;
OBJECT: OBJECTPOINT;
BEGIN
IF W(USER ^.RMCODE) <> 8 THEN WRITELN(TERM, 'GO TO THE PAWN SHOP FIRST.')
ELSE
BEGIN
OBJECT := FINDOBJECT(WORD, NUM, USER ^.OBJECTTAIL);
IF OBJECT <> NIL
THEN
BEGIN
STOPUSING(USER, OBJECT); AMOUNT := OBJECT ^.PRICE;
WITH OBJECT ^ DO
CASE OBCLASS OF
WEAP:
IF STRIKESLEFT < 100
THEN AMOUNT := ROUND(AMOUNT * (STRIKESLEFT / 100.0) + 1.00);
SHIELD:
IF SHHITSLEFT < 50 THEN AMOUNT := ROUND(AMOUNT * (SHHITSLEFT / 50.0));
ARMOR:
IF ARMHITSLEFT < 50 THEN AMOUNT := ROUND(AMOUNT * (ARMHITSLEFT / 50.0));
MAGDEVICE: IF NUMCHARGES = 0 THEN AMOUNT := 5;
OTHERWISE
END (*CASE*);
WRITE(TERM, '"WELL, I''LL GIVE YOU ', AMOUNT: 0, ' SHILLINGS FOR ');
PRINTOBJ(OBJECT ^, TRUE); WRITELN('. IS THIS');
WRITELN(TERM, 'TO YOUR SATISFACTION?"'); USER ^.ENTRY := XSELL;
USER ^.DATA := AMOUNT; USER ^.USWEAP := OBJECT;
END (*IF*)
ELSE WRITELN(TERM, 'YOU DON''T OWN THAT ITEM.')
END (*ELSE*)
END (*PAWN*);
FUNCTION LOOK(WORD: ALFA; NUM: INTEGER; CMDCODE: INTEGER): INTEGER;
VAR
PLAYER: USERPOINT;
MONSTER: MONSTERPOINT;
TOBJ, OBJECT: OBJECTPOINT;
LEGAL: BOOLEAN;
LEV: INTEGER;
DUMMY: ALFA;
WHERE:
(GROUND, PERSON);
BEGIN
LOOK := 0; ERRLOC := 'LOOK '; LEGAL := TRUE;
IF CMDCODE = 31 THEN
BEGIN
LEGAL := SPELLCOST(USER, 10, 5, 10);
IF LEGAL THEN LEGAL := LEGAL AND NOT SPELLIMIT
END (*IF*);
IF LEGAL
THEN
WITH ROOM[USER ^.RMCODE] DO
BEGIN
PLAYER := FINDPLAYER(WORD, RMPLAYERTAIL);
IF PLAYER <> NIL
THEN
WITH PLAYER ^ DO
BEGIN
IF USARM = NIL THEN WRITE(TERM, 'YOU SEE ') ELSE WRITE(TERM);
WRITE(PS(NAME), ' THE ', PS(CNAME[CLASS]));
IF USARM <> NIL
THEN BEGIN WRITE(' IS WEARING '); PRINTOBJ(USARM ^, FALSE) END;
WRITELN('.');
IF (USWEAP <> NIL) OR (USSHIELD <> NIL)
THEN
BEGIN
WRITE(TERM);
IF SEX = MALE THEN WRITE('HE ')
ELSE WRITE('SHE ');
WRITE('IS HOLDING ');
IF USWEAP <> NIL THEN
BEGIN
PRINTOBJ(USWEAP ^, FALSE); IF USSHIELD <> NIL THEN WRITE(' AND ')
END (*IF*);
IF USSHIELD <> NIL THEN PRINTOBJ(USSHIELD ^, FALSE); WRITELN('.');
END (*IF*);
IF CMDCODE = 31 THEN PLAYERDISPLAY(PLAYER)
END (*WITH*)
ELSE (*OBJECT?*)
BEGIN
OBJECT := FINDOBJECT(WORD, NUM, USER ^.OBJECTTAIL); WHERE := PERSON;
IF OBJECT = NIL THEN
BEGIN WHERE := GROUND; OBJECT := FINDOBJECT(WORD, NUM, RMOBJECTTAIL) END;
IF OBJECT <> NIL
THEN
IF (OBJECT ^.OBCLASS = SCROLL) AND (WHERE = GROUND)
THEN WRITELN(TERM, 'PICK IT UP FIRST, EAGLE EYES.')
ELSE
BEGIN
IF CMDCODE = 31 THEN OBJDISPLAY(OBJECT)
ELSE
BEGIN
IF (CMDCODE = 64) AND (OBJECT ^.OBCLASS = SCROLL)
THEN
BEGIN
IF READYCHECK(USER ^.LASTATK)
THEN
BEGIN
GETWORD(USER ^.WDATA, USER ^.DATA, BUFFER, LENBUF, LOC);
LOOK := OBJECT ^.SPELL
END (*IF*)
ELSE CMDCODE := 31 (*KLUDGE PATCH.. INHIBIT SCROLL DISTRUCTION *)
END (*IF*)
ELSE
BEGIN
WRITE(TERM);
IF OBJECT ^.DESCREC <> 0
THEN PRINTDESC(OBJECT ^.DESCREC, OBJECT ^.DESCCODE, 0, FALSE)
ELSE
BEGIN
IF WHERE = GROUND THEN WRITE('IT''S ')
ELSE WRITE('YOU ARE HOLDING ');
PRINTOBJ(OBJECT ^, FALSE)
END (*ELSE*);
WRITELN;
IF OBJECT^.OBCLASS = WEAP THEN
BEGIN
WRITE(TERM,'THIS IS A ');
CASE OBJECT^.WEAPTYPE OF
SHARP: WRITE('SHARP, BLADED');
THRUST: WRITE('THRUSTING');
BLUNT: WRITE('BLUNTED');
LONG: WRITE('POLE');
END;
WRITELN(' WEAPON.')
END;
IF OBJECT ^.OBCLASS = CHEST
THEN
IF NOT OBJECT ^.CLOSED
THEN
IF OBJECT ^.OBJECTTAIL <> NIL
THEN
BEGIN
WRITE(TERM, 'INSIDE '); PRINTOBJ(OBJECT ^, TRUE);
WRITELN(' YOU SEE THE FOLLOWING:'); TOBJ := OBJECT ^.OBJECTTAIL;
WHILE TOBJ <> NIL DO
BEGIN
WRITE(TERM, ' '); PRINTOBJ(TOBJ ^, FALSE); WRITELN;
TOBJ := TOBJ ^.NEXT
END (*WHILE*)
END (*IF*)
ELSE WRITELN(TERM, 'IT''S EMPTY.')
ELSE WRITELN(TERM, 'IT''S CLOSED.');
END (*ELSE*);
IF (OBJECT ^.OBCLASS = SCROLL) AND (CMDCODE <> 31)
THEN
BEGIN
WRITE(TERM); PRINTOBJ(OBJECT ^, TRUE); WRITELN(' DISINTEGRATES!.');
IF DELETEOBJECT(OBJECT, USER ^.OBJECTTAIL)
THEN USER ^.OBJECTTAIL := USER ^.OBJECTTAIL ^.NEXT;
USER ^.WEIGHT := USER ^.WEIGHT - OBJECT ^.WEIGHT; DISPOSE(OBJECT);
END (*IF*);
END (*ELSE*)
END (*IF*)
ELSE (*MONSTER?*)
BEGIN
IF NUM = 0 THEN GETWORD(DUMMY, NUM, BUFFER, LENBUF, LOC);
MONSTER := FINDMONSTER(WORD, NUM, RMMONSTERTAIL);
IF MONSTER = NIL THEN WRITELN(TERM, 'I DON''T SEE THAT HERE.')
ELSE
IF CMDCODE = 31 THEN MONDISPLAY(MONSTER)
ELSE
BEGIN
LEV := (MONSTER ^.LVL DIV 5) * 5 + 1;
WRITELN(TERM, 'IT''S A ', PS(MONSTER ^.NAME), ', ', PNTH(LEV), 'TO ',
PNTH(LEV + 4), 'LEVEL.');
IF MONSTER ^.MAGIC THEN WRITELN(TERM, 'IT LOOKS MAGICAL!');
IF MONSTER ^.SLOWREACT OR MONSTER ^.FASTREACT
THEN WRITELN(TERM, 'IT LOOKS HOSTILE!');
END (*IF*)
END (*ELSE*)
END (*ELSE*)
END (*WITH*)
END (*LOOK*);
FUNCTION USEOBJECT(WORD: ALFA; NUM: INTEGER): INTEGER;
(* "USE", "HOLD", "WIELD" OR "DRAW" A WEAPON, SHIELD, OR ARMOR.
IF USER TRIES TO "USE" ANYTHING ELSE, NOTHING HAPPENS. *)
VAR
OBJECT: OBJECTPOINT;
PLYR: USERPOINT;
ILOOP: INTEGER;
BEGIN
USEOBJECT := 0; ERRLOC := 'USEOBJECT ';
OBJECT := FINDOBJECT(WORD, NUM, USER ^.OBJECTTAIL);
IF OBJECT = NIL THEN WRITELN(TERM, 'BUT YOU AREN''T CARRYING THAT!')
ELSE
WITH USER ^ DO
CASE OBJECT ^.OBCLASS OF
WEAP:
IF (USER^.CLASS = CLERIC) AND (OBJECT^.WEAPTYPE IN [SHARP,THRUST]) THEN
WRITELN(TERM,'IT IS AGAINST YOUR FAITH TO USE WEAPONS THAT DRAW BLOOD!')
ELSE
BEGIN
STOPUSING(USER, USWEAP); USWEAP := OBJECT;
FOR ILOOP := 1 TO MSGTERM(TERMLIST, LOCAL) DO
BEGIN
WRITE(TERMLIST[ILOOP], PS(USER ^.NAME), ' PULLS OUT ');
PRINTOBJ(OBJECT ^, FALSE); WRITELN('!')
END (*FOR*);
WRITELN(TERM, 'YOU READY YOUR WEAPON!')
END (*WEAP*);
ARMOR:
IF (CLASS = MAGICUSER) AND (OBJECT ^.ARMPLUS > 1)
THEN WRITELN(TERM, 'MAGIC-USERS CANNOT WEAR SUCH ARMOR!')
ELSE
BEGIN
STOPUSING(USER, USARM); USARM := OBJECT;
AC := MAX(- 50, MIN(AC - USARM ^.ARMPLUS, 50));
WRITELN(TERM, 'YOU PUT ON YOUR ARMOR.')
END (*ARMOR*);
SHIELD:
IF (CLASS = MAGICUSER) AND (OBJECT ^.SHPLUS > 1)
THEN WRITELN(TERM, 'MAGIC-USERS CANNOT USE SUCH SHIELDS!')
ELSE
BEGIN
STOPUSING(USER, USSHIELD); USSHIELD := OBJECT;
AC := MAX(- 50, MIN(AC - USSHIELD ^.SHPLUS, 50));
WRITELN(TERM, 'YOU READY YOUR SHIELD!')
END (*SHIELD*);
MAGDEVICE:
IF OBJECT ^.NUMCHARGES <= 0
THEN
BEGIN
WRITELN(TERM, 'NOTHING HAPPENS.. IT''S DISCHARGED/EMPTY.');
OBJECT ^.PERMANENT := FALSE
END (*IF*)
ELSE
IF READYCHECK(USER ^.LASTATK)
THEN
BEGIN
GETWORD(WORD, NUM, BUFFER, LENBUF, LOC); WDATA := WORD;
IF NUM = 0 THEN GETWORD(WORD, NUM, BUFFER, LENBUF, LOC); DATA := NUM;
OBJECT ^.NUMCHARGES := OBJECT ^.NUMCHARGES - 1;
USEOBJECT := - (OBJECT ^.SPELL)
END (*ELSE*);
TELEPORT:
IF (OBJECT ^.TACTIVERM <> W(RMCODE)) AND (OBJECT ^.TACTIVERM <> 0)
THEN WRITELN(TERM, 'YOU FEEL A SLIGHT TINGLE, BUT NOTHING ELSE HAPPENS.')
ELSE
BEGIN
FOR ILOOP := 1 TO MSGTERM(TERMLIST, LOCAL) DO
WRITELN(TERMLIST[ILOOP], PS(NAME),
' SUDDENLY VANISHES IN A BLINDING FLASH!');
DELETEPLAYER(USER, RMCODE); PLACEPLAYER(USER, OBJECT ^.TOWHERE);
WRITELN(TERM, 'EVERYTHING SWIRLS AROUND IN A BLINDING FLASH! YOU FIND...')
;
ROOMDISPLAY(RMCODE, FALSE);
FOR ILOOP := 1 TO MSGTERM(TERMLIST, LOCAL) DO
WRITELN(TERMLIST[ILOOP], PS(NAME),
' SUDDENLY APPEARS IN A BLINDING FLASH OF LIGHT!')
END (*ELSE*);
CARD:
BEGIN
GETWORD(WORD, NUM, BUFFER, LENBUF, LOC); PLYR := FINDUSER(WORD, USERTAIL);
IF PLYR <> NIL
THEN
BEGIN
DELETEPLAYER(USER, RMCODE); PLACEPLAYER(USER, W(PLYR ^.RMCODE));
WRITELN(TERM, 'YOU TELEPORT TO PLAYER ', PS(PLYR ^.NAME));
ROOMDISPLAY(RMCODE, FALSE)
END (*IF*)
ELSE WRITELN(TERM, 'PLAYER NOT FOUND.');
END (*CARD*);
OTHERWISE
WRITELN(TERM, 'NOTHING HAPPENS.')
END (*CASE*);
END (*USEOBJECT*);
(* THE FOLLOWING ARE PROCEDURES FOR PROCESSING THE ATTACK COMMANDS.
PLAYERS ATTACK WITH THE WEAPON CURRENTLY HELD. THEY DEFEND THEM-
SELVES WITH SHIELDS AND ARMOR. *)
PROCEDURE PROTECTNPC(PLAYER: USERPOINT; MONSTER: MONSTERPOINT);
VAR
ILOOP: INTEGER;
TEMP: OBJECTPOINT;
BEGIN
ERRLOC := ' NINTEEN '; TERM := PLAYER ^.TRM;
WRITELN(TERM, 'AS YOU STEP FORWARD TO ATTACK, THE ', PS(MONSTER ^.NAME), ' YELLS'
);
WRITELN(TERM, '"HELP! HELP! GUARDS! GUARDS!"... IN SECONDS SEVERAL');
WRITELN(TERM, 'BURLY GUARDS GRAB YOU, AND TAKE AWAY YOUR WEAPON!');
IF PLAYER ^.USWEAP <> NIL
THEN
BEGIN
TEMP := PLAYER ^.USWEAP; PLAYER ^.USWEAP := NIL;
IF DELETEOBJECT(TEMP, PLAYER ^.OBJECTTAIL)
THEN PLAYER ^.OBJECTTAIL := PLAYER ^.OBJECTTAIL ^.NEXT;
PLAYER ^.WEIGHT := MAX(0, PLAYER ^.WEIGHT - TEMP ^.WEIGHT); DISPOSE(TEMP);
END (*IF*);
IF PLAYER ^.LVL <= 2
THEN
BEGIN
WRITELN(TERM, 'BUT SINCE YOU ARE A YOUNG, INEXPERIENCED ADVENTURER, THEY');
WRITELN(TERM, 'GIVE YOU A STERN WARNING, AND DECIDE NOT TO THROW YOU IN JAIL.')
;
FOR ILOOP := 1 TO MSGTERM(TERMLIST, LOCAL) DO
WRITELN(TERMLIST[ILOOP], PS(PLAYER ^.NAME), ' ASSAULTS THE ', PS(MONSTER ^.
NAME), ', BUT THE TOWN GUARDS STOP HIM.');
END (*IF*)
ELSE
BEGIN
WRITELN(TERM, 'THEN THEY THROW YOU IN JAIL!');
FOR ILOOP := 1 TO MSGTERM(TERMLIST, ALL) DO
BEGIN
WRITELN(TERMLIST[ILOOP], '### ', PS(PLAYER ^.NAME), ' WAS THROWN IN JAIL FOR'
, ' ASSAULTING THE ', PS(MONSTER ^.NAME), '.');
END (*FOR*);
DELETEPLAYER(PLAYER, PLAYER ^.RMCODE); PLACEPLAYER(PLAYER, 5) (*JAIL*);
WRITELN(TERM); ROOMDISPLAY(PLAYER ^.RMCODE, FALSE);
END (*ELSE*);
PLAYER ^.DEFMON := NIL;
END (*PROTECTNPC*);
FUNCTION SELECTWEAP: OBJECTPOINT;
(* SELECTWEAP CHECKS THAT THE ATTACKING PLAYER ACTUALLY WIELDS
A WEAPON. THE WEAPON MUST NOT BE BROKEN. *)
BEGIN
IF USER ^.USWEAP = NIL THEN SELECTWEAP := NIL
ELSE
IF USER ^.USWEAP ^.STRIKESLEFT = 0
THEN
BEGIN
USER ^.USWEAP ^.PERMANENT := FALSE; SELECTWEAP := NIL;
WRITELN(TERM, 'YOUR WEAPON IS BROKEN!')
END (*IF*)
ELSE SELECTWEAP := USER ^.USWEAP
END (*SELECTWEAP*);
PROCEDURE SHAREEXPERIENCE(MON: MONSTERPOINT; RM: RMCODETYPE);
(* SHAREEXPERIENCE WILL DISTRIBUTE EXPERIENCE POINTS TO ALL
PLAYERS WHO ARE INVOVLED IN KILLING A MONSTER. THE ACTUAL
KILLER OF THE MONSTER GETS AN EXTRA SHARE OF EXPERIENCE POINTS.*)
VAR
NEWEXP, NUMINVOLVED: INTEGER;
PLYR: USERPOINT;
FUNCTION ATKING(OTHR: USERPOINT): BOOLEAN;
BEGIN ATKING := (OTHR ^.DEFMON = MON) END;
BEGIN (*SHAREEXPERIENCE*)
NUMINVOLVED := 0; PLYR := MATCHPLAYER(ROOM[RM].RMPLAYERTAIL, ATKING);
WHILE PLYR <> NIL DO
BEGIN
NUMINVOLVED := NUMINVOLVED + 1; PLYR := MATCHPLAYER(PLYR ^.NEXT, ATKING);
END (*WHILE*);
NUMINVOLVED := NUMINVOLVED + 1 (* ADD SHARE FOR SLAYER *);
PLYR := MATCHPLAYER(ROOM[RM].RMPLAYERTAIL, ATKING);
WHILE PLYR <> NIL DO
BEGIN
IF PLYR = USER
THEN
PLYR ^.EXPERIENCE := MIN(262000, PLYR ^.EXPERIENCE + MON ^.EXPERIENCE * 2 DIV
NUMINVOLVED)
ELSE
BEGIN
NEWEXP := MON ^.EXPERIENCE DIV NUMINVOLVED;
IF NOTIMEOUT(PLYR) THEN
WRITELN(PLYR ^.TRM, 'YOU EARNED ', NEWEXP: 0,
' EXPERIENCE POINTS FOR THE MELEE.');
PLYR ^.EXPERIENCE := MIN(262000, PLYR ^.EXPERIENCE + NEWEXP)
END (*ELSE*);
PLYR := MATCHPLAYER(PLYR ^.NEXT, ATKING)
END (*WHILE*);
END (*SHAREEXPERIENCE*);
PROCEDURE MAKETREASURE(MONSTER: MONSTERPOINT; RM: INTEGER);
VAR
NOTHING: BOOLEAN;
OBJ, LASTOBJ: OBJECTPOINT;
ILOOP, NUMOBJS, OBNUM: INTEGER;
FACTOR: REAL;
BEGIN
ERRLOC := ' TWENTY '; NOTHING := TRUE;
WRITELN(TERM, 'ON ', PM(MONSTER), ' YOU FIND:');
WITH MONSTER ^ DO
BEGIN
IF OBJECTTAIL <> NIL
THEN
BEGIN
NOTHING := FALSE; LASTOBJ := OBJECTTAIL;
WHILE LASTOBJ ^.NEXT <> NIL DO LASTOBJ := LASTOBJ ^.NEXT;
LASTOBJ ^.NEXT := ROOM[RM].RMOBJECTTAIL (*INSERT INTO ROOM*);
LASTOBJ := LASTOBJ ^.NEXT (* POINT TO LAST OBJ + 1 *);
ROOM[RM].RMOBJECTTAIL := OBJECTTAIL; OBJECTTAIL := NIL;
END (*IF*)
ELSE LASTOBJ := ROOM[RM].RMOBJECTTAIL;
IF WHICHOBJ > OBJLISTLEN THEN
BEGIN
WRITELN(TERM, 'MIL105 - OBJECT LIST INDEX OUT OF BOUNDS!'); WHICHOBJ := 0
END (*IF*);
IF WHICHOBJ > 0
THEN
BEGIN
IF RND(4) = 1 THEN NUMOBJS := RND(4) ELSE NUMOBJS := 1;
FOR ILOOP := 1 TO NUMOBJS DO
BEGIN
OBNUM := OBJINDEX[WHICHOBJ, RND(6)];
IF OBNUM > 0
THEN
BEGIN
NOTHING := FALSE; NEW(OBJ); OBJ ^ := RANOBJLIST[OBNUM];
FACTOR := (RND(40) + 80) / 100;
OBJ ^.PRICE := ROUND(OBJ ^.PRICE * FACTOR);
OBJ ^.NEXT := ROOM[RM].RMOBJECTTAIL; ROOM[RM].RMOBJECTTAIL := OBJ
END (*IF*)
END (*FOR*)
END (*IF*);
IF NOTHING THEN WRITELN(TERM, ' NOTHING.')
ELSE
BEGIN
OBJ := ROOM[RM].RMOBJECTTAIL;
REPEAT
WRITE(TERM, ' '); PRINTOBJ(OBJ ^, FALSE); WRITELN; OBJ := OBJ ^.NEXT
UNTIL OBJ = LASTOBJ
END (*ELSE*)
END (*WITH*)
END (*MAKETREASURE*);
PROCEDURE HITPLAYER(DAMAGE: INTEGER);
(* HURTPLAYER INFLICTS DAMAGE AGAINST A PLAYER. MESSAGES ARE
SENT TO ALL CONCERNED. EXCESSIVE DAMAGE CAUSES DEATH, WITH A
COLORFUL MESSAGE FLASHED TO ALL USERS ABOUT THE EVENT. *)
VAR
I: INTEGER;
PLAYER: USERPOINT;
REVENENT: MONSTERPOINT;
MERC, COLD: BOOLEAN;
BEGIN
ERRLOC := 'HITPLAYER '; PLAYER := USER ^.DEFPLAYER; HITSHARMOR(PLAYER, DAMAGE);
WRITE(TERM, 'YOU HIT ', PS(PLAYER ^.NAME), ' FOR ');
PRINTDMG(PLAYER, DAMAGE, USER ^.BRIEF);
IF NOTIMEOUT(PLAYER) THEN
BEGIN
WRITE(PLAYER ^.TRM, PS(USER ^.NAME), ' HITS YOU FOR ');
PRINTDMG(PLAYER, DAMAGE, PLAYER ^.BRIEF);
END (*IF*);
IF PLAYER ^.HITS + PLAYER ^.FATIGUE <= DAMAGE
THEN
IF REALTIME - PLAYER ^.HITATTIME <= 30
THEN
BEGIN
WRITELN(TERM, 'YOU KILLED ', PRO[PLAYER^.SEX], '!');
WRITELN(PLAYER ^.TRM, 'YOU''RE DEAD, ', PS(PLAYER ^.NAME), '!');
MERC := (USER ^.LVL - PLAYER ^.LVL > 3); COLD := (PLAYER ^.DEFPLAYER = NIL);
IF PLAYER ^.LVL > 5 THEN DAYMSG('KIL', PLAYER, USER ^.NAME, USER ^.LVL);
FOR I := 1 TO MSGTERM(TERMLIST, ALL) DO
BEGIN
WRITE(TERMLIST[I], '### ', PS(USER ^.NAME), ' JUST KILLED ', PS(PLAYER ^.
NAME));
IF MERC THEN WRITE(' MERCILESSLY');
IF COLD THEN WRITELN(' IN COLD BLOOD!') ELSE WRITELN('!');
END (*FOR*);
IF MERC THEN USER ^.PTY := MAX(- 10, USER ^.PTY - 1);
IF COLD THEN USER ^.PTY := MAX(- 10, USER ^.PTY - 1);
IF (USER ^.CLASS = PALADIN) AND (MERC OR COLD) AND (PLAYER ^.CLASS <> THIEF)
THEN USER ^.CLASS := FIGHTER;
IF USER ^.AGUILD THEN USER ^.PTY := MAX(0, USER ^.PTY - 1);
IF (PLAYER ^.CON >= 18)
THEN
BEGIN (*REVENENT*)
NEW(REVENENT); REVENENT ^ := RANMONLIST[1];
INSERTMONSTER(REVENENT, USER ^.RMCODE);
WITH REVENENT ^ DO
BEGIN
HITS := PLAYER ^.MAXHITS; LVL := PLAYER ^.LVL; DEFPLAYER := USER;
MAXHITS := HITS;
END (*WITH*);
WRITELN(TERM, 'FROM THE DEAD BODY YOU SEE A GASEOUS SHAPE FORM...');
END (*IF*);
PLAYER ^.DEAD := TRUE;
PLAYER ^.FATIGUE := 0; PLAYER ^.HITS := 0 (* KILL PLAYER..AW... *);
IF (- (USER ^.PTY * 10) > RND(100)) AND (MERC OR COLD)
THEN (*TO THE GALLOWS!*)
BEGIN
WRITELN(TERM,
'ENOUGH IS ENOUGH! THE PEOPLE RISE UP AGAINST YOU IN AN ANGRY MOB!');
WRITELN(TERM, 'YOU HAVE BEEN LYNCHED!'); DAYMSG('LYN', USER, BLANKS, 0);
FOR I := 1 TO MSGTERM(TERMLIST, ALL) DO
WRITELN(TERMLIST[I], '### ', PS(USER ^.NAME), ', THE ', PS(CNAME[USER ^.
CLASS]), ', WAS JUST LYNCHED BY AN ANGRY MOB.');
USER ^.DEAD := TRUE;
USER ^.HITS := 0; USER ^.FATIGUE := 0
END (*IF*)
END (*IF*)
ELSE
BEGIN
PLAYER ^.FATIGUE := 0; PLAYER ^.HITS := 1;
WRITELN(PLAYER ^.TRM, 'YOU HEAR A VOICE CRY OUT, "RUN, FOOL, RUN!"')
END (*ELSE*)
ELSE
BEGIN
IF DAMAGE > PLAYER ^.FATIGUE
THEN PLAYER ^.HITS := MAX(0, PLAYER ^.HITS - DAMAGE + PLAYER ^.FATIGUE);
PLAYER ^.FATIGUE := MAX(0, PLAYER ^.FATIGUE - DAMAGE);
END (*ELSE*)
END (*HURTPLAYER*);
PROCEDURE HITMONSTER(DAMAGE: INTEGER);
(* *HITMONSTER* STRIKES MONSTERS FOR DAMAGE. ENOUGH DAMAGE WILL
KILL THEM. MESSAGES ARE SENT TO ALL INVOLVED PLAYERS, PLUS ANY
EXPERIENCE AND/OR TREASURE GAINED. MONSTER-PERSONALITY BITS
USED HERE ARE *FLEE*, *DEFEND*, AND *ATKLASTAGGR*. *)
VAR
MONSTER: MONSTERPOINT;
RM: RMCODETYPE;
I: INTEGER;
BEGIN
ERRLOC := 'HITMONSTER'; RM := USER ^.RMCODE; MONSTER := USER ^.DEFMON;
IF MONSTER ^.HITS - DAMAGE <= 0
THEN
BEGIN
WRITELN(TERM, 'YOU KILLED THE ', PS(MONSTER ^.NAME), '!');
FOR I := 1 TO MSGTERM(TERMLIST, LOCAL) DO
WRITELN(TERMLIST[I], PS(USER ^.NAME), ' JUST KILLED ', PM(MONSTER), '!');
SHAREEXPERIENCE(MONSTER, RM); MAKETREASURE(MONSTER, RM);
DELETEMONSTER(MONSTER, RM); DESTROY(MONSTER); USER ^.DEFMON := NIL
END (* KILL MONSTER *)
ELSE
BEGIN
IF MONSTER ^.MPARLEY IN [1, 3, 4]
THEN IF NOT MONSTER ^.PERMANENT THEN MONSTER ^.MPARLEY := 2;
MONSTER ^.HITS := MONSTER ^.HITS - DAMAGE;
IF USER ^.BRIEF
THEN WRITELN(TERM, 'YOU HIT IT FOR ', DAMAGE: 1, ' HIT POINTS!')
ELSE
WRITELN(TERM, 'YOU HIT THE ', PS(MONSTER ^.NAME), ' FOR ', DAMAGE: 0,
' HIT POINTS!');
IF MONSTER ^.FLEE OR (USER ^.LVL >= 5 + MONSTER ^.LVL)
THEN
IF MONSTER ^.HITS / MONSTER ^.MAXHITS < 0.01 * RND(40)
THEN
BEGIN
FOR I := 1 TO MSGTERM(TERMLIST, LOCAL) DO
BEGIN
WRITELN(TERMLIST[I], PM(MONSTER), 'FLEES FROM ', PS(USER ^.NAME),
'''S ATTACK!');
END (*FOR*);
WRITELN(TERM, 'THE ', PS(MONSTER ^.NAME), ' FLEES FROM YOUR ATTACK!');
MONSTER ^.EXPERIENCE := MONSTER ^.EXPERIENCE DIV 2;
IF (USER ^.LVL < 5 + MONSTER ^.LVL) THEN SHAREEXPERIENCE(MONSTER, RM);
DELETEMONSTER(MONSTER, RM); DESTROY(MONSTER); USER ^.DEFMON := NIL
END (*IF*)
END (* HIT, BUT NOT KILL *)
END (*HITMONSTER*);
PROCEDURE HITATMONSTER(WEAPON: OBJECTPOINT; PLUS: INTEGER);
(* THIS PROCEDURE "ROLLS THE DICE" TO SEE IF A PLAYER HIT A MONSTER. *)
VAR
DAMAGE: INTEGER;
WITHFIST: BOOLEAN;
BEGIN
ERRLOC := 'HITATMONST'; WITHFIST := FALSE;
IF WEAPON = NIL
THEN BEGIN WITHFIST := TRUE; NEW(WEAPON); WEAPON ^ := FIST END;
WITH USER ^ DO
BEGIN
WITH WEAPON ^ DO
IF DEFMON ^.MAGIC AND NOT MAGIC
THEN WRITELN(TERM, 'YOUR WEAPON STRIKES WITH NO EFFECT!!')
ELSE
BEGIN
IF CLASS = PALADIN
THEN IF DEFMON ^.SLOWREACT OR DEFMON ^.FASTREACT THEN PLUS := PLUS + 1;
IF CLASS = FIGHTER THEN PLUS := PLUS + 1;
IF LVL = 1 THEN PLUS := PLUS + 2;
IF DEFMON ^.INVISIBLE THEN PLUS := PLUS - 4 (*-4 TO HIT*);
IF DEFMON ^.DEFEND AND (DEFMON ^.DEFPLAYER = NIL) OR DEFMON^.ATKLASTAGGR
AND (DEFMON^.DEFPLAYER <> USER)
THEN BEGIN DEFMON ^.DEFPLAYER := USER (* ATTACK BACK *);
IF DEFMON^.MREACT >= 5 THEN DEFMON^.MREACT := 0
END;
IF NOT DEFMON ^.PERMANENT
THEN IF DEFMON ^.MPARLEY IN [1, 3, 4] THEN DEFMON ^.MPARLEY := 2;
IF (RND(20) <> 20) AND (RND(20) < 14 + DEFMON ^.LVL - LVL - WEAPLUS - STR
DIV 6 - PLUS)
THEN
IF WITHFIST THEN WRITELN(TERM, 'YOUR FIST MISSES!')
ELSE WRITELN(TERM, 'YOU MISSED!')
ELSE
BEGIN (* HIT *)
STRIKESLEFT := STRIKESLEFT - 1;
DAMAGE := MAX(0, MINHP + RND(MAXHP - MINHP + 1) + WEAPLUS + PLUS);
IF WITHFIST THEN WRITELN(TERM, 'PUNCH!');
CASE RND(100 - LVL) OF
1, 2, 3, 4:
BEGIN WRITELN(TERM, 'DOUBLE DAMAGE!'); DAMAGE := DAMAGE * 2 END;
90:
BEGIN WRITELN(TERM, 'YOU FUMBLED!'); DAMAGE := 0; USWEAP := NIL END;
OTHERWISE
END (*CASE*);
IF DAMAGE >= DEFMON ^.HITS
THEN
IF ((DEFMON ^.LVL - LVL ) * 5 > RND(25)) AND NOT SKILLNEW
THEN
BEGIN
SKILLNEW := TRUE;
CASE WEAPON ^.WEAPTYPE OF
SHARP: IF RND(SSHARP) = 1 THEN SSHARP := MIN(7, SSHARP + 1);
THRUST: IF RND(STHRUST) = 1 THEN STHRUST := MIN(7, STHRUST + 1);
BLUNT: IF RND(SBLUNT) = 1 THEN SBLUNT := MIN(7, SBLUNT + 1);
LONG: IF RND(SLONG) = 1 THEN SLONG := MIN(7, SLONG + 1);
END (*CASE*);
END (*IF*);
HITMONSTER(DAMAGE) (* WHAM! *)
END (*ELSE*)
END (*ELSE*)
END (*WITH USER*);
IF WITHFIST THEN DISPOSE(WEAPON);
END (*HITATMONSTER*);
PROCEDURE HITATPLAYER(WEAPON: OBJECTPOINT; PLUS: INTEGER);
(* HITATPLAYER LETS ONE PLAYER ATTACK ANOTHER *)
VAR
DAMAGE: INTEGER;
WITHFIST: BOOLEAN;
BEGIN
ERRLOC := ' T-TWO-B '; WITHFIST := FALSE;
IF WEAPON = NIL
THEN BEGIN WITHFIST := TRUE; NEW(WEAPON); WEAPON ^ := FIST END;
WITH USER ^ DO
BEGIN
WITH WEAPON ^ DO
IF (RND(20) <> 20) AND (RND(20) < 24 + DEFPLAYER ^.LVL - LVL - WEAPLUS - STR
DIV 6 - DEFPLAYER ^.AC + DEFPLAYER ^.DEX DIV 6 - PLUS) OR (DEFPLAYER ^.HITS
= 0)
THEN
BEGIN
IF WITHFIST THEN WRITELN(TERM, 'WOOSH! YOUR FIST MISSES!')
ELSE WRITELN(TERM, 'YOU MISSED!');
IF NOTIMEOUT(DEFPLAYER)
THEN WRITELN(DEFPLAYER ^.TRM, PS(USER ^.NAME), ' MISSES YOU!')
END (*IF*)
ELSE
BEGIN
WEAPON ^.STRIKESLEFT := WEAPON ^.STRIKESLEFT - 1;
DAMAGE := MAX(0, MINHP + RND(MAXHP - MINHP + 1) + WEAPLUS + PLUS);
IF WITHFIST THEN WRITELN(TERM, 'POW!'); HITPLAYER(DAMAGE)
END (*ELSE*);
IF DEFPLAYER <> NIL THEN DEFPLAYER ^.HITATTIME := REALTIME;
END (*WITH USER*);
IF WITHFIST THEN DISPOSE(WEAPON);
END (*HITATPLAYER*);
PROCEDURE ATTACK(CMDCODE: INTEGER; WORD: ALFA; RM: RMCODETYPE);
(* THIS IS THE MAIN ATTACK PROCESSOR. IT CALLS ALL THE ABOVE ROUTINES
IN ORDER TO PROCESS PLAYER-MONSTER ATTACKS AND PLAYER-PLAYER ATTACKS.
EXAMPLE: "ATTACK POOTWADDLE", "ATTACK RAT/3", "STRIKE HAROLD"
*)
TYPE
TOWHATTYPE =
(TONONE, TOMONSTER, TOPLAYER);
VAR
WEAPON: OBJECTPOINT;
TOWHAT: TOWHATTYPE;
PLUS: INTEGER;
FUNCTION ATTACKWHAT(WORD: ALFA): TOWHATTYPE;
(* ATTACKWHAT SCANS TO SEE IF THE TARGET IS A PLAYER OR A MONSTER.
THE APPROPRIATE *DEFMON* AND *DEFPLAYER* POINTERS ARE SET, AND
MESSAGES ARE SENT TO ALL PLAYERS IN THE ROOM ABOUT THE ATTACK. *)
VAR
OLDDEFPLAYER: USERPOINT;
OLDDEFMON: MONSTERPOINT;
I: INTEGER;
DUMMY: ALFA;
BEGIN
ERRLOC := ' T-THREE ';
WITH USER ^ DO
BEGIN
OLDDEFPLAYER := DEFPLAYER;
DEFPLAYER := FINDPLAYER(WORD, ROOM[RM].RMPLAYERTAIL);
IF DEFPLAYER = USER THEN DEFPLAYER := NIL;
IF DEFPLAYER = NIL
THEN
BEGIN
OLDDEFMON := DEFMON;
IF NUM = 0 THEN GETWORD(DUMMY, NUM, BUFFER, LENBUF, LOC);
(*GET MONSTER #, IF ANY*)
DEFMON := FINDMONSTER(WORD, NUM, ROOM[RM].RMMONSTERTAIL);
(* CHECK FOR A MONSTER FIRST *)
IF DEFMON = NIL
THEN
BEGIN
ATTACKWHAT := TONONE;
IF FINDOBJECT(WORD, NUM, ROOM[RM].RMOBJECTTAIL) <> NIL
THEN WRITELN(TERM, 'USE THE COMMAND "SMASH" INSTEAD.')
ELSE WRITELN(TERM, PS(WORD), ' ISN''T HERE.')
END (*IF*)
ELSE
BEGIN
ATTACKWHAT := TOMONSTER;
IF OLDDEFMON <> DEFMON THEN
FOR I := 1 TO MSGTERM(TERMLIST, LOCAL) DO
WRITELN(TERMLIST[I], PS(NAME), ' ATTACKS ', PM(DEFMON), '!');
END (*ELSE*)
END (*IF*)
ELSE
BEGIN
ATTACKWHAT := TOPLAYER;
IF OLDDEFPLAYER <> DEFPLAYER
THEN
BEGIN
IF NOTIMEOUT(DEFPLAYER)
THEN WRITELN(DEFPLAYER ^.TRM, PS(NAME), ' IS ATTACKING YOU!');
FOR I := 1 TO MSGTERM(TERMLIST, LOCAL) DO
IF TERMLIST[I] <> DEFPLAYER ^.TRM THEN
WRITELN(TERMLIST[I], PS(NAME), ' ATTACKS ', PS(DEFPLAYER ^.NAME), '!');
END (*IF*)
END (*ELSE*)
END (*WITH*)
END (*ATTACKWHAT*);
BEGIN (*ATTACK*)
ERRLOC := 'ATTACK ';
WITH USER ^ DO
BEGIN
TOWHAT := TONONE; WEAPON := SELECTWEAP;
IF READYCHECK(LASTATK) AND ((WEAPON <> NIL) OR (USER ^.USWEAP = NIL))
THEN
BEGIN
IF ROOM[RMCODE].SAFE THEN WRITELN(TERM, 'THIS IS A SAFE HAVEN.')
ELSE
IF WORD = BLANKS
THEN
IF (DEFMON <> NIL) OR (DEFPLAYER <> NIL)
THEN IF DEFMON <> NIL THEN TOWHAT := TOMONSTER ELSE TOWHAT := TOPLAYER
ELSE WRITELN(TERM, 'SPECIFY TARGET, PLEASE!')
ELSE TOWHAT := ATTACKWHAT(WORD);
IF (TOWHAT <> TONONE)
THEN
IF (CMDCODE = 42) OR (FATIGUE > 0)
THEN
BEGIN
CASE CMDCODE OF
11: BEGIN PLUS := 0; FATIGUE := MAX(0, FATIGUE - RND(2) + 1); END;
42 (*PARRY*):
BEGIN
PLUS := - (LVL DIV 2 + 1);
IF TOWHAT = TOMONSTER THEN DEFMON ^.MREACT := 5 (*HALF DAMAGE*)
END (*42*);
43 (*THRUST*):
BEGIN
PLUS := LVL; FATIGUE := MAX(0, FATIGUE - LVL);
IF TOWHAT = TOMONSTER THEN
IF RND(4) = 4 THEN
BEGIN
DEFMON ^.MREACT := 6 (*DOUBLE DAMAGE*);
WRITELN(TERM, 'YOU ARE VULNERABLE!')
END (*IF*);
END (*43*);
85 (* FEINT *):
BEGIN
WRITELN(TERM, 'OK');
IF DEX > RND(30)
THEN
IF TOWHAT = TOMONSTER THEN DEFMON ^.MREACT := 3
ELSE
BEGIN
DEFPLAYER ^.LASTATK := REALTIME + 10;
WRITELN(DEFPLAYER ^.TRM, PS(NAME), ' FEINTS AT YOU!');
WRITELN(TERM, PS(DEFPLAYER ^.NAME), ' FALLS BACK!')
END (*ELSE*)
ELSE WRITELN(TERM, 'DIDN''T WORK!');
TOWHAT := TONONE;
END (*85*);
86 (* CIRCLE *):
BEGIN
WRITELN(TERM, 'OK');
IF DEX > RND(20)
THEN
IF TOWHAT = TOMONSTER THEN DEFMON ^.MREACT := 2
ELSE
BEGIN
DEFPLAYER ^.LASTATK := REALTIME + 8;
WRITELN(DEFPLAYER ^.TRM, PS(NAME), ' CIRCLES YOU!');
WRITELN(TERM, 'YOU CIRCLE ', PRO[DEFPLAYER^.SEX], '!');
END (*ELSE*)
ELSE WRITELN(TERM, 'DIDNT''T WORK!');
TOWHAT := TONONE;
END (*86*);
72:
IF HIDDEN THEN PLUS := 5
ELSE
BEGIN
PLUS := - 5; WRITELN(TERM, 'YOU ARE DISCOVERED!');
IF TOWHAT = TOMONSTER THEN DEFMON ^.MREACT := 6 (*DOUBLE DAMAGE*)
END (*ELSE*);
END (*CASE*);
IF WEAPON <> NIL
THEN
CASE WEAPON ^.WEAPTYPE OF
SHARP: PLUS := PLUS + SSHARP;
THRUST: PLUS := PLUS + STHRUST;
BLUNT: PLUS := PLUS + SBLUNT;
LONG: PLUS := PLUS + SLONG;
END (*CASE*);
IF TOWHAT = TOPLAYER THEN LASTATK := REALTIME + 8
ELSE LASTATK := REALTIME + 5;
HIDDEN := FALSE;
IF TOWHAT = TOMONSTER
THEN
IF DEFMON ^.ASSISTANCE THEN PROTECTNPC(USER, USER ^.DEFMON)
ELSE HITATMONSTER(WEAPON, PLUS)
ELSE IF TOWHAT = TOPLAYER THEN HITATPLAYER(WEAPON, PLUS)
END (*IF*)
ELSE WRITELN(TERM, 'YOU''RE TOO EXHAUSTED TO STRIKE!')
END (*IF*)
END (*WITH*)
END (*ATTACK*);
PROCEDURE SPELL(SPELLCODE: INTEGER);
(* CAST SPELL ON A PLAYER, MONSTER, OR USER HIMSELF *)
VAR
OBJ: OBJECTPOINT;
PLAYER: USERPOINT;
MONSTER: MONSTERPOINT;
TARGET, DUMMY: ALFA;
GOODSPL: BOOLEAN;
MAGTYPE:
(CHANT, SCRL, DEVICE);
LENCHANT, DAMAGE, SUM, LVLNEEDED, MPNEEDED, ILOOP: INTEGER;
INNEEDED: INTEGER;
BEGIN
USER ^.HIDDEN := FALSE; MAGTYPE := CHANT; ERRLOC := 'SPELL ';
GOODSPL := FALSE; PLAYER := NIL; MONSTER := NIL; OBJ := NIL;
IF SPELLCODE = 0
THEN
BEGIN
ILOOP := 1; SUM := 0; USER ^.ENTRY := XCMD; LENCHANT := 0;
WHILE ILOOP <= LENBUF DO
BEGIN
IF BUFFER[ILOOP] IN ['A' .. 'Z']
THEN BEGIN SUM := SUM + ORD(BUFFER[ILOOP]); LENCHANT := LENCHANT + 1 END;
ILOOP := ILOOP + 1
END (*WHILE*);
SPELLCODE := 0;
WHILE (SPELLCODE < SPELLEN) AND NOT GOODSPL DO
BEGIN
SPELLCODE := SPELLCODE + 1;
GOODSPL := (SPELLCLASS[SPELLCODE].SPLHASH = SUM) AND (LENCHANT = SPELLCLASS[
SPELLCODE].SPLLEN);
END (*WHILE*)
END (*IF*)
ELSE
BEGIN
GOODSPL := TRUE;
IF SPELLCODE < 0
THEN BEGIN SPELLCODE := ABS(SPELLCODE); MAGTYPE := DEVICE END
ELSE MAGTYPE := SCRL;
END (*ELSE*);
IF NOT GOODSPL THEN WRITELN(TERM, 'YOU MISPRONOUNCED THE SPELL!')
ELSE
WITH SPELLCLASS[SPELLCODE] DO
BEGIN
TARGET := USER ^.WDATA; NUM := USER ^.DATA;
CASE SPLTYPE OF
ONUSER, ONPLAYER, ONUSPLAYER:
BEGIN
IF TARGET = BLANKS THEN PLAYER := USER
ELSE PLAYER := FINDPLAYER(TARGET, ROOM[USER ^.RMCODE].RMPLAYERTAIL);
IF (SPLTYPE = ONPLAYER) AND ((TARGET = BLANKS) OR (PLAYER = USER)) OR (
TARGET <> BLANKS) AND ((PLAYER = NIL) OR (SPLTYPE = ONUSER))
THEN
BEGIN
GOODSPL := FALSE;
IF TARGET <> BLANKS THEN WRITELN(TERM, 'THAT SPELL TARGET IS ILLEGAL!')
ELSE WRITELN(TERM, 'THE SPELL TARGET WAS NOT SPECIFIED!')
END (*IF*)
END (*ONUSER*);
ONMON, ONMONPLAYER:
BEGIN
PLAYER := FINDPLAYER(TARGET, ROOM[USER ^.RMCODE].RMPLAYERTAIL);
MONSTER := FINDMONSTER(TARGET, NUM, ROOM[USER ^.RMCODE].RMMONSTERTAIL);
IF (MONSTER = NIL) AND ((PLAYER = NIL) OR (SPLTYPE = ONMON)) OR (PLAYER =
USER)
THEN
BEGIN
GOODSPL := FALSE;
IF TARGET <> BLANKS THEN WRITELN(TERM, 'THE SPELL TARGET IS ILLEGAL!')
ELSE WRITELN(TERM, 'THE SPELL TARGET WAS NOT SPECIFIED!')
END (*IF*)
END (*ONMON*);
ONOBJECT:
BEGIN
OBJ := FINDOBJECT(TARGET, NUM, USER ^.OBJECTTAIL);
IF OBJ = NIL
THEN OBJ := FINDOBJECT(TARGET, NUM, ROOM[USER ^.RMCODE].RMOBJECTTAIL);
IF OBJ = NIL
THEN BEGIN GOODSPL := FALSE; WRITELN(TERM, 'OBJECT NOT HERE!') END
END (*ONOBJECT*);
END (*CASE*);
IF ROOM[USER ^.RMCODE].SAFE
THEN
IF NOT (SPELLCODE IN [1, 2, 6, 13]) THEN
BEGIN
GOODSPL := FALSE;
WRITELN(TERM, 'SUCH MAGIC DOES NOT WORK HERE. SPELL FAILS.')
END (*IF*);
IF (MONSTER <> NIL) AND (PLAYER <> NIL) THEN PLAYER := NIL;
IF MONSTER <> NIL THEN
IF MONSTER ^.ANTIMAGIC THEN
BEGIN GOODSPL := FALSE; WRITELN(TERM, 'YOUR SPELL HAS NO EFFECT ON IT!')
END (*IF*);
GOODSPL := GOODSPL AND READYCHECK(USER ^.LASTATK); MPNEEDED := SPLMP;
LVLNEEDED := SPLLVL; INNEEDED := SPLINT;
IF MAGTYPE = SCRL THEN
BEGIN
MPNEEDED := 0; LVLNEEDED := SPLLVL - 3 - RND(4); INNEEDED := INNEEDED - 3;
END (*IF*);
IF MAGTYPE = DEVICE
THEN BEGIN MPNEEDED := 0; LVLNEEDED := - 10; INNEEDED := 0 END;
IF MAGTYPE = CHANT
THEN
BEGIN
IF (USER ^.CLASS <> MAGICUSER) AND (SPELLCODE IN [7, 10, 12, 14])
THEN
BEGIN
GOODSPL := FALSE; WRITELN(TERM, 'ONLY MAGIC-USERS CAN CAST THAT SPELL!')
END (*IF*);
IF (USER ^.CLASS <> CLERIC) AND (SPELLCODE IN [2, 13]) THEN
BEGIN
GOODSPL := FALSE; WRITELN(TERM, 'ONLY CLERICS CAN CAST THAT SPELL!')
END (*IF*);
IF NOT (USER ^.CLASS IN [CLERIC, MAGICUSER]) AND (SPELLCODE = 1)
THEN
BEGIN
GOODSPL := FALSE;
WRITELN(TERM, 'ONLY MAGIC USERS AND CLERICS MAY CAST VIGOR SPELLS!')
END (*IF*);
END (*IF*);
IF GOODSPL AND (MAGTYPE = CHANT) THEN
IF SPELLCODE IN [7, 9, 10, 12, 13, 15, 16] THEN GOODSPL := NOT SPELLIMIT;
IF GOODSPL
THEN
IF SPELLCOST(USER, MPNEEDED, LVLNEEDED, INNEEDED)
THEN
BEGIN
IF MAGTYPE <> DEVICE
THEN WRITELN(TERM, 'YOU CAST A ', PS(SPELLIST[SPELLCODE]), ' SPELL!')
ELSE WRITELN(TERM, 'OK');
IF PLAYER <> USER
THEN
FOR ILOOP := 1 TO MSGTERM(TERMLIST, LOCAL) DO
BEGIN
WRITE(TERMLIST[ILOOP], PS(USER ^.NAME), ' CASTS A ', PS(SPELLIST[
SPELLCODE]), ' SPELL ON ');
IF MONSTER <> NIL THEN WRITELN(PM(MONSTER), '!')
ELSE
IF OBJ <> NIL THEN BEGIN PRINTOBJ(OBJ ^, TRUE); WRITELN('!') END
ELSE
IF PLAYER ^.TRM <> TERMLIST[ILOOP]
THEN WRITELN(PS(PLAYER ^.NAME), '!')
ELSE WRITELN('YOU!');
END (*FOR*);
DAMAGE := SPELLCASE(SPELLCODE, USER ^.LVL, USER ^.INT, PLAYER, MONSTER, OBJ
, TARGET);
IF SPELLCODE IN [3, 4, 5, 7]
THEN
BEGIN
USER ^.LASTATK := REALTIME + MAX(5, SPLMP DIV 2 - USER ^.LVL);
USER ^.DEFPLAYER := NIL; USER ^.DEFMON := NIL;
IF PLAYER <> NIL
THEN
BEGIN USER ^.DEFPLAYER := PLAYER; PLAYER ^.HITATTIME := REALTIME END
ELSE
IF MONSTER <> NIL THEN USER ^.DEFMON := MONSTER
ELSE ABORT(' MIL106 - NO SPELL TARGET!');
IF DAMAGE = 0
THEN
BEGIN
WRITELN(TERM, 'IT MISSED!');
IF PLAYER <> NIL THEN WRITELN(PLAYER ^.TRM, 'IT MISSED!')
END (*IF*)
ELSE
IF PLAYER <> NIL THEN HITPLAYER(DAMAGE)
ELSE
IF MONSTER ^.ASSISTANCE THEN PROTECTNPC(USER, MONSTER)
ELSE
BEGIN
IF MONSTER ^.DEFEND AND (MONSTER ^.DEFPLAYER = NIL)
OR MONSTER^.ATKLASTAGGR AND (MONSTER^.DEFPLAYER <> USER)
THEN BEGIN MONSTER ^.DEFPLAYER := USER;
IF MONSTER^.MREACT >= 5 THEN MONSTER^.MREACT := 0 END;
HITMONSTER(DAMAGE);
END (*ELSE*)
END (*IF*);
END (*IF*)
END (*WITH*)
END (*SPELL*);
PROCEDURE MISCMD(CMDCODE: INTEGER; WORD: ALFA; NUM: INTEGER);
VAR
FOBJ, TOBJ, OBJ: OBJECTPOINT;
WORD3, WORD4: ALFA;
TPLYR: USERPOINT;
NUM2, COST: INTEGER;
BEGIN
WITH USER ^ DO
CASE CMDCODE OF
57:
IF W(RMCODE) = 10 THEN WRITELN(TERM, '"I DONT HAVE SUCH SKILLS, SORRY!"')
ELSE
IF W(RMCODE) <> 18 THEN WRITELN(TERM, 'FIND A SMITH FIRST!')
ELSE
BEGIN
OBJ := FINDOBJECT(WORD, NUM, OBJECTTAIL);
IF OBJ = NIL THEN WRITELN(TERM, 'OBJECT NOT FOUND.')
ELSE
IF NOT (OBJ ^.OBCLASS IN [WEAP, ARMOR, SHIELD])
THEN WRITELN(TERM, '"I DON''T KNOW HOW TO REPAIR THAT!"')
ELSE
BEGIN
DATA := TRUNC(OBJ ^.PRICE * 0.60) + RND(5);
IF OBJ ^.MAGIC THEN
BEGIN
DATA := DATA * 2;
WRITELN(TERM, '"VERY WELL! BUT IT MAY LOSE ITS MAGICAL DWEOMER!"')
END (*IF*);
IF OBJ^.OBCLASS = WEAP THEN IF OBJ^.MAXHP + OBJ^.MINHP > 30 THEN
WRITELN(TERM,'"I''M NOT SURE IF I CAN REPAIR SUCH A GREAT WEAPON!"');
WRITE(TERM, '"HMM, REPAIRING '); PRINTOBJ(OBJ ^, FALSE);
WRITELN(' WILL COST YOU ', DATA: 0, ' SHILLINGS. DO YOU ACCEPT?"');
ENTRY := XREPAIR; USWEAP := OBJ
END (*ELSE*);
END (*ELSE*);
58:
BEGIN
NUM := 1;
WHILE NUM <= 10 DO
IF NOT (WORD[NUM] IN ['A' .. 'Z', ' '])
THEN
BEGIN
FOR NUM2 := NUM + 1 TO 10 DO WORD[NUM2 - 1] := WORD[NUM2];
WORD[10] := ' '
END (*IF*)
ELSE NUM := NUM + 1;
IF WORD = BLANKS THEN WRITELN(TERM, 'MISSING OR BAD CHARS IN NAME.')
ELSE
IF (SEARCHPLINDEX(WORD) > 0) OR (FINDUSER(WORD, USERTAIL) <> NIL)
THEN WRITELN(TERM, 'NAME ALREADY IN USE ELSEWHERE.')
ELSE
BEGIN
NUM := SEARCHPLINDEX(NAME); IF NUM > 0 THEN PLAYERINDEX[NUM] := WORD;
FOR ILOOP := 1 TO MSGTERM(TERMLIST, LOCAL) DO
WRITELN(TERMLIST[ILOOP], PS(NAME), ' JUST CHANGED HIS NAME TO ', PS(WORD)
, '.');
NAME := WORD; WRITELN(TERM, 'NAME CHANGE COMPLETE.');
WRITELN(TERM, 'BE SURE TO "SAVE" YOUR CHARACTER TO RECORD THE CHANGE.')
END (*ELSE*);
END (*58*);
59:
BEGIN
GETWORD(WORD3, NUM, BUFFER, LENBUF, LOC);
IF (WORD3 = BLANKS) OR (NUM <> 0)
THEN WRITELN(TERM, 'MISSING OR BAD CHARS IN NEW PASSWORD.')
ELSE
IF HASH(WORD,10) <> PW THEN WRITELN(TERM, 'WRONG PASSWORD, SORRY.')
ELSE
BEGIN
PW := HASH(WORD3,10); WRITELN(TERM, 'PW CHANGE COMPLETE.');
WRITELN(TERM, 'BE SURE TO "SAVE" YOUR CHARACTER TO RECORD THE CHANGE.')
END (*ELSE*)
END (*59*);
60:
IF TRADETIME >= REALTIME
THEN
WRITELN(TERM, 'TRADE ALREADY IN PROGRESS. TRY AGAIN IN ', TRADETIME -
REALTIME: 0, ' SECONDS.')
ELSE
IF LOC > LENBUF
THEN
WRITELN(TERM,
'FORMAT IS: OFFER <WHO> <YOUR ITEM/CASH> FOR <THEIR ITEM/CASH>')
ELSE
BEGIN
GETWORD(WORD3, NUM, BUFFER, LENBUF, LOC);
GETWORD(WORD4, NUM2, BUFFER, LENBUF, LOC);
TPLYR := FINDPLAYER(WORD, ROOM[RMCODE].RMPLAYERTAIL);
IF TPLYR = NIL THEN WRITELN(TERM, 'PLAYER IS NOT HERE!')
ELSE
BEGIN
FOBJ := FINDOBJECT(WORD3, NUM, OBJECTTAIL);
IF (FOBJ = NIL) AND (WORD3 <> BLANKS)
THEN WRITELN(TERM, 'YOU DONT HAVE THAT!')
ELSE
BEGIN
TOBJ := FINDOBJECT(WORD4, NUM2, TPLYR ^.OBJECTTAIL);
IF (TOBJ = NIL) AND (WORD4 <> BLANKS)
THEN WRITELN(TERM, 'TRANSACTION CANCELLED.')
ELSE
BEGIN
WRITELN(TERM, 'OFFER SENT TO ', PS(TPLYR ^.NAME), '.');
FCASH := MAX(0, NUM); TCASH := MAX(0, NUM2);
TRADETIME := REALTIME + 20; NFPLYR := NAME; NTPLYR := TPLYR ^.NAME;
IF FOBJ <> NIL THEN SFOBJ := FOBJ ^.NAME; NFOBJ := WORD3;
IF TOBJ <> NIL THEN STOBJ := TOBJ ^.NAME; NTOBJ := WORD4;
WRITE(TPLYR ^.TRM, PS(NAME), ' OFFERS YOU ');
IF FOBJ <> NIL THEN PRINTOBJ(FOBJ ^, FALSE)
ELSE WRITE(FCASH: 0, ' SHILLINGS');
IF TOBJ <> NIL
THEN BEGIN WRITE(' FOR '); PRINTOBJ(TOBJ ^, TRUE) END
ELSE IF TCASH <> 0 THEN WRITE(' FOR ', TCASH: 0, ' SHILLINGS');
WRITELN('.');
WRITELN(TPLYR ^.TRM, 'ENTER "ACCEPT" TO ACCEPT THE OFFER.');
END (*ELSE*)
END (*ELSE*)
END (*ELSE*)
END (*ELSE*)
END (*CASE*)
END (*MISCMDS*);
PROCEDURE ACCEPT;
(* ACCEPT AN OFFER TO TRADE *)
VAR
FPLYR: USERPOINT;
FOBJ, TOBJ: OBJECTPOINT;
OKTRADE: BOOLEAN;
BEGIN
OKTRADE := TRUE;
IF (TRADETIME < REALTIME) OR (NTPLYR <> USER ^.NAME)
THEN WRITELN(TERM, 'NOTHING TO ACCEPT.')
ELSE
WITH USER ^ DO
BEGIN
FPLYR := FINDPLAYER(NFPLYR, ROOM[RMCODE].RMPLAYERTAIL);
IF FPLYR = NIL THEN WRITELN(TERM, 'TRANSACTION CANCELLED.')
ELSE
BEGIN
FOBJ := FINDOBJECT(NFOBJ, FCASH, FPLYR ^.OBJECTTAIL);
TOBJ := FINDOBJECT(NTOBJ, TCASH, OBJECTTAIL);
IF (FOBJ = NIL) AND (NFOBJ <> BLANKS) OR (TOBJ = NIL) AND (NTOBJ <> BLANKS)
THEN WRITELN(TERM, 'TRANSACTION CANCELLED.')
ELSE
BEGIN
IF FOBJ <> NIL THEN
OKTRADE := (FOBJ ^.NAME = SFOBJ) AND (FOBJ ^.WEIGHT + WEIGHT <= STR * 10)
;
IF TOBJ <> NIL THEN
OKTRADE := OKTRADE AND (TOBJ ^.NAME = STOBJ) AND (TOBJ ^.WEIGHT + FPLYR ^
.WEIGHT <= FPLYR ^.STR * 10);
OKTRADE := OKTRADE AND (FCASH <= FPLYR ^.MONEY) AND (TCASH <= MONEY);
IF NOT OKTRADE THEN WRITELN(TERM, 'TRANSACTION CANCELLED.')
ELSE
BEGIN
IF FOBJ <> NIL
THEN
BEGIN
STOPUSING(FPLYR, FOBJ);
IF DELETEOBJECT(FOBJ, FPLYR ^.OBJECTTAIL)
THEN FPLYR ^.OBJECTTAIL := FPLYR ^.OBJECTTAIL ^.NEXT;
FPLYR ^.WEIGHT := MAX(0, FPLYR ^.WEIGHT - FOBJ ^.WEIGHT);
FOBJ ^.NEXT := OBJECTTAIL; OBJECTTAIL := FOBJ;
WEIGHT := MIN(5000, WEIGHT + FOBJ ^.WEIGHT);
END (*IF*)
ELSE
BEGIN
FPLYR ^.MONEY := FPLYR ^.MONEY - FCASH;
MONEY := MIN(500000, MONEY + FCASH)
END (*ELSE*);
IF TOBJ <> NIL
THEN
BEGIN
STOPUSING(USER, TOBJ);
IF DELETEOBJECT(TOBJ, OBJECTTAIL)
THEN OBJECTTAIL := OBJECTTAIL ^.NEXT;
WEIGHT := MAX(0, WEIGHT - TOBJ ^.WEIGHT);
TOBJ ^.NEXT := FPLYR ^.OBJECTTAIL; FPLYR ^.OBJECTTAIL := TOBJ;
FPLYR ^.WEIGHT := MIN(5000, FPLYR ^.WEIGHT + TOBJ ^.WEIGHT);
END (*IF*)
ELSE
BEGIN
MONEY := MONEY - TCASH;
FPLYR ^.MONEY := MIN(500000, FPLYR ^.MONEY + TCASH)
END (*ELSE*);
WRITELN(TERM, 'OK, YOU TRADE WITH ', PRO[FPLYR ^.SEX], '.');
WRITELN(FPLYR ^.TRM, PS(NAME),
' ACCEPTS YOUR OFFER AND TRADES WITH YOU.');
TRADETIME := 0;
END (*ELSE*)
END (*ELSE*)
END (*ELSE*)
END (*WITH*);
END (*ACCEPT*);
PROCEDURE TURN(WORD: ALFA; NUM: INTEGER);
(* TURN AWAY UNDEAD MONSTERS *)
VAR
DUMMY: ALFA;
MON: MONSTERPOINT;
FACTOR: INTEGER;
TURNED: BOOLEAN;
BEGIN
IF NUM = 0 THEN GETWORD(DUMMY, NUM, BUFFER, LENBUF, LOC);
MON := FINDMONSTER(WORD, NUM, ROOM[USER ^.RMCODE].RMMONSTERTAIL);
IF MON = NIL THEN WRITELN(TERM, 'MONSTER NOT FOUND HERE.')
ELSE
IF NOT MON ^.UNDEAD THEN WRITELN(TERM, PM(MON), 'IS NOT UNDEAD!')
ELSE
WITH USER ^ DO
IF NOT (CLASS IN [CLERIC, PALADIN, DM])
THEN WRITELN(TERM, 'YOU CAN''T TURN AWAY THE UNDEAD!')
ELSE
IF READYCHECK(LASTATK)
THEN
BEGIN
USER^.HIDDEN := FALSE;
TURNED := FALSE; FACTOR := LVL - MON ^.LVL + 2; LASTATK := REALTIME + 30;
IF CLASS = PALADIN THEN FACTOR := FACTOR - 2; FACTOR := FACTOR - RND(5);
USER ^.DEFMON := MON;
MON^.DEFPLAYER := USER; MON^.MREACT := 6;
IF RND(3)=1 THEN FACTOR := -1 (*FAIL 1/3RD OF TIME*);
IF FACTOR < 0 THEN WRITELN(TERM, PM(MON), 'IGNORES YOUR COMMAND!')
ELSE
IF FACTOR <= 3
THEN
BEGIN
TURNED := TRUE; MON ^.EXPERIENCE := MON ^.EXPERIENCE DIV 2;
WRITELN(TERM, PM(MON), ' FLEES AT YOUR COMMAND!');
END (*IF*)
ELSE
BEGIN
TURNED := TRUE; WRITELN(TERM, PM(MON), 'COLLAPSES AND TURNS TO DUST!');
MAKETREASURE(MON, RMCODE)
END (*ELSE*);
FOR ILOOP := 1 TO MSGTERM(TERMLIST, LOCAL) DO
BEGIN
WRITE(TERMLIST[ILOOP], PS(NAME));
IF TURNED
THEN
IF FACTOR <= 3 THEN WRITE(' TURNS AWAY ')
ELSE WRITE(' DAMNS AND DESTROYS ')
ELSE WRITE(' FAILS TO TURN AWAY ');
WRITELN(PM(MON), '!')
END (*FOR*);
IF TURNED THEN
BEGIN
SHAREEXPERIENCE(MON, RMCODE); DELETEMONSTER(MON, RMCODE); DESTROY(MON)
END (*IF*)
END (*IF*)
END (*TURN*);
PROCEDURE DEAD;
(* *DEAD* HANDLES UNEXPECTED DEATH (ZERO H.P.) OF A USER *)
VAR
ILOOP: INTEGER;
RM: RMCODETYPE;
OBJ2, OBJ, BODY: OBJECTPOINT;
BEGIN
ERRLOC := 'DEAD '; RM := USER ^.RMCODE;
OBJ := USER ^.OBJECTTAIL (* DROP ALL OBJECTS *); USER ^.OBJECTTAIL := NIL;
(* NOW PLACE THE DEAD BODY AND THE OBJECTS IN THE ROOM *)
NEW(BODY) (*CREATE DEAD BODY*); BODY ^ := DEADBODY;
ILOOP := 1;
REPEAT
BODY^.NAME[ILOOP+5] := USER^.NAME[ILOOP];
ILOOP := ILOOP + 1;
UNTIL (ILOOP = 10) OR (USER^.NAME[ILOOP] = ' ');
ILOOP := ILOOP + 5;
BODY^.NAME[ILOOP] := '''';
BODY^.NAME[ILOOP + 1] := 'S';
BODY^.NAME[ILOOP + 2] := ' ';
BODY^.NAME[ILOOP + 3] := '*';
USER ^.WEIGHT := 0; USER ^.AC := 10;
IF USER ^.CON * 5 >= RND(100)
THEN
WITH USER ^ DO
BEGIN (*RESURRECTION*)
USARM := NIL; USSHIELD := NIL; USWEAP := NIL; WRITELN(TERM);
ENTRY := XCMD; STATUS := SNORMAL;
IF NOTIMEOUT(USER)
THEN
BEGIN
WRITELN(TERM, 'EVERYTHING GOES DARK... YOU FEEL YOURSELF FLOATING AWAY INTO'
);
WRITELN(TERM, 'SPACE. AFTER WHAT SEEMS LIKE AN ETERNITY, YOU FAINTLY HEAR')
;
WRITELN(TERM, 'VOICES! AS YOU COME TO YOUR SENSES, YOU FIND.....');
END (*IF*);
WRITELN(TERM); WRITELN(TERM); PLACEPLAYER(USER, 17) (*INFIRMARY*);
POISONED := FALSE; CON := MAX(3, CON - 1); HITS := MAXHITS; FATIGUE := 5;
IF LVL > 2
THEN
BEGIN
STATUS := SNORMAL; MAXHITS := MAX(3, MAXHITS - MAXHITS DIV LVL);
MAXMAGIC := MAX(3, MAXMAGIC - MAXMAGIC DIV LVL);
MAXFATIGUE := MAX(3, MAXFATIGUE - MAXFATIGUE DIV LVL); MAGIC := MAXMAGIC;
LVL := LVL - 1; HITS := MAXHITS; FATIGUE := 10;
CASE RND(4) OF
1: STR := MAX(3, STR - 1);
2: INT := MAX(3, INT - 1);
3: DEX := MAX(3, DEX - 1);
4: CON := MAX(3, CON - 1);
END (*CASE*);
END (*IF*);
ROOMDISPLAY(RMCODE, BRIEF); MONEY := MAX(3, PTY) * 10; EXPERIENCE := 0;
WRITELN(TERM, 'THE ACOLYTE GIVES YOU A SMALL BAG OF MONEY AND BIDS YOU GO');
WRITELN(TERM, 'ON YOUR WAY.');
DEAD := FALSE;
WRITELN(TERM); SAVECHAR;
PROMPTUSER(USER)
END (*WITH*)
ELSE
BEGIN
IF USER ^.LVL >= 5 THEN DAYMSG('ERA', USER, 'CON FAILED', USER ^.CON + 1);
WRITE(TERM); PRINTDESC(1, 2, 0, FALSE); WRITELN;
(* ISSUE A "YOU'RE DEAD!" MESSAGE. *)
USER^.DEAD := FALSE;
KILL; WRITECONTROL(MTLO, ZEROPARM, TERM); WRITELN (*LOGOFF*); USER := NIL;
END (*ELSE*);
BODY ^.NEXT := ROOM[RM].RMOBJECTTAIL; ROOM[RM].RMOBJECTTAIL := BODY;
OBJ2 := OBJ;
IF OBJ <> NIL THEN
BEGIN
WHILE OBJ2 ^.NEXT <> NIL DO OBJ2 := OBJ2 ^.NEXT; OBJ2 ^.NEXT := BODY ^.NEXT;
BODY ^.NEXT := OBJ;
END (* OBJECTS DROPPED *);
END (*DEAD*);
PROCEDURE WHYDIE;
VAR
ILOOP, INDX: INTEGER;
BEGIN
USER ^.STATUS := SLOGIN; DELETEPLAYER(USER, USER ^.RMCODE);
IF (MIN(MIN(TLVL[1], TLVL[2]), TLVL[3]) < USER ^.LVL) AND NOTIMEOUT(USER)
THEN
BEGIN
INDX := 3;
FOR ILOOP := 3 DOWNTO 1 DO IF TLVL[ILOOP] < TLVL[INDX] THEN INDX := ILOOP;
USER ^.ENTRY := XDEAD; TLVL[INDX] := USER ^.LVL; TNAME[INDX] := USER ^.NAME;
TCLASS[INDX] := CNAME[USER ^.CLASS]; PROMPTUSER(USER)
END (*IF*)
ELSE DEAD
END (*WHYDIE*);
PROCEDURE ENTERWHYDIE;
(* READ IN LINE EXPLAINING WHY CHARACTER DIED *)
VAR
ILOOP, JLOOP: INTEGER;
FOUND: BOOLEAN;
BEGIN
ILOOP := 0; FOUND := FALSE;
WHILE NOT FOUND AND (ILOOP < 3) DO
BEGIN
ILOOP := ILOOP + 1;
FOUND := ((TNAME[ILOOP] = USER ^.NAME) AND (TLVL[ILOOP] = USER ^.LVL));
END (*WHILE*);
IF NOT FOUND THEN WRITELN(TERM, 'ON SECOND THOUGHT, FORGET IT!')
ELSE
BEGIN
FOR JLOOP := 1 TO MIN(LENBUF, 78) DO TBUF[ILOOP, JLOOP] := BUFFER[JLOOP];
FOR JLOOP := LENBUF + 1 TO 80 DO TBUF[ILOOP, JLOOP] := COL;
END (*ELSE*);
DEAD
END (*ENTERWHYDIE*);
PROCEDURE MINORCMDS(USER: USERPOINT; CMDCODE: INTEGER);
BEGIN
WITH USER ^ DO
CASE CMDCODE OF
18:
BEGIN
TASKCLOSED := 'C'; WRITELN(TERM, 'MILIEU CLOSED.');
DAYMSG('CLO', USER, BLANKS, 0)
END (*18*);
19:
BEGIN
TASKCLOSED := 'O'; WRITELN(TERM, 'MILIEU OPENED.');
DAYMSG('OPE', USER, BLANKS, 0)
END (*19*);
51:
BEGIN
TASKCLOSED := 'T'; WRITELN(TERM, 'MILIEU OPEN FOR TESTING ONLY.');
DAYMSG('TST', USER, BLANKS, 0);
END (*51*);
20:
BEGIN
WRITELN(TERM, ABSOLUTEPLMAX: 0, ' USERS (CAPACITY)');
WRITELN(TERM, CURRENTPLINDEX: 0, ' USERS (STORED)');
WRITELN(TERM, NUMQUEUED: 0, ' USERS (IN WAITING QUEUE)');
WRITELN(TERM, MAXUSERS: 0, ' USERS (MAX ONLINE)');
WRITELN(TERM, NUSERS: 0, ' USERS (ACTIVE)');
END (*20*);
21:
BEGIN
DAYMSG('ABT', USER, BLANKS, 0); UPDATE; OFF; FLUSH(OUTPUT);
ABORT(' MIL00 - DM TOOK TASK DOWN.');
END (*21*);
26:
BEGIN
ETIME(WORD); WRITE(TERM, WORD, ' '); EDATE(WORD); WRITELN(WORD);
WRITELN(TERM, REALTIME: 0, ' SECONDS SINCE DEADSTART OF SYSTEM.');
WRITELN(TERM, CLOCK: 0, ' MILLISECONDS USED SINCE PROGRAM INITIALIZATION.');
WRITELN(TERM, 'A RANDOM MONSTER CHECK OCCURS EVERY ', MSPEED: 0, ' SECONDS.')
;
END (*26*);
27:
BEGIN ERRFLAG := 0; ABORT(' MIL01 - DM TOOK TASK DOWN. (UPDATE INHIBITED.)')
END (*27*);
28:
BEGIN (*HELP*)
RESET(EDESC); GETSEG(EDESC);
WHILE NOT EOS(EDESC) DO
BEGIN
WRITE(TERM);
WHILE NOT EOLN(EDESC) DO BEGIN READ(EDESC, CH); WRITE(CH) END;
READLN(EDESC); WRITELN
END (*WHILE*);
CURRENTREC := 0 (*FLAG FILE MIXED UP*); WRITELN(TERM);
WRITELN(TERM, 'LIST OF ALL COMMANDS:'); WRITE(TERM);
FOR ILOOP := 1 TO CMDLISTLEN DO
BEGIN
IF ILOOP MOD 5 = 1 THEN BEGIN WRITELN; WRITE(TERM) END;
WRITE(' ', CMDLIST[ILOOP])
END (*FOR*);
WRITELN;
END (*28*);
30:
BEGIN
INVISIBLE := NOT INVISIBLE; NONEXISTANT := FALSE;
IF INVISIBLE THEN WRITELN(TERM, 'YOU ARE NOW INVISIBLE.')
ELSE WRITELN(TERM, 'YOU ARE NOW VISIBLE.')
END (*30*);
34:
BEGIN
ECHO := NOT ECHO;
IF ECHO THEN WRITELN(TERM, 'ECHO MODE ON.')
ELSE WRITELN(TERM, 'ECHO MODE OFF.')
END (*34*);
83:
BEGIN
NONEXISTANT := NOT NONEXISTANT;
IF NONEXISTANT
THEN
BEGIN
INVISIBLE := TRUE;
WRITELN(TERM, 'YOU NO LONGER EXIST TO THE OUTSIDE WORLD.')
END (*IF*)
ELSE BEGIN INVISIBLE := FALSE; WRITELN(TERM, 'YOU NOW EXIST.') END
END (*83*);
OTHERWISE
ABORT(' MIL133 - CASE EXPRESSION OUT OF RANGE!');
END (*CASE*);
END (*MINORCMDS*);
BEGIN (*DOCMD*)
ERRLOC := 'DOCMD ';
IF USER ^.ENTRY = XDEAD THEN ENTERWHYDIE
ELSE
IF (USER ^.HITS > 0) AND NOT USER^.DEAD
THEN (* NOT DEAD *)
BEGIN
IF REALTIME > LASTUPDATE + UPDATEPERIOD
THEN
IF (NUSERS > 0) AND (USER ^.STATUS <> SLOGIN) THEN
BEGIN
UPDATE (* UPDATE THE DATA FILES *); FLUSH(OUTPUT); LASTUPDATE := REALTIME;
FLUSH(OUTPUT);
END (*IF*);
WITH USER ^ DO
IF ENTRY = XSPELL THEN SPELL(0)
ELSE
IF ENTRY = XSURE THEN QUIT(DATA)
ELSE
BEGIN
IF REALTIME >= LASTHEAL + HEALWAIT
THEN
IF POISONED
THEN
BEGIN
LASTHEAL := REALTIME;
WRITELN(TERM, 'YOU FEEL THE POISON COARSING THROUGH YOUR VEINS!');
HITS := MAX(0, HITS - RND(2) * LVL);
IF (HITS = 0) OR DEAD
THEN
BEGIN
IF LVL > 5 THEN DAYMSG('POI', USER, BLANKS, 0);
FOR ILOOP := 1 TO MSGTERM(TERMLIST, ALL) DO
WRITELN(TERMLIST[ILOOP], '### ', PS(NAME), ', THE ', PS(CNAME[CLASS])
, ', FINALLY DIED FROM HIS POISONOUS WOUNDS.');
END (*IF*)
END (*IF*)
ELSE
BEGIN (*HEAL *LVL* HP/MP*)
LASTHEAL := REALTIME;
IF REALTIME - HITATTIME >= 90 THEN FATIGUE := MAXFATIGUE
ELSE FATIGUE := MIN(MAXFATIGUE, FATIGUE + LVL);
MAGIC := MIN(MAXMAGIC, MAGIC + MIN(LVL, 5));
(* HEAL VITALITY *)
HITS := MIN(MAXHITS, HITS + LVL DIV 2 + 1);
END (*IF*);
LOC := 1 (* RESET GETWORD POINTER *);
GETWORD(CMD, NUM, BUFFER, LENBUF, LOC) (* GET WORD FROM BUFFER *);
IF CMD <> BLANKS THEN CMDCODE := BINARYMATCH(CMD, CMDLISTLEN, CMDLIST)
ELSE CMDCODE := - 1 (* EMPTY C/R *);
IF (CMD[1] = '*') AND NOT SSJ THEN CMDCODE := - 2 (* ILLEGAL ACCESS! *);
IF CMDCODE > 0
THEN
BEGIN
USER ^.LASTCMD := CMDLIST[CMDCODE]; CMDCODE := CMDNUM[CMDCODE];
(* SPECIFY WHICH *CASE* LABEL TO JUMP TO. CMDCODE = -1 IF NOT
UNIQUE, = 0 IF NOT FOUND. *)
GETWORD(WORD, NUM, BUFFER, LENBUF, LOC) (* FETCH 2ND CMD WORD *);
END (*IF*)
ELSE USER ^.LASTCMD := BLANKS;
IF USER ^.ASSOC AND (CMDCODE IN [18, 19, 51, 27, 54]) THEN CMDCODE := - 3;
CASE CMDCODE OF (* *USER* IS AN IMPLIED PARAMETER IN ALL CMDS *)
- 3: WRITELN(TERM, 'SORRY, ASSOCIATE DM''S MAY NOT USE THAT COMMAND.');
- 2: WRITELN(TERM, 'SORRY.. THAT''S FOR DM USE ONLY!');
- 1: (* NOT UNIQUE. WORDMATCH ALREADY SENT AN ERROR MSG *);
0: WRITELN(TERM, 'I DON''T UNDERSTAND.');
18, 19, 51, 20, 26, 27, 28, 30, 34, 83: MINORCMDS(USER, CMDCODE);
1, 2, 3, 4, 5, 6, 7, 9:
BEGIN FOLCOUNT := 0; GODIRECTION(WORD, NUM, CMDCODE); END;
63: GETOBJECT(WORD, NUM, RMCODE);
8: DROPOBJECT(WORD, NUM, RMCODE);
10: BEGIN NUM := USEOBJECT(WORD, NUM); IF NUM <> 0 THEN SPELL(NUM) END;
85, 86, 72, 42, 43, 11: ATTACK(CMDCODE, WORD, RMCODE);
82, 36, 37, 38, 12, 13, 14:
IF (CMDCODE = 82) AND NOT USER ^.MASTER
THEN WRITELN(TERM, 'ONLY MASTER DM''S CAN LOGOFF PLAYERS.')
ELSE TALK(LENBUF, CMDCODE, WORD);
16: ENTRY := XEDIT;
39, 17: BEGIN DATA := CMDCODE; ENTRY := XSURE END;
21:
BEGIN
DAYMSG('ABT', USER, BLANKS, 0); UPDATE; OFF; FLUSH(OUTPUT);
ABORT(' MIL00 - DM TOOK TASK DOWN.');
END (*21*);
22: PLAYERDISPLAY(USER);
23:
BEGIN
UPDATE; LASTUPDATE := REALTIME; WRITELN(TERM, 'FILES UPDATED.');
FLUSH(OUTPUT);
END (*23*);
64, 24, 31:
IF WORD = BLANKS THEN ROOMDISPLAY(RMCODE, FALSE)
ELSE
BEGIN NUM := LOOK(WORD, NUM, CMDCODE); IF NUM > 0 THEN SPELL(NUM) END;
25: BRIEF := NOT BRIEF;
29: RETURNOBJ(WORD, NUM);
33: GETSTATUS(WORD, USER);
32: WRITELN(TERM, 'WHEN IN DOUBT, PANIC.');
40: SAVECHAR;
41: INVENTORY;
35: USERS;
44: ENTERSPELL(WORD, NUM);
45: APPEAL;
46: BUY(WORD, NUM, RMCODE);
47: ENTRY := XNOTICE;
48: CATALOG;
49: PAWN(WORD, NUM);
50:
IF (NUM < 1) OR (NUM > 3) THEN WRITELN(TERM, 'MUST BE 1 TO 3')
ELSE
BEGIN
DAYMSG('PUR', USER, 'DEATH NEWS', 0); YLVL[NUM] := 0;
WRITELN(TERM, 'DEATH ENTRY DELETED.')
END (*ELSE*);
52: ENTRY := XNEWS;
53:
IF (NUM < 1) OR (NUM > 5) THEN WRITELN(TERM, 'MUST BE 1 TO 5')
ELSE BEGIN NEWSBUF[NUM, 1] := COL; WRITELN(TERM, 'NEWS DELETED.') END;
54:
BEGIN
MSPEED := MAX(1, MIN(NUM, 10));
DAYMSG('SPD', USER, 'MONSPEED ', MSPEED)
END (*54*);
55: FOLLOWPLYR(WORD);
56: LOSE(WORD);
57, 58, 59, 60: MISCMD(CMDCODE, WORD, NUM);
61: ACCEPT;
62: TURN(WORD, NUM);
65, 66, 67, 68, 69, 70: OPENCLOSE(CMDCODE, WORD, NUM);
71: TRACK;
73: HIDE(WORD, NUM);
74: SEARCH;
75: TRAIN;
76:
BEGIN
MESBLOCK := NOT MESBLOCK;
IF MESBLOCK THEN WRITELN(TERM, 'SEND MESSAGES BLOCKED.')
ELSE WRITELN(TERM, 'SEND MESSAGES RECEIVED.')
END (*76*);
77: PRINTBREG;
78: RUN;
79: PRINTEXP;
80: DISPDAY(NUM);
81: PARLEY(WORD, NUM);
84: STEALOBJ(WORD, NUM);
87: AUTO := TRUE;
OTHERWISE
ABORT(' MIL153 - CASE LABEL UNDEFINED!');
END (*CASE*)
END (*WITH*);
IF USER <> NIL THEN
IF (USER^.HITS = 0) OR USER^.DEAD THEN WHYDIE
ELSE IF NOT USER ^.AUTO THEN PROMPTUSER(USER) (* ISSUE THE "CMD-?" PROMPT *)
END (*IF*)
ELSE WHYDIE (*OOPS, SORRY*)
END (*DOCMD*);
PROCEDURE MONSTERATTACK;
VAR
PLYR: USERPOINT;
TEMPFAT: INTEGER;
PROCEDURE MONSTRIKE(RM: RMCODETYPE);
VAR
PLYRSWODM, NUMSP, ACLASS, NUMPLYRS, MONNUM, ILOOP, NUMMONS, DAMAGE: INTEGER;
PLYR: USERPOINT;
MONSTER: MONSTERPOINT;
ATKFLAG: BOOLEAN;
ESPEED, SPEED: INTEGER;
BEGIN (*MONSTRIKE*)
SPEED := MSPEED; ESPEED := 10; ERRLOC := 'MONSTRIKE ';
IF NUSERS = 1 THEN BEGIN SPEED := 1; ESPEED := 40 END;
WITH ROOM[RM] DO
BEGIN
PLYRSWODM := 0; NUMPLYRS := 0; PLYR := RMPLAYERTAIL;
IF RMMONSTERTAIL <> NIL
THEN IF NOT RMMONSTERTTAIL ^.PERMANENT THEN ESPEED := ESPEED DIV 5;
WHILE PLYR <> NIL DO
BEGIN
IF NOT PLYR ^.INVISIBLE THEN PLYRSWODM := PLYRSWODM + 1;
NUMPLYRS := NUMPLYRS + 1; PLYR := PLYR ^.NEXT
END (*WHILE*);
IF (ENCOUNTERTIME > 0) AND (WHICHENCOUNTER > 0)
THEN (*CHECK FOR ENCOUNTER*)
IF RND((ENCOUNTERTIME * 25) DIV ESPEED) <= 3
THEN
BEGIN (*RND ENCOUNTER*)
ILOOP := 1;
WHILE (ENCOUNTERINDEX[WHICHENCOUNTER, MIN(ILOOP + 1, 6)] > 0) AND (ILOOP < 6
) DO
ILOOP := ILOOP + 1;
IF ENCOUNTERINDEX[WHICHENCOUNTER, 1] > 0
THEN
BEGIN
MONNUM := ENCOUNTERINDEX[WHICHENCOUNTER, RND(ILOOP)];
NUMMONS := RND(MAX(1, PLYRSWODM - 1));
IF RND(4) = 2 THEN NUMMONS := RND(MAX(1, PLYRSWODM - 1) * 2);
FOR ILOOP := 1 TO NUMMONS DO
BEGIN
NEW(MONSTER); MONSTER ^ := RANMONLIST[MONNUM];
MONSTER ^.HITS := MIN(MONSTER ^.MAXHITS, MAX(1, ROUND(MONSTER ^.HITS *
0.8 + MONSTER ^.HITS * RND(40) / 100)));
MONSTER ^.LVL := MIN(25, MAX(1, MONSTER ^.LVL + 2 - RND(3)));
INSERTMONSTER(MONSTER, RM);
END (*FOR*);
PLYR := RMPLAYERTAIL;
FOR ILOOP := 1 TO NUMPLYRS DO
BEGIN
IF NOT PLYR ^.AUTO THEN PLYR ^.ENCOUNTSTOP := TRUE;
IF NOTIMEOUT(PLYR)
THEN
BEGIN
WRITE(PLYR ^.TRM);
IF PLYRSWODM <= 1 THEN WRITE('YOU ENCOUNTER ')
ELSE WRITE('YOUR PARTY ENCOUNTERS ');
IF NUMMONS = 1 THEN WRITE('A ', PS(MONSTER ^.NAME))
ELSE WRITE(PN(NUMMONS), PS(MONSTER ^.NAME), 'S');
WRITELN('!');
END (*IF*);
PLYR := PLYR ^.NEXT
END (*FOR*);
END (*IF*)
END (*IF*);
MONSTER := RMMONSTERTTAIL;
IF NOT SAFE
THEN
WHILE MONSTER <> NIL DO
WITH MONSTER ^ DO
BEGIN
ATKFLAG := FALSE;
IF (DEFPLAYER = NIL) AND (TOP OR (NUM < 9))
THEN
IF SLOWREACT AND (RND(SPEED * 2) = 1) OR FASTREACT
THEN
BEGIN
ATKFLAG := TRUE; PLYR := RMPLAYERTAIL;
FOR ILOOP := 1 TO RND(NUMPLYRS) - 1 DO (*HIT RANDOMLY*)
PLYR := PLYR ^.NEXT;
IF NOT PLYR ^.EVIL AND NOT PLYR ^.INVISIBLE AND NOT PLYR ^.HIDDEN
THEN DEFPLAYER := PLYR
ELSE ATKFLAG := FALSE;
END (*IF*)
ELSE
IF MORALREACT AND (RND(SPEED) = 1)
THEN
BEGIN
PLYR := RMPLAYERTAIL; DEFPLAYER := PLYR;
FOR ILOOP := 1 TO NUMPLYRS DO
BEGIN
IF (PLYR ^.PTY < DEFPLAYER ^.PTY) AND (RND(3) <= 2)
THEN DEFPLAYER := PLYR;
PLYR := PLYR ^.NEXT
END (*FOR*);
IF (DEFPLAYER ^.PTY > 7) OR DEFPLAYER ^.INVISIBLE
THEN DEFPLAYER := NIL
ELSE ATKFLAG := TRUE;
END (*IF*);
USER := DEFPLAYER; IF USER <> NIL THEN TERM := USER ^.TRM; PLYR := USER;
IF ATKFLAG
THEN
BEGIN
MREACT := 0;
FOR ILOOP := 1 TO MSGTERM(TERMLIST, LOCAL) DO
WRITELN(TERMLIST[ILOOP], PM(MONSTER), 'ATTACKS ', PS(PLYR ^.NAME), '!');
WRITELN(TERM, PM(MONSTER), ' ATTACKS YOU!')
END (*IF*);
IF (DEFPLAYER <> NIL) AND (RND(SPEED) = 1) AND NOT (MREACT IN [1, 2, 3])
THEN
BEGIN
IF REGENERATE THEN HITS := MIN(MAXHITS, HITS + LVL DIV 2 + 1);
PLYR := DEFPLAYER; PLYR ^.HITATTIME := REALTIME;
ACLASS := - (PLYR ^.AC - 10);
IF (RND(19) <> 19) AND (RND(21) < 9 - LVL + PLYR ^.LVL + ACLASS + PLYR ^.
DEX DIV 6) AND (MREACT <> 6) OR (PLYR ^.HITS = 0) OR (MREACT = 4)
THEN
BEGIN
IF NOT PLYR ^.BRIEF AND NOTIMEOUT(PLYR)
THEN WRITELN(PLYR ^.TRM, PM(MONSTER), 'MISSES YOU!')
END (*IF*)
ELSE
WITH PLYR ^ DO
BEGIN
DAMAGE := MONSTER ^.LVL * 4; DAMAGE := MAX(1, DAMAGE + 3 - RND(5));
IF MONSTER ^.MONSPELLS
THEN
IF RND(3) = 2
THEN
BEGIN
CASE RND(4) OF
1: NUMSP := 3;
2: NUMSP := 4;
3: NUMSP := 8;
4: NUMSP := 16;
END (*CASE*);
USER := PLYR; TERM := PLYR ^.TRM;
FOR ILOOP := 1 TO MSGTERM(TERMLIST, LOCAL) DO
WRITELN(TERMLIST[ILOOP], 'THE ', PS(MONSTER ^.NAME), ' CASTS A ',
PS(SPELLIST[NUMSP]), ' SPELL ON ', PS(NAME), '!');
WRITELN(TERM, 'THE ', PS(MONSTER ^.NAME), ' CASTS A ', PS(SPELLIST[
NUMSP]), ' SPELL ON YOU!');
DAMAGE := SPELLMON(NUMSP, MONSTER ^.LVL, 15, PLYR, NIL, NIL, NAME);
IF DAMAGE = 0 THEN DAMAGE := MONSTER ^.LVL * 3;
END (*IF*);
IF MREACT = 5 THEN DAMAGE := DAMAGE DIV 2 + 1;
IF MREACT = 6 THEN DAMAGE := DAMAGE * 2; TEMPFAT := 0;
IF NOTIMEOUT(PLYR)
THEN
CASE RND(100) OF
1, 2, 3, 4:
BEGIN WRITELN(TRM, 'DOUBLE DAMAGE!'); DAMAGE := DAMAGE * 2 END;
12, 13, 14:
BEGIN
WRITELN(TRM, 'VITAL WOUND!'); TEMPFAT := FATIGUE; FATIGUE := 0;
END (*12*);
18, 19, 20, 21:
BEGIN
MREACT := 3; DAMAGE := 0;
WRITELN(TRM, 'THE ', PS(MONSTER ^.NAME), ' FUMBLES!');
MONSTER ^.DEFPLAYER := NIL;
END (*18*);
OTHERWISE
END (*CASE*);
HITSHARMOR(PLYR, DAMAGE);
IF NOTIMEOUT(PLYR) THEN
BEGIN
WRITE(TRM, PM(MONSTER));
IF BRIEF THEN WRITE('HITS FOR ') ELSE WRITE('HITS YOU FOR ');
PRINTDMG(PLYR, DAMAGE, BRIEF);
END (*IF*);
IF DRAIN AND (RND(4) = 4)
THEN
BEGIN
IF LVL <= 1 THEN BEGIN CON := 0; DEAD := TRUE; HITS := 0; FATIGUE := 0 END
ELSE
BEGIN
IF NOTIMEOUT(PLYR)
THEN WRITELN(TRM, 'YOU FEEL WEAK AND DRAINED...');
MAXHITS := MAXHITS - MAXHITS DIV LVL;
MAXFATIGUE := MAXFATIGUE - MAXFATIGUE DIV LVL;
MAXMAGIC := MAXMAGIC - MAXMAGIC DIV LVL; LVL := LVL - 1;
FOR ILOOP := 1 TO 2 DO
CASE RND(4) OF
1: STR := MAX(3, STR - 1);
2: INT := MAX(3, INT - 1);
3: DEX := MAX(3, DEX - 1);
4: CON := MAX(3, CON - 1);
END (*CASE*)
END (*ELSE*)
END (*IF*);
IF HITS + FATIGUE <= DAMAGE
THEN
BEGIN
DEAD := TRUE;
HITS := 0; FATIGUE := 0; USER := PLYR; TERM := TRM;
IF USER ^.LVL > 5
THEN DAYMSG('KIL', USER, MONSTER ^.NAME, MONSTER ^.LVL);
FOR ILOOP := 1 TO MSGTERM(TERMLIST, ALL) DO
BEGIN
WRITE(TERMLIST[ILOOP], '### ', PS(NAME), ', THE ', PS(CNAME[CLASS]
), ', WAS JUST ');
CASE RND(4) OF
1: WRITE('SLAIN');
2: WRITE('KILLED');
3: WRITE('DE-REZZED');
4: WRITE('MURDERED');
END (*CASE*);
WRITELN(' BY A ', PS(MONSTER ^.NAME), '.');
IF LVL > 10 THEN
WRITELN(TERMLIST[ILOOP], '### WE SHALL ALL GRIEVE FOR ', PRO[SEX], '.'
);
END (*FOR*);
END (*IF*)
ELSE
BEGIN
IF POISON AND (DAMAGE > 0)
THEN
IF (RND(MONSTER ^.LVL * 2) > LVL) AND (RND(3) = 3) THEN
BEGIN
IF NOTIMEOUT(PLYR) THEN WRITELN(TRM, 'YOU''VE BEEN POISONED!');
POISONED := TRUE
END (*IF*);
IF DAMAGE > FATIGUE THEN HITS := HITS - DAMAGE + FATIGUE;
FATIGUE := MAX(0, FATIGUE - DAMAGE);
IF TEMPFAT > 0 THEN FATIGUE := TEMPFAT
END (*ELSE*);
MONSTER ^.MREACT := 0;
END (*WITH*);
IF MREACT = 4 THEN MREACT := 0;
END (*IF*)
ELSE IF MREACT IN [1, 2, 3] THEN MREACT := MREACT - 1;
MONSTER := MONSTER ^.NEXT
END (*WHILE*)
END (*WITH*)
END (*MONSTRIKE*);
PROCEDURE TIMECHECK(VAR NEXTCHECK: ALFA);
(* CHECK FOR A TIMED EVENT OCCURANCE. *)
VAR
EVENTNUM, ILOOP: INTEGER;
FOUND: BOOLEAN;
BEGIN (* EXECUTE THE TIMED EVENT. *)
USER := USERTAIL; TERM := USER ^.TRM;
(* SELECT A DUMMY USER FOR MSGTERM MESSAGES. *)
IF NEXTCHECK = 'INITIALIZE'
THEN
BEGIN
FOR ILOOP := LENEVENT DOWNTO 1 DO
IF CLOCKTIME <= EVENT[ILOOP] THEN NEXTCHECK := EVENT[ILOOP];
IF NEXTCHECK = 'INITIALIZE' (*STILL*) THEN NEXTCHECK := EVENT[1]
END (*IF*)
ELSE
BEGIN
ILOOP := LENEVENT; FOUND := FALSE;
WHILE NOT FOUND AND (ILOOP >= 1) DO
BEGIN FOUND := (NEXTCHECK >= EVENT[ILOOP]); ILOOP := ILOOP - 1 END;
IF FOUND THEN EVENTNUM := ILOOP + 1
ELSE ABORT(' MIL943 - TIMED EVENT NOT FOUND!');
CASE EVENTNUM OF
1 (*12:01 AM*): NEXTCHECK := EVENT[2];
2 (*12:05 AM*): IF CLOCKTIME < ' 23.00.00.' THEN NEXTCHECK := EVENT[3];
3 (*12:10 AM*):
FOR ILOOP := 1 TO MSGTERM(TERMLIST, SYSMSG) DO
WRITELN(TERMLIST[ILOOP], 'YOU HEAR AN OWL HOOTING IN THE DISTANCE.');
4 (*12:30 AM*):
FOR ILOOP := 1 TO MSGTERM(TERMLIST, SYSMSG) DO
WRITELN(TERMLIST[ILOOP], '>>> PROGRAM WILL ABORT AT 1:00 AM.');
5 (*12:45 AM*):
FOR ILOOP := 1 TO MSGTERM(TERMLIST, SYSMSG) DO
WRITELN(TERMLIST[ILOOP],
'>>> PROGRAM ABORTING IN 15 MINUTES. UP AGAIN AT 7 AM.');
6 (*12:55 AM*):
FOR ILOOP := 1 TO MSGTERM(TERMLIST, SYSMSG) DO
WRITELN(TERMLIST[ILOOP], '>>> PROGRAM ABORTING IN 5 MINUTES. ');
7 (*12:58 AM*):
BEGIN
FOR ILOOP := 1 TO MSGTERM(TERMLIST, SYSMSG) DO
WRITELN(TERMLIST[ILOOP],
'WAIT UNTIL PROGRAM ABORTS: A HANGUP WILL COST YOU A CON POINT.');
LASTUPDATE := REALTIME - UPDATEPERIOD - 10 (* FORCE UPDATE *);
END (*7*);
8 (*12:59 AM*):
BEGIN
FOR ILOOP := 1 TO MSGTERM(TERMLIST, SYSMSG) DO
WRITELN(TERMLIST[ILOOP], '*** WARNING *** PROGRAM ABORTING.');
OFF; FLUSH(OUTPUT); ABORT(' MIL001 - PROGRAM TOOK ITSELF DOWN.')
END (*8*);
9 (*7:10 AM*):
BEGIN
WRITELN(DAYFILE, CLOCKTIME, ' ---- TASK OPEN FOR THE DAY ----');
FOR ILOOP := 1 TO MSGTERM(TERMLIST, SYSMSG) DO
WRITELN(TERMLIST[ILOOP], 'GOOD MORNING AND WELCOME TO MILIEU!');
END (*9*);
10 (*12:00 PM*):
FOR ILOOP := 1 TO MSGTERM(TERMLIST, SYSMSG) DO
WRITELN(TERMLIST[ILOOP], 'YOU HEAR THE TOWN CLOCK STRIKE THE NOON HOUR.');
11 (*2:30 PM*):
FOR ILOOP := 1 TO MSGTERM(TERMLIST, SYSMSG) DO
WRITELN(TERMLIST[ILOOP], '>>> PROGRAM WILL ABORT AT 3 OCLOCK.');
12 (*2:45 PM*):
FOR ILOOP := 1 TO MSGTERM(TERMLIST, SYSMSG) DO
WRITELN(TERMLIST[ILOOP], '>>> PROGRAM WILL ABORT IN 15 MINUTES.');
13 (*2:55 PM*):
FOR ILOOP := 1 TO MSGTERM(TERMLIST, SYSMSG) DO
WRITELN(TERMLIST[ILOOP], '>>> PROGRAM WILL ABORT IN 5 MINUTES.');
14 (*2:59 PM*):
BEGIN
FOR ILOOP := 1 TO MSGTERM(TERMLIST, SYSMSG) DO
WRITELN(TERMLIST[ILOOP],
'WAIT FOR ABORT: A HANGUP WILL COST YOU A CON POINT.');
LASTUPDATE := REALTIME - UPDATEPERIOD - 10 (* FORCE UPDATE *);
END (*14*);
15 (*3:00 PM*):
BEGIN
FOR ILOOP := 1 TO MSGTERM(TERMLIST, SYSMSG) DO
WRITELN(TERMLIST[ILOOP], '*** WARNING *** PROGRAM ABORTING');
OFF; FLUSH(OUTPUT); ABORT(' MIL001 - PROGRAM TOOK ITSELF DOWN.')
END (*15*);
16 (*3:04 PM*):
FOR ILOOP := 1 TO MSGTERM(TERMLIST, SYSMSG) DO
WRITELN(TERMLIST[ILOOP], 'WELCOME BACK! THAT WASN''T SO BAD, WAS IT?');
17 (*7:00 PM*):
FOR ILOOP := 1 TO MSGTERM(TERMLIST, SYSMSG) DO
WRITELN(TERMLIST[ILOOP], 'THE SUN SETS IN THE WEST.');
18: IF DAY=4 THEN
LASTUPDATE := REALTIME - UPDATEPERIOD - 10;
19 (*8:59 PM*):
IF DAY=4 THEN BEGIN
OFF; FLUSH(OUTPUT); ABORT(' MIL001 - PROGRAM TOOK ITSELF DOWN.')
END
ELSE
FOR ILOOP := 1 TO MSGTERM(TERMLIST, SYSMSG) DO
WRITELN(TERMLIST[ILOOP], 'THE TOWN WATCH SETS OUT ON THE WALLS OF THE CITY.'
);
21 (*10:30 PM*):
FOR ILOOP := 1 TO MSGTERM(TERMLIST, SYSMSG) DO
WRITELN(TERMLIST[ILOOP], 'YOU HEAR CRICKETS CHIRP IN THE GRASS.');
20 (*12:55 PM*):
FOR ILOOP := 1 TO MSGTERM(TERMLIST, SYSMSG) DO
WRITELN(TERMLIST[ILOOP], 'THE TOWN CLOCK STRIKES THE MIDNIGHT HOUR.');
END (*CASE*);
IF (EVENTNUM > 2) THEN
IF EVENTNUM = LENEVENT THEN NEXTCHECK := EVENT[1]
ELSE NEXTCHECK := EVENT[EVENTNUM + 1]
END (*ELSE*);
END (*TIMECHECK*);
BEGIN (*MONSTERATTACK*)
IF (CLOCKTIME >= NEXTCHECK) OR (NEXTCHECK = 'INITIALIZE')
THEN IF NUSERS > 0 THEN TIMECHECK(NEXTCHECK);
PLYR := USERTAIL;
WHILE PLYR <> NIL DO
BEGIN
IF PLYR ^.STATUS <> SLOGIN
THEN IF ROOM[PLYR ^.RMCODE].RMPLAYERTAIL = PLYR THEN MONSTRIKE(PLYR ^.RMCODE);
PLYR := PLYR ^.NEXTUSER
END (*WHILE*)
END (*MONSTERATTACK*);
PROCEDURE INITIALIZE;
(**********************************************************
THIS PROCEDURE INITIALIZES THE DUNGEON, FETCHES THE FILES, AND
BRINGS THE TASK UP. IT GETS THE EDESC, EROOM, EMON, EOBJ AND EPERSON
FILES. THE PROCEDURE *ROLLOUT* ROLLS OUT THE TASK AFTER EVERY
50 RA+1 REQUESTS AS PER *MULTI* PROTOCOL. USERS WHO INADVERTENTLY
LOG IN WHILE THIS PROCEDURE IS IN EFFECT ARE GRACIOUSLY ASKED
TO WAIT 10 SECONDS, AND THEN TRY LOGGING IN AGAIN.
************************************************************)
VAR
I, LASTDAY, DAYSAPART, ILOOP, JLOOP: INTEGER;
OBJECT, OBJECT2: OBJECTPOINT;
MONSTER, MONSTER2: MONSTERPOINT;
PLYR: USERPOINT;
D: ALFA;
DUMPARM: PARMBLOCK;
CH: CHAR;
INITBUF: BUFTYPE;
INITLEN: LENBUFTYPE;
INITLOG: LOGLENTYPE;
PROCEDURE READALFA(VAR STRING: ALFA);
VAR
ILOOP: INTEGER;
CH: CHAR;
BEGIN
STRING := BLANKS; ILOOP := 1; WHILE EDESC ^ = ' ' DO READ(EDESC, CH);
WHILE NOT EOLN(EDESC) AND (ILOOP <= 10) DO
BEGIN
READ(EDESC, CH); IF CH = ' ' THEN ILOOP := 100 ELSE STRING[ILOOP] := CH;
ILOOP := ILOOP + 1
END (*WHILE*)
END (*READALFA*);
PROCEDURE GETFILE(VAR F: SEGCHARFIL; PFN, PW, UN: ALFA7);
EXTERN;
PROCEDURE SAVEFET(VAR F: SEGCHARFIL; OFFSET, LOC: INTEGER);
EXTERN;
PROCEDURE GETDFILE(VAR F: BINFILETYPE; PFN, PW, UN: ALFA7);
EXTERN;
PROCEDURE ATTACHF(VAR F: BINFILETYPE; PFN, PW, UN: ALFA7);
EXTERN;
FUNCTION PDATE: INTEGER;
EXTERN;
FUNCTION DAYWEEK(SYSDATE: INTEGER): INTEGER;
EXTERN;
PROCEDURE SETRA(VAR RA: INTEGER);
(* PASS THE ADDRESS OF THE GLOBAL VARIABLE *RA* TO COMCSYS. *RA*
WILL BE INCREMENTED EACH AN RA+1 REQUEST IS ISSUED. *)
EXTERN;
BEGIN (*INITIALIZE*)
RTIME(REALTIME); CLOSE(INPUT); OPEN(INPUT, 'INPUT ', FALSE);
(* CHANGE INPUT FROM SCRATCH TO "INPUT" *)
NEW(USER); USER ^ := PROTOUSER (* SET DEFAULTS *); LOGLEN := 0; LENBUF := 0;
(* READ IN THE FIRST USER. OFFICIAL LOGIN DOES NOT OCCUR UNTIL THE
END OF THIS INITILIZATION PHASE *)
LENBUF := 0; LOGLEN := 0;
READCONTROL(CONTROL, PARM, TERM, BUFFER, LENBUF, LOGLEN);
PACK(BUFFER, 1, USER ^.UN); INITLEN := 0; INITLOG := 0; ILOOP := 7;
WHILE USER ^.UN[ILOOP] = COL DO
BEGIN USER ^.UN[ILOOP] := ' '; ILOOP := ILOOP - 1 END;
READCONTROL(CONTROL, DUMPARM, TERM, INITBUF, INITLEN, INITLOG);
(* READ IN LOGIN TEXT *)
USER ^.TRM := TERM; USER ^.ENTRY := XINIT; USER ^.STATUS := SINIT; RA := 0;
SETRA(RA) (* FORCE SYS= TO INCREMENT THE GLOBAL VARIABLE *RA* *);
WRITELN(TERM, 'PLEASE WAIT.'); ROLLOUT(TERM); TIME(CLOCKTIME); HEADER;
SYSDATE := PDATE; SEEDRND(SYSDATE); DAY := DAYWEEK(SYSDATE);
(* NOW READ IN THE DUNGEON FILES *)
OPENDFIL(EPERSON, 'EPERSON ', FALSE);
ATTACHF(EPERSON, 'EPERSON', FILEPW, ORIGINUN);
GETFILE(DAYFILE, 'DAYFILE', FILEPW, ORIGINUN);
GETFILE(EDESC, 'EDESCRP', FILEPW, ORIGINUN); SWITCH(FALSE, 1);
GETDFILE(EROOM, 'DUNJON1', FILEPW, ORIGINUN); RESET(EDESC); RESET(EPERSON);
RESET(DAYFILE); SAVEFET(DAYFILE, 14, 1); RESET(EROOM); SAVEFET(EDESC, 14, 4);
SWITCH(FALSE, 2); GETDFILE(EROOM, 'DUNJON2', FILEPW, ORIGINUN); RESET(EROOM);
SWITCH(FALSE, 1); LINELIMIT(OUTPUT, MAXINT); LINELIMIT(INPUT, MAXINT);
LINELIMIT(DAYFILE, MAXINT); LINELIMIT(EDESC, MAXINT); TRADETIME := 0;
NTPLYR := BLANKS; NFPLYR := BLANKS;
FOR ILOOP := 1 TO 3 DO
BEGIN
TNAME[ILOOP] := EMPTY; YNAME[ILOOP] := EMPTY; TLVL[ILOOP] := 0;
YLVL[ILOOP] := 0; TCLASS[ILOOP] := EMPTY; YCLASS[ILOOP] := EMPTY;
FOR JLOOP := 1 TO 80 DO
BEGIN TBUF[ILOOP, JLOOP] := COL; YBUF[ILOOP, JLOOP] := COL END;
END (*FOR*);
FOR ILOOP := 1 TO 5 DO FOR JLOOP := 1 TO 80 DO NEWSBUF[ILOOP, JLOOP] := COL;
FOR ILOOP := 1 TO ABSOLUTEPLMAX DO PLAYERINDEX[ILOOP] := EMPTY;
IF EOF(EPERSON) OR EOS(EPERSON)
THEN
BEGIN
REWRITE(EPERSON); NEW(PLYR); PLYR ^ := PROTOUSER; WRITEUSR(PLYR, TRUE);
NEW(PLYR); PLYR ^ := PROTOUSER; WRITEUSR(PLYR, TRUE);
PUTSEG(EPERSON) (* WRITE EMPTY PRU OF USERS *);
END (*IF*);
ILOOP := 1; ROLLCHECK(TERM);
WHILE NOT EOS(EROOM) AND (ILOOP <= RANOBJLEN) DO
BEGIN READUOBJ(EROOM, RANOBJLIST[ILOOP]); ILOOP := ILOOP + 1; END;
FOR ILOOP := ILOOP TO RANOBJLEN DO
BEGIN RANOBJLIST[ILOOP] := PROTOOBJECT; RANOBJLIST[ILOOP].PERMANENT := FALSE
END (*FOR*);
IF NOT EOF(EROOM) THEN GETSEG(EROOM); ILOOP := 1; ROLLCHECK(TERM);
WHILE NOT EOS(EROOM) AND (ILOOP <= RANMONLEN) DO
BEGIN READMON(EROOM, RANMONLIST[ILOOP]); ILOOP := ILOOP + 1; END;
FOR ILOOP := ILOOP TO RANMONLEN DO
BEGIN RANMONLIST[ILOOP] := PROTOMONSTER; RANMONLIST[ILOOP].PERMANENT := FALSE;
END (*FOR*);
IF NOT EOF(EROOM) THEN GETSEG(EROOM); ROLLCHECK(TERM); REWRITE(EMAP);
CURRENTSEG := 0; NUMSEGS := 0; EOFSEG := 1;
FOR ILOOP := 0 TO MAXPLUSONE DO
BEGIN SLOTTBL[ILOOP] := - 1; ACTIVE[ILOOP] := 0; END;
FOR ILOOP := 0 TO RMLIMIT DO ROOM[ILOOP] := PROTOROOM;
FOR ILOOP := 0 TO MAXSEGS DO RMSEGLOC[ILOOP] := 0;
IF EOS(EROOM) OR EOF(EROOM) THEN ADDSEG
ELSE
WHILE NOT EOF(EROOM) AND (NUMSEGS <= MAXSEGS) DO
BEGIN
IF NUMSEGS = 70 THEN SWITCH(FALSE, 2); ILOOP := 0; EOFSEG := EOFSEG + 1;
ROLLCHECK(TERM);
WHILE NOT EOS(EROOM) DO
BEGIN READ(EROOM, I); WRITE(EMAP, I); ILOOP := ILOOP + 1; END (*WHILE*);
NUMSEGS := NUMSEGS + 1; RMSEGLOC[NUMSEGS - 1] := NUMSEGS; PUTSEG(EMAP);
GETSEG(EROOM); ROLLCHECK(TERM);
END (*WHILE*);
NUMROOMS := NUMSEGS * 10 - 1 (* HIGHEST #ED ACTIVE ROOM *); GETSEG(EDESC, 10000);
GETSEG(EDESC, - 1) (* READ IN PROGRAM CONSTANTS *); ROLLCHECK(TERM);
READLN(EDESC, TASKCLOSED, NUMRUN, LASTDAY, MSPEED); CURRENTPLINDEX := 0;
DATE(D); TODAY := (ORD(D[8]) - ORD('0')) * 10;
TODAY := TODAY + (ORD(D[9]) - ORD('0')); RESET(EPERSON); NEW(PLYR);
WHILE NOT EOS(EPERSON) AND NOT EOF(EPERSON) DO
BEGIN
CURRENTPLINDEX := CURRENTPLINDEX + 1; READUSR(PLYR, FALSE) (*DON'T READ OBJ*);
PLAYERINDEX[CURRENTPLINDEX] := PLYR ^.NAME;
DAYSAPART := ABS(PLYR ^.LASTACCESS - TODAY);
IF (DAYSAPART > 10) AND (DAYSAPART < 20) AND (PLYR ^.NAME <> EMPTY)
THEN PLAYERINDEX[CURRENTPLINDEX] := EMPTY;
(* ERASE PLAYER ENTRY IF 10-15 DAYS OLD *)
IF NOT ODD(CURRENTPLINDEX) THEN GETSEG(EPERSON); ROLLCHECK(TERM);
END (*WHILE*);
RANDOMACCESS(EPERSON); DISPOSE(PLYR) (* ERASE TEMP VAR *); ILOOP := 1;
WHILE NOT EOLN(EDESC) AND (ILOOP < 80) DO
BEGIN READ(EDESC, NOTICE[ILOOP]); ILOOP := ILOOP + 1; END;
READLN(EDESC);
IF NOT EOS(EDESC)
THEN
BEGIN
FOR ILOOP := 1 TO 5 DO
BEGIN
JLOOP := 1;
WHILE NOT EOLN(EDESC) AND (JLOOP < 80) DO
BEGIN READ(EDESC, NEWSBUF[ILOOP, JLOOP]); JLOOP := JLOOP + 1 END;
READLN(EDESC);
END (*FOR*);
FOR ILOOP := 1 TO 3 DO
BEGIN
READ(EDESC, TLVL[ILOOP], YLVL[ILOOP]); READLN(EDESC);
READALFA(TNAME[ILOOP]); READALFA(YNAME[ILOOP]); READALFA(TCLASS[ILOOP]);
READALFA(YCLASS[ILOOP]); READLN(EDESC); JLOOP := 1;
WHILE NOT EOLN(EDESC) DO
BEGIN READ(EDESC, TBUF[ILOOP, JLOOP]); JLOOP := JLOOP + 1 END;
READLN(EDESC); JLOOP := 1;
WHILE NOT EOLN(EDESC) DO
BEGIN READ(EDESC, YBUF[ILOOP, JLOOP]); JLOOP := JLOOP + 1 END;
READLN(EDESC);
END (*FOR*);
END (*IF*);
ROLLCHECK(TERM);
IF LASTDAY <> TODAY
THEN
FOR ILOOP := 1 TO 3 DO
BEGIN
YNAME[ILOOP] := TNAME[ILOOP]; TNAME[ILOOP] := EMPTY;
YLVL[ILOOP] := TLVL[ILOOP]; TLVL[ILOOP] := 0; YCLASS[ILOOP] := TCLASS[ILOOP];
TCLASS[ILOOP] := EMPTY; YBUF[ILOOP] := TBUF[ILOOP]; TBUF[ILOOP, 1] := COL;
END (*FOR*);
SETDAYFILE; PUTSEG(DAYFILE); BUFFER := INITBUF; LENBUF := INITLEN;
LOGLEN := INITLOG;
(* PUT LOGIN TEXT OF FIRST USER BACK IN BUFFER *)
ROLLOUT(TERM); MESSAGE(' GET DATABASE.');
ERRFLAG := 1 (*ENABLE ERROR TRAPPING *); LASTUPDATE := REALTIME;
SETERR(ERRFLAG, ERRLOC) (*POKE IN ERR TRAP*);
END (*INITIALIZE*);
PROCEDURE UPDATE;
(* UPDATE WILL REWRITE THE DUNGEON FILES. THIS IS DONE EVERY
60 MINUTES. *)
VAR
I, RLOOP, ILOOP, JLOOP: INTEGER;
OBJECT: OBJECTPOINT;
MONSTER: MONSTERPOINT;
USR: USERPOINT;
BEGIN
ERRLOC := 'UPDATE '; ERRFLAG := 0 (* INHIBIT REPLACE *);
FOR ILOOP := 1 TO MSGTERM(TERMLIST, SYSMSG) DO
WRITELN(TERMLIST[ILOOP], 'FILES UPDATING. PLEASE WAIT.');
ROLLCHECK(TERM); SWITCH(TRUE, 1); REWRITE(EROOM); ROLLCHECK(TERM);
FOR ILOOP := 1 TO RANOBJLEN DO WRITEUOBJ(EROOM, RANOBJLIST[ILOOP]);
PUTSEG(EROOM); ROLLCHECK(TERM);
FOR ILOOP := 1 TO RANMONLEN DO WRITEMON(EROOM, RANMONLIST[ILOOP]); PUTSEG(EROOM);
ROLLCHECK(TERM);
FOR ILOOP := 0 TO MAXUSERS DO
BEGIN
IF SLOTTBL[ILOOP] > - 1 THEN WRITESEG(ILOOP, SLOTTBL[ILOOP], FALSE);
ROLLCHECK(TERM)
END (*FOR*);
RESET(EMAP); CURRENTSEG := 1;
FOR RLOOP := 0 TO NUMSEGS - 1 DO
BEGIN
IF RLOOP = 70
THEN BEGIN WRITE(EROOM, 0); PUTSEG(EROOM); SWITCH(TRUE, 2); END;
ROLLCHECK(TERM);
IF RMSEGLOC[RLOOP] = 0 THEN ABORT(' MIL288 - UNDEFINED RMSEGLOC!');
GETSEG(EMAP, RMSEGLOC[RLOOP] - CURRENTSEG);
IF EOS(EMAP) THEN ABORT(' MIL423 - EMPTY ROOM SEG TO UPDATE!'); ILOOP := 0;
WHILE NOT EOS(EMAP) DO
BEGIN READ(EMAP, I); WRITE(EROOM, I); ILOOP := ILOOP + 1; END (*WHILE*);
CURRENTSEG := RMSEGLOC[RLOOP]; PUTSEG(EROOM); ROLLCHECK(TERM);
END (*FOR*);
SWITCH(FALSE, 1); ROLLCHECK(TERM); RESET(EROOM); REWRITE(EMAP);
GETSEG(EROOM, 2); ROLLCHECK(TERM);
FOR RLOOP := 0 TO NUMSEGS - 1 DO
BEGIN
IF RLOOP = 70 THEN SWITCH(FALSE, 2); ILOOP := 0; ROLLCHECK(TERM);
WHILE NOT EOS(EROOM) DO
BEGIN READ(EROOM, I); WRITE(EMAP, I); ILOOP := ILOOP + 1; END (*WHILE*);
GETSEG(EROOM); PUTSEG(EMAP); ROLLCHECK(TERM); RMSEGLOC[RLOOP] := RLOOP + 1;
END (*FOR*);
EOFSEG := NUMSEGS + 1; CURRENTSEG := 0; RESET(EDESC); GETSEG(EDESC, 10000);
ROLLCHECK(TERM); REWRITE(EDESC, - 1); ROLLCHECK(TERM);
WRITELN(EDESC, TASKCLOSED, NUMRUN + 1, TODAY, MSPEED); ILOOP := 1;
WHILE (ILOOP < 80) AND (NOTICE[ILOOP] <> COL) DO
BEGIN WRITE(EDESC, NOTICE[ILOOP]); ILOOP := ILOOP + 1 END;
WRITELN(EDESC);
FOR ILOOP := 1 TO 5 DO
BEGIN
JLOOP := 1;
WHILE (JLOOP < 80) AND (NEWSBUF[ILOOP, JLOOP] <> COL) DO
BEGIN WRITE(EDESC, NEWSBUF[ILOOP, JLOOP]); JLOOP := JLOOP + 1 END;
WRITELN(EDESC)
END (*FOR*);
FOR ILOOP := 1 TO 3 DO
BEGIN
WRITELN(EDESC, TLVL[ILOOP], YLVL[ILOOP]);
WRITELN(EDESC, TNAME[ILOOP], ' ', YNAME[ILOOP], ' ', TCLASS[ILOOP], ' ', YCLASS[
ILOOP]);
JLOOP := 1;
WHILE TBUF[ILOOP, JLOOP] <> COL DO
BEGIN WRITE(EDESC, TBUF[ILOOP, JLOOP]); JLOOP := JLOOP + 1 END;
WRITELN(EDESC); JLOOP := 1;
WHILE YBUF[ILOOP, JLOOP] <> COL DO
BEGIN WRITE(EDESC, YBUF[ILOOP, JLOOP]); JLOOP := JLOOP + 1 END;
WRITELN(EDESC);
END (*FOR*);
PUTSEG(EDESC); CURRENTREC := 0 (* POSITION OF EDESC IS UNPREDICTABLE NOW *);
MESSAGE(' FILES UPDATED.'); ROLLCHECK(TERM); ERRFLAG := 1 (* RESTART REPLACE *);
END (*UPDATE*);
BEGIN (*MULTIO*)
INITIALIZE (* FETCH ALL FILES, READ IN CONSTANTS, ETC. *);
WRITELN(DAYFILE, CLOCKTIME, ' DAY ', TODAY: 0, ', TASK INITIALIZED.');
USER := LOGIN(PARM, TERM, BUFFER, NUSERS, USERTAIL);
(* LOG IN THE FIRST USER. *FIRSTLOGIN* IS TRUE SO NO INPUT IS
ACTUALLY READ BY *LOGIN* *)
IF USER <> NIL THEN PROMPTUSER(USER); FIRSTLOGIN := FALSE;
REPEAT
ERRLOC := 'MULTIO ';
WHILE EOS(INPUT) DO
BEGIN
FLUSH(OUTPUT); GETSEG(INPUT); RA := 1; RTIME(REALTIME); TIME(CLOCKTIME);
IF NOT EOS(INPUT) THEN MONSTERATTACK
END (*WHILE*);
NOPROMPT := FALSE; READCONTROL(CONTROL, PARM, TERM, BUFFER, LENBUF, LOGLEN);
WHICHCONTROL := ORD(CONTROL[1]);
IF WHICHCONTROL <> 40B THEN WHICHCONTROL := ORD(CONTROL[2]); ACTIVEFLAG := 0;
IF WHICHCONTROL <> MTLI (*LOGIN*)
THEN
BEGIN
ACTIVEFLAG := ACTIVETRM(TERM);
IF ACTIVEFLAG = 0
THEN
BEGIN
FINDLIMBO(TERM, LIMBOINDEX, FALSE);
IF LIMBOINDEX = 0 THEN
BEGIN USER := FINDTERM(TERM, USERTAIL); USER ^.LASTINPUT := REALTIME END
END (*IF*)
ELSE MESSAGE(' UNDEF TERM IGNORED.');
END (*IF*);
IF ACTIVEFLAG = 0
THEN
CASE WHICHCONTROL OF
40B (*MTXT*): DOINPUT(BUFFER, LENBUF, USER);
MTAN: IF TERM <> NORESTART THEN IF LIMBOINDEX = 0 THEN PROMPTUSER(USER);
MTNT: (*INTERRUPT*)
BEGIN
WRITECONTROL(MTAK, ZEROPARM, TERM); WRITELN (*INTERRUPT ACKNOWLEDGE*);
IF LIMBOINDEX <> 0
THEN
BEGIN
WRITELN(TERM, 'END MILIEU.'); WRITECONTROL(MTLO, ZEROPARM, TERM); WRITELN;
DELETELIMBO(TERM)
END (*IF*)
ELSE BEGIN USER ^.AUTO := FALSE; PROMPTUSER(USER) END
END (*MTNT*);
MTHU: (*HANGUP*)
IF LIMBOINDEX <> 0 THEN DELETELIMBO(TERM)
ELSE LOGOFF(USER, TRUE) (* NO MTLO WRITE NEEDED *);
MTLI: (*LOGIN*)
BEGIN
USER := LOGIN(PARM, TERM, BUFFER, NUSERS, USERTAIL);
IF USER <> NIL THEN PROMPTUSER(USER);
END (*MTLI*);
MTRC: (* IAF ABORT *)
BEGIN
MESSAGE(' MIL303 - IAF ABORTED.'); HELLFREEZESOVER := TRUE (* AMAZING!! *)
END (*MTRC*);
END (*CASE*);
UNTIL HELLFREEZESOVER
END (*MULTIO*);
FUNCTION GETEPT: INTEGER;
(* GETEPT RETURNS THE 5000 LOADER TABLE HEADER FOR GENERATING
THE RUNTIME OVL *)
EXTERN;
FUNCTION PEEK(ADDR: INTEGER): INTEGER;
(* PEEK RETURNS THE VALUE OF DATA AT ADDRESS *ADDR* *)
EXTERN;
PROCEDURE SAVEB;
(* SAVEB SAVES THE STACK POINTERS (B4,B5,B6) BEFORE THE
PROGRAM FREEZES *)
EXTERN;
PROCEDURE FREEZE;
(* FREEZE STOPS THE PROGRAM AFTER THE OVL IS GENERATED. THE
RUN IS RESUMED AT THE RESTART LABEL. *)
EXTERN;
PROCEDURE COPYABS(TASKNAME, UN: ALFA7);
(* COPYABS WILL COPY THE LOAD FILE TO A RUNTIME SEGMENT LIBRARY.
THE FIRST RECORD (OVL) IS SKIPPED. *)
EXTERN;
BEGIN (*MILIEU*)
TASKNAM := 'MILIEU '; TASKNAM[7] := COL;
(* THE FIRST THING WE DO IS SAVE THE PROGRAM TO A FILE. THIS FILE
IS WHAT IS ACTUALLY RUN ON MULTI. *)
OPENBOOT(BOOTSEG, 'BOOTSEG ', TRUE); WRITELN('SNAPSHOT DUMP BEING CONSTRUCTED.');
REWRITE(BOOTSEG); WRITE(BOOTSEG, 77000016000000000000B);
WRITE(BOOTSEG, 23030520240522000000B); WRITE(BOOTSEG, 43355033375036345555B);
WRITE(BOOTSEG, GETEPT); FLUSH(OUTPUT); SAVEB (* SAVE STACK *);
FOR ILOOP := 101B TO BOOTLEN DO WRITE(BOOTSEG, PEEK(ILOOP)); PUTSEG(BOOTSEG);
CLOSEBOOT(BOOTSEG); FREEZE (* HALT PROGRAM *); 1: FLUSH(OUTPUT);
(* COPY 2ND SEGMENT AND ONWARD OF MILIEU TO ABS *)
COPYABS(TASKNAM, ORIGINUN); MESSAGE(' PASCAL/MULTI-6000.3.2 RUNTIME SYSTEM.');
MULTIO (* DO MILIEU! *)
END (*MILIEU*).