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

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

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

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

-+-+-+-+-+-+-+-+ START OF PART 31 -+-+-+-+-+-+-+-+
X$   IF .not. $SEVERITY`032
X$     THEN
X$       WRITE SYS$ERROR "Creating of ''full' failed"
X$       GOTO again1
X$   ENDIF
X$ ENDIF
X$ CALL DIRNAME 'full' dirname
X$ SET FILE/PROTECTION=(W:E)/LOG 'dirname
X$ IF .not. $SEVERITY THEN CALL FATAL "Set file/protection failed"
X$ SET FILE/ACL=(IDENTIFIER='F$USER(),access=r+w+e+d+c)/LOG 'dirname
X$ IF .not. $SEVERITY THEN CALL FATAL "Set file/acl failed"
X$ SET FILE/ACL=(IDENTIFIER='F$USER(),OPTIONS=DEFAULT,access=r+w+e+d+c)/LOG '
Vdirname
X$ IF .not. $SEVERITY THEN CALL FATAL "Set file/acl failed"
X$ SET FILE/ACL=(DEFAULT_PROTECTION,SYSTEM:RWED,OWNER:RWED,GROUP,WORLD:R)/LOG
V 'dirname
X$ IF .not. $SEVERITY THEN CALL FATAL "Set file/acl failed"
X$ 'p1 == full
X$ EXIT
X$ ENDSUBROUTINE
X$!
X$ CREATE_SUBDIR: SUBROUTINE
X$ base = p1 - ">" - "`093"        ! This can fail
X$ tail = p1 - base
X$ dir = base + "." + p2 + tail
X$ IF F$PARSE(dir,,,,"SYNTAX_ONLY") .eqs. "" THEN CALL FATAL "Internal error
V - bad path: ''dir'"
X$ if F$PARSE(dir) .eqs. "" THEN CREATE/DIRECTORY/LOG 'dir
X$ CALL DIRNAME 'dir' dirname
X$ SET FILE/PROTECTION=(W:E)/LOG 'dirname
X$ IF .not. $SEVERITY THEN CALL FATAL "Set file/protection failed"
X$ SET FILE/ACL=(IDENTIFIER='F$USER(),access=r+w+e+d+c)/LOG 'dirname
X$ IF .not. $SEVERITY THEN CALL FATAL "Set file/acl failed"
X$ SET FILE/ACL=(IDENTIFIER='F$USER(),OPTIONS=DEFAULT,access=r+w+e+d+c)/LOG '
Vdirname
X$ IF .not. $SEVERITY THEN CALL FATAL "Set file/acl failed"
X$ SET FILE/ACL=(DEFAULT_PROTECTION,SYSTEM:RWED,OWNER:RWED,GROUP,WORLD:RW)/LO
VG 'dirname
X$ IF .not. $SEVERITY THEN CALL FATAL "Set file/acl failed"
X$ 'p3 == dir
X$ EXIT
X$ ENDSUBROUTINE
X$!
X$ DIRNAME: SUBROUTINE
X$ disk = F$PARSE(p1,,,"DEVICE","SYNTAX_ONLY")
X$ path = F$PARSE(p1,,,"DIRECTORY","SYNTAX_ONLY")
X$ IF disk .eqs. "" .or. path .eqs. "" THEN CALL FATAL "Internal error - bad
V path ''p1'"
X$ last = ""
X$ build = ""
X$ i = 0
X$again2:
X$ e = F$ELEMENT(i,".",path)
X$ IF e .nes. "."`032
X$   THEN
X$   IF build .nes. "" THEN build = build + "."
X$   build = build + last
X$   last = e
X$   i = i + 1
X$   GOTO again2
X$ ENDIF
X$ name = last - ">" - "`093"
X$ tail = last - name
X$ dirname = disk + build + tail + name + ".DIR"
X$ IF F$PARSE(dirname) .eqs. "" THEN CALL FATAL "Internal error - bad pathnam
Ve ''dirname'"
X$ IF F$SEARCH(dirname) .eqs. "" THEN CALL FATAL "Internal error - not found
V ''dirname'"
X$ 'p2 == dirname
X$ EXIT
X$ ENDSUBROUTINE
X$!
X$ MAKE_FILE: SUBROUTINE
X$ OPEN/ERROR=error1 from 'p1
X$ WRITE SYS$OUTPUT "Creating file: ''p2'"
X$ OPEN/WRITE/ERROR=error2 to 'p2
X$again4:
X$ READ/END_OF_FILE=out from line
X$ pos = F$LOCATE("%",line)
X$ IF pos .eq. F$LENGTH(line) THEN GOTO done
X$ start = F$EXTRACT(0,pos,line)
X$ rest = F$EXTRACT(pos+1,F$LENGTH(line)-pos,line)
X$ itm = F$LOCATE("%",rest)
X$ IF itm .eq. F$LENGTH(line) THEN GOTO done
X$ symbol = F$EXTRACT(0,itm,rest)
X$ tail = F$EXTRACT(itm+1,F$LENGTH(rest)-itm,rest)
X$ x = "SB_" + symbol
X$ line = start + 'x' + tail
X$done:
X$ WRITE to line
X$ GOTO again4
X$out:
X$ CLOSE to
X$ CLOSE from
X$ SET FILE/PROTECTION=(W:R)/LOG 'p2
X$ EXIT
X$error1:
X$ CALL FATAL "Opening of ''p1' failed"
X$ EXIT
X$error2:
X$ CLOSE from
X$ CALL FATAL "Creating of ''p2' failed"
X$ EXIT
X$ ENDSUBROUTINE
X$
X$ QUERY_DIR: SUBROUTINE
X$again5:
X$ WRITE SYS$OUTPUT P2
X$ WRITE SYS$OUTPUT "Default: ",P3
X$ INQUIRE dir "Directory"
X$ IF dir .eqs. "" THEN dir = P3
X$ path = F$PARSE(dir) - ".;"
X$ IF path .eqs. ""`032
X$   THEN
X$   WRITE SYS$ERROR "Directory ",dir," not exist."
X$   GOTO again5
X$ ENDIF
X$ 'P1 == path
X$ EXIT
X$ ENDSUBROUTINE
X$`032
X$ PATHNAME: SUBROUTINE
X$ node = F$PARSE(P2,,,"NODE","SYNTAX_ONLY")
X$ device = F$PARSE(P2,,,"DEVICE","SYNTAX_ONLY")
X$ directory = F$PARSE(P2,,,"DIRECTORY","SYNTAX_ONLY")
X$ IF node + device + directory .eqs. "" THEN CALL FATAL "Bad filename: ''P2'
V"
X$ 'P1 == node  + device + directory
X$ EXIT
X$ ENDSUBROUTINE
X$
X$ COMPILE: SUBROUTINE
X$ source = F$PARSE(".PAS",source_directory + P1)
X$ result = F$PARSE(".OBJ",work_directory + P1)
X$ IF source .eqs. "" THEN CALL FATAL "Internal_error: Bad filename: ''P1'"
X$ IF result .eqs. "" THEN CALL FATAL "Internal error: Bad filename: ''P1'"
X$ IF F$SEARCH(result) .nes. "" THEN EXIT
X$ CALL CHECK_FILE 'source'
X$ PASCAL/CHECK=ALL/OBJECT='result'/TERMINAL=FILE_NAME 'source'
X$ IF .not. $SEVERITY THEN CALL FATAL "Compilation of ''source' failed"
X$ IF F$SEARCH(result) .eqs. "" THEN CALL FATAL "Compile failed: ''result' no
Vt found"
X$ EXIT
X$ ENDSUBROUTINE
X$
X$ MAKE_MON: SUBROUTINE
X$ IF F$SEARCH("MON.EXE") .nes. "" THEN EXIT
X$ CALL COMPILE GLOBAL
X$ CALL COMPILE GUTS
X$ CALL COMPILE KEYS
X$ CALL COMPILE PRIVUSERS
X$ CALL COMPILE DATABASE
X$ CALL COMPILE PARSER
X$ CALL COMPILE INTERPRETER
X$ CALL COMPILE QUEUE
X$ CALL COMPILE CLI
X$ CALL COMPILE CUSTOM
X$ CALL COMPILE MON
X$ LINK MON,GLOBAL,GUTS,KEYS,PRIVUSERS,DATABASE,PARSER,INTERPRETER,QUEUE,CLI,
VCUSTOM
X$ IF .not. $SEVERITY THEN CALL FATAL "Linking of MON.EXE failed"
X$ IF F$SEARCH("MON.EXE") .eqs. "" THEN CALL FATAL "Link failed: MON.EXE not
V found"
X$ EXIT
X$ ENDSUBROUTINE
X$
X$ MAKE_WHO: SUBROUTINE
X$ IF F$SEARCH("MONSTER_WHO.EXE") .nes. "" THEN EXIT
X$ CALL COMPILE GLOBAL
X$ CALL COMPILE GUTS`032
X$ CALL COMPILE PRIVUSERS
X$ CALL COMPILE DATABASE
X$ CALL COMPILE PARSER
X$ CALL COMPILE MONSTER_WHO
X$ LINK MONSTER_WHO,GLOBAL,GUTS,PRIVUSERS,DATABASE,PARSER
X$ IF .not. $SEVERITY THEN CALL FATAL "Linking of MONSTER_WHO.EXE failed"
X$ IF F$SEARCH("MONSTER_WHO.EXE") .eqs. "" THEN CALL FATAL "Link failed: MONS
VTER_WHO.EXE not found"
X$ EXIT
X$ ENDSUBROUTINE
X$
X$ MAKE_DUMP: SUBROUTINE
X$ IF F$SEARCH("MONSTER_DUMP.EXE") .nes. "" THEN EXIT
X$ CALL COMPILE GLOBAL
X$ CALL COMPILE GUTS`032
X$ CALL COMPILE PRIVUSERS
X$ CALL COMPILE DATABASE
X$ CALL COMPILE PARSER
X$ CALL COMPILE MONSTER_DUMP
X$ LINK MONSTER_DUMP,GLOBAL,GUTS,PRIVUSERS,DATABASE,PARSER
X$ IF .not. $SEVERITY THEN CALL FATAL "Linking of MONSTER_DUMP.EXE failed"
X$ IF F$SEARCH("MONSTER_DUMP.EXE") .eqs. "" THEN CALL FATAL "Link failed: MON
VSTER_DUMP.EXE not found"
X$ EXIT
X$ ENDSUBROUTINE
X$
X$ MAKE_HELP: SUBROUTINE
X$ IF F$SEARCH("MONSTER_E.HLB") .nes. "" THEN EXIT
X$ CALL CHECK_FILE 'source_directory'MONSTER_E.HLP
X$ LIBRARY/HELP/LOG/CREATE MONSTER_E.HLB 'source_directory'MONSTER_E.HLP
X$ IF .not. $SEVERITY THEN CALL FATAL "Creating of MONSTER_E.HLB failed"
X$ IF F$SEARCH("MONSTER_E.HLB") .eqs. "" THEN CALL FATAL "Creating failed: MO
VNSTER_E.HLB not found"
X$ EXIT
X$ ENDSUBROUTINE
X$
X$ DEFINE_MONSTER: SUBROUTINE
X$ IF F$TYPE(monster) .nes. ""
X$    THEN
X$    WRITE SYS$OUTPUT "Deleting symbol MONSTER"
X$    DELETE/SYMBOL/GLOBAL monster
X$ ENDIF
X$ SET COMMAND 'image_directory'MONSTER.CLD
X$ IF .not. $SEVERITY THEN CALL FATAL "Defining of command MONSTER failed"
X$ WRITE SYS$OUTPUT "Command MONSTER defined"
X$ WRITE SYS$OUTPUT ""
X$ WRITE SYS$OUTPUT "Add to your LOGIN.COM command:"
X$ WRITE SYS$OUTPUT "$ SET COMMAND ''image_directory'MONSTER.CLD"
X$ WRITE SYS$OUTPUT ""
X$ EXIT
X$ ENDSUBROUTINE
X$
X$ BUILD_DATABASE: SUBROUTINE
X$ WRITE SYS$OUTPUT "Building monster database"
X$ MONSTER/REBUILD/NOSTART
Xyes
X$ EXIT
X$ ENDSUBROUTINE
X$
X$ ASK_OPTION: SUBROUTINE
X$again7:
X$ WRITE SYS$OUTPUT "You can: "
X$ WRITE SYS$OUTPUT "  1 =  Build new empty monster database"
X$ WRITE SYS$OUTPUT "  2 =  Convert old (Skrenta's Monster V1) database"
X$ WRITE SYS$OUTPUT "  3 =  Build new empire database with the starter's CAST
VLE"
X$ INQUIRE option "Select 1, 2 or 3"
X$ IF option .ne. 1 .and. option .ne. 2 .and. option .ne. 3 THEN GOTO again7
X$ option == option
X$ EXIT
X$ ENDSUBROUTINE
X$
X$ CONVERT_DATABASE: SUBROUTINE
X$ COPY/LOG 'old_database'DESC.MON,EVENTS.MON,INDEX.MON,INTFILE.MON,LINE.MON,
VNAMS.MON,OBJECTS.MON,ROOMS.MON 'dbdir'
X$ MONSTER/NOSTART/BATCH='source_directory'CONVERT.BATCH
X$ EXIT
X$ ENDSUBROUTINE
X$
X$ BUILD_CASTLE: SUBROUTINE
X$ MONSTER/BUILD 'source_directory'CASTLE.DMP
Xyes
X$ EXIT
X$ ENDSUBROUTINE
$ CALL UNPACK MONSTER_INSTALL.COM;35 1090939009
$ create/nolog 'f'
X`091 INHERIT('database', 'guts', 'global' , 'privusers', 'parser')`093
XPROGRAM MONSTER_WHO ( INPUT, OUTPUT) ;
X`032
X`123
XPROGRAM DESCRIPTION:`032
X`032
X    Image for MONSTER/WHO -command
X`032
XAUTHORS:`032
X`032
X    Kari Hurtta
X`032
XCREATION DATE:`00930.4.1990
X`032
X`032
X`009    C H A N G E   L O G
X`032
X     Date     `124   Name  `124 Description
X--------------+---------+---------------------------------------------------
V----
X 11.6.1990    `124   K E H `124  read_global_flag
X--------------+---------+---------------------------------------------------
V----
X%`091change_entry`093%
X`125
X`032
X`123 DUMMY for linker `125
X`091global`093
Xfunction player_here(id: integer; var slot: integer): boolean;
Xbegin
X    player_here := false;
Xend;
X
X`123 DUMMY for linker `125
X`091global`093
Xprocedure gethere(n: integer := 0);
Xbegin
Xend;
X
X`123 DUMMY for linker `125
X`091global`093
Xprocedure checkevents(silent: boolean := false);
Xbegin
Xend;
X
Xvar play,exist: indexrec;
X    userid: `091global`093 veryshortstring;`009`123 userid of this player `1
V25
X
X    public_id, disowned_id, system_id: shortstring;
X
Xprocedure do_who ;
Xvar
X`009i,j: integer;
X`009ok: boolean;
X`009metaok: boolean;
X`009roomown: veryshortstring;
X        code: integer;
X`009c: char;
X`009s: shortstring;
X`009write_this: boolean;
X`009count: integer;
X`009s1: string;
X
Xvar short_line : boolean;
Xbegin
X
X    short_line := terminal_line_len < 50;
X
X
X`009`123 we need just about everything to print this list:
X`009`009player alloc index, userids, personal names,
X`009`009room names, room owners, and the log record`009`125
X
X`009getpers;
X`009freepers;
X`009getnam;
X`009freenam;
X`009getown;
X`009freeown;
X`009getint(N_LOCATION);`009`123 get where they are `125
X`009freeint;
X`009if not short_line then write('              ');
X`009writeln('     Monster Status');
X`009writeln;
X`009if not short_line then write('Username        ');
X`009writeln('Game Name                 Where');
X
X`009if userid = MM_userid then metaok := true
X`009else metaok := false;
X
X`009for i := 1 to exist.top do begin
X`009`009if not(exist.free`091i`093) then begin
X
X`009`009`009write_this := not play.free`091i`093;
X                        if user.idents`091i`093 = '' then begin
X                           if write_this and not short_line then`032
X`009`009`009    write('<unknown>       ')
X                        end else if user.idents`091i`093`0911`093 <> ':' the
Vn begin
X`009`009`009   if write_this and not short_line then begin
X`009`009`009`009write(user.idents`091i`093);
X`009`009`009`009for j := length(user.idents`091i`093) to 15 do
X`009`009`009`009    write(' ');
X`009`009`009   end;
X                        end else write_this := false;
X                       `032
X                        if write_this then begin
X`009`009`009   write(pers.idents`091i`093);
X`009`009`009   j := length(pers.idents`091i`093);
X`009`009`009   while j <= 25 do begin
X`009`009`009      write(' ');
X`009`009`009      j := j + 1;
X`009`009`009   end;
X                                                   `032
X`009`009`009   if not(metaok) then begin
X`009`009`009      roomown := own.idents`091anint.int`091i`093`093;
X
X`123 if a person is in a public or disowned room, or
X  if they are in the domain of the WHOer, then the player should know
X  where they are  `125
X
X`009`009`009      if (roomown = public_id) or
X`009`009`009`009    (roomown = disowned_id) or
X`009`009`009`009    (roomown = userid) then
X`009`009`009`009`009ok := true
X`009`009`009      else
X`009`009`009`009`009ok := false;
X
X`009`009`009   end;
X
X`009`009`009   if ok or metaok then begin
X`009`009`009`009writeln(nam.idents`091anint.int`091i`093`093);
X`009`009`009   end else
X`009`009`009`009writeln('n/a');
X                       end; `123 write_this `125
X`009`009end;
X`009end;
Xend; `123 do who `125
X
Xvar count,I: integer;
X`032
XBEGIN
X    Get_Environment;
X
X    if not lookup_class(system_id,'system') then
X`009writeln('%error in main program: system');
X    if not lookup_class(public_id,'public') then
X`009writeln('%error in main program: public');
X    if not lookup_class(disowned_id,'disowned') then
X`009writeln('%error in main program: disowned');
X
X    Setup_Guts;
X    if open_database then begin
X`009if read_global_flag(GF_VALID) then begin
X
X`009    getindex(I_PLAYER);
X`009    freeindex;
X`009    exist := indx;
X
X`009    getindex(I_ASLEEP);`009`123 Get index of people who are playing now
V `125
X`009    freeindex;
X`009    play := indx;
X
X`009    getuser;
X`009    freeuser;
X
X`009    count := 0;
X`009    for i := 1 to exist.top do`032
X`009`009if not(exist.free`091i`093) then`032
X`009`009    if not (play.free`091i`093) then`032
X`009`009`009if (user.idents`091i`093 <> '') then
X`009`009`009    if user.idents`091i`093`0911`093 <> ':' then
X`009`009`009`009count := count +1;
X
X`009    if count > 0 then begin
X`009`009    do_who;
X
X`009`009    writeln;
X`009`009    writeln('Number of players: ',count:1);
X`009    end;
X`009end;
X    end;
X    Finish_Guts;
XEND.
$ CALL UNPACK MONSTER_WHO.PAS;5 1349400437
$ create/nolog 'f'
X`091environment,inherit ('Global','Database') `093
XModule Parser(Output);`032
X
X`091hidden`093 Const`032
X`009maxclass  = 3;
X`009maxpriv   = 9;
X`009maxflag   = 3;
X
X`009maxtype`009  = 5;
X
Xconst
X`009PR_manager = 1;
X`009PR_poof    = 2;
X`009PR_global  = 4;
X`009PR_owner   = 8;
X`009PR_special = 16;
X`009PR_monster = 32;
X`009PR_exp     = 64;
X`009PR_quota   = 128;
X`009PR_spell   = 256;
X
X`009all_privileges =`032
X`009    PR_manager +
X`009    PR_poof    +
X`009    PR_global  +
X`009    PR_owner   +
X`009    PR_special +
X`009    PR_monster +
X`009    PR_exp     +
X`009    PR_quota   +
X`009    PR_spell;
X
Xtype
X      class = ( bracket , letter , space, string_c,
X`009`009comment );`009`009`009    `123 merkkien luokitus`009    `125
X
X`009o_type = (t_none, t_room, t_object, t_spell, t_monster,
X`009`009  t_player );
X
X    privrec =
X`009record
X`009    name: shortstring;
X`009    value: unsigned;
X`009end;
X
X   `032
X    typerec =
X`009record
X`009    name: shortstring;
X`009    plname: shortstring;
X`009    value: o_type;
X`009end;
X`032
X   flagrec =
X`009record
X`009    name: shortstring;
X`009    value: integer;
X`009end;
X
X
Xvar
X`009typetable: `091hidden`093 array `0911..maxtype`093 of typerec :=
X`009    `123   name, plname, value `125
X`009    ( (`009'monster', 'monsters', t_monster ),
X`009      ( 'object',  'objects',  t_object ),
X`009      ( 'room',`009   'rooms',    t_room`009),
X`009      ( 'spell',   'spells',   t_spell`009),
X`009      ( 'player',  'players',  t_player) );
X
X
X`009classtable: `091hidden`093 array `0911..maxclass`093 of classrec :=
X`009    `123   name`009    , id `125
X`009    ( ( 'Public'    , ''    ),
X`009      ( 'Disowned'  , '*'   ),
X`009      ( 'System'    , '#'   ));
X
X`009privtable: `091hidden`093 array `0911..maxpriv`093 of privrec :=`032
X
X`009    `123   name`009    , value `125
X`009    ( ( 'Manager'   , PR_manager ),
X`009      ( 'Poof'`009    , PR_poof ),
X`009      ( 'Global'    , PR_global ),
X`009      ( 'Owner'     , PR_owner ),
X`009      ( 'Special'   , PR_special ),
X`009      ( 'Monster'   , PR_monster ),
X`009      ( 'Experience', PR_exp ),
X`009      ( 'Quota'     , PR_quota ),
X`009      ( 'Spell'     , PR_spell ) );
X
X    `009flagtable : `091hidden`093 array `0911..maxflag`093 of flagrec :=`03
V2
X`009    `123   name`009    , value `125
X`009    ( ( 'Active'    , GF_ACTIVE),
X`009      ( 'Valid'`009    , GF_VALID),
X`009      ( 'Wartime'   , GF_WARTIME ) );
X
X
X
X`009auth_priv: `091hidden`093 unsigned := 0;
X`009cur_priv: `091hidden`093 unsigned := 0;
X`009
X`009direct: `091global`093 array`0911..maxexit`093 of shortstring :=
X`009`009('north','south','east','west','up','down');
X
X`009show: `091global`093 array`0911..maxshow`093 of shortstring;
X
X`009numshow: `091global`093 integer;
X
X`009setkey: `091global`093 array`0911..maxshow`093 of shortstring;
X
X`009numset: `091global`093 integer;
X
X
X`091external`093 function player_here(id: integer; var slot: integer): boole
Van;
X`009`009    external;
X`091external`093 procedure gethere(n: integer := 0); external;
X
X`123 PRIVS `125
X
X`091global`093
Xfunction spell_priv: boolean;`009`009
Xbegin
X    spell_priv := uand(cur_priv,PR_spell) > 0;
Xend;`032
X
X
X`091global`093
Xfunction manager_priv: boolean;`009`009
X    `123 Tells if user may use 'system' `125
Xbegin
X    manager_priv := uand(cur_priv,PR_manager) > 0;
Xend;`032
X
X`091global`093
Xfunction`009quota_priv: boolean;`009`009
X    `123 Tells if user may extend quota `125
Xbegin
X   quota_priv := uand(cur_priv,PR_quota) > 0;
Xend;`032
X
X`091global`093
Xfunction poof_priv: boolean;`123 Tells if the user may poof `125
Xbegin
X    poof_priv := uand(cur_priv,PR_poof) > 0;
X
Xend;`032
X
X`091global`093
Xfunction owner_priv: boolean; `123 Tells if the user may custom others' stuf
Vf `125
Xbegin
X    owner_priv := uand(cur_priv,PR_owner) > 0;
Xend;`032
X
X`091global`093
Xfunction global_priv: boolean;`032
Xbegin
X    global_priv := uand(cur_priv,PR_global) > 0;
Xend;`032
X
X`091global`093
Xfunction special_priv: boolean; `123 Tells if the user may create 'special'
V objects or exits `125
Xbegin
X    special_priv := uand(cur_priv, PR_special) > 0;
Xend;`032
X
X`091global`093
Xfunction monster_priv: boolean; `123 tells if the user may create evil monst
Vers `125
Xbegin
X    monster_priv := uand(cur_priv,PR_monster) > 0;
Xend;`032
X
X`091global`093
Xfunction exp_priv: boolean;`009`123 Tells if the user may alter experience `
V125
Xbegin
X    exp_priv := uand(cur_priv,PR_exp) > 0;
Xend;`032
X
Xvar  wizard: `091global`093 boolean;
X`009`009`009`009`123 Tells if user has rights to rebuild `125
X
X
X`091global`093
Xprocedure set_auth_priv(priv: unsigned);
Xbegin
X    auth_priv := priv;
X    cur_priv  := uand(cur_priv,priv);
Xend;
X
X`091global`093
Xprocedure set_cur_priv(priv: unsigned);
Xbegin
X    cur_priv := uand(priv, auth_priv);
Xend;
X
X`091global`093
Xfunction read_cur_priv: unsigned;
Xbegin
X    read_cur_priv := cur_priv;
Xend;
X
X`091global`093
Xfunction read_auth_priv: unsigned;
Xbegin
X    read_auth_priv := auth_priv;
Xend;
X
Xprocedure list_privileges (privs: unsigned);
Xvar i: integer;
Xbegin
X    if privs = 0 then write('None')
X    else for i := 1 to maxpriv do
X`009if uand(privtable`091i`093.value,privs) > 0 then`032
X`009    write(privtable`091i`093.name,' ');
X    writeln;
Xend;
X
X`123 ---- `125
X
X
X
X`091global`093
Xfunction lowcase(s: string):string;
Xvar
X`009sprime: string;
X`009i: integer;
X
Xbegin
X`009if length(s) = 0 then
X`009`009lowcase := ''
X`009else begin
X`009`009sprime := s;
X`009`009for i := 1 to length(s) do
X`009`009`009if sprime`091i`093 in `091'A'..'Z'`093 then
X`009`009`009   sprime`091i`093 := chr(ord('a')+(ord(sprime`091i`093)-ord('A'
V)));
X`009`009lowcase := sprime;
X`009end;
Xend;
X
X`091global`093
Xfunction classify (a: char): class;
Xbegin
X   case a of
X`009' ',''(9):`009classify := space;
X`009'"':`009`009classify := string_c;
X`009'(',')',',','-':classify := bracket;            `032
X`009'!':`009`009classify := comment;
X`009otherwise`009classify := letter;
X   end;
Xend;
X
X`091global`093
Xfunction clean_spaces(inbuf: mega_string):mega_string;
Xvar bf: mega_string;
X    space_f: boolean;
Xbegin
X    bf := '';`032
X    space_f := true;
X    while inbuf > '' do begin
X`009if classify(inbuf `0911`093) <> space then bf := bf + inbuf `0911`093
X`009else if not space_f then bf := bf + ' ';
X`009space_f := classify(inbuf `0911`093) = space;
X`009inbuf := substr(inbuf,2,length(inbuf)-1)
X    end;     `032
X    if bf > '' then if classify(bf`091length(bf)`093) = space then
X`009bf := substr(bf,1,length(bf)-1);
X    clean_spaces := bf
Xend; `123 clean spaces `125
X
X`091global`093
Xprocedure write_debug(a: string; b: mega_string := '');
Xbegin
X   if debug then begin
X      write(a,'   ');
X      if length(b) > 200 then`009`123 system limit printable string `125
X                                `123 about 200 characters          `125
X         writeln('(PARAMETER TOO LONG FOR PRINTING)')
X      else writeln(b);
X   end;
Xend;
X
X`091global`093
Xfunction cut_atom (var main: mega_string; var x: integer;
X`009`009    delimeter: char): shortstring;
Xvar start,i,last: integer;
Xbegin   `032
X    write_debug('%cut_atom');
X    start := x;              `032
X    if x > length (main) then cut_atom := ''
X    else begin                 `032
X`009if start + shortlen <=  length(main) then`032
X`009    last := start + shortlen-1
X`009else last := length(main);  `032
X`009x := last+1;
X`009for i := last downto start do
X`009    if main`091i`093 = delimeter then x := i;
X`009cut_atom := substr(main,start,x-start);
X`009x := x +1
X    end
Xend; `123 cut_atom `125
X
Xfunction lookup_general(rec: namrec; ind: integer;`032
X`009`009`009var id: integer; s: string;
X`009`009`009help: boolean): boolean;
Xvar i,poss,maybe,num: integer;
X    temp: string;
Xbegin
X    if debug then writeln('lookup_general: ',s);   `032
X    getindex(ind);
X    freeindex;
X    s := lowcase(s);
X    i := 1;
X    maybe := 0;
X    num := 0;
X    for i := 1 to indx.top do begin
X`009if not(indx.free`091i`093) then begin
X`009    temp := lowcase(rec.idents`091i`093);
X`009    if s = temp then num := i
X`009    else if index(temp,s) = 1 then begin
X`009`009maybe := maybe + 1;
X`009`009poss := i;
X`009    end;
X`009end;
X    end;
X    if debug then writeln ('lookup_general: (',num:1,',',maybe:1,')');
X    if num <> 0 then begin
X`009id := num;
X`009lookup_general := true;
X    end else if maybe = 1 then begin
X`009id := poss;
X`009lookup_general := true;
X    end else if maybe > 1 then begin
X`009if help then begin
X`009    writeln('Ambiguous - Refer you one of following?');
X`009    for i := 1 to indx.top do`032
X`009`009if not(indx.free`091i`093) then`032
X`009`009    if index(lowcase(rec.idents`091i`093),s) = 1 then`032
X`009`009`009writeln('          ',rec.idents`091i`093);
X`009end;
X`009lookup_general := false;
X    end else begin
X`009lookup_general := false;
X    end;
Xend; `123 lookup_general `125
X
X`091global`093
Xfunction lookup_user(var pnum: integer;s: string;
X    help: boolean := false): boolean;
Xbegin
X    getuser;
X    freeuser;
X    lookup_user := lookup_general(user,i_PLAYER,pnum,s,help);
Xend;
X
X`091global`093
Xfunction lookup_room(var n: integer; s: string;
X    help: boolean := false): boolean;
Xbegin
X   if s <> '' then begin
X`009getnam;
X`009freenam;
X`009lookup_room := lookup_general(nam,I_ROOM,n,s,help);
X   end else lookup_room := false;
Xend; `123 lookup_room `125
X
X`091global`093
Xfunction lookup_pers(var pnum: integer;s: string;
X    help: boolean := false): boolean;
Xbegin
X    getpers;
X    freepers;
X    lookup_pers := lookup_general(pers,I_PLAYER,pnum,s,help);
Xend; `123 lookup_pers `125
X
X`091global`093
Xfunction lookup_obj(var pnum: integer;s: string;
X    help: boolean := false): boolean;
Xbegin
X    getobjnam;
X    freeobjnam;
X    lookup_obj := lookup_general(objnam,I_OBJECT,pnum,s,help);
Xend;
X
X`091global`093
Xfunction lookup_spell(var sp: integer;s: string;
X    help: boolean := false): boolean;
Xbegin
X    getspell_name;
X    freespell_name;
X    lookup_spell := lookup_general(spell_name,I_SPELL,sp,s,help);
Xend;
X
Xfunction meta_scan( indx:  indexrec;
X`009`009    name:    namrec;
X`009`009    function action(`009nameid:`009shortstring;
X`009`009`009`009`009id:`009integer
X`009`009`009):  boolean;
X`009`009    line:   mega_string;
X`009`009    silent: boolean;
X`009`009    function restriction (id: integer): boolean
X`009`009    ):`009    boolean;
Xtype tabletype = array `091 1.. maxroom`093 of boolean;
X
Xvar table,temp:  tabletype;
X    i,cur,count,exact: integer;
X    result: boolean;
X    atom: shortstring;
X    unambiqous,error: boolean;
X
X
X    function sub_scan(`009indx: indexrec;`032
X`009`009`009name: namrec;
X`009`009`009atom: shortstring;
X`009`009    var`009result: tabletype;
X`009`009    var`009exact:`009integer): integer;
X    var i,count: integer;
X    begin
X`009write_debug('%sub_scan: ',atom);
X`009for i := 1 to maxroom do result`091i`093 := false;
X`009count := 0;
X`009exact := 0;
X`009for i := 1 to indx.top do if not indx.free`091i`093 then begin
X`009    if ((index(clean_spaces(lowcase(name.idents`091i`093)),atom) = 1) or
V`032
X`009`009((index(clean_spaces(lowcase(name.idents`091i`093)),' '+atom) > 0)`0
V32
X`009`009 and unambiqous) ) and restriction(i) then begin
X`009`009result`091i`093 := true;
X`009`009count := count +1;
X`009    end;
X`009    if (lowcase(name.idents`091i`093) = atom) and restriction(i)
X`009`009then exact := i;
X`009end;
X`009sub_scan := count;
X    end;    `123 sub_scan `125
X
X
X
Xbegin
X    write_debug('%meta_scan: ',line);
X    if length(line) = 3 then`009`123 we can't do direct check because line c
Van `125
X`009if lowcase(line) = 'all' then line := '*';   `123 be over 80 characters
V `125
X    result := false;
X    error  := false;
X    for i := 1 to maxroom do table`091i`093 := false;
X    cur := 1;
X    while cur <= length(line) do begin
X`009atom := lowcase(cut_atom(line,cur,','));
X`009unambiqous := true;
X`009if atom > '' then if atom`091length(atom)`093 = '*' then begin
X`009    atom := substr(atom,1,length(atom)-1);
X`009    unambiqous := false;
X`009end;
X`009atom := clean_spaces(atom);
X`009count := sub_scan(indx,name,atom,temp,exact);
X`009if unambiqous and (exact = 0) and (count > 1) then begin
X`009    error := true;
X`009    if not silent then writeln('"',atom,'" is ambiguous.');
X`009end;
X`009if (count = 0) and unambiqous then begin
X`009    error := true;
X`009    if not silent then writeln('"',atom,'" not exist.');
X`009end;
X`009if unambiqous and (exact > 0) then
X`009    table`091exact`093 := true
X`009else for i := 1 to maxroom do
X`009    table`091i`093 := table`091i`093 or temp`091i`093;
X    end;
X    `123 action part `125
X    if not error then
X`009for i := 1 to maxroom do
X`009    if table`091i`093 then
X`009`009result := result or action(name.idents`091i`093,i);
X    meta_scan := result;
Xend; `123 meta_scan `125
X
X`091global`093
Xfunction scan_room(`009function action(    nameid:`009shortstring;
X`009`009`009`009`009    id:`009integer
X`009`009`009):  boolean;
X`009`009    line:   mega_string;
X`009`009    silent: boolean := false;
X`009`009    function restriction (id: integer): boolean
X`009`009    ):`009    boolean;
Xbegin
X    getnam;
X    freenam;
X    getindex(I_ROOM);
X    freeindex;
X    scan_room := meta_scan(indx,nam,action,line,silent,restriction);
Xend;
X
X`091global`093
Xfunction scan_pers(`009function action(    nameid:`009shortstring;
X`009`009`009`009`009    id:`009integer
X`009`009`009):  boolean;
X`009`009    line:   mega_string;
X`009`009    silent: boolean := false;
X`009`009    function restriction (id: integer): boolean
X`009`009    ):`009    boolean;
Xbegin
X    getpers;
X    freepers;
X    getindex(I_PLAYER);
X    freeindex;
X    scan_pers := meta_scan(indx,pers,action,line,silent,restriction);
Xend;
X
X`091global`093
Xfunction scan_obj(`009function action(    nameid:`009shortstring;
X`009`009`009`009`009    id:`009integer
X`009`009`009):  boolean;
X`009`009    line:   mega_string;
X`009`009    silent: boolean := false;
X`009`009    function restriction (id: integer): boolean
X`009`009    ):`009    boolean;
Xbegin
X    getobjnam;
X    freeobjnam;
X    getindex(I_OBJECT);
X    freeindex;
X    scan_obj := meta_scan(indx,objnam,action,line,silent,restriction);
Xend;
X
X`091global`093
Xfunction scan_pers_slot(function action(`009nameid:`009    shortstring;
X`009`009`009`009`009`009slot:`009    integer
X`009`009`009    ):`009boolean;
X`009`009`009line:`009mega_string;
X`009`009`009silent: boolean := false;
X`009`009`009function restriction (slot: integer): boolean
X`009`009`009):`009boolean;
X
X    function real_res(id: integer): boolean;
X    var slot: integer;
X    begin
X`009if player_here(id,slot) then
X`009    real_res := restriction(slot)
X`009else real_res := false;
X    end; `123 real_res `125
X
X    function real_action(   nameid: shortstring;
X`009`009`009    id:`009    integer
X`009`009`009    ):`009    boolean;
X    var slot: integer;
X    begin
X`009gethere;`009`123 we need this here because action can change 'here' `125
X`009if player_here(id,slot) then
X`009    real_action := action(nameid,slot)
X`009else real_action := false;
X    end; `123 real_acttion `125
X
X
Xbegin
X
X    gethere;
X    scan_pers_slot := scan_pers (real_action,line,silent,real_res);
X
Xend; `123 scan_pers_obj `125
X
X
X`123 translate a direction s `091north, south, etc...`093 into the integer c
Vode `125
X
X`091global`093
Xfunction lookup_dir(var dir: integer;s:string;
X    help: boolean := false): boolean;
Xvar
X`009i,poss,maybe,num: integer;
X
Xbegin
X    if debug then writeln('lookup_dir: ',s);
X`009s := lowcase(s);
X`009i := 1;
X`009maybe := 0;
X`009num := 0;
X`009for i := 1 to maxexit do begin
X`009`009if s = direct`091i`093 then
X`009`009`009num := i
X`009`009else if index(direct`091i`093,s) = 1 then begin
X`009`009`009maybe := maybe + 1;
X`009`009`009poss := i;
X`009`009end;
X`009end;
X`009if debug then writeln ('lookup_dir: (',num:1,',',maybe:1,')');
X
X`009if num <> 0 then begin
X`009`009dir := num;
X`009`009lookup_dir := true;
X`009end else if maybe = 1 then begin
X`009`009dir := poss;
X`009`009lookup_dir := true;
X`009end else if maybe > 1 then begin
X`009    if help then begin
X`009`009writeln('Ambiguous - Refer you one of following?');
X`009`009for i := 1 to maxexit do `032
X`009`009`009if index(lowcase(direct`091i`093),s) = 1 then`032
X`009`009`009    writeln('          ',direct`091i`093);
X`009    end;
X`009    lookup_dir := false;
X`009end else begin
X`009    lookup_dir := false;
X`009end;
Xend; `123 lookup_dir `125
X
X`091global`093
Xfunction lookup_show(var n: integer;s:string;
X    help: boolean := false): boolean;
Xvar
X`009i,poss,maybe,num: integer;
X
Xbegin
X    if debug then writeln('lookup_show: ',s);
X`009s := lowcase(s);
X`009i := 1;
X`009maybe := 0;
X`009num := 0;
X`009for i := 1 to numshow do begin
X`009`009if s = show`091i`093 then
X`009`009`009num := i
X`009`009else if index(show`091i`093,s) = 1 then begin
X`009`009`009maybe := maybe + 1;
X`009`009`009poss := i;
X`009`009end;
X`009end;
X`009if debug then writeln ('lookup_show: (',num:1,',',maybe:1,')');
X
X`009if num <> 0 then begin
X`009`009n := num;
X`009`009lookup_show := true;
X`009end else if maybe = 1 then begin
X`009`009n := poss;
X`009`009lookup_show := true;
X`009end else if maybe > 1 then begin
X`009    if help then begin
X`009`009writeln('Ambiguous - Refer you one of following?');
X`009`009for i := 1 to numshow do`032
X`009`009    if index(lowcase(show`091i`093),s) = 1 then`032
X`009`009`009writeln('          ',show`091i`093);
X`009    end;
X`009    lookup_show := false;
X`009end else begin
X`009`009lookup_show := false;
X`009end;
Xend;`009`123 lookup_show `125
X
X`091global`093
Xfunction lookup_set(var n: integer;s:string;
X    help: boolean := false): boolean;
Xvar
X`009i,poss,maybe,num: integer;
X
Xbegin
X    if debug then writeln('lookup_set: ',s);
X`009s := lowcase(s);
X`009i := 1;
X`009maybe := 0;
X`009num := 0;
X`009for i := 1 to numset do begin
X`009`009if s = setkey`091i`093 then
X`009`009`009num := i
X`009`009else if index(setkey`091i`093,s) = 1 then begin
X`009`009`009maybe := maybe + 1;
X`009`009`009poss := i;
X`009`009end;
X`009end;
X`009if debug then writeln ('lookup_set: (',num:1,',',maybe:1,')');
X`009if num <> 0 then begin
X`009`009n := num;
X`009`009lookup_set := true;
X`009end else if maybe = 1 then begin
X`009`009n := poss;
X`009`009lookup_set := true;
X`009end else if maybe > 1 then begin
X`009    if help then begin
X`009`009writeln('Ambiguous - Refer you one of following?');
X`009`009for i := 1 to numset do`032
X`009`009if index(lowcase(setkey`091i`093),s) = 1 then`032
X`009`009`009writeln('          ',setkey`091i`093);
X`009    end;
X`009    lookup_set := false;
X`009end else begin
X`009`009lookup_set := false;
X`009end;
Xend;
X
X`091global`093
Xfunction exact_room(var n: integer;s: string): boolean;
Xvar
X`009match: boolean;
X
Xbegin
X`009if debug then
X`009`009writeln('%exact room: s = ',s);
X`009if lookup_room(n,s) then begin
X`009`009if nam.idents`091n`093 = lowcase(s) then
X`009`009`009exact_room := true
X`009`009else
X`009`009`009exact_room := false;
X`009end else
X`009`009exact_room := false;
Xend;`009`123 exact_room `125
X
X`091global`093
Xfunction exact_pers(var n: integer;s: string): boolean;
Xvar
X`009match: boolean;
X
Xbegin
X`009if lookup_pers(n,s) then begin
X`009`009if lowcase(pers.idents`091n`093) = lowcase(s) then
X`009`009`009exact_pers := true
X`009`009else
X`009`009`009exact_pers := false;
X`009end else
X`009`009exact_pers := false;
Xend;`009`123 exact_user `125
X
X`091global`093
Xfunction exact_user(var n: integer;s: string): boolean;
Xvar
X`009match: boolean;
X
Xbegin
X`009if lookup_user(n,s) then begin
X`009`009if lowcase(user.idents`091n`093) = lowcase(s) then
X`009`009`009exact_user := true
X`009`009else
X`009`009`009exact_user := false;
X`009end else
X`009`009exact_user := false;
Xend;`009`123 exact_user `125
X
X`091global`093
Xfunction exact_obj(var n: integer;s: string): boolean;
Xvar
X`009match: boolean;
X
Xbegin
X`009if lookup_obj(n,s) then begin
X`009`009if objnam.idents`091n`093 = lowcase(s) then
X`009`009`009exact_obj := true
X`009`009else
X`009`009`009exact_obj := false;
X`009end else
X`009`009exact_obj := false;
Xend;`009`123 exact_obj `125
X
X`091global`093
Xfunction lookup_class(var id: shortstring; s:string;
X    help: boolean := false): boolean;
Xvar
X`009i,poss,maybe,num: integer;
X
Xbegin
X    if debug then writeln('lookup_class: ',s);
X`009s := lowcase(s);
X`009i := 1;
X`009maybe := 0;
X`009num := 0;
X`009for i := 1 to maxclass do begin
X`009`009if s = lowcase(classtable`091i`093.name) then
X`009`009`009num := i
X`009`009else if index(lowcase(classtable`091i`093.name),s) = 1 then begin
X`009`009`009maybe := maybe + 1;
X`009`009`009poss := i;
X`009`009end;
X`009end;
X`009if debug then writeln ('lookup_class: (',num:1,',',maybe:1,')');
X
X`009if num <> 0 then begin
X`009`009id := classtable`091num`093.id;
X`009`009lookup_class := true;
X`009end else if maybe = 1 then begin
X`009`009id := classtable`091poss`093.id;
X`009`009lookup_class := true;
X`009end else if maybe > 1 then begin
X`009    if help then begin
X`009`009writeln('Ambiguous - Refer you one of following?');
X`009`009for i := 1 to maxclass do`032
X`009`009    if index(lowcase(classtable`091i`093.name),s) = 1 then`032
X`009`009`009writeln('          ',classtable`091i`093.name);
X`009    end;
X`009    id := '<error>';
X`009    lookup_class := false;
X`009end else begin
X`009`009id := '<error>';
X`009`009lookup_class := false;
X`009end;
Xend;
X
X`091global`093
Xfunction lookup_priv(var id: unsigned; s:string;
X    help: boolean := false): boolean;
Xvar
X`009i,poss,maybe,num: integer;
X
Xbegin
X    if debug then writeln('lookup_priv: ',s);
X`009s := lowcase(s);
X`009i := 1;
X`009maybe := 0;
X`009num := 0;
X`009for i := 1 to maxpriv do begin
X`009`009if s = lowcase(privtable`091i`093.name) then
X`009`009`009num := i
X`009`009else if index(lowcase(privtable`091i`093.name),s) = 1 then begin
X`009`009`009maybe := maybe + 1;
X`009`009`009poss := i;
X`009`009end;
X`009end;
X`009if debug then writeln ('lookup_priv: (',num:1,',',maybe:1,')');
X
X`009if num <> 0 then begin
X`009`009id := privtable`091num`093.value;
X`009`009lookup_priv := true;
X`009end else if maybe = 1 then begin
X`009`009id := privtable`091poss`093.value;
X`009`009lookup_priv := true;
X`009end else if maybe > 1 then begin
X`009    if help then begin
X`009`009writeln('Ambiguous - Refer you one of following?');
X`009`009for i := 1 to maxpriv do`032
X`009`009    if index(lowcase(privtable`091i`093.name),s) = 1 then`032
X`009`009`009writeln('          ',privtable`091i`093.name);
X`009    end;
X`009    id := 0;
X`009    lookup_priv := false;
X`009end else begin
X`009`009id := 0;
X`009`009lookup_priv := false;
X`009end;
Xend;
X
X`091global`093
Xfunction lookup_type(var id: o_type; s:string; pl: boolean;
X    help: boolean := false): boolean;
Xvar
X`009i,poss,maybe,num: integer;
X`009name: shortstring;
X
Xbegin
X    if debug then writeln('lookup_type: ',s);
X`009s := lowcase(s);
X`009i := 1;
X`009maybe := 0;
X`009num := 0;
X`009for i := 1 to maxtype do begin
X`009`009if pl then name :=  typetable`091i`093.plname`032
X`009`009else name := typetable`091i`093.name;
X
X`009`009if s = name then num := i
X`009`009else if index(lowcase(name),s) = 1 then begin
X`009`009`009maybe := maybe + 1;
X`009`009`009poss := i;
X`009`009end;
X`009end;
X`009if debug then writeln ('lookup_type: (',num:1,',',maybe:1,')');
X
X`009if num <> 0 then begin
X`009`009id := typetable`091num`093.value;
X`009`009lookup_type := true;
X`009end else if maybe = 1 then begin
X`009`009id := typetable`091poss`093.value;
X`009`009lookup_type := true;
X`009end else if maybe > 1 then begin
X`009    if help then begin
X`009`009writeln('Ambiguous - Refer you one of following?');
X`009`009if pl then begin
X`009`009    for i := 1 to maxtype do`032
X`009`009`009if index(lowcase(typetable`091i`093.plname),s) = 1 then`032
X`009`009`009    writeln('          ',typetable`091i`093.plname);
X`009`009end else begin
X`009`009    for i := 1 to maxtype do`032
X`009`009`009if index(lowcase(typetable`091i`093.name),s) = 1 then`032
X`009`009`009    writeln('          ',typetable`091i`093.name);
X`009`009end;
X`009    end;
X
X`009`009id := t_none;
X`009`009lookup_type := false;
X`009end else begin
X`009`009id := t_none;
X`009`009lookup_type := false;
X`009end;
Xend;
X
X`091global`093
Xfunction lookup_flag(var id: integer; s:string;
X    help: boolean := false)   : boolean;
Xvar
X`009i,poss,maybe,num: integer;
X
Xbegin
X    if debug then writeln('lookup_flag: ',s);
X`009s := lowcase(s);
X`009i := 1;
X`009maybe := 0;
X`009num := 0;
X`009for i := 1 to maxflag do begin
X`009`009if s = lowcase(flagtable`091i`093.name) then
X`009`009`009num := i
X`009`009else if index(lowcase(flagtable`091i`093.name),s) = 1 then begin
X`009`009`009maybe := maybe + 1;
X`009`009`009poss := i;
X`009`009end;
X`009end;
X`009if debug then writeln ('lookup_flag: (',num:1,',',maybe:1,')');
X
X`009if num <> 0 then begin
X`009`009id := flagtable`091num`093.value;
X`009`009lookup_flag := true;
X`009end else if maybe = 1 then begin
X`009`009id := flagtable`091poss`093.value;
X`009`009lookup_flag := true;
X`009end else if maybe > 1 then begin
X`009    if help then begin
X`009`009writeln('Ambiguous - Refer you one of following?');
X`009`009for i := 1 to maxflag do`032
X`009`009    if index(lowcase(flagtable`091i`093.name),s) = 1 then`032
X`009`009`009writeln('          ',flagtable`091i`093.name);
X`009    end;
X`009    id := 0;
X`009    lookup_flag := false;
X`009end else begin
X`009`009id := 0;
X`009`009lookup_flag := false;
X`009end;
Xend; `123 lookup_flag `125
X
X
X`091global`093
Xfunction class_out(id: shortstring): shortstring;
Xvar i: integer;
Xbegin
X    class_out := id;
X    for i := 1 to maxclass do
X`009if id = classtable`091i`093.id then class_out := classtable`091i`093.nam
Ve;
Xend; `123 class_out `125
X
X`123 global procedures for module interpreter `125
X
X`091global`093
Xfunction int_spell_level(pname: shortstring; sname: shortstring): integer;
X   `123 -1 = error `125
Xvar pid: integer;
X    sid: integer;
Xbegin
X    if debug then begin
X`009writeln('%int_spell_level: ',pname);
X`009writeln('%               : ',sname);
X    end;
X    if not lookup_pers(pid,pname) then int_spell_level := -1
X    else if not lookup_spell(sid,sname) then int_spell_level := -2
X    else begin
X`009getspell(pid);
X`009freespell;
X`009int_spell_level := spell.level`091sid`093;
X    end;
Xend; `123 int_spell_level `125
X
X`091global`093
Xfunction int_set_spell_level(pname: shortstring; sname: shortstring;
X    lev: integer): boolean;
Xvar pid: integer;
X    sid: integer;
Xbegin
X    if debug then begin
X`009writeln('%int_set_spell_level: ',pname);
X`009writeln('%                   : ',sname);
X`009writeln('%                   : ',lev:1);
X    end;
X    if not lookup_pers(pid,pname) then int_set_spell_level := false
X    else if not lookup_spell(sid,sname) then int_set_spell_level := false
X    else begin
X`009getspell(pid);
X`009spell.level`091sid`093 := lev;
X`009putspell;
X`009int_set_spell_level := true;
X    end;
Xend; `123 int_set_spell_level `125
X
X`091global`093
Xfunction int_lookup_player(name: shortstring): shortstring;
Xvar i: integer;
Xbegin
X   if debug then writeln('%int_lookup_player: ',name);
X   if lookup_pers(i,name) then int_lookup_player := pers.idents`091i`093
X   else int_lookup_player := '';
Xend; `123 int_lookup_player `125
X
X`091global`093
Xfunction int_lookup_object(name: shortstring): shortstring;
Xvar i: integer;
Xbegin
X   if debug then writeln('%int_lookup_object: ',name);
X   if lookup_obj(i,name) then int_lookup_object := objnam.idents`091i`093
X   else int_lookup_object := '';
Xend; `123 int_lookup_object `125
X
X`091global`093
Xfunction int_lookup_room(name: shortstring): shortstring;
Xvar i: integer;
Xbegin
X   if debug then writeln('%int_lookup_room: ',name);
X   if lookup_room(i,name) then int_lookup_room := nam.idents`091i`093
X   else int_lookup_room := '';
Xend; `123 int_lookup_room `125
X
X`091global`093
Xfunction int_lookup_direction(name: shortstring): shortstring;
Xvar i: integer;
Xbegin
X   if debug then writeln('%int_lookup_direction: ',name);
X   if lookup_dir(i,name) then int_lookup_direction := direct`091i`093
X   else int_lookup_direction := '';
Xend; `123 int_lookup_direction `125
X
X`091global`093
Xfunction slead(s: string):string;
Xvar
X`009i: integer;
X`009going: boolean;
X
Xbegin
X`009if length(s) = 0 then begin
X`009`009slead := '';
X`009`009if debug then writeln('slead: ');
X`009end else begin
X`009`009i := 1;
X`009`009going := true;
X`009`009while going do begin
X`009`009`009if i > length(s) then
X`009`009`009`009going := false
X`009`009`009else if (s`091i`093=' ') or (s`091i`093=chr(9)) then
X`009`009`009`009i := i + 1
X`009`009`009else
X`009`009`009`009going := false;
X`009`009end;
X
X`009`009if i > length(s) then begin
X`009`009    slead := '';
X`009`009    if debug then writeln('slead: ');
X`009`009end else begin
X`009`009    slead := substr(s,i,length(s)+1-i);
X`009`009    if debug then writeln('slead: ',substr(s,i,length(s)+1-i));
X`009`009end;
X`009end;
Xend;
X
X`091global`093
Xfunction bite(var s: string): string;
Xvar
X`009i: integer;
X
Xbegin
X`009if length(s) = 0 then
X`009`009bite := ''
X`009else begin
X`009`009i := index(s,' ');
X`009`009if i = 0 then begin
X`009`009`009bite := s;
X`009`009`009s := '';
X`009`009end else begin
+-+-+-+-+-+-+-+-  END  OF PART 31 +-+-+-+-+-+-+-+-