Source Code 1994 March

home *** CD-ROM | disk | FTP | other *** search

/ Source Code 1994 March / Source_Code_CD-ROM_Walnut_Creek_March_1994.iso / compsrcs / games / vmsnet / monhl104 / part31 < prev next >

Wrap

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

Path: uunet!mcsun!news.funet.fi!hydra!klaava!hurtta From: Kari.Hurtta@Helsinki.FI (Kari E. Hurtta) Newsgroups: vmsnet.sources.games Subject: Monster Helsinki V 1.04 - part 31/32 Keywords: Monster, a multiplayer adventure game Message-ID: <1992Jun14.111915.14691@klaava.Helsinki.FI> Date: 14 Jun 92 11:19:15 GMT Sender: hurtta@klaava.Helsinki.FI (Kari Hurtta) Followup-To: vmsnet.sources.d Organization: University of Helsinki Lines: 1524 Archieve-name: monster_helsinki_104/part31 Author: Kari.Hurtta@Helsinki.FI 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 +-+-+-+-+-+-+-+-