uyydyBtytotz (*$L'MILIEU - MULTI USER ROLE PLAY GAME.',L'DECLARATIONS AND VARIABLES'*) (*$A+,E+,P-,T-,R- *) (*[E=3,I=1,B+,S=2,L=2,W1-85] FOR SPRUCE. *) (* N O T E - LIST THIS SOURCE WHILE IN CSET(NORMAL). DO NOT REPEAT *DO NOT* LIST THIS SOURCE USING CSET(ASCII). CERTAIN CHARACTERS SUCH AS POINTERS (^) WILL DISAPPEAR FROM THE LISTING IF YOU LIST UNDER CSET(ASCII). *) (*$B5 SET OUTPUT BUFFER LARGE *) PROGRAM MILIEU(OUTPUT +); (*$B1 RESET BUFFER LENGTH TO 129D WORDS *) (* MILIEU - INTERACTIVE ADVENTURE SIMULATION PROGRAM. A. E. KLIETZ 79/07/13., 82/03/10., 83/03/03. COPYRIGHT (C) 1979, 1981, 1982, 1983 A.E.KLIETZ. ALL RIGHTS RESERVED. MILIEU IS AN INTERACTIVE ROLE-PLAY GAME. IT LETS YOU, THE USER, INVOLVE YOURSELF WITH OTHER USERS IN A SIMULATED WORLD OF TOWNS, DUNGEONS, CASTLES AND WILDERNESS. INTERACTION WITH OTHER PLAYERS IS TOTAL -- ALLOWING YOU TO TALK, TRADE WITH, AND EVEN FIGHT IN HAND-HAND COMBAT WITH OTHER PLAYERS. THE "WORLD" IS STOCKED WITH A WIDE ARRAY OF "NON-PLAYER CHARACTERS": COMPUTER CONTROLLED CREATURES, BARTENDERS, SOLDIERS, ETC. IN ORDER TO ADD A BIT OF SPICE TO YOUR PLAY, DIFFICULT TRIALS AND CHALLENGES ARE BUILT INTO THE WORLD... WIZARDS TO OVERTHROW, SOLDIERS TO AVOID. THE ACTUAL ENCOUNTERS CAN BE CHANGED AROUND EASILY BY THE USE OF A SPECIAL "EDITOR". THE EDITOR CAN MODIFY ANY PART OF THE DATABASE, EVEN WHILE THE GAME IS IN PROGRESS! THE PROGRAM ITSELF IS WRITTEN IN PASCAL-6000, WITH SOME COMPASS SUBROUTINES ADDED FOR INTERFACING WITH NOS. THE PROGRAM TAKES ADVANTAGE OF THE MULTI OPERATING SYSTEM BY DIRECTLY TALKING TO THE SUBCONTROL-POINT VIA TEXT CONTROL WORDS. A SPECIAL PASCAL COMPILER IS NOT NEEDED SINCE THE PROGRAM ITSELF DOES ALL THE EXTRA WORK NEEDED FOR MULTI. MILIEU IS A SEGMENTED PROGRAM. THAT IS, ONLY CERTAIN PARTS OF THE PROGRAM ARE ACTUALLY IN MEMORY AT ANY GIVEN TIME. THE LIST OF SEGMENTS IS STORED IN A LIBRARY *ABS*. THEY ARE AUTOMATICALLY FETCHED AS NEEDED, AND ERASED WHEN NO LONGER IN USE. DISPITE THE MULTI USER ENVIRONMENT, MILIEU CONTAINS ALL THE FEATURES USED IN STANDARD PASCAL, INCLUDING RECURSION AND DYNAMIC MEMORY ALLOCATION. EVERY USER ASSOCIATED WITH THE TASK HAS A DATA RECORD. THIS RECORD CONTAINS THE USER'S TERMINAL NUMBER AND THE ADDRESS OF THE NEXT ENTRY POINT IN THE PROGRAM THAT THE USER WILL RUN WHEN HE IS ROLLED IN. THE RECORD LIST IS STORED DYNAMICALLY, WITH RECORDS BEING CREATED AND DISPOSED OF AS USERS LOG IN AND OUT. *) LABEL (*$E'RESTART' *) 1; (* THE RESTART LABEL IS THE RE-ENTRY POINT FOR THE PROGRAM. THE PROGRAM JUMPS HERE AFTER THE SNAPSHOT DUMP. *) CONST BOOTLEN = 7700B (* LENGTH OF BOOT SEGMENT *); (* THE FOLLOWING IS A LIST OF DEFINITIONS FOR MULTI CONTROL WORDS. THESE TWO CHARACTER STRINGS PREFACE ALL OUTPUT FROM THIS PROGRAM. NOTE THAT THE *MTXT* CONTROL WORD EQUALS 4000B OCTAL, OR "5:" IN THE CHARACTER SET. *) MTXT = '5 MTLI = 1B; MTLO = 'PB'; MTHU = 3B; MTNT = 4B; MTIN = 'PE'; MTAK = 'PF'; MTRN = 'PG'; MTAN = 10B; MTRC = 11B; BLANKS = ' '; QUITWAIT = 20 (*MIN # OF SECS TO WAIT BEFORE QUITTING AFTER ATK*); HEALWAIT = 30 (* # OF SECS TO INCREASE MP/HP OF USER*); UPDATEPERIOD = 3600 (* # OF SECS BETWEEN FILE UPDATES. 60MIN*); EMPTY = 'ZZZEMPTY ' (* EMPTY PERSON SECTOR *); ABSOLUTEPLMAX = 210 (* MAX # OF USERS IN FILE *); MAXOBJS = 6 (* MAX # OF OBJECTS STORED/PERSON *); MAXLOGLEN = 128 (* MAX NUMBER OF U/L CHARACTERS *); MAXBUFLEN = 257 (* MAXLOGLEN * 2 + 1 PHYSICAL BUFFER *); VERSION = '2.4.1PUBLIC B^O^L^D^H^O^L^M V^I^L^L^A^G^E '; MAXUSERS = 25 (*MAX NUMBER OF USERS*); MAXPLUSONE = 26 (* MAXUSERS + 1 *); RMLIMIT = 259 (* MAXUSERS * 10 + 9 *); MAXQUEUE = 15 (* MAX USERS IN WAITING QUEUE *); ORIGINUN = 'GWAKIM6'; AUTHOR = 'MORDOR '; MAXNAMES = 40 (*MAX # OF ITEMS IN A ROOM FOR PARSING*); CMDLISTLEN = 112 (*NUMBER OF COMMANDS*); SPELLEN = 17; LENCOUNTER = 18; OBJLISTLEN = 16; RANMONLEN = 100; RANOBJLEN = 78; MAXSEGS = 199 (* 10 ROOMS PER SEGMENT = 2000 ROOMS *); RESPONDLIMIT = 60 (* SECS TO RESPOND TO PROMPT *); LENEVENT = 21 (*NUMBER OF EVENTS IN THE CIRCULAR QUEUE *); DAYRECLEN = 6 (* 6 RECORDS STORED IN DAYFILE *); (* ZEROPARM = SIX BYTES OF ZEROS *) TYPE USREC = ARRAY [1..10] OF INTEGER (*BUFFER FOR USER FILE RECORDS*); SEGCHARFIL = SEGMENTED FILE OF CHAR; (*$B2 INPUT FILE'S BUFFER LENGTH*) INPUTTYPE = SEGMENTED FILE OF CHAR; (*$B= RESET BUFFER LENGTH *) BUFTYPE = ARRAY [1.. MAXBUFLEN] OF CHAR (*INPUT BUFFER*); BYTE = PACKED ARRAY [1..2] OF CHAR (*CONTROL BYTE*); PARMBLOCK = PACKED ARRAY [1..6] OF CHAR; LOGLENTYPE = 0.. MAXLOGLEN (*LOGICAL BUFFER LEN*); LENBUFTYPE = 0.. MAXBUFLEN (*ACTUAL BUFFER LEN*); ALFA20 = PACKED ARRAY [1..20] OF CHAR; ALFA7 = PACKED ARRAY [1..7] OF CHAR; ALFA3 = PACKED ARRAY [1..3] OF CHAR; CMDTYPELIST = ARRAY [1.. CMDLISTLEN] OF ALFA; CMDNUMTYPE = PACKED ARRAY [1.. CMDLISTLEN] OF 0.. CMDLISTLEN; TERMTYPELIST = ARRAY [1.. MAXNAMES] OF ALFA (* TERM # LIST FOR MSGS *); EDITTYPELIST = ARRAY [1..14] OF ALFA (* LIST OF EDIT CMDS *); PARAMETERS = PACKED RECORD PNAME: BYTE (* NAME OF PARAMETER *); PTYPE: (DFLAG, DNUM, DWORD, DOTHER) END; PARMTYPELIST = PACKED ARRAY [INTEGER] OF PARAMETERS (*EDIT PARMS*); RMCODETYPE = 0.. 4000; TALKHOWTYPE = (LOCAL, YELL, OTHERS, ALL, BROTHERS, BRALL, NOBLOCK, SYSMSG); ENTRYTYPE = (XINIT, XNAME, XCMD, XEDIT, XPASSWORD, XNEWPW, XCHANGEPW, XNEWCLASS, XSEX, XSTATS, XNOTICE, XDEAD, XNEWS, XSELL, XREPAIR, XWISH, XSPELL, XSURE, XPARLEY, XSKILL, XRES5, XRES6, XRES7, XRES8); STATUSTYPE = (SINIT, SLOGIN, SNORMAL); TIMETYPE = 0..262143 (*THREE DAYS*); (*$T- COMPRESS POINTERS TO 18 BITS INSTEAD OF 36 BITS *) USERPOINT = ^ USERTYPE; OBJECTPOINT = ^ OBJECTTYPE; MONSTERPOINT = ^ MONSTERTYPE; (*$T= RESTORE RUN-TIME CHECKS *) MONSTERTYPE = PACKED RECORD NAME: ALFA; NEXT: MONSTERPOINT; DEFEND, BLOCK, FOLLOW, GUARD, ATKLASTAGGR, SLOWREACT, FASTREACT, INVISIBLE, REGENERATE, DRAIN, POISON, ANTIMAGIC, UNDEAD, MORALREACT, FLEE, ASSISTANCE: BOOLEAN; MONSPELLS, MRES2, MRES3: BOOLEAN; (* THESE FLAGS DETERMINE A MONSTER'S PERSONALITY *) DEFPLAYER: USERPOINT (* DEFENDING PLAYER, IF ANY*); LVL: 0..25 (* MONSTER'S LEVEL *); HITS: 0..1000; MAXHITS: 0..1000 (* STARTING # OF HITS *); OBJECTTAIL: OBJECTPOINT; EXPERIENCE: 0..100000 (* EXP POINTS *); TOP: BOOLEAN (* FIRST MONSTER IN LIST? *); NUM: 0..9 (* INDEX # OF MONSTER, IF MORE THAN ONE*); PERMANENT: BOOLEAN (* IS MONSTER A PRE-SET ENCOUNTER*); MAGIC: BOOLEAN; WHICHOBJ: 0..200; MREACT: 0..20; MPARLEY: 0..30; END; OBCLASSTYPE = (PORTAL, TREASURE, WEAP, ARMOR, SHIELD, COINS, SCROLL, CHEST, DOOR, BADKEYS, MAGDEVICE, TELEPORT, KEYS, CARD, OBJDUMMY, MISC); SKILLTYPE = (SHARP, THRUST, BLUNT, LONG) (* WEAP SKILL TYPES *); OBJECTTYPE = PACKED RECORD NAME: ALFA20; NEXT: OBJECTPOINT; ARTICLE: (A, AN, SOME, THE, NONE); CARRY: BOOLEAN; WEIGHT: 0..1000; PRICE: 0..15000; MAGIC: BOOLEAN; PERMANENT: BOOLEAN; INVISIBLE: BOOLEAN; RESERVED: 1..100B; DESCCODE: 0..50; DESCREC: 0..300; CASE OBCLASS: OBCLASSTYPE OF PORTAL: (TOWHERE: RMCODETYPE); WEAP: (MINHP, MAXHP: 0..100; STRIKESLEFT: 0..500; WEAPLUS: - 5..10; WEAPTYPE: SKILLTYPE); SHIELD: (SHPLUS: - 5..10; SHHITSLEFT: 0..500); ARMOR: (ARMPLUS: - 5..10; ARMHITSLEFT: 0..500); COINS: (MULTIPLIER: 1..100); SCROLL: (SPELL: 0..500); CHEST: (CLOSED: BOOLEAN; LOCKED: 0..1000; TRAP: 0..50; NUMINSIDE: 0..10; OBJECTTAIL: OBJECTPOINT); DOOR: (DTOWHERE: RMCODETYPE; DCLOSED: BOOLEAN; DTRAP: 0..50; DLOCKED: 0..1000); KEYS: (UNLOCK: 0..1000); MAGDEVICE: (MSPELL: 0..500; NUMCHARGES: 0..200); TELEPORT: (TTOWHERE: RMCODETYPE; TACTIVERM: 0..2000); END; CHTYPE = (FIGHTER, THIEF, MAGICUSER, DM, CLERIC, PALADIN, MAYOR, RANGER, DUMMY, BARBARIAN, CRES3); USERTYPE = PACKED RECORD NAME: ALFA; SSJ: BOOLEAN (*SPECIAL PRIVILEDGES FLAG*); WEIGHT: 0..5000 (* MAX CARRYING WEIGHT *); OBJECTTAIL: OBJECTPOINT; LVL: 0..25 (* PLAYER LEVEL *); CLASS: CHTYPE; HITS: 0..2500; MAXHITS: 0..2500; MAGIC: 0..2500; MAXMAGIC: 0..2500; EXPERIENCE: 0..262000; AGUILD: BOOLEAN; SENDDAY: 0..31 (* NUMBER OF PUBLIC SENDS TODAY *); AC: - 50..50 (* ARMOR CLASS *); RMCODE: RMCODETYPE (* LOCATION *); STR, INT, DEX, PTY, CON: - 10..25; EVIL: BOOLEAN; SPELLDAY: 0..10 (* NUMBER OF SPECIAL SPELLS TODAY *); LASTACCESS: 0..31 (* DATE IN MONTH OF LAST LOGIN *); PW: 0..131071 (* HASH OF PW *); MONEY: 0..500000 (* MONEY IN BANK*); INVISIBLE: BOOLEAN; FATIGUE: 0..2500; NONEXISTANT: BOOLEAN; SKILLNEW: BOOLEAN; SEX: (MALE,FEMALE); DEAD: BOOLEAN; MAXFATIGUE: 0..2500; POISONED: BOOLEAN; PLAYTESTER: BOOLEAN; PLYRTEMP, ECHO: BOOLEAN; SSHARP,STHRUST,SBLUNT,SLONG: 0..7 (* SKILL LEVELS *); CONVERTED: 0..1023; HIDDEN,ASSOC,MASTER,TGUILD: BOOLEAN; RESERVED: 0..777777B; UNHASH: INTEGER (* HASH OF UP TO 4 LEGAL ACCESS UN'S *); LASTINPUT: TIMETYPE; NEXT: USERPOINT; USWEAP, USARM, USSHIELD: OBJECTPOINT; DEFPLAYER: USERPOINT; DEFMON: MONSTERPOINT; TRM: ALFA; LASTCMD: ALFA; ENTRY: ENTRYTYPE; STATUS: STATUSTYPE; FOLLOW, NEXTUSER: USERPOINT; UN: ALFA7; LASTATK: TIMETYPE (*LAST ATK TIME*); LASTHEAL: TIMETYPE (*LAST HP/MP INCREASE*); HITATTIME: TIMETYPE (*TIME OF LAST ENEMY ATK*); ENCOUNTSTOP: BOOLEAN; DRUNK: TIMETYPE; AUTO, BRIEF, MESBLOCK: BOOLEAN; DATA: INTEGER; WDATA: ALFA; END; SPELLTYPE = PACKED RECORD SPLHASH: INTEGER; SPLLEN: 0..1000; SPLMP: 0..200; SPLLVL: - 4..25; SPLINT: 0..25; SPLTYPE: (ONUSER, ONPLAYER, ONMON, ONUSPLAYER, ONMONPLAYER, ONOBJECT); END; (*$B2 LARGER BUFFER *) INTFILE = SEGMENTED FILE OF INTEGER (*BOOTSEG FILE*); (*$B= RESTORE SIZE *) BINFILETYPE = SEGMENTED FILE OF INTEGER; ADJOINTYPE = PACKED ARRAY [1..6] OF 0.. 1000; ROOMTYPE = PACKED RECORD ADJOIN: ADJOINTYPE; OUT: RMCODETYPE; DESCCODE: 0..50 (* DESCRIPTION INDEX *); DESCREC: 0..300 (* DESCRIPTION RECORD *); LASTDIR: 0..8 (*FOR TRACKING*); WHICHENCOUNTER: 0..200; ENCOUNTERTIME: 0..1000; NOTIFYDM: BOOLEAN; THOUSANDS: SET OF 1..6; RMPLAYERTAIL: USERPOINT; RMMONSTERTAIL: MONSTERPOINT; RMOBJECTTAIL: OBJECTPOINT; SAFE: BOOLEAN (* ROOM SAFE AGAINST ATK *); END; ROOMLIST = PACKED ARRAY [0.. RMLIMIT] OF ROOMTYPE; VAR TASKNAM: ALFA7; USER: USERPOINT; BOOTSEG: INTFILE (* BINARY OVL + SEGFILE *); ILOOP: INTEGER (*LOOP VAR FOR STORING BOOTSEG DATA*); EPERSON: BINFILETYPE (*PERSON FILE*); DAYFILE: SEGCHARFIL (* GAME DAYFILE *); (* GLOBAL VARIABLES *) (*THE FOLLOWING VARIABLES ARE PART OF THE MULTI CONTROL WORD. FOR SIMPLICITY'S SAKE, THEY ARE MADE INTO GLOBAL PARAMETERS RATHER THAN FORMAL PASSED PARAMETERS. *) TERM: ALFA (* TERMINAL NUMBER FOR I/O. USED EVERYWHERE *); INPUT: INPUTTYPE (* SPECIAL INPUT FILE WITH BIG BUFFER *); CURRENTREC: INTEGER (* CURRENT RECORD OF EDESC FILE *); CURRENTLINE: INTEGER (* CURRENT LINE OF EDESC FILE *); LASTUPDATE: INTEGER (* LAST POSTING OF DATA FILES *); RA: INTEGER (* COUNT OF RA+1 REQUESTS SINCE LAST READ *); (* THE FOLLOWING ARE PSUEDO CONSTANTS. THESE ARE FUNDAMENTAL VALUES WHICH ARE INITIALIZED AT THE BEGINNING OF THE PROGRAM. *) ZEROPARM: PARMBLOCK (* = NULL BLOCK. 000000000000B *); FIST, DEADBODY: OBJECTTYPE (* DEAD PLAYER "OBJECT *); CNAME: ARRAY [CHTYPE] OF ALFA (* CHARACTER TYPES *); TODAY: INTEGER (* DAY OF MONTH FOR FILE EXPIRATION *); DAY, SYSDATE: INTEGER (* DAY OF WEEK, SYSTEM PDATE *); NTH: ARRAY [0..20] OF ALFA (* WORD VALUE OF #'S 0-20 *); NUMSTRING: ARRAY [0..20] OF ALFA (*NUMBERS SPELLED IN WORDS*); DIRLIST: PACKED ARRAY [1..7] OF ALFA; CMDLIST: CMDTYPELIST (* TABLE OF ALL COMMANDS *); CMDNUM: CMDNUMTYPE (* HASH CODE FOR COMMANDS *); SPELLIST: ARRAY [0.. SPELLEN] OF ALFA; SPELLCLASS: PACKED ARRAY [0.. SPELLEN] OF SPELLTYPE; ENCOUNTERINDEX: PACKED ARRAY [1.. LENCOUNTER, 1..6] OF 0..200; OBJINDEX: PACKED ARRAY [1.. OBJLISTLEN, 1..6] OF 0..200; EDITLIST: EDITTYPELIST (* DO NOT CHANGE THE ORDER OF THIS LIST! *); PROTOUSER: USERTYPE (*DEFAULT STATS*); PROTOMONSTER: MONSTERTYPE (*DEFAULT STATS*); PROTOOBJECT: OBJECTTYPE; PROTOROOM: ROOMTYPE; (* POINTER TAILS. THESE ARE THE BEGINNINGS OF LINKED LISTS. THE TAILS POINT TO THE FIRST VALUE IN THE LIST. IN A SENSE, THE TAILS ARE ENTRY POINTS TO THE LISTS, AND ARE USED AS SUCH. *) USERTAIL: USERPOINT; (* SYSTEM-WIDE VARIABLES. THESE ARE GLOBAL VARIABLES*) NUSERS: INTEGER (* # OF ACTIVE USERS*); REALTIME: INTEGER (*CURRENT TIME IN SECS*); CLOCKTIME: ALFA (*CURRENT TIME IN CLOCK FORMAT*); NEXTCHECK: ALFA (*TIME OF NEXT TIMED-EVENT*); EVENT: ARRAY [1.. LENEVENT] OF ALFA (*EVENT QUEUE*); FIRSTLOGIN: BOOLEAN (* FLAG SET WHILE INITIALIZING *); TASKCLOSED: CHAR (* FLAG SET TO 'C' IF CLOSED *); ERRFLAG: INTEGER (* ERROR TRAP FLAG. =0 IF INHIBIT ERROR TRAP *); MSPEED: INTEGER; NUMRUN: INTEGER (* NUMBER OF TIMES TASK TAKEN UP *); NOTICE: PACKED ARRAY [1..80] OF CHAR (*CURRENT PROGRAM NOTICE*); MONPARMLIST: PACKED ARRAY [1..26] OF PARAMETERS; OBJPARMLIST: PACKED ARRAY [1..33] OF PARAMETERS; RMPARMLIST: PACKED ARRAY [1..13] OF PARAMETERS; USRPARMLIST: PACKED ARRAY [1..42] OF PARAMETERS; ERRLOC: ALFA; UNACTIVE: ARRAY [1.. MAXPLUSONE] OF PACKED RECORD OFFTERM: ALFA; OFFTIME: TIMETYPE; END; UNACLOC: INTEGER; QUEUE: PACKED ARRAY [1.. MAXQUEUE] OF PACKED RECORD QTERM: ALFA; QUN: ALFA7; QTIME: TIMETYPE END; NUMQUEUED: INTEGER; HELLFREEZESOVER: BOOLEAN; NORESTART: ALFA; PRO: ARRAY[MALE..FEMALE] OF PACKED ARRAY [1..3] OF CHAR; BADUN: ALFA7 (* UN BLOCKED OFF DUE TO PW GUESSING *); BADCOUNT: INTEGER (* NUMBER OF PW GUESSES *); VALUE RA = 0 (* COUNT OF RA+1 REQUESTS *); QUEUE = (MAXQUEUE OF (BLANKS, 'ABC1234', 0)); NUMQUEUED = 0; TERM = ALFA ('5', 9 OF COL) (* MTXT AND TERM # 0 *); UNACTIVE = (MAXPLUSONE OF (BLANKS, 0)); UNACLOC = 1; CURRENTREC = 0; CURRENTLINE = 0; LASTUPDATE = 0; ZEROPARM = (6 OF COL) (* THIS IS CONSTANT. *); NUSERS = 0; REALTIME = 0; NEXTCHECK = 'INITIALIZE'; EVENT = (' 00.01.00.', ' 00.05.00.', ' 00.10.00.', ' 00.30.00.', ' 00.45.00.', ' 00.55.00.' , ' 00.58.59.', ' 00.59.00.', ' 07.10.00.', ' 12.00.00.', ' 14.30.00.' , ' 14.45.00.', ' 14.55.00.', ' 14.59.59.', ' 15.00.00.', ' 15.04.00.', ' 19.00.00.' , ' 20.58.59.' , ' 20.59.00.', ' 22.40.00.', ' 23.55.00.'); USERTAIL = NIL; ENCOUNTERINDEX = ((2, 3, 4, 5, 6, 7), (8, 9, 10, 78, 79, 80), (11, 12, 13, 14, 15, 0), (16, 17, 18, 0, 0, 0), (19, 20, 21, 22, 23, 0), (22, 23, 24, 25, 0, 0), (26, 27, 28, 29, 30, 31), (32, 33, 34, 35, 0, 0), (36, 37, 38, 39, 0, 0), (40, 41, 42, 43, 44, 0), (45, 46, 47, 48, 49, 0), (58, 59, 50, 51, 0, 0), (52, 0, 0, 0, 0, 0), (53, 54, 0, 0, 0, 0), (55, 56, 57, 0, 0, 0), (60, 61, 62, 63, 64, 65), (66, 67, 68, 69, 70, 71), (72, 73, 74, 75, 76, 77)); OBJINDEX = ((1, 2, 11, 16, 21, 22), (2, 5, 12, 23, 0, 0), (24, 25, 26, 27, 0, 0), (23, 26, 27, 0, 0, 0), (28, 0, 0, 0, 0, 0), (7, 17, 29, 30, 0, 0), (31, 32, 33, 34, 0, 0), (35, 36, 37, 38, 0, 0), (39, 40, 41, 42, 0, 0), (43, 44, 45, 46, 0, 0), (47, 48, 49, 0, 0, 0), (50, 51, 52, 53, 54, 0), (55, 56, 57, 58, 59, 60), (61, 62, 63, 64, 65, 66), (67, 68, 69, 70, 71, 72), (73, 74, 75, 76, 77, 78)); CNAME = ('FIGHTER ', 'THIEF ', 'MAGIC-USER', 'CARETAKER ', 'CLERIC ', 'PALADIN ' , 'TOWN MAYOR', 'RANGER ', 'DUMMY ', 'BARBARIAN ', ' '); NTH = ('ZEROTH ', 'FIRST ', 'SECOND ', 'THIRD ', 'FOURTH ', 'FIFTH ' , 'SIXTH ', 'SEVENTH ', 'EIGHTH ', 'NINTH ', 'TENTH ', 'ELEVENTH ', 'TWELFTH ', 'THIRTEENTH', 'FOURTEENTH', 'FIFTEENTH ', 'SIXTEENTH ' , 'SEVENT"NTH', 'EIGHTEENTH', 'NINTEENTH ', 'TWENTIETH '); NUMSTRING = ('ZERO ', 'ONE ', 'TWO ', 'THREE ', 'FOUR ', 'FIVE ' , 'SIX ', 'SEVEN ', 'EIGHT ', 'NINE ', 'TEN ', 'ELEVEN ', 'TWELVE ', 'THIRTEEN ', 'FOURTEEN ', 'FIFTEEN ', 'SIXTEEN ' , 'SEVENTEEN ', 'EIGHTEEN ', 'NINTEEN ', 'TWENTY '); DIRLIST = ('NORTH ', 'SOUTH ', 'EAST ', 'WEST ', 'UP ', 'DOWN ' , 'OUT '); CMDLIST = CMDTYPELIST ('ACCEPT ', 'APPEAL ', 'ATTACK ', 'BACKSTAB ', 'BLOCK ', 'BREAK ' , 'BRIEF ', 'BUY ', 'CAST ', 'CATALOG ', 'CHANGEPW ', 'CIRCLE ', 'CLIMB ', 'CLOCK ', 'CLOSE ', 'DOWN ', 'DRAW ' , 'DRINK ', 'DROP ', 'D ', 'EAST ', 'ECHO ', 'END ', 'ENTER ', 'EXAMINE ', 'EXIT ', 'EXPERIENCE', 'E ' , 'FEINT ', 'FOLLOW ', 'GET ', 'GO ', 'HELP ', 'HIDE ', 'HINT ', 'HIT ', 'HOLD ', 'IDENTIFY ', 'INFORMATIO' , 'INVENTORY ', 'KILL ', 'LEAVE ', 'LOCK ', 'LOOK ', 'LOSE ', 'NORTH ', 'NUSERS ', 'N ', 'OFFER ', 'OPEN ' , 'OUT ', 'PANIC ', 'PARLEY ', 'PARRY ', 'PAWN ', 'PICKLOCK ', 'PUT ', 'QUIT ', 'READ ', 'REPAIR ', 'RETURN ' , 'RUN ', 'SAVE ', 'SAY ', 'SEARCH ', 'SELL ', 'SEND ', 'SMASH ', 'SOUTH ', 'STATUS ', 'STEAL ', 'STRIKE ' , 'SUICIDE ', 'S ', 'TAKE ', 'TALK ', 'THRUST ', 'TRACK ', 'TRAIN ', 'TURN ', 'UNLOCK ', 'UP ', 'USERS ' , 'USE ', 'U ', 'WEAR ', 'WEST ', 'WIELD ', 'W ', 'YELL ', '*ABORT ', '*AUTO ', '*CHANGENAM', '*CLOSE ' , '*DAYFILE ', '*DELETENEW', '*EDIT ', '*INVISIBLE', '*MONSPEED ', '*NEWS ', '*NONEXISTA', '*NOTICE ', '*OFF ', '*OPEN ', '*PANIC ' , '*PURGEDEAT', '*REGISTERS', '*SAY ', '*SEND ', '*TEST ', '*UPDATE ', '*YELL '); CMDNUM = CMDNUMTYPE (61, 45, 11, 72, 76, 70, 25, 46, 44, 48, 59, 86, 9, 26, 66, 6, 10, 10, 8, 6, 3, 34, 17, 9, 24, 7, 79, 3, 85, 55, 63, 9, 28, 73, 32, 11, 10, 31, 22, 41, 11, 7, 67, 24, 56, 1, 20, 1, 60, 65, 7, 78, 81, 42, 49, 69, 8, 17, 64, 57, 29, 78, 40, 12, 74, 49 , 14, 70, 2, 33, 84, 11, 39, 2, 63, 81, 43, 71, 75, 62, 68, 5, 35, 10, 5, 10, 4, 10, 4, 13, 21, 87, 58, 18, 80, 53, 16, 30, 54, 52, 83, 47, 82, 19, 27, 50, 77, 36, 38, 51, 23, 37); EDITLIST = EDITTYPELIST ('MODIFY ', 'DELETE ', 'DISPLAY ', 'CREATE ', 'STOP ', 'XQ ' , 'END ', 'ROOM ', 'OBJECT ', 'MONSTER ', 'PLAYER ', 'FILE ', 'MLIST ', 'OLIST '); SPELLIST = ('NULL ', 'VIGOR ', 'HEAL ', 'FIREBALL ', 'LIGHTNING ', 'HURT ' , 'CUREPOISON', 'DISINTEGRA', 'BEFUDDLE ', 'TELEPORT ', 'WISH ', 'PASSDOOR ', 'ENCHANT ', 'BLESS ', 'PROTECTION', 'CURSE ', 'POISON ' , 'INTOXICATE'); SPELLCLASS = ((0, 0, 0, 0, 0, ONUSER) (*NULL*) , (172, 14, 3, 0, 10, ONUSPLAYER) (*VIGOR*) , (153, 15, 6, 1, 10, ONUSPLAYER) (*HEAL*) , (205, 19, 10, 2, 11, ONMONPLAYER) (*FIREBALL*) , (385, 31, 15, 4, 13, ONMONPLAYER) (*LIGHTNING*) , (47, 4, 1, - 3, 8, ONMONPLAYER) (*HURT*) , (205, 15, 6, 1, 9, ONUSPLAYER) (*CUREPOISON*) , (567, 48, 20, 5, 14, ONMONPLAYER) (*DISINTEGRATE*) , (296, 28, 5, 1, 11, ONMONPLAYER) (*BEFUDDLE*) , (620, 46, 30, 6, 14, ONUSPLAYER) (*TELEPORT*) , (697, 62, 50, 10, 17, ONUSPLAYER) (*WISH*) , (277, 23, 20, 5, 13, ONOBJECT) (*PASSDOOR*) , (385, 34, 20, 5, 13, ONOBJECT) (*ENCHANT*) , (181, 14, 16, 4, 11, ONPLAYER) (*BLESS*) , (269, 21, 10, 2, 10, ONUSER) (*PROTECTION*) , (327, 23, 10, 5, 10, ONPLAYER) (*CURSE*) , (315, 25, 10, 4, 10, ONUSPLAYER) (*POISON*) , (310, 23, 8, 3, 9, ONUSPLAYER) (*INTOXICATE*) ); MONPARMLIST = (('DE', DFLAG), ('BL', DFLAG), ('FO', DFLAG), ('GU', DFLAG), ('AT', DFLAG), ('SR', DFLAG), ('MO', DFLAG), ('FL', DFLAG), ('AS', DFLAG), ('LV', DNUM), ('HI', DNUM), ('MH', DNUM), ('EX', DNUM), ('PE', DFLAG), ('MA', DFLAG), ('TR', DNUM), ('NA', DWORD), ('FR', DFLAG), ('IN', DFLAG), ('RE', DFLAG), ('DR', DFLAG), ('PO', DFLAG), ('AM', DFLAG), ('UN', DFLAG), ('SP', DFLAG), ('PA', DNUM)); OBJPARMLIST = (('NA', DOTHER), ('AR', DWORD), ('CA', DFLAG), ('WE', DNUM), ('VA', DNUM), ('MA', DFLAG), ('PE', DFLAG), ('TY', DWORD), ('TO', DNUM), ('MI', DNUM), ('MH', DNUM), ('SL', DNUM), ('WP', DNUM), ('SF', DNUM), ('SH', DNUM), ('AF', DNUM), ('AH', DNUM), ('DI', DNUM), ('DR', DNUM), ('IN', DFLAG), ('MU', DNUM), ('SP', DNUM), ('CC', DFLAG), ('CT', DNUM), ('CI', DNUM), ('XX', DNUM), ('CL', DNUM), ('DC', DFLAG), ('DT', DNUM), ('DL', DNUM), ('UL', DNUM), ('CH', DNUM), ('RO', DNUM)); USRPARMLIST = (('NA', DWORD), ('ZZ', DWORD), ('WE', DNUM), ('LV', DNUM), ('CL', DWORD), ('VI', DNUM), ('MV', DNUM), ('MA', DNUM), ('MM', DNUM), ('EX', DNUM), ('AC', DNUM), ('RO', DNUM), ('BR', DFLAG), ('ST', DNUM), ('IN', DNUM), ('DX', DNUM), ('PT', DNUM), ('EC', DFLAG), ('CO', DNUM), ('SE', DWORD), ('UN', DWORD), ('PW', DWORD), ('MO', DNUM), ('LA', DNUM), ('IV', DFLAG), ('FA', DNUM), ('MF', DNUM), ('PO', DFLAG), ('PL', DFLAG), ('HD', DFLAG), ('TG', DFLAG), ('MB', DFLAG), ('AG', DFLAG), ('EV', DFLAG), ('SL', DNUM), ('TL', DNUM), ('NO', DFLAG), ('SS', DNUM), ('TS', DNUM), ('BS', DNUM), ('PS', DNUM), ('OR',DOTHER)); RMPARMLIST = (('DI', DNUM), ('DR', DNUM), ('N ', DNUM), ('S ', DNUM), ('E ', DNUM), ('W ', DNUM), ('U ', DNUM), ('D ', DNUM), ('OU', DNUM), ('EN', DNUM), ('ET', DNUM), ('NO', DFLAG), ('SA', DFLAG)); PROTOUSER = USERTYPE (EMPTY,FALSE,0,NIL,1,FIGHTER,10,10,10,10,0, FALSE, 0, 10, 1, 11,11,11,11,11,FALSE,0,1, 15187, 200, FALSE, 15, FALSE,FALSE,MALE,FALSE,10,FALSE,FALSE,FALSE,FALSE, 0,0,0,0,457,FALSE,FALSE,FALSE,FALSE,0,1 ,0,NIL,NIL,NIL,NIL,NIL , NIL, ALFA('5', 9 OF COL), ' ', XINIT, SINIT, NIL, NIL, 'ABC1234', 0, 0, 0, FALSE, 0, FALSE, FALSE, FALSE, 0, ' '); PROTOMONSTER = MONSTERTYPE ('SOMETHING ', NIL, TRUE, FALSE, FALSE, FALSE, TRUE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, NIL, 0, 10, 10, NIL, 100, TRUE, 1, TRUE, FALSE, 0, 0, 0); PROTOOBJECT = OBJECTTYPE (ALFA20('T', 'H', 'I', 'N', 'G', 15 OF COL), NIL, A, TRUE, 1, 0, FALSE, FALSE, FALSE, 1, 0, 0, MISC); PROTOROOM = ROOMTYPE (ADJOINTYPE(6 OF 0), 0, 1, 3, 0, 0, 0, FALSE, [], NIL, NIL, NIL, FALSE); DEADBODY = OBJECTTYPE (ALFA20('B','O','D','Y',' ',15 OF COL), NIL, NONE , FALSE, 150, 0, FALSE, FALSE, FALSE, 1, 0, 0, MISC); FIST = OBJECTTYPE (ALFA20('F', 'I', 'S', 'T', 16 OF COL), NIL, A, TRUE, 0, 0, FALSE, FALSE, FALSE, 1, 0, 0, WEAP, 1, 3, 100, - 2, BLUNT); FIRSTLOGIN = TRUE (* SET FOR BRINGING UP THE TASK. *); TASKCLOSED = 'C'; ERRFLAG = 0 (*INHIBIT ERROR TRAPPING FOR INITIALIZATION*); NOTICE = (80 OF COL); HELLFREEZESOVER = FALSE; BADUN = 'ABC1234'; BADCOUNT = 0; PRO = ('HIM','HER'); (*$L'LOW LEVEL PROCEDURES' *) PROCEDURE (*$E'MILIEU.' *) HEADER; BEGIN MESSAGE('COPYRIGHT (C) 1983 A. KLIETZ.'); END (*HEADER*); PROCEDURE ABORT(STRING: DYNAMIC ALFA); (* FORCE AN ERROR IN THE PROGRAM *) BEGIN MESSAGE(STRING); IF USER <> NIL THEN IF USER ^.NAME <> EMPTY THEN BEGIN MESSAGE('PLAYER WHO CAUSED PTA IS:'); MESSAGE(USER ^.NAME); WRITELN(DAYFILE, CLOCKTIME, ' PLAYER WHO CAUSED PTA IS: ', USER ^.NAME) END (*IF*); WRITELN(DAYFILE, CLOCKTIME, ' ', STRING); HALT END (*ABORT*); PROCEDURE MULTIO; (* THIS IS THE MAIN LOOP OF MILIEU. ALL ROUTINES CONTAINED HEREIN ARE EXCLUSIVELY FOR MILIEU. THE ABOVE ROUTINES ARE GENERAL UTILITIES ONLY; THE FOLLOW ROUTINES ARE MORE SPECIFIC TO THE PROGRAM *) TYPE PLINDEXTYPE = 1.. ABSOLUTEPLMAX (* LENGTH OF HASH INDEX FOR PERSON FILE *); NAMETYPELIST = ARRAY [1.. MAXNAMES] OF ALFA; VAR ROOM: ROOMLIST (*DUNGEON MAP*); TERMLIST: TERMTYPELIST (*LIST OF TERMINAL #'S TO SENT MSGS TO*); EMAP, EROOM, EROOM2: BINFILETYPE (*DUNGEON FILES*); EDESC: SEGCHARFIL (*DESCRIPTION FILE*); BUFFER: BUFTYPE (* INPUT BUFFER *); LOGLEN: LOGLENTYPE; LENBUF: LENBUFTYPE; CONTROL: BYTE (* CONTROL WORD *); PARM: PARMBLOCK; WHICHCONTROL: INTEGER; PLAYERINDEX: ARRAY [PLINDEXTYPE] OF ALFA (*LIST OF STORED PLAYERS*); CURRENTPLINDEX: 0.. ABSOLUTEPLMAX; LOC: INTEGER (* LOCATION OF GETWORD POINTER *); NUM: INTEGER (* KLUDGE PATCH: MONSTER INDEX # *); CMDCODE: INTEGER (* COMMAND NUMBER *); RANMONLIST: PACKED ARRAY [1.. RANMONLEN] OF MONSTERTYPE; RANOBJLIST: PACKED ARRAY [1.. RANOBJLEN] OF OBJECTTYPE; TNAME, YNAME, TCLASS, YCLASS: ARRAY [1..3] OF ALFA; TLVL, YLVL: ARRAY [1..3] OF INTEGER; TBUF, YBUF: PACKED ARRAY [1..3, 1..80] OF CHAR; NEWSBUF: PACKED ARRAY [1..5, 1..80] OF CHAR; TRADETIME, FCASH, TCASH: INTEGER; NFPLYR, NTPLYR, NFOBJ, NTOBJ: ALFA; SFOBJ, STOBJ: ALFA20; RMSEGLOC: PACKED ARRAY [0.. MAXSEGS] OF 0..1000; NUMSEGS: INTEGER (* # OF SEGS *); CURRENTSEG: INTEGER (* CURRENT LOC OF EMAP *); EOFSEG: INTEGER (* EOF, LAST SEG + 1 *); SLOTTBL: ARRAY [0.. MAXPLUSONE] OF INTEGER; ACTIVE: ARRAY [0.. MAXPLUSONE] OF INTEGER; NUMROOMS: RMCODETYPE; ACTIVEFLAG: INTEGER (* FLAG INACTIVE PORT ERR *); NOPROMPT: BOOLEAN; CURRENTDUM: 0..2 (*SELECT EROOMS FILE NONE, 1, 2*); LIMBOINDEX: INTEGER; PROCEDURE SETPFM(VAR F: BINFILETYPE; PFM, UN, PW: ALFA7); EXTERN; PROCEDURE (*$E'SAVEFET' *) SAVDFILE(VAR F: BINFILETYPE; OFFSET, LOC: INTEGER); EXTERN; PROCEDURE SWITCH(WFLAG: BOOLEAN; SELECTDUN: INTEGER); BEGIN IF SELECTDUN = 1 THEN BEGIN OPENDFIL(EROOM, 'DUNJON1 ', WFLAG); SETPFM(EROOM, 'DUNJON1', ORIGINUN, FILEPW); OPENDFIL(EROOM2, 'DUNJON2 ', FALSE); SETPFM(EROOM2, 'DUNJON2', ORIGINUN, FILEPW) END (*IF*) ELSE IF SELECTDUN = 2 THEN BEGIN OPENDFIL(EROOM, 'DUNJON2 ', WFLAG); SETPFM(EROOM, 'DUNJON2', ORIGINUN, FILEPW); OPENDFIL(EROOM2, 'DUNJON1 ', FALSE); SETPFM(EROOM2, 'DUNJON1', ORIGINUN, FILEPW) END (*IF*); SAVDFILE(EROOM, 2, 2); SAVDFILE(EROOM2, 2, 3); IF WFLAG THEN REWRITE(EROOM) ELSE RESET(EROOM); END (*SWITCH*); FUNCTION SUBSET(PART, FULL: ALFA): BOOLEAN; (* SUBSET RETURNS THE VALUE TRUE IF THE STRING "PART" IS IDENTICAL TO THE BEGINNING OF "FULL". EXAMPLE: "VASE" IS A SUBSET OF "VASELINE".*) VAR I: - 10..11; BEGIN SUBSET := TRUE (* DEFAULT *); I := 1; WHILE (I >= 1) AND (I <= 10) DO IF PART[I] = FULL[I] THEN I := I + 1 ELSE I := - I (* FLAG MISMATCH *); IF I < 0 THEN SUBSET := (PART[- I] = ' ') END (*SUBSET*); PROCEDURE ODESTROY(VAR CONT: OBJECTPOINT); VAR OBJ: OBJECTPOINT; BEGIN IF CONT ^.OBCLASS = CHEST THEN WHILE CONT ^.OBJECTTAIL <> NIL DO BEGIN OBJ := CONT ^.OBJECTTAIL; CONT ^.OBJECTTAIL := CONT ^.OBJECTTAIL ^.NEXT; ODESTROY(OBJ) END (*WHILE*); DISPOSE(CONT); CONT := NIL END (*ODESTROY*); FUNCTION PM(MON: MONSTERPOINT): CHAR; (* PRINTMONSTER WILL WRITE OUT THE NAME OF A MONSTER. IF THERE IS MORE THAN ONE MONSTER IN THE ROOM, THEN A MONSTER'S NUMBER IS RETURNED IN THE FORM "RAT #3", "JACKAL #5", ETC. *) VAR SINGLE: BOOLEAN; BEGIN SINGLE := MON ^.TOP AND (MON ^.NUM = 1); IF SINGLE THEN WRITE('THE '); WRITE(PS(MON ^.NAME)) (* WRITE MONSTER'S NAME. *); IF NOT SINGLE THEN WRITE(' #', MON ^.NUM: 0) (* WRITE OUT MONSTER # *); PM := ' ' (* RETURN DUMMY SPACE *) END (*PM*); FUNCTION SEARCHPLINDEX(NAME: ALFA): INTEGER; (* SEARCHPLINDEX LOOKS THROUGH *PLAYERINDEX* TO SEE IF A USER IS ALREADY LOGGED IN. IF SO, THE INDEX # IS RETURNED. IF NOT, ZERO IS RETURNED. USES CURRENTPLINDEX *) VAR INDEX: 0.. ABSOLUTEPLMAX; FOUND: BOOLEAN; BEGIN FOUND := FALSE; INDEX := 0; WHILE NOT FOUND AND (INDEX < CURRENTPLINDEX) DO BEGIN INDEX := INDEX + 1; FOUND := (PLAYERINDEX[INDEX] = NAME); END (*WHILE*); IF FOUND THEN SEARCHPLINDEX := INDEX ELSE SEARCHPLINDEX := 0 END (*SEARCHPLINDEX*); FUNCTION FINDOPENLOC: INTEGER; (* LOOKS FOR OPENINGS FOR NEW USER ENTRIES. - 1 = FULL FILE, 0 = APPEND ENTRY TO EOF, > 0 = OPEN LOCATION *) VAR LOC: INTEGER; BEGIN LOC := SEARCHPLINDEX(EMPTY); FINDOPENLOC := LOC; IF LOC = 0 THEN IF CURRENTPLINDEX >= ABSOLUTEPLMAX THEN FINDOPENLOC := - 1; END (*FINDOPENLOC*); PROCEDURE READPLAYER(VAR PLAYER: USERPOINT; NAME: ALFA); VAR INDEX: INTEGER; BEGIN INDEX := SEARCHPLINDEX(NAME); IF INDEX > 0 THEN BEGIN POINTFILE(EPERSON, (INDEX + 1) DIV 2); GETSEG(EPERSON); IF ODD(INDEX) THEN READUSR(PLAYER, TRUE) ELSE BEGIN READUSR(PLAYER, FALSE); READUSR(PLAYER, TRUE) END; WITH PLAYER ^ DO BEGIN AC := 10; NEXT := NIL; USWEAP := NIL; USARM := NIL; DEFPLAYER := NIL; USSHIELD := NIL; DEFMON := NIL; LASTINPUT := REALTIME; ENTRY := XNAME; STATUS := SLOGIN END (*WITH*) END (*IF*); END (*READPLAYER*); PROCEDURE WRITEPLAYER(VAR PLAYER: USERPOINT; NAME: ALFA); (* WRITEPLAYER WILL WRITE THE PLAYER'S RECORD INTO THE POSITION *NAME*. IF THE NAME IS NOT FOUND, THEN A NEW ENTRY IS CREATED. THERE ARE TWO PLAYERS PER PRU. UP TO SIX OBJECTS CAN BE STORED FOR EACH PLAYER. MESSAGES ARE SENT TELLING THE USER IF THE SAVE WAS SUCCESSFUL OR NOT. *) VAR INDEX: INTEGER; TEMP: USERPOINT; FULL: BOOLEAN; BEGIN FULL := FALSE; INDEX := SEARCHPLINDEX(NAME); IF INDEX <= 0 THEN (* NOT FOUND *) BEGIN INDEX := FINDOPENLOC; IF INDEX < 0 THEN FULL := TRUE (* FILE FULL *) ELSE (* FIND OPEN LOC *) BEGIN IF INDEX = 0 THEN BEGIN (* OPEN LOC AT EOI *) NEW(TEMP); TEMP ^ := PROTOUSER; REWRITE(EPERSON, 10000); WRITEUSR(TEMP, TRUE); NEW(TEMP); TEMP ^ := PROTOUSER; WRITEUSR(TEMP, TRUE); CURRENTPLINDEX := CURRENTPLINDEX + 2; (* MAKE 2 NEW ENTRIES IN A NEW PRU *) PUTSEG(EPERSON); INDEX := CURRENTPLINDEX - 1; END (*IF*); IF WHICHCONTROL <> MTHU THEN WRITELN(TERM, 'ENTRY CREATED.') END (*ELSE*) END (* MAKE INDEX *); IF NOT FULL THEN BEGIN PLAYERINDEX[INDEX] := PLAYER ^.NAME; POINTFILE(EPERSON, (INDEX + 1) DIV 2); GETSEG(EPERSON) (* READ IN OLD PRU *); NEW(TEMP); IF ODD(INDEX) THEN BEGIN READUSR(TEMP, FALSE); READUSR(TEMP, TRUE) END ELSE READUSR(TEMP, TRUE); OPENDFIL(EPERSON, 'EPERSON ', TRUE); RANDOMACCESS(EPERSON) (*RESET RANDOM BIT*); IF ODD(INDEX) THEN BEGIN WRITEUSR(PLAYER, TRUE); WRITEUSR(TEMP, TRUE) END ELSE BEGIN WRITEUSR(TEMP, TRUE); WRITEUSR(PLAYER, TRUE) END; POINTFILE(EPERSON, (INDEX + 1) DIV 2); PUTSEG(EPERSON) (* WRITE PRU *); IF WHICHCONTROL <> MTHU THEN WRITELN(TERM, 'PLAYER FILE UPDATED.') END (*IF*) ELSE BEGIN IF WHICHCONTROL <> MTHU THEN WRITELN(TERM, 'SORRY, FILE FULL. PLAYER CANNOT BE SAVED.'); WRITEUSR(PLAYER, FALSE); (* DISPOSE OF USER AND OBJECTS *) END (*ELSE*) END (*WRITEPLAYER*); PROCEDURE PRINTDESC(REC, LINE, PHRASENUM: INTEGER; BRIEF: BOOLEAN); (* PRINTDESC WILL DISPLAY LINE *LINE* IN RECORD *REC*OF THE EDESC FILE. THE CURRENT RECORD IS STORED IN *CURRENTREC*, A GLOBAL VARIABLE. IF IT IS ZERO, THEN THE CURRENTREC IS UNKNOWN, AND THE FILE IS REWOUND. *) VAR CH: CHAR; LINENUM, NUMPHRASES, ILOOP: INTEGER; BRMARK: BOOLEAN; BEGIN BRMARK := FALSE; IF CURRENTREC <= 0 THEN BEGIN (* REWIND FILE *) RESET(EDESC); CURRENTREC := 1; CURRENTLINE := 1 END; IF (REC <= 0) OR (REC > 1000) OR (LINE <= 0) OR (LINE > 500) THEN ABORT(' MIL72 - BAD DESCRIPTION INDEX!'); IF (REC <> CURRENTREC) OR (CURRENTLINE > LINE) THEN BEGIN CURRENTLINE := 1; GETSEG(EDESC, REC - CURRENTREC); CURRENTREC := REC; END (*IF*); IF EOS(EDESC) OR EOF(EDESC) THEN WRITE('MEL314 - BAD DESCRIPTION RECORD!') ELSE BEGIN WHILE CURRENTLINE < LINE DO (* SKIP DOWN TO LINE # *) BEGIN READLN(EDESC); CURRENTLINE := CURRENTLINE + 1; IF EOS(EDESC) THEN BEGIN WRITE('MEL315 - BAD DESCRIPTION INDEX!'); CURRENTLINE := LINE END END (*WHILE*); IF NOT EOS(EDESC) THEN BEGIN READ(EDESC, LINENUM, NUMPHRASES); IF LINENUM <> CURRENTLINE THEN ABORT(' MIL73 - LINE NUMBER MISMATCH IN DESC FILE!'); IF PHRASENUM > NUMPHRASES THEN ABORT(' MIL74 - PHRASENUM NUMBER TOO LARGE!'); IF PHRASENUM = 0 THEN (*RANDOM PHRASE*) PHRASENUM := RND(NUMPHRASES); FOR ILOOP := 1 TO PHRASENUM DO REPEAT READ(EDESC, CH) UNTIL CH = '/'; CH := ' '; WHILE NOT EOLN(EDESC) AND (CH <> '/') DO BEGIN READ(EDESC, CH); IF CH <> '/' THEN IF CH = '#' THEN BRMARK := NOT BRMARK ELSE IF NOT (BRMARK AND BRIEF) THEN IF CH = '+' THEN BEGIN WRITELN; WRITE(TERM); PRINTDESC(REC, LINE + 1, PHRASENUM, BRIEF); CH := '/' (*FLAG EOLN*) END (*IF*) ELSE WRITE(CH) END (*WHILE*); IF NOT EOS(EDESC) THEN READLN(EDESC); CURRENTLINE := CURRENTLINE + 1; END (*IF*) ELSE CURRENTREC := 0 END (*ELSE*) END (*PRINTDESC*); PROCEDURE WRITESEG(SLOTNUM, SEGNUM: INTEGER; ERASE: BOOLEAN); (* WRITE ROOM SEGMENT TO EMAP K*) VAR RM, RLOOP, ILOOP: INTEGER; MON2, MONSTER: MONSTERPOINT; OBJ2, OBJECT: OBJECTPOINT; PROCEDURE WRITERM(VAR ROOM: ROOMTYPE); VAR ILOOP: 1..3; BUF: USREC; PROCEDURE (*$E'COPYREC'*) WCPYRM(VAR OLD: ROOMTYPE; NEW: USREC; LEN: INTEGER); EXTERN; BEGIN (*WRITERM*) WCPYRM(ROOM, BUF, 3); FOR ILOOP := 1 TO 3 DO WRITE(EMAP, BUF[ILOOP]) END (*WRITERM*); PROCEDURE SAVECHEST(VAR CONT: OBJECTPOINT); VAR OBJ, OBJ2: OBJECTPOINT; BEGIN IF CONT ^.OBCLASS = CHEST THEN BEGIN OBJ := CONT ^.OBJECTTAIL; WHILE OBJ <> NIL DO BEGIN WRITEUOBJ(EMAP, OBJ ^); SAVECHEST(OBJ); OBJ2 := OBJ ^.NEXT; IF ERASE THEN DISPOSE(OBJ); OBJ := OBJ2 END (*WHILE*) END (*IF*) END (*SAVECHEST*); BEGIN (*WRITESEG*) IF (SEGNUM < 0) OR (SEGNUM >= NUMSEGS) THEN ABORT(' MIL211 - SEGNUM OUT OF BOUNDS!'); REWRITE(EMAP, 10000); RMSEGLOC[SEGNUM] := EOFSEG; EOFSEG := EOFSEG + 1; FOR RLOOP := 0 TO 9 DO BEGIN RM := RLOOP + 10 * SLOTNUM; WRITERM(ROOM[RM]); OBJECT := ROOM[RM].RMOBJECTTAIL; WHILE OBJECT <> NIL DO BEGIN WRITEUOBJ(EMAP, OBJECT ^); SAVECHEST(OBJECT); OBJ2 := OBJECT ^.NEXT; IF ERASE THEN DISPOSE(OBJECT); OBJECT := OBJ2 END (*WHILE*); MONSTER := ROOM[RM].RMMONSTERTAIL; WHILE MONSTER <> NIL DO BEGIN MONSTER ^.DEFPLAYER := NIL; WRITEMON(EMAP, MONSTER ^); OBJECT := MONSTER ^.OBJECTTAIL; WHILE OBJECT <> NIL DO BEGIN WRITEUOBJ(EMAP, OBJECT ^); OBJ2 := OBJECT ^.NEXT; IF ERASE THEN DISPOSE(OBJECT); OBJECT := OBJ2 END (*WHILE*); MON2 := MONSTER ^.NEXT; IF ERASE THEN DISPOSE(MONSTER); MONSTER := MON2 END (*WHILE*) END (*FOR*); PUTSEG(EMAP); CURRENTSEG := EOFSEG; END (*WRITESEG*); PROCEDURE READSEG(SLOTNUM, SEGNUM: INTEGER); (* READ IN A ROOM SEGMENT *) VAR ILOOP, RLOOP, RM: INTEGER; OBJECT, OBJECT2: OBJECTPOINT; MONSTER, MONSTER2: MONSTERPOINT; PROCEDURE READRM(VAR ROOM: ROOMTYPE); VAR ILOOP: 1..3; BUF: USREC; PROCEDURE (*$E'COPYREC'*) RCPYRM(VAR OLD: USREC; VAR NEW: ROOMTYPE; LEN: INTEGER); EXTERN; BEGIN (*READRM*) FOR ILOOP := 1 TO 3 DO READ(EMAP, BUF[ILOOP]); RCPYRM(BUF, ROOM, 3) END (*READRM*); PROCEDURE GETCHEST(CONT: OBJECTPOINT); VAR OBJ, OBJ2: OBJECTPOINT; BEGIN IF CONT ^.OBCLASS = CHEST THEN IF CONT ^.OBJECTTAIL <> NIL THEN BEGIN NEW(OBJ); CONT ^.OBJECTTAIL := OBJ; READUOBJ(EMAP, OBJ ^); GETCHEST(OBJ); WHILE (OBJ ^.NEXT <> NIL) DO BEGIN NEW(OBJ2); OBJ ^.NEXT := OBJ2; READUOBJ(EMAP, OBJ2 ^); OBJ := OBJ2; GETCHEST(OBJ) END (*WHILE*) END (*IF*) END (*GETCHEST*); PROCEDURE GETMONOBJECTS(VAR MONSTER: MONSTERPOINT); VAR OBJ, OBJ2: OBJECTPOINT; BEGIN IF MONSTER ^.OBJECTTAIL <> NIL THEN BEGIN NEW(OBJ); MONSTER ^.OBJECTTAIL := OBJ; READUOBJ(EMAP, OBJ ^); WHILE OBJ ^.NEXT <> NIL DO BEGIN NEW(OBJ2); OBJ ^.NEXT := OBJ2; READUOBJ(EMAP, OBJ2 ^); OBJ := OBJ2 END (*WHILE*) END (*IF*) END (*GETMONOBJECTS*); BEGIN (*READSEG*) IF (SEGNUM < 0) OR (SEGNUM >= NUMSEGS) THEN ABORT(' MIL210 - SEGNUM OUT OF BOUNDS!'); SLOTTBL[SLOTNUM] := SEGNUM; IF CURRENTSEG = 0 THEN BEGIN RESET(EMAP); CURRENTSEG := 1; END; GETSEG(EMAP, RMSEGLOC[SEGNUM] - CURRENTSEG); CURRENTSEG := RMSEGLOC[SEGNUM]; FOR RLOOP := 0 TO 9 DO BEGIN RM := RLOOP + 10 * SLOTNUM; READRM(ROOM[RM]); ROOM[RM].RMPLAYERTAIL := NIL; IF ROOM[RM].RMOBJECTTAIL <> NIL THEN BEGIN NEW(OBJECT); ROOM[RM].RMOBJECTTAIL := OBJECT; READUOBJ(EMAP, OBJECT ^); GETCHEST(OBJECT); WHILE OBJECT ^.NEXT <> NIL DO BEGIN NEW(OBJECT2); OBJECT ^.NEXT := OBJECT2; READUOBJ(EMAP, OBJECT2 ^); OBJECT := OBJECT2; GETCHEST(OBJECT) END (*WHILE*); END (*IF*); IF ROOM[RM].RMMONSTERTAIL <> NIL THEN BEGIN NEW(MONSTER); ROOM[RM].RMMONSTERTAIL := MONSTER; READMON(EMAP, MONSTER ^); MONSTER ^.DEFPLAYER := NIL; GETMONOBJECTS(MONSTER); WHILE MONSTER ^.NEXT <> NIL DO BEGIN NEW(MONSTER2); MONSTER ^.NEXT := MONSTER2; READMON(EMAP, MONSTER2 ^); MONSTER2 ^.DEFPLAYER := NIL; GETMONOBJECTS(MONSTER2); MONSTER := MONSTER2 END (*WHILE*); END (*IF*) END (*FOR*); IF NOT EOS(EMAP) THEN ABORT(' MIL287 - FAILED TO READ ENTIRE RM SEG!'); END (*READSEG*); FUNCTION S(RM: INTEGER): INTEGER; (* RETURN PHYSICAL LOC OF ROOM IN ROOM LIST *) VAR ILOOP, SEGNUM: INTEGER; BEGIN IF (RM < 1) OR (RM >= NUMSEGS * 10) THEN ABORT(' MIL205 - ROOM # OUT OF BOUNDS!'); SEGNUM := RM DIV 10; ILOOP := 0; WHILE (ILOOP <= MAXUSERS) AND (SLOTTBL[ILOOP] <> SEGNUM) DO ILOOP := ILOOP + 1; IF ILOOP <= MAXUSERS THEN (*FOUND*) S := ILOOP * 10 + RM - SEGNUM * 10 ELSE BEGIN ILOOP := 0; WHILE (ILOOP <= MAXUSERS) AND (SLOTTBL[ILOOP] > - 1) DO ILOOP := ILOOP + 1; IF ILOOP > MAXUSERS THEN BEGIN ILOOP := 0; WHILE (ILOOP <= MAXUSERS) AND (ACTIVE[ILOOP] > 0) DO ILOOP := ILOOP + 1; END (*IF*); IF ILOOP > MAXUSERS THEN ABORT(' MIL206 - ROOM BUFFER FULL!'); ERRFLAG := 0; IF SLOTTBL[ILOOP] > - 1 THEN WRITESEG(ILOOP, SLOTTBL[ILOOP], TRUE); READSEG(ILOOP, SEGNUM); S := ILOOP * 10 + RM - SEGNUM * 10; END (*ELSE*); ERRFLAG := 1; END (*S*); PROCEDURE ADDSEG; VAR ILOOP, JLOOP: INTEGER; BEGIN ERRFLAG := 0; IF NUMSEGS > MAXSEGS THEN WRITELN(TERM, ' SORRY, MAX ROOM LIMIT REACHED.') ELSE BEGIN ILOOP := 0; WHILE (ILOOP <= MAXUSERS) AND (ACTIVE[ILOOP] > 0) DO ILOOP := ILOOP + 1; IF ILOOP > MAXUSERS THEN ABORT(' MIL209 - RM BUF FULL.'); IF SLOTTBL[ILOOP] > - 1 THEN WRITESEG(ILOOP, SLOTTBL[ILOOP], TRUE); FOR JLOOP := ILOOP * 10 TO ILOOP * 10 + 9 DO ROOM[JLOOP] := PROTOROOM; SLOTTBL[ILOOP] := NUMSEGS; WRITELN(TERM, 'NEW ROOMS ', NUMSEGS * 10: 1, ' TO ', NUMSEGS * 10 + 9: 1, ' CREATED.'); NUMSEGS := NUMSEGS + 1; WRITESEG(ILOOP, NUMSEGS - 1, FALSE); END (*ELSE*); NUMROOMS := NUMSEGS * 10 - 1 (* NEW HIGHEST #ED ROOM *); ERRFLAG := 1 END (*ADDSEG*); FUNCTION SA(RM: INTEGER): INTEGER; (* LOAD AND SET-ACTIVE ROOM SEG *) VAR SEG, SEGRM: INTEGER; BEGIN SEGRM := S(RM); SEG := SEGRM DIV 10; ACTIVE[SEG] := ACTIVE[SEG] + 1; SA := SEGRM END (*SA*); PROCEDURE INACTIVE(RM: INTEGER); (* SET ROOM INACTIVE *) VAR SEG: INTEGER; BEGIN SEG := RM DIV 10; IF ACTIVE[SEG] = 0 THEN ABORT(' SEC222 - NON ACTIVE SEG ASSUMED ACTIVE!'); ACTIVE[SEG] := ACTIVE[SEG] - 1 END (*INACTIVE*); FUNCTION W(RM: INTEGER): INTEGER; (* RETURN LOGICAL NUM OF PHYSICAL ROOM NUM *) VAR WHERE: INTEGER; BEGIN IF (RM < 0) OR (RM > RMLIMIT) THEN WHERE := 0 ELSE WHERE := SLOTTBL[RM DIV 10] * 10 + RM - (RM DIV 10) * 10; IF (WHERE < 0) OR (WHERE > NUMROOMS) THEN WHERE := 0; W := WHERE; END (*W*); FUNCTION MATCHMONSTER(MONSTERTAIL: MONSTERPOINT; FUNCTION TEST(MON: MONSTERPOINT): BOOLEAN): MONSTERPOINT; (* MATCHMONSTER WILL GO THOUGH A LIST OF MONSTERS (MONSTERTAIL) UNTIL IT FINDS A MONSTER THAT MEETS THE CRITERIA OF *TEST* *) VAR FOUND: BOOLEAN; POINTER: MONSTERPOINT; BEGIN FOUND := FALSE; POINTER := MONSTERTAIL; WHILE NOT FOUND AND (POINTER <> NIL) DO IF TEST(POINTER) (* IT'S EFFICIENT TO PASS ONLY THE POINTER *) THEN FOUND := TRUE ELSE POINTER := POINTER ^.NEXT; IF FOUND THEN MATCHMONSTER := POINTER ELSE MATCHMONSTER := NIL END (*MATCHMONSTER*); FUNCTION MATCHOBJECT(OBJECTTAIL: OBJECTPOINT; FUNCTION TEST(OBJECT: OBJECTPOINT): BOOLEAN): OBJECTPOINT; (* MATCHOBJECT WILL GO THROUGH A LIST OF OBJECTS UNTIL IT FINDS AN OBJECT THAT MEETS THE CRITERIA OF *TEST* *) VAR FOUND: BOOLEAN; POINTER: OBJECTPOINT; BEGIN FOUND := FALSE; POINTER := OBJECTTAIL; WHILE NOT FOUND AND (POINTER <> NIL) DO IF TEST(POINTER) THEN FOUND := TRUE ELSE POINTER := POINTER ^.NEXT; IF FOUND THEN MATCHOBJECT := POINTER ELSE MATCHOBJECT := NIL END (*MATCHOBJECT*); FUNCTION MATCHPLAYER(PLAYERTAIL: USERPOINT; FUNCTION TEST(PLAYER: USERPOINT): BOOLEAN): USERPOINT; (* MATCHPLAYER WILL GO THROUGH A LIST OF PLAYERS (PLAYERTAIL) UNTIL IT FINDS A PLAYER THAT MEETS THE CRITERIA OF *TEST* *) VAR FOUND: BOOLEAN; POINTER: USERPOINT; BEGIN FOUND := FALSE; POINTER := PLAYERTAIL; WHILE NOT FOUND AND (POINTER <> NIL) DO IF TEST(POINTER) THEN FOUND := TRUE ELSE POINTER := POINTER ^.NEXT; IF FOUND THEN MATCHPLAYER := POINTER ELSE MATCHPLAYER := NIL END (*MATCHPLAYER*); FUNCTION MATCHUSER(USERTAIL: USERPOINT; FUNCTION TEST(USER: USERPOINT): BOOLEAN): USERPOINT; (* MATCHUSER WILL GO THROUGH THE MAIN USER LIST (USERTAIL) UNTIL IT FINDS A USER THAT MEETS THE CRITERIA OF *TEST*. *) VAR FOUND: BOOLEAN; POINTER: USERPOINT; BEGIN FOUND := FALSE; POINTER := USERTAIL; WHILE NOT FOUND AND (POINTER <> NIL) DO IF TEST(POINTER) THEN FOUND := TRUE ELSE POINTER := POINTER ^.NEXTUSER; IF FOUND THEN MATCHUSER := POINTER ELSE MATCHUSER := NIL END (*MATCHUSER*); PROCEDURE FIXMONCOUNT(MONSTERTAIL: MONSTERPOINT; NAME: ALFA); (* FIXMONCOUNT RESTORES THE INDEX NUMBERS OF MONSTERS AFTER ONE LEAVES OR ARRIVES. IT UPDATES .TOP AND .NUM *) VAR PT: MONSTERPOINT; I, NUMMON: INTEGER; FUNCTION NAMEMON(MON: MONSTERPOINT): BOOLEAN; (* IF MONSTER'S NAME = NAMECLASS TO PATCH *) BEGIN NAMEMON := (NAME = MON ^.NAME) END; BEGIN (*FIXMONCOUNT*) PT := MATCHMONSTER(MONSTERTAIL, NAMEMON); IF PT <> NIL THEN BEGIN NUMMON := 0; WHILE PT <> NIL DO BEGIN PT := MATCHMONSTER(PT ^.NEXT, NAMEMON); NUMMON := NUMMON + 1 END (*WHILE*); PT := MATCHMONSTER(MONSTERTAIL, NAMEMON); FOR I := NUMMON DOWNTO 1 DO BEGIN PT ^.NUM := MIN(I, 9); PT ^.TOP := (I = NUMMON); PT := MATCHMONSTER(PT ^.NEXT, NAMEMON) END (*FOR*) END (*IF*) END (*FIXMONCOUNT*); PROCEDURE STOPOTHERATK (* AGAINST PLAYER *) (PLAYER: USERPOINT; (* GLOBAL RMPLAYERTAIL AND RMMONSTERTAIL *) RM: RMCODETYPE); (* STOPOTHERATK WILL RESET THE DEFPLAYER POINTERS ON HOSTILE PLAYERS AND MONSTERS. IT ALSO STOPS THE USER'S ATTACKS. *) VAR OTHERPLAYER: USERPOINT; OTHERMONSTER: MONSTERPOINT; FUNCTION PATK(PLYR: USERPOINT): BOOLEAN; (* IS ANOTHER PLAYER ATTACKING? *) BEGIN PATK := (PLYR ^.DEFPLAYER = PLAYER) END; FUNCTION MATTACK(MON: MONSTERPOINT): BOOLEAN; (* IS ANOTHER MONSTER ATTACKING? *) BEGIN MATTACK := (MON ^.DEFPLAYER = PLAYER) END; BEGIN (*STOPOTHERATK*) PLAYER ^.DEFMON := NIL (* STOP PLAYER'S ATTACKS TOO.*); PLAYER ^.DEFPLAYER := NIL (* STOP PLAYER'S ATTACKS TOO.*); WITH ROOM[RM] DO BEGIN OTHERPLAYER := MATCHPLAYER(RMPLAYERTAIL, PATK); WHILE OTHERPLAYER <> NIL DO BEGIN OTHERPLAYER ^.DEFPLAYER := NIL; OTHERPLAYER := MATCHPLAYER(OTHERPLAYER ^.NEXT, PATK) END (*WHILE*); (* MAKE MONSTERS STOP ATTACKING TOO *) OTHERMONSTER := MATCHMONSTER(RMMONSTERTAIL, MATTACK); WHILE OTHERMONSTER <> NIL DO BEGIN OTHERMONSTER ^.DEFPLAYER := NIL; IF OTHERMONSTER^.MREACT >= 5 THEN OTHERMONSTER^.MREACT := 0; OTHERMONSTER := MATCHMONSTER(OTHERMONSTER ^.NEXT, MATTACK) END (*WHILE*) END (*WITH*) END (*STOPOTHERATK*); PROCEDURE STOPPLYRATK(MONSTER: MONSTERPOINT; RM: RMCODETYPE); (* STOPPLRYATK WILL STOP THE ATTACKS OF PLAYERS AGAINST THE MONSTER THAT IS DELETED. *) VAR OTHERPLAYER: USERPOINT; FUNCTION PATTACKING(OTHRPLYR: USERPOINT): BOOLEAN; (* PATTACKING RETURNS TRUE IF ANOTHER PLAYER IS ATTACKING MONSTAR *) BEGIN PATTACKING := (OTHRPLYR ^.DEFMON = MONSTER) END; BEGIN (*STOPPLYRATK*) WITH ROOM[RM] DO BEGIN OTHERPLAYER := MATCHPLAYER(RMPLAYERTAIL, PATTACKING); WHILE OTHERPLAYER <> NIL DO BEGIN OTHERPLAYER ^.DEFMON := NIL; OTHERPLAYER := MATCHPLAYER(OTHERPLAYER ^.NEXT, PATTACKING) END (*WHILE*) END (*WITH*) END (*STOPPLYRATK*); PROCEDURE DESTROY(VAR MON: MONSTERPOINT); (* DESTROY MONSTER RECORD *) VAR OBJ: OBJECTPOINT; BEGIN WHILE MON ^.OBJECTTAIL <> NIL DO BEGIN OBJ := MON ^.OBJECTTAIL; MON ^.OBJECTTAIL := MON ^.OBJECTTAIL ^.NEXT; ODESTROY(OBJ); END (*WHILE*); DISPOSE(MON); MON := NIL END (*DESTROY*); PROCEDURE INSERTMONSTER(VAR MONSTER: MONSTERPOINT; RM: RMCODETYPE); (* INSERTMONSTER WILL ADD A MONSTER TO THE TAIL. IT ALSO CALLS *FIXMONCOUNT* WHICH RESTORES .TOP AND .NUM *) BEGIN WITH ROOM[RM] DO BEGIN MONSTER ^.NEXT := RMMONSTERTAIL; RMMONSTERTAIL := MONSTER; FIXMONCOUNT(RMMONSTERTAIL, MONSTER ^.NAME); (* RESTORE .NUM AND .TOP OF THE MONSTERCLASS *) END (*WITH*) END (*INSERTMONSTER*); PROCEDURE PLACEPLAYER(VAR PLYR: USERPOINT; RM: RMCODETYPE); (* INSERT PLAYER INTO LOGICAL *RM* *) VAR NEWRM: RMCODETYPE; BEGIN NEWRM := SA(RM); PLYR ^.NEXT := ROOM[NEWRM].RMPLAYERTAIL; ROOM[NEWRM].RMPLAYERTAIL := PLYR; PLYR ^.RMCODE := NEWRM END (*PLACEPLAYER*); PROCEDURE DELETEMONSTER(PT: MONSTERPOINT; RM: RMCODETYPE); (* DELETE MONSTER REMOVES A MONSTER FROM A LIST OF MONSTERS (MONSTERTAIL). IF THE MONSTER (PT) IS NOT FOUND, THE PROGRAM ABORTS! SO MAKE SURE THE MONSTER EXISTS BEFORE DELETING IT *) VAR PT2: MONSTERPOINT; FOUND: BOOLEAN; BEGIN IF PT = NIL THEN ABORT(' MIL86 - CANNOT DELETE NIL MONSTER!'); WITH ROOM[RM] DO BEGIN IF PT = RMMONSTERTAIL THEN RMMONSTERTAIL := RMMONSTERTAIL ^.NEXT ELSE BEGIN FOUND := FALSE; PT2 := RMMONSTERTAIL; WHILE NOT FOUND AND (PT2 <> NIL) DO IF PT2 ^.NEXT = PT THEN FOUND := TRUE ELSE PT2 := PT2 ^.NEXT; IF FOUND THEN PT2 ^.NEXT := PT ^.NEXT (*DELETE*) ELSE BEGIN MESSAGE(PT ^.NAME); ABORT(' MIL02 - DELETED MON NOT FOUND') END END (*ELSE*); FIXMONCOUNT(RMMONSTERTAIL, PT ^.NAME); (* RESTORE .NUM AND .TOP OF THE REMAINING MONSTERS *) IF RMPLAYERTAIL <> NIL THEN STOPPLYRATK(PT, RM) END (*WITH*) END (*DELETEMONSTER*); FUNCTION DELETEOBJECT(PT, OBJECTTAIL: OBJECTPOINT): BOOLEAN; (* DELETEOBJECT REMOVES AN OBJECT FROM A LINKED LIST *) VAR PT2: OBJECTPOINT; FOUND: BOOLEAN; BEGIN IF PT = NIL THEN ABORT(' MIL84 - CANNOT DELETE NIL OBJ!'); IF PT = OBJECTTAIL THEN DELETEOBJECT := TRUE ELSE BEGIN DELETEOBJECT := FALSE; FOUND := FALSE; PT2 := OBJECTTAIL; WHILE NOT FOUND AND (PT2 <> NIL) DO IF PT2 ^.NEXT = PT THEN FOUND := TRUE ELSE PT2 := PT2 ^.NEXT; IF FOUND THEN PT2 ^.NEXT := PT ^.NEXT (* DELETE *) ELSE BEGIN MESSAGE(PT ^.NAME); ABORT(' MIL05 - DELETED OBJ NOT FOUND') END END (*ELSE*) END (*DELETEOBJECT*); PROCEDURE CLEANRM(RM: RMCODETYPE); (* CLEANRM REMOVES OLD MONSTERS AND OBJECTS THAT DON'T HAVE THE *PERMANENT* BIT SET. *) VAR NEXTMON, OLDMON: MONSTERPOINT; NEXTOBJ, OLDOBJ: OBJECTPOINT; FUNCTION TEMPOBJ(OBJ: OBJECTPOINT): BOOLEAN; (* IS OBJECT TEMPORARY*) BEGIN TEMPOBJ := (NOT OBJ ^.PERMANENT) END; BEGIN (*CLEANRM*) WITH ROOM[RM] DO BEGIN OLDOBJ := MATCHOBJECT(RMOBJECTTAIL, TEMPOBJ); WHILE OLDOBJ <> NIL DO BEGIN NEXTOBJ := OLDOBJ ^.NEXT; IF DELETEOBJECT(OLDOBJ, RMOBJECTTAIL) THEN RMOBJECTTAIL := RMOBJECTTAIL ^.NEXT; ODESTROY(OLDOBJ); OLDOBJ := MATCHOBJECT(NEXTOBJ, TEMPOBJ) END (*WHILE*); OLDMON := RMMONSTERTAIL; WHILE OLDMON <> NIL DO BEGIN NEXTMON := OLDMON ^.NEXT; IF OLDMON ^.PERMANENT THEN OLDMON ^.HITS := OLDMON ^.MAXHITS ELSE BEGIN DELETEMONSTER(OLDMON, RM); DISPOSE(OLDMON); END; OLDMON := NEXTMON END (*WHILE*) END (*WITH*) END (*CLEANRM*); PROCEDURE DELETEPLAYER(PT: USERPOINT; RM: RMCODETYPE); (* DELETEPLAYER WILL REMOVE A PLAYER FROM A LINKED LIST *) VAR PT2: USERPOINT; FOUND: BOOLEAN; BEGIN IF PT = NIL THEN ABORT(' MIL87 - CANNOT DELETE NIL PLAYER!'); WITH ROOM[RM] DO BEGIN IF PT = RMPLAYERTAIL THEN BEGIN RMPLAYERTAIL := RMPLAYERTAIL ^.NEXT; IF RMPLAYERTAIL = NIL THEN CLEANRM(PT ^.RMCODE) ELSE IF RMPLAYERTAIL ^.HITS = 0 THEN CLEANRM(PT ^.RMCODE) END (*IF*) ELSE BEGIN FOUND := FALSE; PT2 := RMPLAYERTAIL; WHILE NOT FOUND AND (PT2 <> NIL) DO IF PT2 ^.NEXT = PT THEN FOUND := TRUE ELSE PT2 := PT2 ^.NEXT; IF FOUND THEN PT2 ^.NEXT := PT ^.NEXT (*DELETE*) ELSE BEGIN MESSAGE(PT ^.NAME); ABORT(' MIL06 - DELETED PLYR NOT FOUND!') END END (*ELSE*); STOPOTHERATK(PT, RM (* RMPLAYERTAIL, RMMONSTERTAIL*)) (* STO P ATTACKS ON THIS USER BY MONSTERS/PLAYERS *); PT ^.FOLLOW := NIL; INACTIVE(RM); END (*WITH*) END (*DELETEPLAYER*); PROCEDURE DELETEUSER(PT: USERPOINT; VAR USERTAIL: USERPOINT); (* DELETEUSER WILL REMOVE A USER FROM THE MAIN LIST. IF THE USER IS NOT CURRENTLY LOGGING IN (STATUS=SLOGIN), THEN HE IS ALSO DELETED FROM THE ROOM HE IS IN. *) VAR PT2: USERPOINT; FOLLOWPLYR: USERPOINT; FOUND: BOOLEAN; FUNCTION PLFOLLOW(USR: USERPOINT): BOOLEAN; BEGIN PLFOLLOW := (USR ^.FOLLOW = PT) END; BEGIN (*DELETEUSER*) IF (PT = NIL) OR (USERTAIL = NIL) THEN ABORT(' MIL88 - CANNOT DELETE NIL USER!'); IF PT = USERTAIL THEN USERTAIL := USERTAIL ^.NEXTUSER ELSE BEGIN FOUND := FALSE; PT2 := USERTAIL; WHILE NOT FOUND AND (PT2 <> NIL) DO IF PT2 ^.NEXTUSER = PT THEN FOUND := TRUE ELSE PT2 := PT2 ^.NEXTUSER; IF FOUND THEN PT2 ^.NEXTUSER := PT ^.NEXTUSER (*DELETE*) ELSE BEGIN MESSAGE(PT ^.NAME); ABORT(' MIL08 - DELETED RECORD NOT FOUND!') END END (*ELSE*); IF PT ^.STATUS <> SLOGIN THEN DELETEPLAYER(PT, PT ^.RMCODE); PT ^.RMCODE := W(PT ^.RMCODE); FOLLOWPLYR := MATCHUSER(USERTAIL, PLFOLLOW); WHILE FOLLOWPLYR <> NIL DO BEGIN FOLLOWPLYR ^.FOLLOW := NIL; FOLLOWPLYR := MATCHUSER(FOLLOWPLYR ^.NEXT, PLFOLLOW) END (*WHILE*) END (*DELETEUSER*); FUNCTION NOTIMEOUT(USR: USERPOINT): BOOLEAN; BEGIN IF USR = NIL THEN ABORT(' MIL220 - NIL USR POINTER!'); IF (REALTIME - USR ^.LASTINPUT <= RESPONDLIMIT) THEN NOTIMEOUT := TRUE ELSE NOTIMEOUT := USR ^.AUTO; END (*NOTIMEOUT*); FUNCTION MSGTERM(VAR TERMLIST: TERMTYPELIST; TALKHOW: TALKHOWTYPE): INTEGER; (* USERTAIL IS USED GLOBALLY *) (* MSGTERM SETS UP A LIST OF TERMINAL NUMBERS FOR TO SEND TEXT TO. IT IS USED TO SEND MESSAGES TO PLAYERS IN THE SAME ROOM, IN ADJACENT ROOMS, AND THROUGHOUT THE WHOLE PROGRAM. *) VAR FACTOR, COUNT, ILOOP: INTEGER; OTHERPLAYER: USERPOINT; FUNCTION OKSEND(USR: USERPOINT): BOOLEAN; BEGIN OKSEND := ((USR <> USER) AND NOTIMEOUT(USR) AND (USR ^.STATUS <> SLOGIN)); END (*OKSEND*); BEGIN (*MSGTERM*) COUNT := 0; IF NOT USER ^.INVISIBLE OR (CMDCODE IN [12, 13, 14, 16, 36, 37, 38]) OR (TALKHOW = SYSMSG) THEN IF (TALKHOW = LOCAL) OR (TALKHOW = YELL) THEN WITH ROOM[USER ^.RMCODE] DO BEGIN OTHERPLAYER := MATCHPLAYER(RMPLAYERTAIL, OKSEND); WHILE (OTHERPLAYER <> NIL) AND (COUNT < MAXNAMES) DO BEGIN COUNT := COUNT + 1; TERMLIST[COUNT] := OTHERPLAYER ^.TRM; OTHERPLAYER := MATCHPLAYER(OTHERPLAYER ^.NEXT, OKSEND); END (*WHILE*); IF TALKHOW = YELL THEN FOR ILOOP := 1 TO 6 DO IF ADJOIN[ILOOP] > 0 THEN BEGIN IF ILOOP IN THOUSANDS THEN FACTOR := 1000 ELSE FACTOR := 0; OTHERPLAYER := MATCHPLAYER(ROOM[S(ADJOIN[ILOOP] + FACTOR)].RMPLAYERTAIL, OKSEND); WHILE (OTHERPLAYER <> NIL) AND (COUNT < MAXNAMES) DO BEGIN COUNT := COUNT + 1; TERMLIST[COUNT] := OTHERPLAYER ^.TRM; OTHERPLAYER := MATCHPLAYER(OTHERPLAYER ^.NEXT, OKSEND) END (*WHILE*) END (*IF*) END (* WITH *) ELSE IF TALKHOW IN [ALL, OTHERS, NOBLOCK, BRALL, BROTHERS, SYSMSG] THEN BEGIN OTHERPLAYER := MATCHUSER(USERTAIL, OKSEND); WHILE (OTHERPLAYER <> NIL) AND (COUNT < MAXNAMES) DO BEGIN IF NOT ((TALKHOW IN [BROTHERS, BRALL]) AND OTHERPLAYER ^.BRIEF) THEN IF NOT ((TALKHOW = NOBLOCK) AND (OTHERPLAYER ^.MESBLOCK)) THEN BEGIN COUNT := COUNT + 1; TERMLIST[COUNT] := OTHERPLAYER ^.TRM; END; OTHERPLAYER := MATCHUSER(OTHERPLAYER ^.NEXTUSER, OKSEND) END (*WHILE*); IF (TALKHOW IN [SYSMSG, ALL, BRALL]) OR USER ^.ECHO THEN BEGIN COUNT := COUNT + 1; TERMLIST[COUNT] := TERM END; FOR ILOOP := 1 TO MAXQUEUE DO IF QUEUE[ILOOP].QTERM <> BLANKS THEN BEGIN COUNT := COUNT + 1; TERMLIST[COUNT] := QUEUE[ILOOP].QTERM END; END (*IF*) ELSE ABORT(' MIL10 - BAD TALK/TERM FUNCTION!'); IF COUNT > MAXNAMES THEN WRITELN(TERM, 'MIL11 - TERM MSG TABLE OVERFLOW!') ELSE MSGTERM := COUNT END (*MSGTERM*); PROCEDURE STOPUSING(USR: USERPOINT; OBJECT: OBJECTPOINT); (* STOPUSING WILL SET TO NIL EITHER USSHIELD, USARM, OR USWEAP IF THESE OBJECTS ARE DROPPED OR BROKEN. ARMOR CLASS IS ALSO REDUCED ACCORDINGLY *) BEGIN IF OBJECT <> NIL THEN WITH USR ^ DO IF OBJECT = USWEAP THEN USWEAP := NIL ELSE IF OBJECT = USSHIELD THEN BEGIN USSHIELD := NIL; AC := MAX(- 50, MIN(AC + OBJECT ^.SHPLUS, 50)) END ELSE IF OBJECT = USARM THEN BEGIN USARM := NIL; AC := MAX(- 50, MIN(AC + OBJECT ^.ARMPLUS, 50)) END END (*STOPUSING*); FUNCTION FINDTERM(TERM: ALFA; USERTAIL: USERPOINT): USERPOINT; VAR FOUND: BOOLEAN; USERSCANNER: USERPOINT; BEGIN FOUND := FALSE; USERSCANNER := USERTAIL (*POINT TO TOP OF USER LIST*); WHILE NOT FOUND AND (USERSCANNER <> NIL) DO IF USERSCANNER ^.TRM = TERM THEN FOUND := TRUE ELSE USERSCANNER := USERSCANNER ^.NEXTUSER; IF FOUND THEN FINDTERM := USERSCANNER ELSE ABORT(' MIL101 - UNDEFINED TERMINAL!') END (*FINDTERM*); PROCEDURE GETWORD(VAR WORD: ALFA; VAR NUM: INTEGER; VAR BUFFER: BUFTYPE; VAR LENBUF: LENBUFTYPE; VAR LOC: INTEGER); (* GETWORD IS THE MAIN PARSER. IT EXTRACTS THE NEXT WORD OR NUMBER FROM THE BUFFER. THE WORDS "TO", "THE", AND "AT" ARE IGNORED. *) VAR ILOOP, DIGIT: INTEGER; LBSIGN: BOOLEAN; BEGIN WORD := BLANKS; NUM := 0; LBSIGN := FALSE; IF BUFFER[LOC] = ',' THEN LOC := LOC + 1; WHILE (BUFFER[LOC] = ' ') AND (LOC <= LENBUF) DO LOC := LOC + 1 (* SKIP BLANKS *); IF LOC <= LENBUF THEN BEGIN ILOOP := 1; REPEAT IF BUFFER[LOC] = '#' THEN LBSIGN := TRUE; IF (ILOOP <= 10) AND NOT LBSIGN THEN WORD[ILOOP] := BUFFER[LOC]; LOC := LOC + 1; ILOOP := ILOOP + 1; UNTIL (BUFFER[LOC] IN [' ', ',']) OR (LOC > LENBUF); IF WORD[1] IN ['0' .. '9', '-'] THEN WORD := BLANKS (* IT'S A NUMBER, NOT A STRING*); ILOOP := LOC - 1; DIGIT := 1; WHILE ILOOP > 0 DO IF BUFFER[ILOOP] IN ['0' .. '9', '-'] THEN BEGIN IF BUFFER[ILOOP] = '-' THEN NUM := - NUM ELSE BEGIN NUM := NUM + (ORD(BUFFER[ILOOP]) - ORD('0')) * DIGIT; DIGIT := DIGIT * 10 END (*ELSE*); ILOOP := ILOOP - 1 END (*IF*) ELSE ILOOP := 0 (*END WHILE*); IF (WORD = 'TO ') OR (WORD = 'THE ') OR (WORD = 'AT ') OR ( WORD = 'OF ') OR (WORD = 'ON ') OR (WORD = 'IN ') OR ( WORD = 'FOR ') OR (WORD = 'FROM ') OR (WORD = 'SPELL ') OR ( WORD = 'WITH ') THEN GETWORD(WORD, NUM, BUFFER, LENBUF, LOC); (* RECURSIVELY GET THE NEXT WORD.. TO,THE,AT ARE DISCARDED *) END (*IF*) END (*GETWORD*); FUNCTION GETEDITPARM(VAR PARMLIST: DYNAMIC PARMTYPELIST; VAR WORD: ALFA; VAR NUMBER: INTEGER; VAR FLAG: BOOLEAN; VAR BUFFER: BUFTYPE; VAR LENBUF: LENBUFTYPE; VAR LOC: INTEGER): INTEGER; (* GETEDITPARM PARSES THE VARIOUS PARAMETERS USED WHILE USING THE EDITOR.. EXAMPLES ARE: "LV=2,NA=HAROLD,HT=4,SS=FALSE". IT RETURNS 0 IF END-OF-LIST OR ERROR. OTHERWISE IT RETURNS THE INDEX # OF THE PARAMETER PARSED, ALONG WITH ITS VALUE *) VAR PARM: BYTE; WHICHPARM: INTEGER; FOUND: BOOLEAN; BEGIN PARM[1] := ' '; PARM[2] := ' '; WORD := BLANKS; NUM := 0; FLAG := FALSE; IF BUFFER[LOC] = ',' THEN LOC := LOC + 1; WHILE (BUFFER[LOC] = ' ') AND (LOC <= LENBUF) DO LOC := LOC + 1 (* SKIP BLANKS & COMMAS *); IF LOC > LENBUF THEN GETEDITPARM := 0 (* END OF LIST *) ELSE BEGIN PARM[1] := BUFFER[LOC]; LOC := LOC + 1; IF (BUFFER[LOC] <> '=') AND (LOC <= LENBUF) THEN BEGIN PARM[2] := BUFFER[LOC]; LOC := LOC + 1 END; WHILE BUFFER[LOC] IN ['A' .. 'Z'] DO LOC := LOC + 1; IF (BUFFER[LOC] <> '=') OR (LOC >= LENBUF) THEN BEGIN (* BAD PARAMETER *) GETEDITPARM := 0; WRITELN(TERM, 'BAD PARAMETER: ', PARM: 2); END (*IF*) ELSE BEGIN LOC := LOC + 1; FOUND := FALSE; WHICHPARM := 0 (*SEARCH FOR PARM*); WHILE NOT FOUND AND (WHICHPARM < HIGH(PARMLIST)) DO BEGIN WHICHPARM := WHICHPARM + 1; FOUND := (PARM = PARMLIST[WHICHPARM].PNAME) END (*WHILE*); IF NOT FOUND THEN WHICHPARM := 0; IF WHICHPARM = 0 THEN WRITELN(TERM, 'UNKNOWN PARAMETER: ', PARM: 2) ELSE CASE PARMLIST[WHICHPARM].PTYPE OF DFLAG: BEGIN (* BOOLEAN *) IF BUFFER[LOC] = 'T' THEN FLAG := TRUE ELSE IF BUFFER[LOC] = 'F' THEN FLAG := FALSE ELSE BEGIN WHICHPARM := 0; WRITELN(TERM, PARM: 2, ' MUST BE T OR F.') END (*ELSE*); WHILE NOT (BUFFER[LOC] IN [' ', ',']) AND (LOC <= LENBUF) DO LOC := LOC + 1 END (*DFLAG*); DNUM: BEGIN GETWORD(WORD, NUMBER, BUFFER, LENBUF, LOC); IF WORD <> BLANKS THEN BEGIN WHICHPARM := 0; WRITELN(TERM, PARM: 2, ' MUST BE A NUMBER.') END (*IF*) END (*DNUM*); DWORD: BEGIN GETWORD(WORD, NUMBER, BUFFER, LENBUF, LOC); IF (WORD = BLANKS) AND (NUM <> 0) THEN BEGIN WHICHPARM := 0; WRITELN(TERM, PARM: 2, ' - ONLY STRING ALLOWED.') END (*IF*) END (*DWORD*); DOTHER: (*LET CALLING PROGRAM PROCESS PARAMETER*); END (*CASE*); GETEDITPARM := WHICHPARM END (*ELSE*) END (*ELSE*) END (*GETEDITPARM*); PROCEDURE DAYMSG(REASON: ALFA3; WHO: USERPOINT; CAUSE: ALFA; CLEV: INTEGER); (* ISSUE A MESSAGE TO THE GAME DAYFILE *) BEGIN WRITE(DAYFILE, CLOCKTIME, ' ', REASON: 3, ' '); WITH WHO ^ DO WRITE(DAYFILE, NAME, ' ', LVL: 2, ' ', UN: 7); IF CAUSE <> BLANKS THEN WRITE(DAYFILE, ' BY ', CAUSE); IF CLEV <> 0 THEN WRITELN(DAYFILE, ' ', CLEV: 2) ELSE WRITELN(DAYFILE) END (*DAYMSG*); PROCEDURE ROOMDISPLAY(RM: INTEGER; BRIEF: BOOLEAN); (* DISPLAY THE ROOM AFTER ANNOUNCING LOGIN *) FORWARD; PROCEDURE ANNOUNCELOGIN(USER: USERPOINT); VAR I, ILOOP: INTEGER; BEGIN USER ^.STATUS := SNORMAL; WRITELN(TERM) (* SKIP PAST PW ENTRY *); WITH USER ^ DO IF LASTACCESS <> TODAY THEN BEGIN LASTACCESS := TODAY; SPELLDAY := 0; SENDDAY := 0; IF TGUILD OR AGUILD THEN BEGIN MONEY := MAX(0, MONEY - LVL * 20); IF MONEY = 0 THEN BEGIN WRITELN(TERM, 'YOU HAVE NOT THE FUNDS TO PAY YOUR DUES!'); WRITELN(TERM, 'YOU HAVE BEEN EXPELLED FROM THE GUILD.'); AGUILD := FALSE; TGUILD := FALSE; END (*IF*) ELSE WRITELN(TERM, 'DAILY ', LVL * 20: 0, ' GUILD FEE PAID IN FULL. THANK YOU!') END (*IF*); END (*IF*); IF NOTICE[1] <> COL THEN BEGIN WRITELN(TERM, 'NOTICE:'); WRITELN(TERM, PO(NOTICE)); WRITELN(TERM); END; CMDCODE := 0; IF USER ^.SSJ THEN DAYMSG('LOG', USER, BLANKS, 0); USER ^.PLYRTEMP := FALSE; IF USER^.UNHASH IN [0,1] THEN BEGIN USER^.UNHASH := HASH(USER^.UN,5); WRITELN(TERM,'USERNUMBER RESTRICTION TURNED ON.') END; USER^.CONVERTED := 0; FOR ILOOP := 1 TO MSGTERM(TERMLIST, BRALL) DO BEGIN WRITE(TERMLIST[ILOOP], '### PLEASE WELCOME ', PS(USER ^.NAME)); WRITELN(', THE ', PS(CNAME[USER ^.CLASS]), ', FROM ', PS(USER ^.UN), '.'); END (*FOR*); IF NOT USER ^.SSJ AND (USER ^.NONEXISTANT OR USER ^.INVISIBLE) THEN BEGIN USER ^.NONEXISTANT := FALSE; DAYMSG('INV', USER, 'ILLEGAL IV', 0); USER ^.INVISIBLE := FALSE END (*IF*); IF USER ^.INVISIBLE THEN IF USER ^.NONEXISTANT THEN WRITELN(TERM, 'YOU ARE NONEXISTANT.') ELSE WRITELN(TERM, 'YOU ARE CURRENTLY INVISIBLE.'); ROOMDISPLAY(USER ^.RMCODE, USER ^.BRIEF); END (*ANNOUNCELOGIN*); PROCEDURE WRITEPWMASK(TERM: ALFA); BEGIN WRITE(TERM, COL, 'IQQQQQQQQQQ', CHR(76B), CHR(45), 'MMMMMMMMMM', CHR(76B), CHR(45) ); WRITELN('##########', CHR(76B), CHR(45), COL, 'K'); WRITELN(TERM, COL, 'M', COL, 'K'); END (*WRITEPWMASK*); PROCEDURE DOINPUT(VAR BUFFER: BUFTYPE; VAR LENBUF: LENBUFTYPE; VAR USER: USERPOINT); FORWARD; PROCEDURE PROMPTUSER(USER: USERPOINT); VAR ASCII: BOOLEAN; BEGIN IF NOPROMPT AND (LOC <= LENBUF) THEN DOINPUT(BUFFER, LENBUF, USER) ELSE BEGIN ASCII := FALSE; USER ^.ENCOUNTSTOP := FALSE; WRITE(USER ^.TRM); CASE USER ^.ENTRY OF XNAME: WRITELN(COL, 'I', 'E^N^T^E^R ^Y^O^U^R ^N^A^M^E ', COL, 'A'); XNEWCLASS: WRITELN('CLASS ', COL, 'A'); XSTATS: WRITELN('STATS ', COL, 'A'); XSKILL: WRITELN('SKILL ', COL, 'A'); XSEX: WRITELN('FINALLY, IS YOUR CHARACTER A (M)ALE OR (F)EMALE?'); XCMD: IF USER ^.BRIEF THEN WRITELN(COL, 'I', 'D^O ', COL, 'A') ELSE WRITELN(COL, 'I', 'A^C^T^I^O^N ', COL, 'A'); XPASSWORD: BEGIN WRITELN('ENTER YOUR PASSWORD'); WRITEPWMASK(USER ^.TRM); END (*XPASSWORD*); XNEWPW: WRITELN('ENTER ACCESS PASSWORD ', COL, 'A'); XCHANGEPW: WRITELN('ENTER NEW PASSWORD', COL, 'A'); XEDIT: IF USER ^.BRIEF THEN WRITELN('ED', COL, 'A') ELSE WRITELN('EDIT COMMAND', COL, 'A'); XNOTICE: WRITELN('ENTER NOTICE', COL, 'A'); XDEAD: BEGIN WRITELN('CONGRATULATIONS! YOUR DEATH HAS MADE THE NEWSPAPERS!'); WRITELN(TERM, 'IN ONE LINE, TRY TO EXPLAIN WHAT KILLED YOU AND HOW. USE'); WRITELN(TERM, 'WORDS LIKE "HE" AND "SHE" INSTEAD OF "I".'); WRITELN(TERM, 'EXAMPLE: "HIS WEAPON BROKE, AND BEFORE HE KNEW IT THE VAMPIRE'); WRITELN(TERM, 'DRAINED HIS LIFE AWAY.."'); END (*XDEAD*); XSPELL: WRITELN('SAY CHANT ', COL, 'A'); XNEWS: WRITELN('ENTER NEWS', COL, 'A'); XSELL, XREPAIR: WRITELN('YES/NO', COL, 'A'); XWISH: WRITELN('ENTER WISH', COL, 'A'); XSURE: WRITELN('ARE YOU SURE', COL, 'A'); XPARLEY: WRITELN('WOULD YOU LIKE TO HAVE IT, EFFENDI', COL, 'A'); END (*CASE*); REQUESTINPUT(USER ^.TRM, ASCII); END (*ELSE*) END (*PROMPTUSER*); PROCEDURE FINDLIMBO(VAR TERM: ALFA; VAR INDX: INTEGER; PRIORITY: BOOLEAN); (* SCAN FOR A USER IN THE WAITING QUEUE *) VAR ILOOP: INTEGER; PLACED: BOOLEAN; BEGIN IF PRIORITY THEN BEGIN INDX := 1; FOR ILOOP := 1 TO MAXQUEUE DO IF (QUEUE[ILOOP].QTIME < QUEUE[INDX].QTIME) AND (QUEUE[ILOOP].QTIME <> 0) OR ( QUEUE[INDX].QTIME = 0) THEN INDX := ILOOP; TERM := QUEUE[INDX].QTERM; IF TERM = BLANKS THEN ABORT(' MIL532 - QUEUED TERM NOT FOUND!'); END (*IF*) ELSE BEGIN PLACED := FALSE; INDX := 0; WHILE NOT PLACED AND (INDX < MAXQUEUE) DO BEGIN INDX := INDX + 1; PLACED := (TERM = QUEUE[INDX].QTERM) END; IF NOT PLACED THEN INDX := 0; END (*ELSE*) END (*FINDLIMBO*); FUNCTION FINDUSER(WORD: ALFA; USERTAIL: USERPOINT): USERPOINT; FORWARD; PROCEDURE GETSTATUS(WORD: ALFA; USER: USERPOINT); (* OBTAIN A LISTING OF ALL ACTIVE USERS *) VAR PLAYER: USERPOINT; PROCEDURE DISPSTATUS(PLR: USERPOINT); VAR TERMNUM: INTEGER; BEGIN WITH PLR ^ DO BEGIN TERMNUM := ORD(TRM[9]) * 64 + ORD(TRM[10]); WRITE(TERM,NAME,' '); IF MESBLOCK THEN WRITE('*') ELSE WRITE(' '); WRITE(' ', TERMNUM: 3 OCT, ' ', LASTCMD, ' '); IF LVL >= 10 THEN CASE CLASS OF FIGHTER: IF SEX=MALE THEN WRITE('LORD ') ELSE WRITE('LADY '); THIEF: WRITE('MASTER THIEF '); MAGICUSER: WRITE('WIZARD '); CLERIC: IF LVL>=15 THEN WRITE('SAINT ') ELSE WRITE('HIGH PRIEST '); BARBARIAN: WRITE('BARBARIAN CHIEFTAIN '); RANGER: IF SEX=MALE THEN WRITE('RANGER LORD ') ELSE WRITE('AMAZON '); PALADIN: IF SEX=MALE THEN WRITE('LORD OF THE QUEST ') ELSE WRITE('LADY OF THE QUEST '); OTHERWISE WRITE(PS(CNAME[CLASS]), ' ') END (*CASE*) ELSE WRITE(PS(CNAME[CLASS]), ' '); IF USER ^.SSJ THEN WRITE(LVL: 0, ' '); IF NONEXISTANT THEN WRITE(' (NONEXIST)') ELSE IF INVISIBLE THEN WRITE(' (INV)'); IF USER ^.MASTER AND (SEX = FEMALE) THEN WRITE('(F) '); IF USER ^.SSJ THEN IF STATUS = SNORMAL THEN WRITE('(', W(RMCODE): 0, ')'); WRITELN; END (*WITH*); END (*DISPSTATUS*); BEGIN (*GETSTATUS*) WRITELN(TERM); IF NOT USER ^.BRIEF THEN WRITELN(TERM, 'NAME UN S TRM LASTCMD CLASS'); IF WORD <> BLANKS THEN BEGIN PLAYER := FINDUSER(WORD, USERTAIL); IF PLAYER = NIL THEN WRITELN(TERM, 'PLAYER NOT ACTIVE.') ELSE IF NOT PLAYER ^.NONEXISTANT THEN DISPSTATUS(PLAYER) ELSE WRITELN(TERM, 'PLAYER NOT ACTIVE.') END (*IF*) ELSE BEGIN PLAYER := USERTAIL; REPEAT IF (NOT PLAYER ^.INVISIBLE AND (PLAYER ^.STATUS = SNORMAL)) OR USER ^.SSJ THEN DISPSTATUS(PLAYER); PLAYER := PLAYER ^.NEXTUSER UNTIL PLAYER = NIL END (*ELSE*) END (*GETSTATUS*); FUNCTION LOGIN(VAR PARM: PARMBLOCK; VAR TERM: ALFA; VAR BUFFER: BUFTYPE; VAR NUSERS: INTEGER; VAR PLAYERTAIL: USERPOINT): USERPOINT; VAR WORD: ALFA; FOUND: BOOLEAN; VALIDLOGIN: (GOOD, BAD, QUEUED); USFLASH, NEWUSER: USERPOINT; TNUM, NUM, I, ILOOP: INTEGER; DUMPARM: PARMBLOCK; CH, PREVCH: CHAR; PROCEDURE ADDLIMBO(TERM: ALFA; ONTIME: INTEGER; UN: ALFA7); (* ADD A USER TO THE WAITING QUEUE *) VAR N, COUNT, ILOOP: INTEGER; PLACED: BOOLEAN; BEGIN PLACED := FALSE; ILOOP := 0; COUNT := 0; WHILE (ILOOP < MAXQUEUE) AND NOT PLACED DO BEGIN ILOOP := ILOOP + 1; PLACED := (QUEUE[ILOOP].QTERM = BLANKS) END; IF NOT PLACED THEN BEGIN WRITELN(TERM, 'SORRY, THE WAITING ROOM IS FULL.'); WRITECONTROL(MTLO, ZEROPARM, TERM); WRITELN; END (*IF*) ELSE BEGIN N := ILOOP; FOR ILOOP := 1 TO MAXQUEUE DO IF QUEUE[ILOOP].QTERM <> BLANKS THEN WRITELN(QUEUE[ILOOP].QTERM, 'PERSON FROM ', PS(UN), ' ENTERS THE WAITING ROOM.'); QUEUE[N].QTERM := TERM; QUEUE[N].QUN := UN; QUEUE[N].QTIME := ONTIME; COUNT := 0; FOR ILOOP := 1 TO MAXQUEUE DO IF QUEUE[ILOOP].QTERM <> BLANKS THEN COUNT := COUNT + 1; WRITELN(TERM, 'YOU ENTER THE WAITING ROOM, SIT DOWN, AND READ A MAGAZINE.'); WRITELN(TERM, 'YOU ARE THE ', PNTH(COUNT), 'PERSON ON THE WAITING LIST.'); WRITELN(TERM, 'HIT THE KEY IF YOU DO NOT WISH TO WAIT.'); WRITELN(TERM); WRITELN(TERM, 'WAITING...'); WRITELN(TERM); NUMQUEUED := NUMQUEUED + 1; END (*ELSE*); END (*ADDLIMBO*); BEGIN (*LOGIN*) NUSERS := NUSERS + 1; NOPROMPT := FALSE; IF NOT FIRSTLOGIN THEN BEGIN NEW(NEWUSER) (*SET UP NEW USERBLOCK*); NEWUSER ^ := PROTOUSER (* SET DEFAULTS *); PACK(BUFFER, 1, NEWUSER ^.UN) (*PACK USERNUM INTO USER^*); ILOOP := 7; WHILE NEWUSER ^.UN[ILOOP] = COL DO BEGIN NEWUSER ^.UN[ILOOP] := ' '; ILOOP := ILOOP - 1 END; READCONTROL(CONTROL, DUMPARM, TERM, BUFFER, LENBUF, LOGLEN); END (*IF*) ELSE NEWUSER := USER (*FIRST LOGIN ONLY*); ILOOP := 1; FOUND := FALSE; WHILE (ILOOP <= LENBUF) AND NOT FOUND DO BEGIN FOUND := (BUFFER[ILOOP] IN [')', '.']); ILOOP := ILOOP + 1 END; IF FOUND THEN BEGIN LOC := ILOOP; NOPROMPT := (LENBUF >= LOC) END; VALIDLOGIN := GOOD; GETSEG(EDESC, 10000); GETSEG(EDESC, - 2); WHILE NOT EOS(EDESC) DO BEGIN I := 0; PREVCH := ' '; WHILE NOT EOLN(EDESC) AND (I < 7) DO BEGIN I := I + 1; READ(EDESC, CH); IF CH <> NEWUSER ^.UN[I] THEN IF CH <> '$' THEN I := 1000 ELSE IF (PREVCH <> '$') AND (NEWUSER ^.UN[I] = '*') THEN I := 500; PREVCH := CH END (*WHILE*); IF (I >= 0) AND (I <= 7) THEN IF (EDESC ^ <> 'P') OR (CLOCKTIME > ' 07.00.00.') AND (CLOCKTIME < ' 15.00.00.' ) AND (DAY IN [0..4]) THEN BEGIN READ(EDESC, CH); WRITE(TERM, 'THIS USERNUMBER HAS BEEN LOCKED OFF MILIEU '); IF CH = 'P' THEN WRITE('DURING PEAK TIME. '); WRITELN; WRITE(TERM); WHILE NOT EOLN(EDESC) DO BEGIN READ(EDESC, CH); WRITE(CH) END; WRITELN; VALIDLOGIN := BAD END (*IF*); READLN(EDESC) END (*WHILE*); IF NEWUSER ^.UN[7] = '*' THEN WRITELN(TERM, 'MASTER USER: WRITE TO CODENAME "MILIEU" TO BLOCK SUBORDINATES.'); IF (NEWUSER^.UN = BADUN) THEN IF BADCOUNT >= 3 THEN BEGIN VALIDLOGIN := BAD; WRITELN(TERM,'USERNUMBER AUTO-LOCKED OFF DUE TO PW GUESSING.') END; CURRENTREC := 0; I := LOC (*TEMP STORAGE*); WORD := BLANKS; NUM := 0; IF NOPROMPT THEN GETWORD(WORD, NUM, BUFFER, LENBUF, LOC); LOC := I (*RESTORE LOC INDEX*); IF WORD = '+ ' THEN BEGIN VALIDLOGIN := BAD; IF PLAYERTAIL = NIL THEN WRITELN(TERM, 'NO ACTIVE USERS.') ELSE GETSTATUS(BLANKS, NEWUSER); END (*IF*) ELSE IF SUBSET(WORD, '/FLASH ') AND (WORD <> BLANKS) THEN BEGIN VALIDLOGIN := BAD; I := LOC; GETWORD(WORD, NUM, BUFFER, LENBUF, LOC); GETWORD(WORD, NUM, BUFFER, LENBUF, LOC); USFLASH := FINDUSER(WORD, PLAYERTAIL); IF USFLASH = NIL THEN WRITELN(TERM, 'PLAYER NOT FOUND.') ELSE IF REALTIME - ACTIVETRM(TERM) < 20 THEN WRITELN(TERM, 'PLEASE WAIT 20 MORE SECONDS BEFORE TRYING AGAIN.') ELSE IF USFLASH ^.MESBLOCK OR USFLASH ^.SSJ THEN WRITELN(TERM, 'MESSAGE BLOCKED.') ELSE BEGIN WRITELN(USFLASH ^.TRM, 'YOU HEAR A VOICE COME FROM OUT OF NOWHERE:'); TNUM := ORD(TERM[9]) * 64 + ORD(TERM[10]); WRITE(USFLASH ^.TRM, 'T', TNUM: 3 OCT, ' '); FOR ILOOP := LOC + 1 TO MIN(LOC + 1 + 80, LENBUF) DO WRITE(BUFFER[ILOOP]); WRITELN; WRITELN(TERM, 'MESSAGE SENT.'); END (*ELSE*); LOC := I; END (*IF*) ELSE BEGIN IF NUSERS > MAXUSERS THEN BEGIN IF (WORD <> AUTHOR) AND (WORD <> 'RINGTHANE ') OR (NUSERS > MAXPLUSONE) THEN BEGIN IF VALIDLOGIN <> BAD THEN VALIDLOGIN := QUEUED; WRITELN(TERM, 'TOO MANY ACTIVE USERS ARE ON THE TASK.') END (*IF*); END (*IF*); I := ACTIVETRM(TERM); IF I > 0 THEN IF REALTIME - UNACTIVE[I].OFFTIME < 45 THEN BEGIN IF (WORD <> AUTHOR) AND (WORD <> 'RINGTHANE ') THEN BEGIN VALIDLOGIN := BAD; WRITELN(TERM, 'PLEASE WAIT ', 45 - (REALTIME - UNACTIVE[I].OFFTIME): 0, ' MORE SECONDS BEFORE TRYING AGAIN.'); END (*IF*); END (*IF*) ELSE UNACTIVE[I].OFFTIME := REALTIME END (*ELSE*); IF VALIDLOGIN IN [BAD, QUEUED] THEN BEGIN IF VALIDLOGIN = QUEUED THEN BEGIN IF I > 0 THEN UNACTIVE[I].OFFTERM := BLANKS; IF (WORD='HALINDROME') OR (WORD='THOST ') OR (WORD='YENDAR ') OR (WORD='SNOOPY ') THEN ADDLIMBO(TERM,1,NEWUSER^.UN) ELSE ADDLIMBO(TERM, REALTIME, NEWUSER ^.UN) END (*IF*) ELSE BEGIN WRITECONTROL(MTLO, ZEROPARM, TERM); WRITELN (* LOG OUT USER *) END; DISPOSE(NEWUSER); LOGIN := NIL; NUSERS := NUSERS - 1 END (*IF*) ELSE BEGIN IF I > 0 THEN UNACTIVE[I].OFFTERM := BLANKS; WRITE(TERM); PRINTDESC(1, 1, 0, FALSE) (* "MILIEU" *); WRITELN(' V^E^R ', VERSION, ' (R^U^N ', NUMRUN: 0, ')'); WITH NEWUSER ^ DO BEGIN ENTRY := XNAME; STATUS := SLOGIN; TRM := TERM; NEXTUSER := PLAYERTAIL END (*WITH*); PLAYERTAIL := NEWUSER; LOGIN := NEWUSER (* PASS NEW USER TO MAIN ROUTINE *); END (*ELSE*); END (*LOGIN*); PROCEDURE ENTERNOTICE; VAR ILOOP: INTEGER; BEGIN DAYMSG('NOT', USER, BLANKS, 0); FOR ILOOP := 1 TO MIN(LENBUF, 78) DO NOTICE[ILOOP] := BUFFER[ILOOP]; FOR ILOOP := LENBUF + 1 TO 80 DO NOTICE[ILOOP] := COL; USER ^.ENTRY := XCMD; PROMPTUSER(USER); END (*ENTERNOTICE*); PROCEDURE ENTERNEWS; VAR ILOOP, JLOOP: INTEGER; FOUND: BOOLEAN; BEGIN ILOOP := 1; FOUND := FALSE; WHILE NOT FOUND AND (ILOOP <= 5) DO BEGIN FOUND := (NEWSBUF[ILOOP, 1] = COL); ILOOP := ILOOP + 1 END; IF NOT FOUND THEN WRITELN(TERM, '*DELETE A LINE FIRST.') ELSE BEGIN ILOOP := ILOOP - 1; FOR JLOOP := 1 TO MIN(LENBUF, 78) DO NEWSBUF[ILOOP, JLOOP] := BUFFER[JLOOP]; FOR JLOOP := LENBUF + 1 TO 80 DO NEWSBUF[ILOOP, JLOOP] := COL; WRITELN(TERM, 'ENTERED AS LINE ', ILOOP: 0); END (*ELSE*); USER ^.ENTRY := XCMD; PROMPTUSER(USER); END (*ENTERNEWS*); PROCEDURE ENTERSEX(USER: USERPOINT); VAR CH: CHAR; WORD: ALFA; NUM: INTEGER; BEGIN WITH USER ^ DO BEGIN GETWORD(WORD, NUM, BUFFER, LENBUF, LOC); CH := WORD[1]; ENTRY := XCMD; IF CH = 'M' THEN SEX := MALE ELSE IF CH = 'F' THEN SEX := FEMALE ELSE BEGIN ENTRY := XSEX; NOPROMPT := FALSE; WRITELN(TERM, 'TRY AGAIN.') END; IF ENTRY = XCMD THEN BEGIN PLACEPLAYER(USER, 1); NOPROMPT := FALSE; ANNOUNCELOGIN(USER) END (*IF*); PROMPTUSER(USER); END (*WITH*); END (*ENTERSEX*); PROCEDURE NEWPW(USER: USERPOINT); VAR PASSWORD: ALFA; DUMMY: INTEGER; BEGIN GETWORD(PASSWORD, DUMMY, BUFFER, LENBUF, LOC); IF PASSWORD <> BLANKS THEN BEGIN USER ^.PW := HASH(PASSWORD,10); USER ^.ENTRY := XSEX; END; PROMPTUSER(USER); END (*NEWPW*); PROCEDURE ENTERSTATS(USER: USERPOINT); VAR DUMMY: ALFA; ILOOP, SUM, NUM: INTEGER; BADNUM: BOOLEAN; STAT: ARRAY [1..5] OF INTEGER; BEGIN SUM := 0; ILOOP := 1; BADNUM := FALSE; REPEAT GETWORD(DUMMY, NUM, BUFFER, LENBUF, LOC); STAT[ILOOP] := NUM; SUM := SUM + NUM; ILOOP := ILOOP + 1; BADNUM := ((NUM < 5) OR (NUM > 18)); UNTIL BADNUM OR (ILOOP > 5); IF BADNUM THEN BEGIN WRITELN(TERM, 'ERROR. A NUMBER IS MORE THAN 18 OR LESS THAN 5.'); USER ^.ENTRY := XSTATS; NOPROMPT := FALSE END (*IF*) ELSE IF SUM / 5 > 10.1 THEN BEGIN WRITELN(TERM, 'ERROR. YOUR AVERAGE IS ', SUM / 5: 2: 1); USER ^.ENTRY := XSTATS; NOPROMPT := FALSE END (*IF*) ELSE WITH USER ^ DO BEGIN STR := STAT[1]; INT := STAT[2]; DEX := STAT[3]; PTY := STAT[4]; CON := STAT[5]; ENTRY := XSKILL; END (*WITH*); IF (USER ^.ENTRY = XSKILL) AND NOT NOPROMPT THEN BEGIN WRITELN(TERM, 'WHICH WEAPON IS YOUR MOST SKILLFUL?'); WRITELN(TERM, 'CHOOSE FROM: SHARP WEAPON, THRUSTING WEAPON, BLUNT WEAPON,'); WRITELN(TERM, 'OR POLE WEAPON.'); END (*IF*); PROMPTUSER(USER); END (*ENTERSTATS*); PROCEDURE ENTERSKILL(USER: USERPOINT); VAR WORD: ALFA; NUM: INTEGER; CH: CHAR; BEGIN USER ^.ENTRY := XNEWPW; GETWORD(WORD, NUM, BUFFER, LENBUF, LOC); CH := WORD[1]; WITH USER ^ DO CASE CH OF 'S': SSHARP := 1; 'T': STHRUST := 1; 'B': SBLUNT := 1; 'P': SLONG := 1; OTHERWISE NOPROMPT := FALSE; ENTRY := XSKILL; WRITELN(TERM, 'NO SUCH SKILL. TRY AGAIN.'); END; PROMPTUSER( USER) END; PROCEDURE CHOOSECLASS(USER: USERPOINT); VAR WORD: ALFA; NUM: INTEGER; CH: CHAR; PROCEDURE SETSTATS(CL: CHTYPE; VIT,FAT,MAG,MONY: INTEGER); BEGIN WITH USER ^ DO BEGIN CLASS := CL; MAXHITS := VIT; HITS := VIT; MAXFATIGUE := FAT; FATIGUE := FAT; MAXMAGIC := MAG; MAGIC := MAG; MONEY := MONY END (*WITH*) END; BEGIN USER^.ENTRY := XSTATS; GETWORD(WORD,NUM,BUFFER,LENBUF,LOC); CH := WORD[1]; WITH USER ^ DO CASE CH OF 'F': SETSTATS(FIGHTER, 8, 14, 2, 200); 'T': SETSTATS(THIEF, 7, 10, 3, 130); 'M': SETSTATS(MAGICUSER, 6, 9, 6, 150); 'C': SETSTATS(CLERIC, 7, 11, 4, 80); 'R': SETSTATS(RANGER, 7, 11, 3, 150); 'P': SETSTATS(PALADIN, 11, 8, 3, 140); OTHERWISE NOPROMPT := FALSE; ENTRY := XNEWCLASS; WRITELN(TERM, 'NO SUCH CLASS. TRY AGAIN.') END (*CASE*); IF (USER ^.ENTRY = XSTATS) AND NOT NOPROMPT THEN BEGIN WRITELN(TERM, 'CHOOSE YOUR CHARACTER''S ATTRIBUTES FOR STRENGTH, INTELLIGENCE,') ; WRITELN(TERM, ' DEXTERITY, PIETY, AND CONSTITUTION.'); WRITELN(TERM, '(EXAMPLE: 13,7,10,11,5) EACH MUST BE FROM 5 TO 18 AND'); WRITELN(TERM, 'THE TOTAL AVERAGE MUST BE 10 OR LESS.'); END (*IF*); PROMPTUSER(USER); END (*CHOOSECLASS*); PROCEDURE NEXTLIMBO; (* FETCH NEXT USER FROM WAITING ROOM *) VAR TM: ALFA; INDX, ILOOP: INTEGER; QUSER: USERPOINT; BEGIN FINDLIMBO(TM, INDX, TRUE); IF (TM <> BLANKS) AND (NUSERS < MAXUSERS) THEN BEGIN NEW(QUSER); QUSER ^ := PROTOUSER; ILOOP := ACTIVETRM(TM); IF ILOOP > 0 THEN UNACTIVE[ILOOP].OFFTERM := BLANKS; WRITELN(TM, COL, 'I', CHR(76B), CHR(47B)) (* SEND BELL *); WRITE(TM); PRINTDESC(1, 1, 0, FALSE); WRITELN(' V^E^R ', VERSION, ' (R^U^N ', NUMRUN: 0, ')'); WITH QUSER ^ DO BEGIN UN := QUEUE[INDX].QUN; ENTRY := XNAME; STATUS := SLOGIN; TRM := TM; NEXTUSER := USERTAIL; USERTAIL := QUSER; END (*WITH*); NOPROMPT := FALSE; NUSERS := NUSERS + 1; FOR ILOOP := 1 TO MAXQUEUE DO IF QUEUE[ILOOP].QTERM <> BLANKS THEN BEGIN WRITELN(QUEUE[ILOOP].QTERM, 'PAGING PERSON FROM ', PS(QUSER ^.UN), '!'); IF QUEUE[INDX].QTIME = 1 THEN WRITELN(QUEUE[ILOOP].QTERM,'(DM QUEUE OVERRIDE)') END; DELETELIMBO(TM); PROMPTUSER(QUSER); END (*IF*) END (*NEXTLIMBO*); PROCEDURE LOGOFF(USR: USERPOINT; LOGQUEUE: BOOLEAN); (* LOGOFF LOGS OFF THE USER, AND SAVES HIS FILE (IF ROOM LEFT). *NOTE* USR IS NOT A VAR PARAMETER. IT IS DISPOSED IN WRITEPLAYER BUT MAY BE NEEDED AGAIN FOR ABORT! *) VAR ILOOP: INTEGER; BEGIN IF NOT (USR ^.STATUS IN [SLOGIN, SINIT]) OR (USR ^.ENTRY = XDEAD) THEN BEGIN DELETEUSER(USR, USERTAIL); IF WHICHCONTROL = MTHU THEN BEGIN IF USR ^.LVL >= 5 THEN DAYMSG('HUP', USR, BLANKS, 0); USR ^.CON := MAX(3, USR ^.CON - 1) (*TAKE AWAY CON AS PUNISHMENT*); FOR ILOOP := 1 TO MSGTERM(TERMLIST, OTHERS) DO BEGIN WRITE(TERMLIST[ILOOP], '### ', PS(USR ^.NAME): 0, ', THE COWARD, JUST HUNG UP '); IF USR ^.SEX = MALE THEN WRITELN('HIS PHONE.') ELSE WRITELN('HER PHONE.') END (*FOR*) END (*IF*); IF USR ^.LVL >= 2 THEN WRITEPLAYER(USR, USR ^.NAME) ELSE BEGIN IF WHICHCONTROL <> MTHU THEN WRITELN(TERM, 'SORRY, YOU MUST BE AT LEAST 2ND LEVEL TO SAVE YOUR CHARACTER.' ); WRITEUSR(USR, FALSE) (*DISPOSE USR + OBJECTS*) END (*ELSE*); END (*IF*) ELSE BEGIN USR ^.RMCODE := 0; DELETEUSER(USR, USERTAIL); WRITEUSR(USR, FALSE); END; USR := NIL; NUSERS := NUSERS - 1; IF LOGQUEUE AND (NUMQUEUED > 0) THEN NEXTLIMBO; END (*LOGOFF*); PROCEDURE ROLLOUT(TERMNUM: ALFA); FORWARD; PROCEDURE ROLLCHECK(TRM: ALFA); (* CHECK IF 40 RA+1 CALLS HAVE BEEN ISSUED. IF SO, DO A ROLLOUT *) BEGIN IF RA >= 40 THEN ROLLOUT(TRM) END; PROCEDURE OFF; (* OFF - KICK OFF ALL USERS AND SAVE THEIR FILES IN PREPARATION FOR A PTA. 4 RA+1S ARE DONE FOR EACH LOGOFF. SO ROLLOUTS MUST BE DONE *) BEGIN ERRLOC := 'OFF '; ROLLOUT(TERM); USER := USERTAIL; WHILE USER <> NIL DO BEGIN TERM := USER ^.TRM; ROLLCHECK(TERM); USER := USERTAIL (* IN CASE THE PREVIOUS USER HUNG UP *); TERM := USER ^.TRM; LOGOFF(USER, FALSE); WRITECONTROL(MTLO, ZEROPARM, TERM); WRITELN; USER := USERTAIL END (*WHILE*) END (*OFF*); PROCEDURE SETDAYFILE; VAR CH: CHAR; TEMP: SEGCHARFIL; BEGIN RESET(DAYFILE); REWRITE(TEMP); GETSEG(DAYFILE, 10000); ROLLCHECK(TERM); GETSEG(DAYFILE, - DAYRECLEN); ROLLCHECK(TERM); WHILE NOT EOF(DAYFILE) DO BEGIN WHILE NOT EOS(DAYFILE) DO BEGIN WHILE NOT EOLN(DAYFILE) DO BEGIN READ(DAYFILE, CH); WRITE(TEMP, CH); END; READLN(DAYFILE); WRITELN(TEMP); END (*WHILE*); PUTSEG(TEMP); GETSEG(DAYFILE); ROLLCHECK(TERM); END (*WHILE*); REWRITE(DAYFILE); RESET(TEMP); ROLLCHECK(TERM); WHILE NOT EOF(TEMP) DO BEGIN WHILE NOT EOS(TEMP) DO BEGIN WHILE NOT EOLN(TEMP) DO BEGIN READ(TEMP, CH); WRITE(DAYFILE, CH); END; READLN(TEMP); WRITELN(DAYFILE); END (*WHILE*); GETSEG(TEMP); IF NOT EOF(TEMP) THEN PUTSEG(DAYFILE); ROLLCHECK(TERM); END (*WHILE*); END (*SETDAYFILE*); PROCEDURE MATCHPW(USER: USERPOINT); (* MATCHPW COMPARES THE PASSWORD ENTERED TO THE ONE IN USER^. *) VAR PASSWORD: ALFA; DUMMY: INTEGER; BEGIN GETWORD(PASSWORD, DUMMY, BUFFER, LENBUF, LOC); IF NOT NOPROMPT THEN WRITELN(TERM,'ZZZZZZZZZZ'); DUMMY := HASH(USER^.UN,5); IF (USER^.UNHASH DIV DUMMY * DUMMY <> USER^.UNHASH) AND NOT (USER^.UNHASH IN [0,1]) THEN BEGIN NOPROMPT := FALSE; WRITELN(TERM,'IMPROPER USERNUMBER, SORRY.'); LOGOFF(USER,TRUE); WRITECONTROL(MTLO,ZEROPARM,TERM); WRITELN END ELSE IF HASH(PASSWORD,10) <> USER ^.PW THEN BEGIN NOPROMPT := FALSE; IF USER ^.SSJ THEN (* 4-BYTE THE SUCKER *) BEGIN WRITELN(TERM, COL, 'D'); DAYMSG('ILL', USER, 'ILLEGAL PW', 0); IF USER^.UN = BADUN THEN BEGIN BADCOUNT := BADCOUNT + 1; IF BADCOUNT >= 3 THEN DAYMSG('BLO',USER,'UN BLOCKED',0); END ELSE BADCOUNT := 1; BADUN := USER^.UN; END ELSE WRITELN(TERM, 'WRONG PASSWORD, SORRY.'); LOGOFF(USER, TRUE); WRITECONTROL(MTLO, ZEROPARM, TERM); WRITELN; END (*IF*) ELSE BEGIN NOPROMPT := FALSE; PLACEPLAYER(USER, USER ^.RMCODE); ANNOUNCELOGIN(USER); USER ^.ENTRY := XCMD; PROMPTUSER(USER) END (*ELSE*) END (*MATCHPW*); PROCEDURE GETNAM(USER: USERPOINT); (* GETNAM LOOKS IN THE PERSON FILE TO SEE IF THE NAM IN THE BUFFER IS AN OLD CHARACTER. IF NOT, IT BEGINS THE PROMPTING TO DESIGN A NEW ONE. THE SEARCH FOR OLD CHARACTERS IS DONE USING A "TARGET BOARD" OF CODENAMS AND INDEXES IN ORDER TO SPEED UP THE SEARCH. *) VAR NAM: ALFA; TEMPNEXT: USERPOINT (*HOLDER*); I1, I2, DUMMY: INTEGER; OTHER: USERPOINT; FUNCTION SAMENAME(USR: USERPOINT): BOOLEAN; BEGIN SAMENAME := (USR ^.NAME = NAM) END; BEGIN (*GETNAM*) GETWORD(NAM, DUMMY, BUFFER, LENBUF, LOC); I1 := 1; WHILE I1 <= 10 DO IF NOT (NAM[I1] IN ['A' .. 'Z', ' ']) THEN BEGIN FOR I2 := I1 + 1 TO 10 DO NAM[I2 - 1] := NAM[I2]; NAM[10] := ' ' END ELSE I1 := I1 + 1; IF (DUMMY <> 0) OR (NAM = BLANKS) THEN BEGIN NOPROMPT := FALSE; WRITELN(TERM, 'BAD CHARACTERS IN NAME.'); PROMPTUSER(USER) END (*IF*) ELSE BEGIN OTHER := MATCHUSER(USERTAIL, SAMENAME); IF OTHER <> NIL THEN BEGIN NOPROMPT := FALSE; WRITELN(TERM, 'NAME ALREADY IN USE!'); LOGOFF(USER, TRUE); WRITECONTROL(MTLO, ZEROPARM, TERM); WRITELN END (*IF*) ELSE IF NAM = 'STOP ' THEN BEGIN NOPROMPT := FALSE; LOGOFF(USER, TRUE); WRITECONTROL(MTLO, ZEROPARM, TERM); WRITELN END (*IF*) ELSE WITH USER ^ DO BEGIN TEMPNEXT := NEXTUSER; READPLAYER(USER, NAM); STATUS := SLOGIN; TRM := TERM; NEXTUSER := TEMPNEXT; LASTINPUT := REALTIME; IF NOT SSJ AND ((TASKCLOSED = 'C') OR (TASKCLOSED = 'T') AND NOT PLAYTESTER) THEN BEGIN WRITELN(TERM, 'AS YOU APPROACH THE GATES, A LITTLE GNOME JUMPS OUT FROM'); WRITELN(TERM, 'BEHIND A ROCK. HE WHINES "GO BACK! THE MASTERS ARE NOT READY'); WRITELN(TERM, 'FOR YOU YET!" THE GNOME THEN DISAPPEARS INTO THE BRUSH.'); NOPROMPT := FALSE; LOGOFF(USER, TRUE); WRITECONTROL(MTLO, ZEROPARM, TERM); WRITELN (*LOG OFF*); END (*IF*) ELSE IF NOT SSJ AND (CLOCKTIME >= ' 00.58.00.') AND (CLOCKTIME <= ' 07.05.00.') AND (DAY IN [0..4]) THEN BEGIN WRITELN(TERM, 'YOU APPROACH THE GATES IN THE DARK OF NIGHT. SUDDENLY A TIRED GNOME') ; WRITELN(TERM, 'JUMPS OUT FROM BEHIND A ROCK! HE YELLS, "EVERYTHING IS CLOSED'); WRITELN(TERM, 'FOR THE NIGHT... COME BACK AT SUNRISE!". THE GNOME THEN STOMPS OFF'); WRITELN(TERM, 'TO RESUME HIS NAP.'); NOPROMPT := FALSE; LOGOFF(USER, TRUE); WRITECONTROL(MTLO, ZEROPARM, TERM); WRITELN END (*IF*) ELSE IF USER ^.NAME = EMPTY THEN BEGIN NAME := NAM; ENTRY := XNEWCLASS (* ASK FOR NEW CLASS *); IF NOT NOPROMPT THEN BEGIN WRITELN(TERM, 'PLEASE SELECT YOUR CHARACTER''S CLASS:'); WRITELN(TERM, 'FIGHTER, THIEF, CLERIC, PALADIN, RANGER, OR MAGIC-USER.'); END (*IF*); PROMPTUSER(USER) END (*IF*) ELSE BEGIN ENTRY := XPASSWORD (* ASK FOR PW *); IF LOC < LENBUF THEN MATCHPW(USER) ELSE PROMPTUSER(USER) END (*ELSE*); END (*WITH*) END (*ELSE*) END (*GETNAM*); FUNCTION BINARYMATCH(WORD: ALFA; COUNT: INTEGER; VAR NAMELIST: DYNAMIC NAMETYPELIST) : INTEGER; (* DO A BINARY SEARCH OF A ALPHABETIZED LIST *) VAR LOWER, UPPER, POS: INTEGER; BEGIN IF WORD = BLANKS THEN BINARYMATCH := 0 ELSE BEGIN LOWER := 1; UPPER := COUNT; REPEAT POS := (LOWER + UPPER) DIV 2; IF NAMELIST[POS] <= WORD THEN LOWER := POS + 1; IF NAMELIST[POS] >= WORD THEN UPPER := POS - 1 UNTIL (LOWER > UPPER); IF NAMELIST[POS] = WORD THEN BINARYMATCH := POS ELSE IF POS = 1 THEN BINARYMATCH := 0 ELSE BEGIN IF NOT SUBSET(WORD, NAMELIST[POS]) THEN POS := POS - 1; BINARYMATCH := POS; IF NOT SUBSET(WORD, NAMELIST[POS]) THEN BINARYMATCH := 0 ELSE IF POS > 1 THEN IF SUBSET(WORD, NAMELIST[POS - 1]) THEN BEGIN WRITELN(TERM, PS(WORD), ' IS NOT UNIQUE.'); BINARYMATCH := - 1 END END (*ELSE*) END (*ELSE*); END (*BINARYMATCH*); FUNCTION WORDMATCH(WORD: ALFA; COUNT: INTEGER; VAR NAMELIST: DYNAMIC NAMETYPELIST): INTEGER; (* THIS ROUTINE IS SEARCHES A TABLE (NAMELIST) TO SEE IF THE USER TYPED IN SOMETHING RECOGNIZABLE. IT RECOGNIZES A MATCH WHEN IT READS THE MINIMUM NUMBER OF LETTERS TO MAKE THE ENTRY UNIQUE. THE INDEX NUMBER IS RETURNED. INDEX = -1 IF NOT UNIQUE, AND IT ISSUES AN APPROPRIATE MESSAGE. INDEX = 0 IF NOT FOUND, AND THE CALLING PROGRAM MUST ISSUE ITS OWN MESSAGE. *) VAR ILOOP, JLOOP: INTEGER; FOUND: BOOLEAN; BEGIN IF (COUNT < 0) OR (COUNT > HIGH(NAMELIST)) THEN ABORT(' MIL03 - BAD PARSE COUNT!'); IF (COUNT = 0) OR (WORD = BLANKS) THEN WORDMATCH := 0 (* ITEM NOT FOUND BY DEFAULT *) ELSE BEGIN (* SCAN LIST *) ILOOP := 0; REPEAT ILOOP := ILOOP + 1 UNTIL (NAMELIST[ILOOP] = WORD) OR (ILOOP = COUNT); IF NAMELIST[ILOOP] = WORD THEN WORDMATCH := ILOOP (* FOUND DIRECT MATCH *) ELSE BEGIN ILOOP := 0 (*CHECK FOR PARTIAL MATCH*); REPEAT ILOOP := ILOOP + 1; FOUND := SUBSET(WORD, NAMELIST[ILOOP]); UNTIL FOUND OR (ILOOP = COUNT); IF NOT FOUND (* NO MATCH AT ALL*) THEN WORDMATCH := 0 ELSE (*CHECK FOR UNIQUENESS*) IF ILOOP = COUNT THEN WORDMATCH := COUNT (* LAST WORD IS UNIQUE*) ELSE BEGIN JLOOP := ILOOP; REPEAT JLOOP := JLOOP + 1; FOUND := SUBSET(WORD, NAMELIST[JLOOP]); IF FOUND THEN FOUND := (NAMELIST[ILOOP] <> NAMELIST[JLOOP]); (* DON'T FLAG UNQUE-ERROR IF TWO WORDS ARE IDENTICAL IN LIST *) UNTIL FOUND OR (JLOOP = COUNT); IF FOUND THEN BEGIN WRITELN(TERM, PS(WORD), ' IS NOT UNIQUE.'); WORDMATCH := - 1 END (*IF*) ELSE WORDMATCH := ILOOP (* MATCHED+UNIQUE*) END (*ELSE*) END (*PARTIAL SCAN OF LIST*) END (* SCANNING LIST *) END (*WORDMATCH*); FUNCTION FINDMONSTER(WORD: ALFA; NUM: INTEGER; MONSTERTAIL: MONSTERPOINT): MONSTERPOINT; (* FINDMONSTER RETURNS THE MATCHING MONSTER TO *WORD* IN THE LIST . IT ALSO CHECKS THE MONSTER.NUM IF USER SPECIFIES "RAT/5". IF NOT SPECIFIED, IT RETURNS THE FIRST MONSTER ON THE LIST. (WHICH IS THE HIGHEST .NUM'BERED MONSTER) *) VAR MONSTER: MONSTERPOINT; COUNT, INDEX: INTEGER; NAMELIST: NAMETYPELIST; MONNAME: ALFA; FUNCTION MONNUMMATCH(MON: MONSTERPOINT): BOOLEAN; (* MONNUMMATCH RETURNS TRUE IF THE BOTH THE NAME AND NUMBER MATCH *) BEGIN MONNUMMATCH := ((MONNAME = MON ^.NAME) AND (NUM = MON ^.NUM)) END (*MONNUMMATCH*); BEGIN (*FINDMONSTER*) COUNT := 0; MONSTER := MONSTERTAIL; WHILE (MONSTER <> NIL) AND (COUNT < MAXNAMES) DO BEGIN COUNT := COUNT + 1; NAMELIST[COUNT] := MONSTER ^.NAME; MONSTER := MONSTER ^.NEXT END (*WHILE*); IF COUNT >= MAXNAMES THEN WRITELN(TERM, 'MIL04 - MONSTER TABLE OVERFLOW.'); INDEX := WORDMATCH(WORD, COUNT, NAMELIST); IF INDEX <= 0 THEN MONSTER := NIL ELSE BEGIN MONSTER := MONSTERTAIL; FOR COUNT := 1 TO INDEX - 1 DO MONSTER := MONSTER ^.NEXT; IF NUM > 0 THEN BEGIN MONNAME := MONSTER ^.NAME; MONSTER := MATCHMONSTER(MONSTER, MONNUMMATCH) END (*IF*) END (*ELSE*); FINDMONSTER := MONSTER END (*FINDMONSTER*); FUNCTION FINDOBJECT(WORD: ALFA; NUM: INTEGER; OBJECTTAIL: OBJECTPOINT): OBJECTPOINT; (* FINDOBJECT RETURNS THE MATCHING OBJECT TO *WORD* IN THE LIST*) VAR OBJECT: OBJECTPOINT; I, NUMMATCH, COUNT, INDEX: INTEGER; NAMELIST: NAMETYPELIST; NAME: ALFA; PROCEDURE FILLEND(VAR NAM: ALFA); (* FILL END OF NAME WITH SPACES *) VAR ILOOP: 0..10; FOUND: BOOLEAN; BEGIN ILOOP := 0; REPEAT ILOOP := ILOOP + 1; FOUND := (NAM[ILOOP] IN [COL, ' ']); UNTIL FOUND OR (ILOOP >= 10); IF FOUND THEN FOR ILOOP := ILOOP TO 10 DO NAM[ILOOP] := ' ' END (*FILLEND*); BEGIN (*FINDOBJECT*) COUNT := 0; OBJECT := OBJECTTAIL; WHILE (OBJECT <> NIL) AND (COUNT < MAXNAMES) DO BEGIN COUNT := COUNT + 1; LD(OBJECT ^.NAME, NAMELIST[COUNT]); FILLEND(NAMELIST[COUNT]) (* SPACE FILL RIGHT *); OBJECT := OBJECT ^.NEXT END (*WHILE*); IF COUNT >= MAXNAMES THEN WRITELN(TERM, 'MIL30 - OBJECT TABLE OVERFLOW!'); INDEX := WORDMATCH(WORD, COUNT, NAMELIST); IF INDEX <= 0 THEN OBJECT := NIL ELSE BEGIN OBJECT := OBJECTTAIL; FOR I := 1 TO INDEX - 1 DO OBJECT := OBJECT ^.NEXT; IF NUM > 1 THEN BEGIN NAME := NAMELIST[INDEX]; I := INDEX + 1; NUMMATCH := 1; WHILE (NUMMATCH < NUM) AND (I <= COUNT) DO BEGIN OBJECT := OBJECT ^.NEXT; IF NAMELIST[I] = NAME THEN NUMMATCH := NUMMATCH + 1; I := I + 1 END (*WHILE*); IF (I > COUNT) AND (NUMMATCH < NUM) THEN OBJECT := NIL END (*IF*) END (*ELSE*); FINDOBJECT := OBJECT END (*FINDOBJECT*); FUNCTION FINDPLAYER(WORD: ALFA; PLAYERTAIL: USERPOINT): USERPOINT; (*FINDPLAYER TURNS THE PLAYER MATCHING *WORD* IN THE LIST *) VAR PLAYER: USERPOINT; COUNT, INDEX: INTEGER; NAMELIST: NAMETYPELIST; BEGIN COUNT := 0; PLAYER := PLAYERTAIL; WHILE (PLAYER <> NIL) AND (COUNT < MAXNAMES) DO BEGIN COUNT := COUNT + 1; NAMELIST[COUNT] := PLAYER ^.NAME; PLAYER := PLAYER ^.NEXT END (*WHILE*); IF COUNT >= MAXNAMES THEN WRITELN(TERM, 'MIL31 - PLAYER TABLE OVERFLOW!'); INDEX := WORDMATCH(WORD, COUNT, NAMELIST); IF INDEX <= 0 THEN PLAYER := NIL ELSE BEGIN PLAYER := PLAYERTAIL; FOR COUNT := 1 TO INDEX - 1 DO PLAYER := PLAYER ^.NEXT END (*ELSE*); FINDPLAYER := PLAYER END (*FINDPLAYER*); FUNCTION FINDUSER; (* FINDUSER RETURNS THE USER THAT MATCHES *WORD* IN THE LIST*) VAR USR: USERPOINT; COUNT, INDEX: INTEGER; NAMELIST: NAMETYPELIST; BEGIN COUNT := 0; USR := USERTAIL; WHILE (USR <> NIL) AND (COUNT < MAXNAMES) DO BEGIN COUNT := COUNT + 1; NAMELIST[COUNT] := USR ^.NAME; USR := USR ^.NEXTUSER END (*WHILE*); IF COUNT >= MAXNAMES THEN WRITELN(TERM, 'MIL32 - USER TABLE OVERFLOW!'); INDEX := WORDMATCH(WORD, COUNT, NAMELIST); IF INDEX <= 0 THEN USR := NIL ELSE BEGIN USR := USERTAIL; FOR COUNT := 1 TO INDEX - 1 DO USR := USR ^.NEXTUSER END (*ELSE*); FINDUSER := USR END (*FINDUSER*); FUNCTION EXPR(LEV: INTEGER): INTEGER; VAR NUM: INTEGER; BEGIN IF LEV <= 1 THEN EXPR := 0 ELSE BEGIN NUM := LEV + 7; IF NUM <= 17 THEN EXPR := TRUNC(1.0, NUM) ELSE EXPR := TRUNC(1.0, 17) * (NUM - 16) END (*ELSE*) END (*EXPR*); FUNCTION SPELLIMIT: BOOLEAN; BEGIN IF USER ^.SPELLDAY >= 7 THEN BEGIN SPELLIMIT := TRUE; WRITELN(TERM, 'DAILY LIMIT EXCEEDED, SORRY.'); END ELSE BEGIN SPELLIMIT := FALSE; USER ^.SPELLDAY := USER ^.SPELLDAY + 1 END END (*SPELLIMIT*); PROCEDURE PRINTOBJ(VAR OBJECT: OBJECTTYPE; SINGULAR: BOOLEAN); (* PRINTOBJ WILL DISPLAY THE NAME OF AN OBJECT. IF *SINGULAR* IS TRUE, THEN "THE" IS PREFIXED (UNLESS ARTICLE = NONE). ELSE THE ARTICLE IS PREFIXED. TREASURES HAVE THEIR VALUE DISPLAYED, AND WEAPONS, SHIELDS AND ARMOR HAVE THEIR COMBAT VALUES DISPLAYED TOO. (IF SINGULAR IS FALSE.) *) VAR ILOOP, JLOOP, KLOOP: 0..21; FLAG: BOOLEAN; BEGIN WITH OBJECT DO BEGIN IF SINGULAR AND (ARTICLE <> NONE) THEN WRITE('THE '); IF NOT SINGULAR THEN IF OBCLASS <> DOOR THEN CASE ARTICLE OF A: WRITE('A '); AN: WRITE('AN '); THE: WRITE('THE '); SOME: WRITE('SOME '); NONE:; END (*CASE*) ELSE BEGIN CASE ARTICLE OF A, AN: IF DCLOSED THEN WRITE('A ') ELSE WRITE('AN '); THE: WRITE('THE '); SOME: WRITE('SOME '); NONE:; END (*CASE*); IF DCLOSED THEN IF DLOCKED > 0 THEN WRITE('LOCKED ') ELSE WRITE('CLOSED ') ELSE WRITE('OPEN ') END (*ELSE*); IF OBCLASS = COINS THEN WRITE(PRICE DIV MULTIPLIER: 0, ' '); IF MAGIC THEN WRITE('MAGIC '); ILOOP := 0; REPEAT ILOOP := ILOOP + 1; FLAG := (NAME[ILOOP] = ' ') UNTIL FLAG OR (ILOOP >= 20); IF NOT FLAG THEN WRITE(PO(NAME)) (* ONE WORD *) ELSE BEGIN JLOOP := ILOOP + 1; WHILE (JLOOP <= 20) DO IF NAME[JLOOP] <> COL THEN BEGIN IF NAME[JLOOP] = '*' THEN FOR KLOOP := 1 TO ILOOP - 1 DO WRITE(NAME[KLOOP]) ELSE WRITE(NAME[JLOOP]); JLOOP := JLOOP + 1 END (*IF*) ELSE JLOOP := 21 (*END WHILE LOOP*); END (*ELSE*); IF NOT SINGULAR THEN (* WRITE STATS *) BEGIN IF INVISIBLE THEN WRITE(' (INV)'); IF (OBCLASS = WEAP) AND MAGIC THEN WRITE(' (+', ABS(WEAPLUS): 0, ')'); IF OBCLASS = SHIELD THEN WRITE(' (', ABS(SHPLUS): 0, ')'); IF OBCLASS = ARMOR THEN WRITE(' (', ABS(ARMPLUS): 0, ')'); IF OBCLASS = TREASURE THEN WRITE(' (VALUE: ', PRICE: 0, ')'); END (*IF*) END (*WITH*) END (*PRINTOBJ*); PROCEDURE OBJDISPLAY(OBJECT: OBJECTPOINT); VAR TOBJ: OBJECTPOINT; BEGIN ERRLOC := 'OBJDISPLAY'; WRITE(TERM); PRINTOBJ(OBJECT ^, FALSE) (* WRITE OBJ NAME *); WRITE(', '); WITH OBJECT ^ DO BEGIN IF CARRY THEN WRITE('CARRYABLE, '); WRITE(WEIGHT: 0, ' LBS, '); WRITELN(PRICE: 0, ' SHILLINGS'); IF (DESCREC > 0) AND (USER ^.SSJ OR (OBCLASS <> SCROLL)) THEN BEGIN WRITELN(TERM, 'DR=', DESCREC: 0, ', DI=', DESCCODE: 0, '.'); WRITE(TERM, 'DESCRP: '); PRINTDESC(DESCREC, DESCCODE, 0, FALSE); WRITELN END (*IF*); WRITELN(TERM, 'MAGIC=', MAGIC: 5, ', PERMANENT=', PERMANENT: 5, ', INVISIBLE=', INVISIBLE: 5, '.'); WRITE(TERM) (* WRITE CLASS DESCS *); CASE OBCLASS OF PORTAL: WRITELN('PORTAL TO ROOM ', TOWHERE: 0, '.'); WEAP: BEGIN WRITE('OFFENSIVE WEAPON, ', MINHP: 0, '-', MAXHP: 0, ' HP, '); WRITELN(STRIKESLEFT: 0, ' STRIKES LEFT.'); WRITE(TERM); CASE WEAPTYPE OF SHARP: WRITE('SHARP'); THRUST: WRITE('THRUST'); BLUNT: WRITE('BLUNT'); LONG: WRITE('POLE'); END (*CASE*); WRITELN(' CLASS WEAPON.'); WRITELN(TERM, '+ ', WEAPLUS: 0, ' TO HIT.'); END (*WEAP*); SHIELD: WRITELN('SHIELD, + ', SHPLUS: 0, ' PROTECTION, ', SHHITSLEFT: 0, ' HITS LEFT.'); ARMOR: WRITELN('ARMOR, + ', ARMPLUS: 0, ' PROTECTION, ', ARMHITSLEFT: 0, ' HITS LEFT.'); COINS: WRITELN('MONEY, VALUE MULTIPLIER: X', MULTIPLIER: 0); SCROLL: WRITELN('SCROLL, SPELL = ', SPELLIST[SPELL]); CHEST: BEGIN WRITELN('CONTAINER, OBJECTS =', NUMINSIDE: 0, ' TRAP=', TRAP: 0); WRITELN(TERM, 'LOCK TYPE = ', LOCKED: 0); IF OBJECTTAIL <> NIL THEN BEGIN TOBJ := OBJECTTAIL; WRITELN(TERM, 'ITEMS INSIDE:'); WHILE TOBJ <> NIL DO BEGIN WRITE(TERM, ' '); PRINTOBJ(TOBJ ^, FALSE); WRITELN; TOBJ := TOBJ ^.NEXT END (*WHILE*) END (*IF*) END (*CHEST*); DOOR: BEGIN WRITELN('DOOR, PORTAL TO ROOM ', DTOWHERE: 0, '. DOOR TRAP=', DTRAP: 0); WRITELN(TERM, 'DLOCK TYPE=', DLOCKED: 0); END (*DOOR*); MAGDEVICE: BEGIN WRITELN('MAGICAL DEVICE, SPELL = ', SPELLIST[SPELL]); WRITELN(TERM, 'NUMBER OF CHARGES = ', NUMCHARGES: 0) END (*MAGDEVICE*); TELEPORT: WRITELN('TELEPORT DEVICE, FROM ROOM ', TACTIVERM: 0, ' TO ROOM ', TOWHERE: 0, '.'); KEYS: WRITELN('KEYS, UNLOCK TYPE=', UNLOCK: 0); CARD: WRITELN('CARDS, TELEPORT TO PLAYER'); OTHERWISE WRITELN; END (*CASE*); END (*WITH*); END (*OBJDISPLAY*); PROCEDURE PLAYERDISPLAY(PLYER: USERPOINT); VAR COUNT: INTEGER; OBJ: OBJECTPOINT; BEGIN ERRLOC := 'PLAYERDISP'; WITH PLYER ^ DO BEGIN WRITE(TERM, PS(NAME), ', THE ', PNTH(LVL), 'LEVEL ', PS(CNAME[CLASS]), ' '); IF PLAYTESTER THEN WRITE('(PLAYTESTER) '); IF SSJ AND NOT ASSOC AND NOT MASTER THEN WRITE('(DM)'); IF SSJ AND ASSOC THEN WRITE('(ASSOC DM)'); IF SSJ AND MASTER THEN WRITE('(MASTER DM)'); IF USER ^.SSJ THEN WRITE(' IN ROOM ', RMCODE: 0, '/', W(RMCODE): 0); WRITELN; IF INVISIBLE THEN IF NONEXISTANT THEN WRITELN(TERM, 'YOU ARE NONEXISTANT.') ELSE WRITELN(TERM, 'YOU ARE CURRENTLY INVISIBLE.'); IF TGUILD THEN WRITELN(TERM, 'YOU ARE A MEMBER OF THE THIEVES GUILD.'); IF AGUILD THEN WRITELN(TERM, 'YOU ARE A MEMBER OF THE ASSASSINS GUILD.'); IF EVIL THEN WRITELN(TERM, 'YOU HAVE FALLEN INTO THE FORCES OF EVIL.'); WRITE(TERM, 'WITH ', HITS: 0, '/', MAXHITS: 0, ' VITALITY PTS, '); WRITE(FATIGUE: 0, '/', MAXFATIGUE: 0, ' FATIGUE PTS, AND '); WRITELN(MAGIC: 0, '/', MAXMAGIC: 0, ' MAGIC PTS.'); IF POISONED THEN WRITELN(TERM, 'YOU ARE DYING FROM POISON!'); WRITELN(TERM, ' YOU HAVE A DEFENSIVE ARMOUR CLASS OF ', PN(AC)); WRITE(TERM, 'STR=', STR: 0, ', INT=', INT: 0, ', DEX=', DEX: 0); WRITELN(', PTY=', PTY: 0, ', CON=', CON: 0); WRITE(TERM, COL, 'IWEAPON SKILL: SHARP-', SSHARP * 10: 1, '@D, THRUST-'); WRITE(STHRUST * 10: 1, '@D, BLUNT-', SBLUNT * 10: 1, '@D, POLE-'); WRITE(SLONG * 10: 1, '@D'); WRITELN; WRITE(TERM, 'YOU NEED '); WRITE(MAX(0, EXPR(LVL + 1) - EXPR(LVL) - EXPERIENCE): 0); WRITELN(' MORE EXP POINTS TO TRAIN FOR THE NEXT LEVEL.'); WRITELN(TERM, 'YOU HAVE ', MONEY: 0, ' SHILLINGS IN CASH.'); WRITELN(TERM); WRITELN(TERM, 'YOU ARE CARRYING ', WEIGHT: 0, ' LBS OF ITEMS:'); OBJ := OBJECTTAIL; COUNT := 0; WHILE OBJ <> NIL DO BEGIN COUNT := COUNT + 1; WRITE(TERM, ' ', COUNT: 0, ') '); PRINTOBJ(OBJ ^, FALSE); WRITELN; OBJ := OBJ ^.NEXT END (*WHILE*); IF COUNT > MAXOBJS THEN WRITELN(TERM, 'ONLY THE FIRST ', PN(MAXOBJS), 'ITEMS WILL BE SAVED WHEN YOU LOG OUT.'); IF UNHASH=0 THEN WRITELN(TERM,'YOU HAVE NO USERNUMBER RESTRICTIONS.'); IF USER ^.SSJ THEN WRITELN(TERM, 'LAST LOGGED IN ON THE ', PNTH(LASTACCESS), ' OF THE MONTH.'); END (* WITH *) END (*PLAYERDISPLAY*); PROCEDURE MONDISPLAY(MONSTER: MONSTERPOINT); VAR OBJECT: OBJECTPOINT; BEGIN ERRLOC := 'MONDISPLAY'; WITH MONSTER ^ DO BEGIN WRITELN(TERM, PM(MONSTER), 'IS A ', PNTH(LVL), 'LEVEL MONSTER WITH ', HITS: 0, '/', MAXHITS: 0, ' H.P.'); WRITELN(TERM, 'DEFEND=', DEFEND: 5, ', BLOCK=', BLOCK: 5, ', FOLLOW=', FOLLOW: 5 , ','); WRITELN(TERM, 'GUARD=', GUARD: 5, ', ATKLASTAGGR=', ATKLASTAGGR: 5); WRITELN(TERM, EXPERIENCE, ' E.P., PERMANENT=', PERMANENT: 5); IF MORALREACT THEN WRITELN(TERM, 'MONSTER WILL HIT PLAYERS WITH PIETY < 8.'); IF INVISIBLE THEN WRITELN(TERM, 'MONSTER IS INVISIBLE.'); IF FLEE THEN WRITELN(TERM, 'MONSTER MAY FLEE.'); IF ASSISTANCE THEN WRITELN(TERM, 'MONSTER WILL CALL FOR HELP IF ATTACKED.'); IF MAGIC THEN WRITELN(TERM, 'AFFECTED ONLY BY MAGICAL WEAPONS.'); IF POISON THEN WRITELN(TERM, 'MONSTER IS POISONOUS.'); IF ANTIMAGIC THEN WRITELN(TERM, 'MONSTER IS IMMUNE TO SPELLS.'); IF UNDEAD THEN WRITELN(TERM, 'MONSTER IS UNDEAD.'); IF SLOWREACT THEN WRITELN(TERM, 'MONSTER WILL REACT SLOWLY.'); IF FASTREACT THEN WRITELN(TERM, 'MONSTER WILL REACT QUICKLY.'); IF REGENERATE THEN WRITELN(TERM, 'MONSTER CAN REGENERATE H.P.'); IF DRAIN THEN WRITELN(TERM, 'MONSTER HAS ENERGY-DRAIN.'); IF MONSPELLS THEN WRITELN(TERM, 'MONSTER CAN CAST SPELLS.'); IF MPARLEY > 0 THEN WRITELN(TERM, 'MONSTER WILL DO TYPE ', PN(MPARLEY), ' PARLEY.'); WRITELN(TERM, 'TREASURE TYPE: ', WHICHOBJ: 0, '.'); OBJECT := OBJECTTAIL; IF OBJECT <> NIL THEN BEGIN WRITELN(TERM); WRITELN(TERM, 'OBJECTS CARRIED:'); REPEAT WRITE(TERM); PRINTOBJ(OBJECT ^, FALSE); WRITELN; OBJECT := OBJECT ^.NEXT; UNTIL OBJECT = NIL; END (* PRINT MON OBJECTS *); END (*WITH*) END (*MONDISPLAY*); PROCEDURE PUNCTUATE(NUM, TOTAL: INTEGER); BEGIN IF NUM <> TOTAL THEN IF TOTAL - NUM >= 2 THEN WRITE(', ') ELSE WRITE(' AND '); IF (NUM MOD 3 = 0) AND (NUM < TOTAL) THEN BEGIN WRITELN; WRITE(TERM) END END (*PUNCTUATE*); PROCEDURE INVENTORY; (* INVENTORY WILL PRINT A LIST OF CARRIED OBJECTS *) VAR ILOOP, COUNT: INTEGER; OBJECT: OBJECTPOINT; BEGIN WRITELN(TERM, 'YOU ARE CARRYING THE FOLLOWING OBJECTS:'); COUNT := 0; OBJECT := USER ^.OBJECTTAIL; WHILE OBJECT <> NIL DO BEGIN COUNT := COUNT + 1; OBJECT := OBJECT ^.NEXT END; IF COUNT > 0 THEN BEGIN WRITE(TERM); OBJECT := USER ^.OBJECTTAIL; ILOOP := 0; WHILE (ILOOP < COUNT) AND (OBJECT <> NIL) DO BEGIN ILOOP := ILOOP + 1; PRINTOBJ(OBJECT ^, FALSE); PUNCTUATE(ILOOP, COUNT); OBJECT := OBJECT ^.NEXT; END (*WHILE*); WRITELN('.'); WRITELN(TERM); END (*IF*) ELSE WRITELN(TERM, 'NOTHING AT ALL.') END (*INVENTORY*); PROCEDURE ROOMDISPLAY; (* FORWARDED FROM ANNOUNCELOGIN. DISPLAY THE ROOM. *) VAR ILOOP, COUNT: INTEGER; FOUND: BOOLEAN; OBJECT: OBJECTPOINT; MONSTER: MONSTERPOINT; PLAYER: USERPOINT; TEMP: ALFA; TENSE: ARRAY [FALSE .. TRUE] OF PACKED ARRAY [1..3] OF CHAR; BEGIN ERRLOC := 'ROOMDISPLA'; WRITE(TERM, 'YOU''RE '); WITH ROOM[RM] DO BEGIN PRINTDESC(DESCREC, DESCCODE, 0, BRIEF); IF USER ^.SSJ THEN WRITE(' (', W(RM): 0, ')'); WRITELN; COUNT := 0; FOR ILOOP := 1 TO 6 DO IF ADJOIN[ILOOP] <> 0 THEN COUNT := COUNT + 1; IF OUT > 0 THEN COUNT := COUNT + 1; IF COUNT > 0 THEN BEGIN WRITE(TERM, 'OBVIOUS EXITS ARE '); FOR ILOOP := 1 TO 7 DO BEGIN IF ILOOP = 7 THEN FOUND := (OUT <> 0) ELSE FOUND := (ADJOIN[ILOOP] <> 0); IF FOUND THEN BEGIN WRITE(PS(DIRLIST[ILOOP])); IF COUNT = 1 THEN WRITELN('.') ELSE IF COUNT > 2 THEN WRITE(', ') ELSE WRITE(' AND '); COUNT := COUNT - 1 END (*IF*) END (*FOR*); END (*IF*); COUNT := 0; OBJECT := RMOBJECTTAIL; WHILE OBJECT <> NIL DO BEGIN IF NOT OBJECT ^.INVISIBLE OR USER ^.SSJ THEN COUNT := COUNT + 1; OBJECT := OBJECT ^.NEXT END (*WHILE*); MONSTER := RMMONSTERTAIL; WHILE MONSTER <> NIL DO BEGIN IF MONSTER ^.TOP AND (NOT MONSTER ^.INVISIBLE OR USER ^.SSJ) THEN COUNT := COUNT + 1; MONSTER := MONSTER ^.NEXT END (*WHILE*); (* TOTAL # OF THINGS COUNTED. NOW PRINT THEM. *) IF COUNT > 0 THEN BEGIN WRITE(TERM, 'YOU SEE '); OBJECT := RMOBJECTTAIL; MONSTER := RMMONSTERTAIL; ILOOP := 0; WHILE (ILOOP < COUNT) AND (MONSTER <> NIL) DO BEGIN IF MONSTER ^.TOP AND (NOT MONSTER ^.INVISIBLE OR USER ^.SSJ) THEN IF MONSTER ^.NUM = 1 THEN BEGIN ILOOP := ILOOP + 1; WRITE('A ', PS(MONSTER ^.NAME)); IF MONSTER ^.INVISIBLE AND USER ^.SSJ THEN WRITE(' (INV)'); PUNCTUATE(ILOOP, COUNT); END (*IF*) ELSE BEGIN ILOOP := ILOOP + 1; WRITE(PN(MONSTER ^.NUM), PS(MONSTER ^.NAME), 'S'); IF MONSTER ^.INVISIBLE AND USER ^.SSJ THEN WRITE(' (INV)'); PUNCTUATE(ILOOP, COUNT); END (*ELSE*); MONSTER := MONSTER ^.NEXT END (*WHILE*); WHILE (ILOOP < COUNT) AND (OBJECT <> NIL) DO BEGIN IF NOT OBJECT ^.INVISIBLE OR USER ^.SSJ THEN BEGIN ILOOP := ILOOP + 1; PRINTOBJ(OBJECT ^, FALSE); PUNCTUATE(ILOOP, COUNT); END (*IF*); OBJECT := OBJECT ^.NEXT; END (*WHILE*); WRITELN('.'); WRITELN(TERM); END (*IF*); PLAYER := RMPLAYERTAIL (* PRINT PLAYERS IN ROOM *); COUNT := 0; WHILE PLAYER <> NIL DO BEGIN IF (PLAYER <> USER) AND NOT PLAYER ^.INVISIBLE AND (NOT PLAYER ^.HIDDEN OR USER ^.SSJ) THEN COUNT := COUNT + 1; PLAYER := PLAYER ^.NEXT END (*WHILE*); IF COUNT > 0 THEN BEGIN WRITE(TERM); PLAYER := RMPLAYERTAIL; ILOOP := 0; WHILE PLAYER <> NIL DO BEGIN IF (PLAYER <> USER) AND NOT PLAYER ^.INVISIBLE AND (NOT PLAYER ^.HIDDEN OR USER ^.SSJ) THEN BEGIN WRITE(PS(PLAYER ^.NAME)); IF PLAYER ^.HIDDEN THEN WRITE(' (HID)'); ILOOP := ILOOP + 1; PUNCTUATE(ILOOP, COUNT); END (*IF*); PLAYER := PLAYER ^.NEXT; END (*WHILE*); IF COUNT = 1 THEN WRITELN(' IS ALSO HERE.') ELSE WRITELN(' ARE ALSO HERE.'); END (*IF*); TEMP := USER ^.NAME; USER ^.NAME := 'YOU '; TENSE[FALSE] := ' IS'; TENSE[TRUE] := '''RE'; (* SAY "YOU ARE", NOT " IS" *) MONSTER := RMMONSTERTAIL; WHILE MONSTER <> NIL DO BEGIN IF MONSTER ^.DEFPLAYER <> NIL THEN WRITELN(TERM, PM(MONSTER), 'IS ATTACKING ', PS(MONSTER ^.DEFPLAYER ^.NAME), '!'); MONSTER := MONSTER ^.NEXT END (*WHILE*); PLAYER := RMPLAYERTAIL; WHILE PLAYER <> NIL DO BEGIN IF PLAYER ^.DEFMON <> NIL THEN IF PLAYER ^.DEFMON ^.DEFPLAYER <> PLAYER THEN (* DON'T BE REDUNDANT. MONSTER-PLAYER PLAYER-MONSTER *) WRITELN(TERM, PS(PLAYER ^.NAME), TENSE[PLAYER = USER], ' ATTACKING ', PM( PLAYER ^.DEFMON), '!') ELSE IF PLAYER ^.DEFPLAYER <> NIL THEN WRITELN(TERM, PS(PLAYER ^.NAME), TENSE[PLAYER = USER], ' ATTACKING ', PS( PLAYER ^.DEFPLAYER ^.NAME), '!'); PLAYER := PLAYER ^.NEXT; END (*WHILE*); USER ^.NAME := TEMP (*RESTORE NAME*); END (*WITH*); END (*ROOMDISPLAY*); PROCEDURE ASSOCERR; BEGIN WRITELN(TERM, 'SORRY, ASSOCIATE DM''S MAY NOT DO THAT.') END; PROCEDURE MODPLAYER(VAR PLAYER: USERPOINT; ONLINE: BOOLEAN); (* MODPLAY WILL MODIFY A PLAYER'S DATA RECORD. IT IS CALLED BY EDITPLAYER AND EDITFILE. ONLINE IS TRUE IF THE EDITED PLAYER IS ACTUALLY LOGGED IN. *) VAR ILOOP, WHICHPARM, NUMBER: INTEGER; CH: CHAR; WORD: ALFA; FLAG: BOOLEAN; INDEX: INTEGER; BEGIN WHICHPARM := GETEDITPARM(USRPARMLIST, WORD, NUMBER, FLAG, BUFFER, LENBUF, LOC); WHILE WHICHPARM > 0 DO WITH PLAYER ^ DO BEGIN IF USER ^.ASSOC AND (WHICHPARM IN [3, 11, 20, 21, 25, 29,34,37]) THEN BEGIN WRITELN(TERM, USRPARMLIST[WHICHPARM].PNAME, ' - ILLEGAL ACCESS.'); ASSOCERR; LOC := LENBUF + 1 END (*IF*) ELSE CASE WHICHPARM OF 1: BEGIN INDEX := SEARCHPLINDEX(NAME); IF INDEX > 0 THEN PLAYERINDEX[INDEX] := WORD; NAME := WORD END (*1*); 2: IF NOT USER ^.MASTER THEN WRITELN(TERM, 'ONLY MASTER DM''S MAY ACTIVATE DM PRIVILEDGES.') ELSE BEGIN CH := WORD[1]; CASE CH OF 'D': BEGIN SSJ := TRUE; ASSOC := FALSE; MASTER := FALSE END; 'A': BEGIN SSJ := TRUE; ASSOC := TRUE; MASTER := FALSE END; 'M': BEGIN SSJ := TRUE; ASSOC := FALSE; MASTER := TRUE END; 'N': BEGIN SSJ := FALSE; ASSOC := FALSE; MASTER := FALSE END; OTHERWISE WRITELN(TERM, 'ERROR. ZZ MUST = NONE, ASSISTANT, DM, OR MASTER.'); END (*CASE*) END (*ELSE*); 3: WEIGHT := MAX(0, MIN(5000, NUMBER)); 4: LVL := MAX(0, MIN(25, NUMBER)); 5: BEGIN CH := WORD[1]; CASE CH OF 'B': CLASS := BARBARIAN; 'F': CLASS := FIGHTER; 'T': CLASS := THIEF; 'C': CLASS := CLERIC; 'M': IF WORD[3] = 'Y' THEN CLASS := MAYOR ELSE CLASS := MAGICUSER; 'R': CLASS := RANGER; 'P': CLASS := PALADIN; 'D': CLASS := DM; OTHERWISE WRITELN(TERM, 'ILLEGAL CLASS TYPE.'); END (*CASE*); END (*5*); 6: HITS := MAX(0, MIN(2500, NUMBER)); 7: MAXHITS := MAX(0, MIN(2500, NUMBER)); 8: MAGIC := MAX(0, MIN(2500, NUMBER)); 9: MAXMAGIC := MAX(0, MIN(2500, NUMBER)); 10: EXPERIENCE := MAX(0, MIN(262000, NUMBER)); 11: AC := MAX(- 50, MIN(50, NUMBER)); 12: IF ONLINE THEN BEGIN DELETEPLAYER(PLAYER, RMCODE); PLACEPLAYER(PLAYER, NUMBER); END (*IF*) ELSE RMCODE := NUMBER; 13: BRIEF := FLAG; 14: STR := MAX(- 10, MIN(25, NUMBER)); 15: INT := MAX(- 10, MIN(25, NUMBER)); 16: DEX := MAX(- 10, MIN(25, NUMBER)); 17: PTY := MAX(- 10, MIN(25, NUMBER)); 18: ECHO := FLAG; 19: CON := MAX(- 10, MIN(25, NUMBER)); 20: IF WORD[1] = 'M' THEN SEX := MALE ELSE IF WORD[1] = 'F' THEN SEX := FEMALE ELSE WRITELN(TERM,'SEX MUST BE MALE OR FEMALE.'); 21: FOR ILOOP := 1 TO 7 DO UN[ILOOP] := WORD[ILOOP]; 22: IF USER ^.MASTER THEN PW := HASH(WORD,10) ELSE WRITELN(TERM, 'ONLY MASTER DM''S MAY ALTER PASSWORDS.'); 23: MONEY := MAX(0, MIN(500000, NUMBER)); 24: LASTACCESS := MAX(0, MIN(31, NUMBER)); 25: INVISIBLE := FLAG; 26: FATIGUE := MAX(0, MIN(2500, NUMBER)); 27: MAXFATIGUE := MAX(0, MIN(2500, NUMBER)); 28: POISONED := FLAG; 29: PLAYTESTER := FLAG; 30: HIDDEN := FLAG; 31: TGUILD := FLAG; 32: MESBLOCK := FLAG; 33: AGUILD := FLAG; 34: EVIL := FLAG; 35: SPELLDAY := MAX(0, MIN(5, NUMBER)); 36: SENDDAY := MAX(0, MIN(31, NUMBER)); 37: NONEXISTANT := FLAG; 38: SSHARP := MIN(7, MAX(0, NUMBER DIV 10)); 39: STHRUST := MIN(7, MAX(0, NUMBER DIV 10)); 40: SBLUNT := MIN(7, MAX(0, NUMBER DIV 10)); 41: SLONG := MIN(7, MAX(0, NUMBER DIV 10)); 42: BEGIN IF UNHASH = 0 THEN UNHASH := 1 (* TURN OFF NO-RESTRICTIONS *); GETWORD(WORD,NUM,BUFFER,LENBUF,LOC); IF (WORD=BLANKS) AND (NUMBER=0) THEN UNHASH := 1 ELSE IF WORD = 'CLEAR ' THEN UNHASH := 0 ELSE IF UNHASH > TRUNC(1.0,39) THEN WRITELN(TERM,'TOO MANY UNS IN ACCESS BLOCK.') ELSE UNHASH := UNHASH * HASH(WORD,5) END; END (*CASE*); WHICHPARM := GETEDITPARM(USRPARMLIST, WORD, NUMBER, FLAG, BUFFER, LENBUF, LOC); END (*WHILE*); END (*MODPLAYER*); PROCEDURE DISPEDPLAYER(PLAYER: USERPOINT); BEGIN PLAYERDISPLAY(PLAYER) END; (*$L'HIGH LEVEL PROCEDURES' *) PROCEDURE EDITFILE(EDITCMD: INTEGER; WHICH: ALFA); VAR PLAYER: USERPOINT; EXISTS: BOOLEAN; BEGIN EXISTS := TRUE; NEW(PLAYER) (* CREATE TEMP PLAYER *); PLAYER ^ := PROTOUSER; READPLAYER(PLAYER, WHICH); IF PLAYER ^.NAME = EMPTY THEN BEGIN WRITELN(TERM, 'ENTRY NOT FOUND.'); EXISTS := FALSE; PLAYER ^.NAME := WHICH END (*IF*); CASE EDITCMD OF 1: (* MODIFY *) IF EXISTS THEN BEGIN DAYMSG('FIL', PLAYER, USER ^.NAME, 0); MODPLAYER(PLAYER, FALSE); WRITEPLAYER(PLAYER, PLAYER ^.NAME) END (*IF*) ELSE WRITEUSR(PLAYER, FALSE); 2: (* DISPOSE *) IF EXISTS THEN BEGIN DAYMSG('ERA', PLAYER, USER ^.NAME, 0); PLAYER ^.NAME := EMPTY; WRITEPLAYER(PLAYER, WHICH); WRITELN(TERM, 'PLAYER ERASED.') END (*IF*) ELSE WRITEUSR(PLAYER, FALSE); 3: (* EXAMINE *) BEGIN IF EXISTS THEN DISPEDPLAYER(PLAYER); WRITEUSR(PLAYER, FALSE) END (*3*); 4: IF NOT EXISTS THEN BEGIN PLAYER ^.LASTACCESS := TODAY; MODPLAYER(PLAYER, FALSE); DAYMSG('CRE', PLAYER, USER ^.NAME, 0); WRITEPLAYER(PLAYER, PLAYER ^.NAME) END (*IF*) ELSE BEGIN WRITELN(TERM, 'PLAYER ALREADY EXISTS IN FILE.'); WRITEUSR(PLAYER, FALSE) END (*ELSE*) END (*CASE*); END (*EDITFILE*); PROCEDURE EDITPLAYER(EDITCMD: INTEGER; WHICH: ALFA); VAR PLAYER: USERPOINT; ILOOP: INTEGER; BEGIN PLAYER := NIL; IF EDITCMD = 4 THEN WRITELN(TERM, 'YOU CANNOT CREATE PLAYERS.') ELSE BEGIN PLAYER := FINDUSER(WHICH, USERTAIL); IF PLAYER = NIL THEN WRITELN(TERM, 'PLAYER NOT FOUND.') ELSE CASE EDITCMD OF 1: (*MODIFY*) BEGIN IF PLAYER ^.NAME <> USER ^.NAME THEN DAYMSG('MOD', PLAYER, USER ^.NAME, 0); MODPLAYER(PLAYER, TRUE); END (*1*); 2: (*DISPOSE*) IF USER ^.ASSOC THEN ASSOCERR ELSE BEGIN FOR ILOOP := 1 TO MSGTERM(TERMLIST, SYSMSG) DO WRITELN(TERMLIST[ILOOP], '### A LIGHTNING BOLT HITS ', PS(PLAYER ^.NAME), ' AND TURNS ', PRO[PLAYER^.SEX], ' INTO ASHES!'); PLAYER^.DEAD := TRUE; PLAYER ^.HITS := 0; DAYMSG('ZAP', PLAYER, USER ^.NAME, 0); END (*2*); 3: (*DISPLAY*) DISPEDPLAYER(PLAYER); END (*CASE*); END (*ELSE*) END (*EDITPLAYER*); PROCEDURE EDITROOM(EDITCMD: INTEGER; RM: INTEGER); VAR N, ILOOP, WHICHPARM, NUMBER: INTEGER; WORD: ALFA; FLAG: BOOLEAN; BEGIN IF (RM <= 0) OR (RM > NUMROOMS) THEN WRITELN(TERM, 'ROOM # OUT OF BOUNDS.') ELSE CASE EDITCMD OF 1: (*MODIFY*) BEGIN RM := S(RM); WHICHPARM := GETEDITPARM(RMPARMLIST, WORD, NUMBER, FLAG, BUFFER, LENBUF, LOC); WHILE WHICHPARM > 0 DO WITH ROOM[RM] DO BEGIN CASE WHICHPARM OF 1: DESCCODE := MAX(0, MIN(50, NUMBER)); 2: DESCREC := MAX(0, MIN(300, NUMBER)); 3, 4, 5, 6, 7, 8: IF NUMBER = 1000 THEN WRITELN(TERM, 'SORRY, ROOM 1000 IS RESERVED.') ELSE BEGIN NUMBER := MAX(0, MIN(NUMROOMS, NUMBER)); IF NUMBER < 1000 THEN THOUSANDS := THOUSANDS - [WHICHPARM - 2] ELSE BEGIN THOUSANDS := THOUSANDS + [WHICHPARM - 2]; NUMBER := NUMBER - 1000 END (*ELSE*); ADJOIN[WHICHPARM - 2] := NUMBER; END (*ELSE*); 9: OUT := MAX(0, MIN(NUMROOMS, NUMBER)); 10: WHICHENCOUNTER := MAX(0, MIN(LENCOUNTER, NUMBER)); 11: ENCOUNTERTIME := MAX(0, MIN(1000, NUMBER)); 12: NOTIFYDM := FLAG; 13: SAFE := FLAG; END (*CASE*); WHICHPARM := GETEDITPARM(RMPARMLIST, WORD, NUMBER, FLAG, BUFFER, LENBUF, LOC) END (*WITH*); WRITELN(TERM, 'ROOM MODIFIED.') END (*1*); 2: (*DISPOSE*) WRITELN(TERM, 'IT IS NOT POSSIBLE TO DISPOSE OF A ROOM.'); 3: (*EXAMINE*) BEGIN RM := S(RM); ROOMDISPLAY(RM, USER ^.BRIEF); WITH ROOM[RM] DO BEGIN WRITE(TERM); FOR ILOOP := 1 TO 6 DO BEGIN N := ADJOIN[ILOOP]; IF N > 0 THEN BEGIN IF ILOOP IN THOUSANDS THEN N := N + 1000; WRITE(DIRLIST[ILOOP, 1], '=', N: 0, ', '); END (*IF*); END (*FOR*); N := OUT; IF N > 0 THEN WRITE('OUT=', N: 0, ', '); WRITELN('DR=', DESCREC: 0, ', DI=', DESCCODE: 0, ', EN=', WHICHENCOUNTER: 0, ', ET=', ENCOUNTERTIME: 0, '.'); IF NOTIFYDM THEN WRITELN(TERM, 'DM NOTIFIED ON ENTRY.'); IF SAFE THEN WRITELN(TERM, 'ROOM IS HAVEN AGAINST ATTACK.'); END (*WITH*); END (*3*); 4: IF NOT USER ^.MASTER THEN WRITELN(TERM, 'SORRY, ONLY MASTER DM''S MAY CREATE ADDITIONAL ROOMSEGS.') ELSE BEGIN ADDSEG; DAYMSG('ADD', USER, 'ADD ROOMS ', NUMROOMS); END; END (*CASE*); END (*EDITROOM*); PROCEDURE EDITMONSTER(EDITCMD: INTEGER; WHICH: ALFA; MNUM, WHATCODE: INTEGER); VAR MONSTER: MONSTERPOINT; OBJECT: OBJECTPOINT; WHICHPARM, NUMBER, RM: INTEGER; DUMMY, WORD: ALFA; FLAG: BOOLEAN; BEGIN IF WHATCODE = 10 THEN GETWORD(DUMMY, RM, BUFFER, LENBUF, LOC) ELSE BEGIN RM := MNUM; DUMMY := WHICH END; IF (RM <= 0) OR (RM > NUMROOMS) OR (DUMMY <> BLANKS) THEN WRITELN(TERM, 'ILLEGAL LOC NUMBER.') ELSE BEGIN IF WHATCODE = 10 THEN BEGIN RM := S(RM); MONSTER := FINDMONSTER(WHICH, MNUM, ROOM[RM].RMMONSTERTAIL); IF EDITCMD = 4 THEN BEGIN NEW(MONSTER); MONSTER ^ := PROTOMONSTER; MONSTER ^.NAME := WHICH; INSERTMONSTER(MONSTER, RM); WRITELN(TERM, 'MONSTER CREATED.') END (*IF*) END (*IF*) ELSE IF (RM >= 1) AND (RM <= RANMONLEN) THEN BEGIN NEW(MONSTER); MONSTER ^ := RANMONLIST[RM]; END ELSE BEGIN WRITELN(TERM, 'BAD MLIST NUMBER.'); WHATCODE := 0; MONSTER := NIL END; IF MONSTER <> NIL THEN CASE EDITCMD OF 1, 4: (*MODIFY, CREATE*) WITH MONSTER ^ DO BEGIN IF WHATCODE = 13 THEN DAYMSG('MLI',USER,BLANKS,RM); WHICHPARM := GETEDITPARM(MONPARMLIST, WORD, NUMBER, FLAG, BUFFER, LENBUF, LOC); WHILE WHICHPARM > 0 DO BEGIN IF (WHATCODE = 13) AND USER ^.ASSOC THEN BEGIN ASSOCERR; LOC := LENBUF + 1 END ELSE CASE WHICHPARM OF 1: DEFEND := FLAG; 2: BLOCK := FLAG; 3: FOLLOW := FLAG; 4: GUARD := FLAG; 5: ATKLASTAGGR := FLAG; 6: SLOWREACT := FLAG; 7: MORALREACT := FLAG; 8: FLEE := FLAG; 9: ASSISTANCE := FLAG; 10: BEGIN LVL := MAX(0, MIN(25, NUMBER)); IF LVL >= 15 THEN DAYMSG('LVL', USER, MONSTER ^.NAME, MONSTER ^.LVL) END (*10*); 11: HITS := MAX(0, MIN(1000, NUMBER)); 12: MAXHITS := MAX(0, MIN(1000, NUMBER)); 13: EXPERIENCE := MAX(0, MIN(100000, NUMBER)); 14: PERMANENT := FLAG; 15: MAGIC := FLAG; 16: WHICHOBJ := MAX(0, MIN(NUMBER, OBJLISTLEN)); 17: IF WHATCODE <> 10 THEN NAME := WORD ELSE WRITELN(TERM, 'NAME CANNOT BE MODIFIED.'); 18: FASTREACT := FLAG; 19: INVISIBLE := FLAG; 20: REGENERATE := FLAG; 21: DRAIN := FLAG; 22: POISON := FLAG; 23: ANTIMAGIC := FLAG; 24: UNDEAD := FLAG; 25: MONSPELLS := FLAG; 26: MPARLEY := MAX(0, MIN(NUMBER, 30)); END (*CASE*); WHICHPARM := GETEDITPARM(MONPARMLIST, WORD, NUMBER, FLAG, BUFFER, LENBUF, LOC) END (*WHILE*); IF MAXHITS < HITS THEN MAXHITS := HITS; WRITELN(TERM, 'MONSTER MODIFIED.'); END (*1*); 2: (*DISPOSE*) IF WHATCODE = 10 THEN BEGIN DELETEMONSTER(MONSTER, RM); DESTROY(MONSTER); WRITELN(TERM, 'MONSTER DISPOSED.') END (*IF*) ELSE WRITELN(TERM, 'MLIST CANNOT BE DISPOSED.'); 3: (* EXAMINE *) MONDISPLAY(MONSTER); END (*CASE*) ELSE WRITELN(TERM, 'MONSTER NOT FOUND.'); IF WHATCODE = 13 THEN BEGIN RANMONLIST[RM] := MONSTER ^; DISPOSE(MONSTER) END END (*ELSE*) END (*EDITMONSTER*); PROCEDURE EDIT(VAR BUFFER: BUFTYPE; LENBUF: LENBUFTYPE; VAR EDITLIST: EDITTYPELIST); (* *EDIT* IS THE MAIN ROUTINE FOR EDITING THE DATABASE OF MILIEU. IT ALLOWS THE DM TO MODIFY THE DUNGEON *WHILE THE GAME IS RUNNING*. WITH THE EDITOR, THE DM CAN MODIFY PLAYER SITUATION IN ANY WAY, ACCORDING TO HIS/HER OWN DISCRETION. *** WARNING *** IT IS POSSIBLE TO PERMANENTLY DAMAGE THE DATABASE BY ISSUING BAD EDIT COMMANDS. READ THE EDIT INSTRUCTIONS BEFORE USING THIS!!! *) VAR EDITCMD, WHAT, WHICH: ALFA; EDITNUM, DUMMY, WHATCODE, RMORMONNUM: INTEGER; BEGIN LOC := 1 (* RESET GETWORD POINTER *); GETWORD(EDITCMD, DUMMY, BUFFER, LENBUF, LOC); (* FETCH THE COMMAND WORD FROM THE BUFFER *) EDITNUM := WORDMATCH(EDITCMD, 7, EDITLIST); (* FIND WHICH COMMAND # IT IS. *) GETWORD(WHAT, DUMMY, BUFFER, LENBUF, LOC); (* GET THE OPERAND: ROOM, OBJECT, MONSTER, PLAYER OR FILE. *) WHATCODE := WORDMATCH(WHAT, 14, EDITLIST); (* FIND WHICH # IT IS. *) IF EDITNUM = 0 THEN BEGIN IF EDITCMD <> BLANKS THEN WRITELN(TERM, 'ILLEGAL EDIT CMD.') END ELSE IF (WHATCODE <= 7) AND NOT (EDITNUM IN [5, 6, 7]) THEN (* -1, 0, OR CMD AS 2ND WORD *) WRITELN(TERM, 'BAD OPERAND - ', WHAT) ELSE BEGIN GETWORD(WHICH, RMORMONNUM, BUFFER, LENBUF, LOC); CASE EDITNUM OF - 1, 0: (* NOT UNIQUE, MESSAGE ALREADY SENT *); 1, 2, 3, 4: CASE WHATCODE OF 8: IF (EDITNUM <> 3) AND USER ^.ASSOC THEN ASSOCERR ELSE EDITROOM(EDITNUM, RMORMONNUM); 14, 9: EDITOBJECT(EDITNUM, WHICH, RMORMONNUM, WHATCODE); 13, 10: EDITMONSTER(EDITNUM, WHICH, RMORMONNUM, WHATCODE); 11: EDITPLAYER(EDITNUM, WHICH); 12: IF (EDITNUM <> 3) AND USER ^.ASSOC THEN ASSOCERR ELSE EDITFILE(EDITNUM, WHICH); END (*CASE*); 5, 6, 7: BEGIN USER ^.ENTRY := XCMD; IF NOT USER ^.BRIEF THEN WRITELN(TERM, 'EXITING THE EDITOR.') END (*5*) END (*CASE*); END (*ELSE*); PROMPTUSER(USER) END (*EDIT*); PROCEDURE TRAIN; VAR TROOM: INTEGER; BEGIN CASE USER ^.CLASS OF FIGHTER: TROOM := 20; PALADIN: TROOM := 21; CLERIC: TROOM := 22; THIEF: TROOM := 23; MAGICUSER: TROOM := 24; RANGER: TROOM := 25; OTHERWISE TROOM := 20 END (*CASE*); WITH USER ^ DO IF W(RMCODE) <> TROOM THEN WRITELN(TERM, 'THIS IS NOT THE PROPER PLACE FOR TRAINING!') ELSE IF MONEY * 2 < EXPR(LVL + 1) - EXPR(LVL) THEN WRITELN(TERM, 'YOU HAVE NOT ENOUGH FUNDS TO SPEND ON TRAINING!') ELSE IF EXPERIENCE + EXPR(LVL) < EXPR(LVL + 1) THEN WRITELN(TERM, 'YOU ARE NOT EXPERIENCED ENOUGH FOR FURTHER TRAINING!') ELSE IF LVL >= 20 THEN WRITELN(TERM, 'YOU HAVE REACHED THE PEAK OF EXCELLANCE AND KNOWLEDGE.') ELSE BEGIN MONEY := MONEY - (EXPR(LVL + 1) - EXPR(LVL)) DIV 2; WRITE(TERM, 'AFTER MANY WEEKS OF TRAINING'); IF NOT (CLASS IN [BARBARIAN, THIEF, FIGHTER]) THEN WRITE(' AND MEDITATION'); WRITELN(' YOU FIND......'); EXPERIENCE := 0; MAXHITS := MIN(2500, MAXHITS + MAXHITS DIV LVL); MAXFATIGUE := MIN(2500, MAXFATIGUE + MAXFATIGUE DIV LVL); MAXMAGIC := MIN(2500, MAXMAGIC + MAXMAGIC DIV LVL); LVL := MIN(25, LVL + 1); CASE RND(5) OF 1: STR := MIN(25, STR + 1); 2: DEX := MIN(25, DEX + 1); 3: INT := MIN(25, INT + 1); 4: PTY := MIN(25, PTY + 1); 5: CON := MIN(25, CON + 1); END (*CASE*); SKILLNEW := FALSE; IF LVL <= 10 THEN CON := MIN(25, CON + 1); IF (CLASS=CLERIC) AND (LVL >= 15) THEN BEGIN WRITELN(TERM,'YOU HAVE DISCOVERED THE SOURCE OF ULTIMATE KNOWLEDGE AND TRUTH.'); WRITELN(TERM,' '); WRITELN(TERM,'YOU STAND UP, AND ANNOUNCE YOURSELF TO THE WORLD AS YOU MARCH OFF INTO'); WRITELN(TERM,'THE SUNSET AS ',PS(NAME):0,', THE SAINT OF TRUTH AND LIGHT!'); LVL := 6; CON := 0; HITS := 0; DEAD := TRUE END ELSE PLAYERDISPLAY(USER) END (*ELSE*) END (*TRAIN*); PROCEDURE UPDATE; FORWARD; PROCEDURE PRINTDMG(PLAYER: USERPOINT; DAMAGE: INTEGER; BRF: BOOLEAN); BEGIN WITH PLAYER ^ DO IF BRF THEN BEGIN IF FATIGUE = 0 THEN WRITELN(DAMAGE: 0, ' VIT!') ELSE IF DAMAGE > FATIGUE THEN WRITELN(FATIGUE: 0, ' FAT, AND ', DAMAGE - FATIGUE: 0, ' VIT!') ELSE WRITELN(DAMAGE: 0, ' FAT!') END (*IF*) ELSE BEGIN IF FATIGUE = 0 THEN WRITELN(DAMAGE: 0, ' VITALITY POINTS!') ELSE IF DAMAGE > FATIGUE THEN WRITELN(FATIGUE: 0, ' FATIGUE PTS, AND ', DAMAGE - FATIGUE: 0, ' VITALITY PTS!') ELSE WRITELN(DAMAGE: 0, ' FATIGUE POINTS!') END (*ELSE*) END (*PRINTDMG*); PROCEDURE HITSHARMOR(VAR PLYR: USERPOINT; VAR DAMAGE: INTEGER); VAR TEMP: OBJECTPOINT; BEGIN ERRLOC := ' SEVEN '; WITH PLYR ^ DO BEGIN IF USARM <> NIL THEN BEGIN DAMAGE := MAX(0, DAMAGE - USARM ^.ARMPLUS); USARM ^.ARMHITSLEFT := MAX(0, USARM ^.ARMHITSLEFT - 1); IF USARM ^.ARMHITSLEFT = 0 THEN BEGIN WRITELN(TRM, 'YOUR ARMOR FALLS APART!'); IF DELETEOBJECT(USARM, OBJECTTAIL) THEN OBJECTTAIL := OBJECTTAIL ^.NEXT; WEIGHT := WEIGHT - USARM ^.WEIGHT; TEMP := USARM; STOPUSING(PLYR, USARM); DISPOSE(TEMP); END (*IF*) END (*IF*); IF USSHIELD <> NIL THEN BEGIN USSHIELD ^.SHHITSLEFT := MAX(0, USSHIELD ^.SHHITSLEFT - 1); IF USSHIELD ^.SHHITSLEFT = 0 THEN BEGIN WRITELN(TRM, 'YOUR SHIELD BREAKS IN HALF!'); IF DELETEOBJECT(USSHIELD, OBJECTTAIL) THEN OBJECTTAIL := OBJECTTAIL ^.NEXT; WEIGHT := WEIGHT - USSHIELD ^.WEIGHT; TEMP := USSHIELD; STOPUSING(PLYR, USSHIELD); DISPOSE(TEMP); END (*IF*) END (*IF*) END (*WITH*) END (*HITSHARMOR*); PROCEDURE YESNO; VAR YES: BOOLEAN; OBJ: OBJECTPOINT; BEGIN YES := (BUFFER[1] = 'Y'); WITH USER ^ DO CASE ENTRY OF XPARLEY: IF YES THEN IF DATA > MONEY THEN WRITELN(TERM, 'YOU HAVE NOT ENOUGH MONEY, EFFENDI!') ELSE BEGIN MONEY := MONEY - DATA; NEW(OBJ); OBJ ^ := RANOBJLIST[LASTATK]; OBJ ^.NEXT := ROOM[RMCODE].RMOBJECTTAIL; ROOM[RMCODE].RMOBJECTTAIL := OBJ; WRITELN(TERM, 'HERE YOU ARE, MY FRIEND. YOU ARE A SHREWD BUYER, EFFENDI!') END (*ELSE*) ELSE WRITELN(TERM, 'OH PLEASE RECONSIDER, EFFENDI! IT IS OF SUCH HIGH QUALITY!'); XREPAIR: BEGIN OBJ := USWEAP; USWEAP := NIL; IF YES AND (OBJ <> NIL) THEN IF DATA >= MONEY THEN WRITELN(TERM, '"YOU DON''T HAVE ENOUGH MONEY!"') ELSE WITH OBJ ^ DO BEGIN IF RND(2) = 1 THEN MAGIC := FALSE; CASE OBCLASS OF WEAP: IF (MAXHP+MINHP>30) AND (RND(2)=1) THEN BEGIN WRITELN(TERM,'<>! "OOPS! SORRY!", SAYS THE REPAIRMAN MEEKLY.'); MINHP := 1; MAXHP := MAXHP DIV 2 + 1 END ELSE BEGIN IF NOT MAGIC THEN WEAPLUS := MIN(0, WEAPLUS); STRIKESLEFT := MIN(100, STRIKESLEFT * 2 + 50) END (*WEAP*); SHIELD: SHHITSLEFT := MIN(50, SHHITSLEFT * 2 + 25); ARMOR: ARMHITSLEFT := MIN(50, ARMHITSLEFT * 2 + 25); END (*CASE*); WRITELN(TERM, '"HERE IT IS SIR, REPAIRED AS WELL IT CAN BE."'); MONEY := MONEY - DATA END (*WITH*); END (*XREPAIR*); XSELL: BEGIN OBJ := USWEAP; USWEAP := NIL; IF YES AND (OBJ <> NIL) THEN BEGIN MONEY := MIN(500000, MONEY + DATA); WEIGHT := MAX(0, WEIGHT - OBJ ^.WEIGHT); IF DELETEOBJECT(OBJ, OBJECTTAIL) THEN OBJECTTAIL := OBJECTTAIL ^.NEXT; ODESTROY(OBJ); WRITELN(TERM, '"THANK YOU! COME AGAIN!"') END (*IF*); END (*XSELL*); END (*CASE*); USER ^.ENTRY := XCMD; PROMPTUSER(USER); END (*YESNO*); PROCEDURE WISH; (* PRINTOUT A WISH TO THE DM *) VAR DM: USERPOINT; ILOOP: INTEGER; FUNCTION LOCTDM(USR: USERPOINT): BOOLEAN; BEGIN LOCTDM := (USR ^.SSJ) AND (USR ^.STATUS = SNORMAL) END; BEGIN (*WISH*) USER ^.ENTRY := XCMD; DM := MATCHUSER(USERTAIL, LOCTDM); IF DM = NIL THEN WRITELN(TERM, 'YOUR WISH IS NOT HEARD.') ELSE WRITELN(TERM, 'WISH SENT.'); WHILE DM <> NIL DO BEGIN WRITE(DM ^.TRM, '*** ', PS(USER ^.NAME), ' (', W(USER ^.RMCODE): 0, ') CASTS A WISH '); IF USER ^.WDATA <> BLANKS THEN WRITELN('ON ', USER ^.WDATA) ELSE WRITELN('.'); WRITE(DM ^.TRM, '*** "'); FOR ILOOP := 1 TO LENBUF DO WRITE(BUFFER[ILOOP]); WRITELN('"'); DM := MATCHUSER(DM ^.NEXTUSER, LOCTDM); END (*WHILE*); USER ^.CON := MAX(0, USER ^.CON - 1); DAYMSG('WIS', USER, 'WISH CAST ', 0); FOR ILOOP := 1 TO MSGTERM(TERMLIST, ALL) DO WRITELN(TERMLIST[ILOOP], 'THE SKY AROUND ', PS(USER ^.NAME), ' SUDDENLY DARKENS AND THEN CLEARS!'); PROMPTUSER(USER) END (*WISH*); FUNCTION READYCHECK(LASTATK: INTEGER): BOOLEAN; BEGIN READYCHECK := FALSE; IF REALTIME + 1 < LASTATK THEN WRITELN(TERM, 'NOT READY! WAIT ', LASTATK - REALTIME: 1, ' MORE SECONDS.') ELSE IF USER ^.DRUNK - REALTIME >= 60 THEN WRITELN(TERM, 'YOU''RE TOO SMASHED TO DO ANYTHING!') ELSE READYCHECK := TRUE END (*READYCHECK*); FUNCTION SPELLCASE(SPELLCODE, LEVEL, INTEL: INTEGER; PLAYER: USERPOINT; MONSTER: MONSTERPOINT; OBJ: OBJECTPOINT; TARGET: ALFA): INTEGER; VAR DAMAGE: INTEGER; BEGIN DAMAGE := 0; WITH USER ^ DO CASE SPELLCODE OF 1 (*VIGOR, ONUSPLAYER*): BEGIN PLAYER ^.FATIGUE := MIN(PLAYER ^.MAXFATIGUE, PLAYER ^.FATIGUE + LEVEL * 6); WRITELN(PLAYER ^.TRM, 'YOU NOW HAVE ', PLAYER ^.FATIGUE: 0, ' FATIGUE POINTS.' ); END (*1*);