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 / part26 < prev next >

Wrap

Internet Message Format | 1992-08-02 | 42.9 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 26/32 Keywords: Monster, a multiplayer adventure game Message-ID: <1992Jun14.084904.12826@klaava.Helsinki.FI> Date: 14 Jun 92 08:49:04 GMT Sender: hurtta@klaava.Helsinki.FI (Kari Hurtta) Followup-To: vmsnet.sources.d Organization: University of Helsinki Lines: 1342 Archieve-name: monster_helsinki_104/part26 Author: Kari.Hurtta@Helsinki.FI Product: Monster Helsinki V 1.04 Environment: VMS, Pascal Part: 26/32 -+-+-+-+-+-+-+-+ START OF PART 26 -+-+-+-+-+-+-+-+ X Get all X Get <object,...> X XDescription: Gets object X:go XSyntax: Go <direction> XShorcut: <direction> X:health XSyntax: Health X XDescription: Gives your health X:hide XSyntax: Hide X Hide <object> X Hide all X Hide <object,...> X XDescription: Hides object or yourself X:inventory XSyntax: Inventory X Inventory <player> X Inventory all X Inventory <player,...> X XDescription: Gives inventory of <player> or your inventory X:link XSyntax: Link <direction> X XDescription: Creates new exit from this room to <direction> XRequirements: You are the owner of this room X or <direction> is Accepted X or you have the Owner -privilege X or you have the Manager -privilege,`032 X if the owner of this room is System X:list XSyntax: List rooms`032 X List monsters X List objects X List spells X List players X:look XSyntax: Look X Look <object> X Look <monster> X Look <player> X Look <detail> X Look all X Look <object,...> X Look <monster,...> X Look <player,...> X XDescription: Looks something. (Gives its description) X:make XSyntax: Make <object> XAlias: Create object <object> X XDescription: Creates a new object with a name: <object> XRequirements: You are the owner of this room X or this room is public X or you have the Owner -privilege X or you have the Manager -privilege,`032 X if owner of this room is System X:bear XSyntax: Bear <monster> XAlias: Create monster <monster> X XDescription: Creates a new monster with name <object> XRequirements: You are owner of this room X or room is public X or you have the Owner -privilege X or you have the Manager -privilege,`032 X if owner of this room is System X:name XSyntax: Name <nicename> X XDescription: Changes yoy player name to <nicename> X:objects XSyntax: Objects`032 X Objects <player> X Objects all X Objects public X Objects disowned X Objects system X XDescription: Types objets of <player> or yourself XRequirements: You, Public or Disowned have target X or you have the Owner -privilege X:monsters XSyntax: Monsters X Monsters <player> X Monsters all X Monsters public X Monsters disowned X Monsters system XAlias: List monsters X XDescription: Types monsters of <player> or yourself XRequirements: You, Public or Disowned have target X or you have the Owner -privilege X:players XSyntax: Players X Players all X Players monster X Players player XAlias: List players X XDescription: Lists players or monsters X:poof XSyntax: Poof <room> X Poof <player> X Poof <monster> X XDescription: Moves you to <room> or moves <player> or <monster> XRequirements: You are the owner of this room and <room> X or You have the Poof -privilege X:punch XSyntax: Punch <player> X XDescription: Punches <player> XRequirements: Experience of <player> is lower than 700000 X:quit XSyntax: Quit XShortcut: <F10> X XDescription: Ends playing X:relink XSyntax: Relink <direction> X XDescription: Reroutes exit to <direction> XRequirements: You are the owner of this room X You have the Owner -privilege X You have the Manager -privilege,`032 X if the owner of this room is System X:refuse XSyntax: Refuse <direction> X XDescription: Hinders other players to link to <direction> XRequirements: You are the owner of this room X You have the Owner -privilege X You have the Manager -privilege,`032 X if owner of this room is System X:reveal XSyntax: Reveal X XDescription: Reveals yourself X:rooms XSyntax: Rooms X Rooms <player> X Rooms all X Rooms public X Rooms disowned X Rooms system XAlias: List rooms X XDescription: Types all the rooms of <player> or yourself XRequirements: the target is owned by you, public or is disowned. X or you have the Owner -privilege X:say XSyntax: Say <message> XShortcut: "<message> X XDescription: Says a message to other players in this room X:scan XSyntax: Scan <object> X Scan all X Scan <object,...> X XDescription: Lists all locations of object XRequirements: You are the owner of this very object X or you have the Owner -privilege X or you have the Manager -privilege,`032 X if the owner of the object is System X And you are the owner of this room X or this room is public X or you have the Owner -privilege X or you have the Manager -privilege,`032 X if the owner of this room is System X:reset XSyntax: Reset <object> X Reset all X Reset <object,...> X XDescription: Erases all instances of an object from public and your`032 X rooms - and from public and your monsters X Creates one instance of the object to its home location X Doesn't affect objects that players are carrying XRequirements: There is at least one instance of object in public or your roo Vm X or carrying by public or your monster X You are the owner of object X or you have the Owner -privilege X or you have the Manager -privilege,`032 X if the owner of this object is System X And you are the owner of this room X or this room is public X or you have the Owner -privilege X or you have the Manager -privilege,`032 X if owner of this room is System X:score XSyntax: Score X Score <player> X Score <level> X Score all X XDescription: Prints your score and level X or prints score and level of <player> X or prints players, whose level is <level> X:search XSyntax: Search X XDescription: Searches hidden objects and players X:self XSyntax: Self`032 X Self <player> X Self <monster> X Self all X Self <player,...> X Self <monster,..> X XDescription: Creates your own self-description X or types the self-description of <player> X:set XSyntax: Set <option> X XOptions: Password`009`009Change your password X War Allow violance in Monster X Peace Forbid any violance in Monster X Spell Make new spell or customizing spell X NewPlayer Set new player's welcome text X Welcome Set welcome text X Privilege Change your privileges X X:show XSyntax: Show <option> X XOptions: Exits Lists exits you can inspect here X Object Shows internals of an object X Details Shows all the details you can look at this V room X Monster Shows the owner of a monster X Privileges Shows your privileges X Time Shows time and date X Room Shows the owner of a room X Commands.paper Lists COMMANDS.PAPER X Levels Shows all the experience levels X Quotas Show your quotas X Spells Show your spell level or what spells you k Vnow X:summon XSyntax: Summon <spell name> X <victim name> (type to prompt) X:unlink XSyntax: Unlink <direction> X XDescription: Removes exit to <direction> XRequirements: You are the owner of this room X or you have the Owner -privilege X or you have the Manager -privilege,`032 X if the owner of this room is System X:unmake XSyntax: Unmake <object> X XDescription: Removes description of <object> XRequirements: You are the owner of object X or you have the Owner -privilege X or you have the Manager -privilege,`032 X if the owner of object is System X And you are the owner of this room X or this room is public X or you have the Owner -privilege X or you have the Manager -privilege,`032 X if the owner of this room is System X:use XSyntax: Use <object> X:wear XSyntax: Wear X Wear <armour> X:wield XSyntax: Wield X Wield <weapon> X:whisper XSyntax: Whisper <player> X:who XSyntax: Who X Who all X Who player X Who monster X XDescription: Lists active players or monsters X:whois XSyntax: Whois <player> X Whois all X Whois <player,...> X XDescription: Types the username of <player> X:zap XSyntax: Zap <room> XAlias: Delete room <room> X XDescription: Removes <room> XRequirements: You are the owner of <room> X or you have the Owner -privilege X or you have the Manager -privilege,`032 X if the owner of <room> is System X And you are the owner of this room X or this room is public X or you have the Owner -privilege X or you have the Manager -privilege,`032 X if owner of this room is System X:help XSyntax: Help X X:system XSyntax: System X XDescription: Manages Monster XRequirements: You have the Manager -privilege (which is rare) X X:public XSyntax: Public X Public <room> X Public <object> X Public <monster> X Public <spell> X XDescription: Sets the ownership of room or object or monster or spell X or this room to Public XRequirements: You have the Manager -privilege $ CALL UNPACK MONSTER.HELP;44 67553446 $ create/nolog 'f' X! Monster initialization file - written by Kari Hurtta X!`032 X! Name of this file must be MONSTER.INIT X! The file must be located in the same direction as the monster's image. X XMM_userid: monster X`009 X! The Monster Manager has the most power; this should be X! the game administrator.`032 X X! protected_MM: true X Xgen_debug: false X!`009`009 this tells whether everyone may use the debug command. X! it must be able to be disabled because it tells players X! too much about monsters. On the other hand, it must also` V032 X! be able to be enabled, if we want to do test runs under X! an unprivileged userid`009`009 X XREBUILD_OK: false X X!`009`009 if this is true, the MM can blow away and reformat the X!`009`009 entire universe. It's a good idea to set this to false X Xroot: MONSTER_DATABASE_MON_: ! world database Xcoderoot:MONSTER_DATABASE_CODE_: ! mdl database X `032 X!`009`009 This is where the Monster database goes. X!`009`009 The root directory must be world:e and X!`009`009 the datafiles Monster creates in it X!`009`009 world:rw for people to be able to play. X!`009`009 The coderoot directory is where the X!`009`009 codefiles for monsters go. The directory X!`009`009 must additionally have an ACL default X!`009`009 world:rw for files and ACL rw for the X!`009`009 managers. This sucks, but we don't have X!`009`009 setgid to games on VMS.`032 X XLEVELTABLE: X! name`009`009 exp`009 priv`009 health`009 h.fac pow hid Vden`032 XBeginner, 0, 0, 10, 40, 0, nohidden XNovice, 1, 0, 10, 40, 2, nohidden XRanger, 500, 0, 15, 50, 3, nohidden XAdventurer, 1000, 0, 20, 60, 5, nohidden XHero, 2000, 32, 30, 60, 10, nohidden XChampion, 6000, 0, 40, 70, 10, nohidden XConjurer, 12000, 16, 50, 70, 12, nohidden XMagician, 20000, 0, 60, 70, 15, nohidden XEnchanter, 40000, 2, 80, 75, 20, nohidden XSorcerer, 70000, 256, 100, 80, 20, nohidden XWarlock, 120000, 4, 120, 85, 35, nohidden XApprentice wizard, 300000, 8, 150, 85, 50, nohidden XWizard, 700000, 64, 300, 90, 80, nohidden XAlmost Dead, 1000100, 0, 10, 40, 2, hidden XManager, 2000000, 1, 500, 100, 500, hidden XDruid, 2001000, 0, 500, 100, 500, hidden XCharlatan, 2008000, 0, 500, 100, 500, hidden XWanderer, 2009000, 0, 500, 100, 500, hidden XChief Architect, 3000000, 0, 500, 100, 500, hidden XBug Hunter, 5000000, 0, 500, 100, 500, hidden XEND OF LEVELTABLE XArchpriv: 0 XArchhealth: 800 XArchfactor: 100 XArchpower: 1000 X Xmaxexperience: 1000000 X! Monster Manager's experience is MaxInt X Xprotect_exp: 700000 X! gives protection agaist violence X XPlaytime: +++++++++--------+++++++ X! Closed at 09-17 in workdays X Xdefault_allow: 20 ! How many rooms players made at default Xmin_room: 5 ! How many rooms players can made without exit request Xmin_accept: 5 ! How many accepts must players made $ CALL UNPACK MONSTER.INIT;37 857618867 $ create/nolog 'f' X`091 INHERIT('database', 'guts', 'global' , 'privusers', 'parser')`093 XPROGRAM MONSTER_DUMP (INPUT, OUTPUT) ; X`032 X`123 XPROGRAM DESCRIPTION:`032 X`032 X Image for MONSTER/DUMP and MONSTER/BUILD -command X`032 XAUTHORS:`032 X`032 X Kari Hurtta X`032 XCREATION DATE:`0099.2.1991 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 10.02.1991 `124 `124 Some fixing (spelcially to *_PLAYER routines V) X 12.02.1991 `124 `124 Added /OUTPUT -qualifier and fixed OBJDROP% X 13.02.1991 `124 `124 read_EXIT : optional exitrec.closed moved`03 V2 X 13.02.1991 `124 `124 fixed OBJDROP% again! X 19.05.1992 `124 `124 while loop bug fixed in read ROOM and read_R VOOM2 X `124 `124 V 1.01 BOOKSPELL% HIDDEN% was wrong !! X`009 `124 `124 obj.numexist bug fixed in read_MONSTER X 28.05.1992 `124`009`009`124 V 1.02 write going field also for exit X`125 X XCONST VERSION = '1.02'; `123 DUMPER Version `125 X`009`009`009`123 version numbers MUST be dictionary order !!! `125 X`009`009`009`123 ie. '1.00' < '1.01' `125 X Xvar READ_vers_101: boolean; X READ_vers_102: boolean; 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 X`123 ---------- `125 X Xconst X`009cli$_present`009= 261401; X`009cli$_absent`009= 229872; X`009cli$_negated`009= 229880; X`009cli$_defaulted`009= 261409; X`009ss$_normal`009= 1; X Xtype X`009word_unsigned`009= `091word`093 0..65535; X`009cond_value`009= `091long`093 unsigned; X Xvar X`009userid`009`009: `091external`093 veryshortstring; X`009wizard`009`009: `091external`093 boolean; X X Xfunction cli$get_value (%descr entity_desc: string; X`009`009`009%descr retdesc: string; X`009`009`009%ref retlength: word_unsigned): cond_value; X`009external; X Xfunction cli$present (%descr entity_desc: string): cond_value; X`009external; X X Xvar dump_file : string := ''; X build_system : boolean := false; X dump_system : boolean := false; X Xprocedure params; X Xvar X`009qualifier, X`009value, X`009s`009`009: string; X`009value_length`009: word_unsigned; X`009status1, X`009status2`009`009: cond_value; X Xbegin X`009qualifier := 'DUMP_FILE'; X`009status1 := cli$present (qualifier); X`009if status1 = cli$_present then begin X`009 status2 := cli$get_value (qualifier, value, value_length); X`009 if status2 = ss$_normal then begin X`009`009dump_file := value; X`009 end else begin X`009`009writeln ('Something is wrong with /DUMP_FILE.'); X`009`009dump_file := ''; X`009 end; X`009end else dump_file := ''; X X`009qualifier := 'BUILD'; X`009status1 := cli$present (qualifier); X`009if status1 = cli$_present then begin X`009`009if wizard then begin X`009`009`009if REBUILD_OK then begin X`009`009`009`009writeln('Do you really want to destroy the entire universe?' V); X`009`009`009`009readln(s); X`009`009`009`009if length(s) > 0 then X`009`009`009`009`009if substr(lowcase(s),1,1) = 'y' then X`009`009`009`009`009`009build_system := true; X`009`009`009end else X`009`009`009`009writeln('/BUILD is disabled.'); X`009`009end else X`009`009`009writeln ('Only the Monster Manager may /BUILD.'); X`009end; X X`009qualifier := 'DUMP'; X`009status1 := cli$present (qualifier); X`009if status1 = cli$_present then begin X`009 if wizard then begin X`009`009dump_system := true; X`009 end else X`009`009writeln ('Only the Monster Manager may /DUMP.'); X`009end; X X`009qualifier := 'VERSION'; X`009status1 := cli$present (qualifier); X`009if status1 = cli$_present then begin X`009`009`123 Don't take this out please... `125 X`009 `009writeln('Monster dumper, written by Kari Hurtta at University of V Helsinki, 1991-1992'); X writeln('Version: ',VERSION); X`009`009writeln; X`009end; X X`009qualifier := 'DEBUG'; X`009status1 := cli$present (qualifier); X`009if status1 = cli$_present then begin X`009 if gen_debug then debug := true X`009 else if userid = MM_userid then debug := true X`009 else begin X`009`009writeln ('You may not use /DEBUG.'); X`009`009debug := false X`009 end X`009end else debug := false; X X`009qualifier := 'OUTPUT'; X`009status1 := cli$present (qualifier); X`009if status1 = cli$_present then begin X`009 status2 := cli$get_value (qualifier, value, value_length); X`009 if status2 = ss$_normal then begin X`009`009close(OUTPUT); X`009`009open(OUTPUT,value,new,default := '.LOG'); X`009`009rewrite(OUTPUT); X`009 end else begin X`009`009writeln ('Something is wrong with /OUTPUT.'); X`009 end; X`009end else if status1 = cli$_negated then begin X`009`009close(OUTPUT); X`009`009open(OUTPUT,'NLA0:',new); X`009`009rewrite(OUTPUT); X`009end; Xend; X X`123 --------------- `125 X X`123 ITEM `125 X Xprocedure write_ITEM(var f: TEXT; header,data : string); Xbegin X writeln(f,header+data); Xend; `123 write_ITEM `125 X Xfunction read_ITEM(var f: TEXT; header: string; var data : string): boolean; Xvar readed : `091static`093 boolean := false; X line : `091static`093 string := ''; Xbegin X if not readed and not eof(f) then begin X`009readln(f,line); X`009readed := true; X end; X if not readed then read_ITEM := false X else if index(line,header) = 1 then begin X`009data := substr(line,1+length(header),length(line)-length(header)); X`009readed := false; X`009read_ITEM := true; X end else read_ITEM := false; Xend; `123 read_ITEM `125 X X`123 DESCLINE `125 X Xprocedure write_DESCLINE(var f: text; linenum: integer); Xvar error: boolean; Xbegin X X if linenum = DEFAULT_LINE then`032 X`009write_ITEM(f,'DEFAULT*DESCLINE','!') X else if linenum = 0 then`032 X`009write_ITEM(f,'NULL*DESCLINE','!') X else begin X`009getindex (I_LINE); freeindex; X`009error := false; X`009if (linenum < 0) or (linenum > indx.top) then error := true X`009else if indx.free`091linenum`093 then error := true; X X`009if not error then begin X`009 getline(linenum); X`009 write_ITEM(f,'DESCLINE%',oneliner.theline); X`009 freeline; X`009end else begin X`009 writeln('Nonexisted description line #',linenum:1); X`009 write_ITEM(f,'DEFAULT*DESCLINE','!') X`009end; X end; Xend; `123 write_DESCLINE `125 X Xfunction read_DESCLINE(var f: text; var linenum: integer): boolean; Xvar data: string; Xbegin X if read_ITEM(f,'DEFAULT*DESCLINE',data) then begin X`009linenum := DEFAULT_LINE; X`009read_DESCLINE := true; X end else if read_ITEM(f,'NULL*DESCLINE',data) then begin X`009linenum := 0; X`009read_DESCLINE := true; X end else if read_ITEM(f,'DESCLINE%',data) then begin X`009if alloc_general(I_LINE,linenum) then begin X`009 getline(linenum); X`009 oneliner.theline := data; X`009 putline; X`009 read_DESCLINE := true; X`009end else read_DESCLINE := false; X end else read_DESCLINE := false; Xend; `123 read_DESCLINE `125 X X`123 BLOCK `125 X Xprocedure write_BLOCK(var f: text; code: integer); Xvar i : integer; X error: boolean; Xbegin X if code < 0 then write_DESCLINE(f,-code) X else if code = DEFAULT_LINE then`032 X`009write_ITEM(f,'DEFAULT*BLOCK','!') X else if code = 0 then`032 X`009write_ITEM(f,'NULL*BLOCK','!') X else begin X`009getindex (I_BLOCK); freeindex; X`009error := false; X`009if (code < 0) or (code > indx.top) then error := true X`009else if indx.free`091code`093 then error := true; X X`009if not error then begin X`009 getblock(code); X`009 write_ITEM(f,'START*BLOCK','!'); X`009 for i := 1 to block.desclen do`032 X`009`009write_ITEM(f,'BLOCK%',block.lines`091i`093); X`009 freeblock; X`009end else begin X`009 writeln('Nonexisted block desciption #',code:1); X`009 write_ITEM(f,'NULL*BLOCK','!') X`009end; X end; Xend; `123 write_BLOCK `125 X Xfunction read_BLOCK(var f: text; var code: integer): boolean; Xvar data: string; Xbegin X if read_DESCLINE(f,code) then begin X`009code := -code; X`009read_BLOCK := true; X end else if read_ITEM(f,'DEFAULT*BLOCK',data) then begin X`009code := DEFAULT_LINE; X`009read_BLOCK := true; X end else if read_ITEM(f,'NULL*BLOCK',data) then begin X`009code := 0; X`009read_BLOCK := true; X end else if read_ITEM(f,'START*BLOCK',data) then begin X`009if alloc_general(I_block,code) then begin X`009 getblock(code); X`009 block.desclen := 0; X`009 while read_ITEM(f,'BLOCK%',data) do begin X`009`009block.desclen := block.desclen +1; X`009`009block.lines`091block.desclen`093 := data; X`009 end; X`009 putblock; X`009 read_BLOCK := true; X`009end else read_BLOCK := false; X end else read_BLOCK := false; Xend; `123 read_BLOCK `125 X X`123 MEGA `125 X Xprocedure write_MEGA(var f: text; mega: mega_string); Xvar len, i, cut: integer; Xbegin X if mega = '' then write_ITEM(f,'NULL*MEGA','!') X else if length(mega) < string_len - 10 then X`009write_ITEM(f,'SHORTMEGA%',mega) X else begin X`009write_ITEM(f,'START*MEGA','!'); X`009i := 1; X`009len := length(mega); X`009repeat X`009 if i + string_len - 10 <= len then cut := string_len - 10 X`009 else cut := len - i +1; X`009 if cut > 0 then write_ITEM(f,'MEGA%',substr(mega,i,cut)); X`009 i := i + cut; X`009until cut = 0; X end; Xend; `123 write_MEGA `125 X Xfunction read_MEGA(var f: text; var mega: mega_string): boolean; Xvar data: string; Xbegin X mega := ''; X if read_ITEM(f,'NULL*MEGA',data) then read_MEGA := true X else if read_ITEM(f,'SHORTMEGA%',data) then begin X`009mega := data; X`009read_MEGA := true; X end else if not read_ITEM(f,'START*MEGA',data) then read_MEGA := false X else begin X`009mega := ''; X`009while read_ITEM(f,'MEGA%',data) do mega := mega + data; X`009read_MEGA := true; X end; Xend; `123 read_MEGA `125 X X`123 INTEGER `125 X Xprocedure write_INTEGER(var f: text; header: string; code: integer); Xvar data: string; Xbegin X writev(data,code:1); X write_ITEM(f,header,data); Xend; X Xfunction read_INTEGER(var f: text; header: string; var code: integer): BOOLE VAN; Xvar data: string; Xbegin X if read_ITEM(f,header,data) then begin X`009readv(data,code); X`009read_INTEGER := true; X end else read_INTEGER := false; Xend; X X`123 BINARY `125 X Xprocedure write_BINARY(var f: TEXT; header,data : string); Xvar i: integer; Xbegin X write_INTEGER(f,header,length(data)); X for i:= 1 to length(data) do X`009write_INTEGER(f,'BIN%',ord(data`091i`093)); Xend; X Xfunction read_BINARY(var f: TEXT; header: string; var data: string): boolean V; Xvar i,len,c: integer; X flag: boolean; Xbegin X if not read_INTEGER(f,header,len) then X`009read_BINARY := false X else begin X`009flag := true; X`009data := ''; X`009for i := 1 to len do begin X`009 if not read_INTEGER(f,'BIN%',c) then flag := false; X`009 data := data + chr(c); X`009end; X`009if not flag then writeln('Error in reading binary string.'); X`009read_BINARY := true; X end; Xend; X X`123 BOOLEAN `125 X Xprocedure write_BOOLEAN(var f: text; header: string; code: boolean); Xvar data: string; Xbegin X writev(data,code:1); X write_ITEM(f,header,data); Xend; X Xfunction read_BOOLEAN(var f: text; header: string; var code: boolean): BOOLE VAN; Xvar data: string; Xbegin X if read_ITEM(f,header,data) then begin X`009readv(data,code); X`009read_BOOLEAN := true; X end else read_BOOLEAN := false; Xend; X X`123 NAME `125 X Xprocedure write_NAME(var f: text; header: string; class: integer; name: inte Vger); Xvar rec: namrec; Xbegin X if name = 0 then write_ITEM(f,header,'%%NULL%%') X else begin X`009get_namfile(class,rec); X`009unlock(namfile); X`009write_ITEM(f,header,rec.idents`091name`093); X end Xend; `123 write_NAME `125 X Xfunction read_NAME(var f: text; header: string; class,iclass: integer;`032 X var name: integer): boolean; Xvar code,i: integer; X data: string; X rec: namrec; Xbegin X if not read_ITEM(f,header,data) then read_NAME := false X else begin X`009if data = '%%NULL%%' then name := 0 X`009else if data = '' then begin X`009 writeln('Empty name for class ',class:1,'/',iclass:1); X`009 writeln(' Treated as null name.'); X`009 name := 0; X`009end else begin X`009 get_namfile(class,rec); X`009 unlock(namfile); X`009 getindex(iclass); X`009 freeindex; X`009 name := 0; X`009 for i := 1 to indx.top do`032 X`009`009if not indx.free`091i`093 then X`009`009 if rec.idents`091i`093 = data then name := i; X`009 if name = 0 then writeln('Reference error in class ', X`009`009 class:1,'/',iclass:1, ' name ',data); X`009end; X`009read_NAME := true; X end; Xend; X Xfunction read_NEWNAME(var f: text; header: string; class,iclass: integer;`03 V2 X var name: integer): boolean; Xvar code,i: integer; X data: string; X rec: namrec; Xbegin X if not read_ITEM(f,header,data) then read_NEWNAME := false X else begin X`009if data = '%%NULL%%' then name := 0 X`009else if data = '' then begin X`009 writeln('Empty name for class ',class:1,'/',iclass:1); X`009 writeln(' Treated as null name.'); X`009 name := 0; X`009end else begin X`009 get_namfile(class,rec); X`009 getindex(iclass); X`009 `032 X`009 name := 0; X`009 for i := 1 to indx.top do`032 X`009`009if indx.free`091i`093 and (name = 0) then name := i; X`009 `123 must to come same order as original so that`032 X`009`009Great Hall, Void and Pit of Fire gets right number `125 X X`009 if name = 0 then writeln('Overflow error in class ', X`009`009 class:1,'/',iclass:1, ' name ',data) X`009 else begin X`009`009indx.free`091name`093 := false; X`009`009indx.inuse := indx.inuse +1; X`009`009rec.idents`091name`093 := data; X`009 end; X`009 putindex; X`009 put_namfile(class,rec); X X`009end; X`009read_NEWNAME := true; X end; Xend; X X`123 MDL `125 X Xprocedure write_MDL(var f: text; code: integer); Xvar i : integer; X mdl: text; X line: mega_string; X error : boolean; Xbegin X if code = 0 then write_ITEM(f,'NULL*MDL','!') X else begin X`009getindex (I_HEADER); freeindex; X`009error := false; X`009if (code < 0) or (code > indx.top) then error := true X`009else if indx.free`091code`093 then error := true; X X`009if not error then begin `032 X`009 write_ITEM(f,'START*MDL','!'); X`009 open(mdl,file_name(code),old,RECORD_LENGTH := mega_length + 20); X`009 reset(mdl); X`009 while not eof(mdl) do begin X`009`009readln(mdl,line); X`009`009write_MEGA(f,line); X`009 end; X`009 close(mdl); X`009 getheader(code); X`009 freeheader; X`009 write_BOOLEAN(f,'RUNNABLE%',header.runnable); X`009 write_BOOLEAN(f,'PRIV%',header.priv); X`009 write_ITEM(f,'OWNER%',header.owner); X`009 write_ITEM(f,'CTIME%',header.ctime); X`009 for i := 1 to statmax do if header.stats`091i`093.lab <> '' then X`009 begin X`009`009write_ITEM(f,'STATLAB%',header.stats`091i`093.lab); X`009`009write_INTEGER(f,'RCOUNT%',header.stats`091i`093.runcount); X`009`009write_INTEGER(f,'ECOUNT%',header.stats`091i`093.errorcount); X`009`009write_ITEM(f,'LASTRUN%',header.stats`091i`093.lastrun); X`009 end; X`009 write_ITEM(f,'AUTHOR%',header.author); X`009 write_ITEM(f,'WTIME%',header.wtime); X`009 write_MEGA(f,header.state); X`009 write_INTEGER(f,'FLAGS%',header.flags); X`009end else begin X`009 writeln('Nonexisted MDL code #',code:1); X`009 write_ITEM(f,'NULL*MDL','!') X`009end; X end; Xend; `123 write_MDL `125 X Xfunction read_MDL(var f: text; var code: integer): boolean; Xvar data: string; X flag: boolean; X mdl: text; X line: mega_string; X i: integer; Xbegin X if read_ITEM(f,'NULL*MDL',data) then begin X`009code := 0; X`009read_MDL := true; X end else if not read_ITEM(f,'START*MDL',data) then read_mdl := false X else begin X`009getindex(I_HEADER); X`009flag := true; X`009code := 0; X`009for i := 1 to indx.top do`032 X`009 if indx.free`091i`093 then code := i; X X`009if code = 0 then writeln('Overflow error in mdl store.') X`009else begin X`009 indx.free`091code`093 := false; X`009 indx.inuse := indx.inuse +1; X`009 `032 X`009 getheader(code); X X`009 open(mdl,file_name(code),old,RECORD_LENGTH := mega_length + 20); X`009 rewrite(mdl); X`009 while read_MEGA(f,line) do writeln(mdl,line); X`009 close(mdl); X`009 if not read_BOOLEAN(f,'RUNNABLE%',header.runnable) then flag := fals Ve; X`009 if not read_BOOLEAN(f,'PRIV%',header.priv) then flag := false; X`009 header.interlocker := ''; X`009 if not read_ITEM(f,'OWNER%',data) then flag := false; X`009 header.owner := data; X`009 if not read_ITEM(f,'CTIME%',data) then flag := false; X`009 header.ctime := data; X`009 `032 X`009 for i := 1 to statmax do header.stats`091i`093.lab := ''; X`009 i := 1; X`009 while read_ITEM(f,'STATLAB%',data) do begin X`009`009header.stats`091i`093.lab := data; X`009`009if not read_INTEGER(f,'RCOUNT%',header.stats`091i`093.runcount) then V flag := false; X`009`009if not read_INTEGER(f,'ECOUNT%',header.stats`091i`093.errorcount) th Ven flag := false; X`009`009if not read_ITEM(f,'LASTRUN%',data) then flag := false; X`009`009header.stats`091i`093.lastrun := data; X`009`009i := i +1; X`009 end; X`009 if not read_ITEM(f,'AUTHOR%',data) then flag := false; X`009 header.author := data; X`009 if not read_ITEM(f,'WTIME%',data) then flag := false; X`009 header.wtime := data; X`009 header.running_id := ''; X`009 if not read_MEGA(f,header.state) then flag := false; X`009 header.version := 1; X`009 header.ex1 := ''; X`009 header.ex2 := ''; X`009 header.ex3 := ''; X`009 if not read_INTEGER(f,'FLAGS%',header.flags) then flag := false; X`009 header.ex5 := 0; X`009 header.ex6 := 0.0; X`009 putheader; X`009end; X`009putindex; X`009if not flag then writeln('Error in reading mdl code.'); X`009read_MDL := true; X end; Xend; X X`123 OBJECT `125 X Xprocedure write_OBJECT(var f: text; object: integer); Xbegin X if debug then writeln('Writing object #',object:1); X write_NAME(f,'OBJECT%',T_OBJNAM,object); `123 write object name `125 X X getobjown; freeobjown; X write_ITEM(f,'OWNER%',objown.idents`091object`093); X X getobj(object); X freeobj; X write_ITEM(f,'NAME%',obj.oname); `123 duplicate name `125 X write_INTEGER(f,'KIND%',obj.kind); X write_DESCLINE(f,obj.linedesc); X `123 *** home must write later `125 X write_BLOCK(f,obj.homedesc); X write_MDL(f,obj.actindx); X write_BLOCK(f,obj.examine); X write_INTEGER(f,'VALUE%',obj.worth); X `123 don't write numexit `125 X write_BOOLEAN(f,'STICKY%',obj.sticky); X `123 *** getobjreq must write later `125 X write_BLOCK(f,obj.getfail); X write_BLOCK(f,obj.getsuccess); X `123 *** useobjreq must write later `125 X `123 *** uselogreq must write later `125 X write_BLOCK(f,obj.usefail); X write_BLOCK(f,obj.usesuccess); X write_ITEM(f,'USEALIAS%',obj.usealias); X write_BOOLEAN(f,'REQALIAS%',obj.reqalias); X write_BOOLEAN(f,'REQVERB%',obj.reqverb); X write_INTEGER(f,'PARTICLE%',obj.particle); X case obj.kind of X`009O_BOOK: X`009 write_NAME(f,'BOOKSPELL%',T_SPELL_NAME,obj.parms`091OP_SPELL`093); X`009otherwise ; X end; X X write_BLOCK(f,obj.d1); X write_BLOCK(f,obj.d2); X write_INTEGER(f,'POWER%',obj.ap); X write_INTEGER(f,'EXP%',obj.exreq); X `123 *** exp5, exp6 not dumped `125 Xend; `123 write_OBJECT `125 X Xfunction read_OBJECT(var f: text; var object: integer): boolean; Xvar id: integer; X flag : boolean; X s: string; Xbegin X if not read_NEWNAME(f,'OBJECT%',T_OBJNAM,I_OBJECT,object) then read_OBJEC VT := false X else if object = 0 then begin X writeln('Object with empty/null name!'); X read_ITEM(f,'OWNER%',s); X read_ITEM(f,'NAME%',s); X writeln(' Name: ',s); X read_INTEGER(f,'KIND%',id); X read_DESCLINE(f,id); X read_BLOCK(f,id); X read_MDL(f,id); X read_BLOCK(f,id); X read_INTEGER(f,'VALUE%',id); X read_BOOLEAN(f,'STICKY%',flag); X read_BLOCK(f,id); X read_BLOCK(f,id); X read_BLOCK(f,id); X read_BLOCK(f,id); X read_ITEM(f,'USEALIAS%',s); X read_BOOLEAN(f,'REQALIAS%',flag); X read_BOOLEAN(f,'REQVERB%',flag); X read_INTEGER(f,'PARTICLE%',id); X`009`123 one possible parms: `125 X`009read_NAME(f,'BOOKSPELL%',T_SPELL_NAME,I_SPELL,id); X read_BLOCK(f,id); X read_BLOCK(f,id); X read_INTEGER(f,'POWER%',id); X read_INTEGER(f,'EXP%',id); X X read_OBJECT := true; X end else begin X getobjnam; freeobjnam; X if debug then writeln('Reading object ',objnam.idents`091object`093); X flag := true; X X getobjown; X if not read_ITEM(f,'OWNER%',s) then flag := false; X objown.idents`091object`093 := s; X putobjown; X X getobj(object); X obj.onum := object; `123 !! `125 X if not read_ITEM(f,'NAME%',s) then flag := false; X obj.oname := s; X if not read_INTEGER(f,'KIND%',obj.kind) then flag := false; X if not read_DESCLINE(f,obj.linedesc) then flag := false; X obj.home := 0; X if not read_BLOCK(f,obj.homedesc) then flag := false; X if not read_MDL(f,obj.actindx) then flag := false; X if not read_BLOCK(f,obj.examine) then flag := false; X if not read_INTEGER(f,'VALUE%',obj.worth) then flag := false; X obj.numexist := 0; X if not read_BOOLEAN(f,'STICKY%',obj.sticky) then flag := false; X obj.getobjreq := 0; X if not read_BLOCK(f,obj.getfail) then flag := false; X if not read_BLOCK(f,obj.getsuccess) then flag := false; X obj.useobjreq := 0; X obj.uselocreq := 0; X if not read_BLOCK(f,obj.usefail) then flag := false; X if not read_BLOCK(f,obj.usesuccess) then flag := false; X if not read_ITEM(f,'USEALIAS%',s) then flag := false; X obj.usealias := s; X if not read_BOOLEAN(f,'REQALIAS%',obj.reqalias) then flag := false; X if not read_BOOLEAN(f,'REQVERB%',obj.reqverb) then flag := false; X if not read_INTEGER(f,'PARTICLE%',obj.particle) then flag := false; X for id := 1 to maxparm do obj.parms`091id`093 := 0; X case obj.kind of`032 X`009 O_BOOK: if READ_vers_101 then `123 BOOKSPELL% was in version 1.01 !! V `125 X`009`009if not read_NAME(f,'BOOKSPELL%',T_SPELL_NAME,I_SPELL, X`009`009 obj.parms`091OP_SPELL`093) then flag := false; X`009 otherwise ; X end; X if not read_BLOCK(f,obj.d1) then flag := false; X if not read_BLOCK(f,obj.d2) then flag := false; X if not read_INTEGER(f,'POWER%',obj.ap) then flag := false; X if not read_INTEGER(f,'EXP%',obj.exreq) then flag := false; X putobj; X if not flag then writeln('Error in reading object ', X`009objnam.idents`091object`093); X read_OBJECT := true; X end; Xend; `123 read_OBJECT `125 X X`123 OBJECT2 `125 X Xprocedure write_OBJECT2(var f: text; object: integer); Xbegin X write_NAME(f,'OBJECT2%',T_OBJNAM,object); `123 write object name `125 X getobj(object); X freeobj; X write_NAME(f,'HOME%',T_NAM,obj.home); `123 write room name `125 X write_NAME(f,'GETOBJREQ%',T_OBJNAM,obj.getobjreq); `123 write object name V `125 X write_NAME(f,'USEOBJREQ%',T_OBJNAM,obj.useobjreq); `123 write object name V `125 X write_NAME(f,'USELOC%',T_NAM,obj.uselocreq); `123 write room name `125 X X case obj.kind of X O_BOOK: write_name(f,'SPELLREF%',T_SPELL_NAME,obj.parms`091OP_SPELL`09 V3); X otherwise ; X end; `123 case `125 X Xend; `123 write_OBJECT2 `125 X Xfunction read_OBJECT2(var f: text; var object: integer): boolean; Xvar id: integer; X flag : boolean; X s: string; Xbegin X if not read_NAME(f,'OBJECT2%',T_OBJNAM,I_OBJECT,object) then read_OBJECT2 V := false X else if object = 0 then begin X`009writeln('Empty/null/unknown object name!'); X read_NAME(f,'HOME%',T_NAM,I_ROOM,id); X read_NAME(f,'GETOBJREQ%',T_OBJNAM,I_OBJECT,id); X read_NAME(f,'USEOBJREQ%',T_OBJNAM,I_OBJECT,id); X read_NAME(f,'USELOC%',T_NAM,I_ROOM,id); X read_NAME(f,'SPELLREF%',T_SPELL_NAME,I_SPELL,id); X read_OBJECT2 := true; X end else begin X getobjnam; freeobjnam; X if debug then writeln('Reading object ',objnam.idents`091object`093); X flag := true; X getobj(object); X if not read_NAME(f,'HOME%',T_NAM,I_ROOM,obj.home) then flag := false; V `123 room name `125 X if not read_NAME(f,'GETOBJREQ%',T_OBJNAM,I_OBJECT,obj.getobjreq) then V flag := false; `123 object name `125 X if not read_NAME(f,'USEOBJREQ%',T_OBJNAM,I_OBJECT,obj.useobjreq) then V flag := false; `123 object name `125 X if not read_NAME(f,'USELOC%',T_NAM,I_ROOM,obj.uselocreq) then flag := V false; X X case obj.kind of X`009O_BOOK: begin X`009 if not read_NAME(f,'SPELLREF%',T_SPELL_NAME,I_SPELL,obj.parms`091OP_ VSPELL`093) then flag := false; X`009end; X`009otherwise ; X end; `123 case `125 X X putobj; X if not flag then writeln('Error in reading object ', X`009 objnam.idents`091object`093); X read_OBJECT2 := true; X end; Xend; `123 read_OBJECT2 `125 X X`123 MONSTER `125 X Xprocedure write_MONSTER(var f: text; rec: peoplerec); Xvar i: integer; X c: char; X id: integer; X `032 Xbegin X write_INTEGER(f,'MONSTERKIND%',rec.kind); X write_MDL(f,rec.parm); X `123 don't write rec.username - it's :<rec.parm> `125 X write_ITEM(f,'NAME%',rec.name); X write_INTEGER(f,'HIDING%',rec.hiding); X for i := 1 to maxhold do if rec.holding`091i`093 <> 0 then X`009write_NAME(f,'HOLD%',T_OBJNAM,rec.holding`091i`093); `123 write object n Vame `125 X write_NAME(f,'WEAR%',T_OBJNAM,rec.wearing); `123 write object name `125 X write_NAME(f,'WIELD%',T_OBJNAM,rec.wielding); `123 write object name `12 V5 X `123 don't write self desc `125 Xend; `123 write_MONSTER `125 X Xfunction read_MONSTER(var f: text; var rec: peoplerec): boolean; Xvar i,a,id: integer; X flag : boolean; X data: string; Xbegin X if not read_INTEGER(f,'MONSTERKIND%',rec.kind) then read_MONSTER := fals Ve X else begin X`009getpers; freepers; X`009flag := true; X`009if not read_MDL(f,rec.parm) then flag := false; X`009writev(rec.username,':',rec.parm:1); `123 username is MDL code number `1 V25 X X`009if not read_ITEM(f,'NAME%',data) then flag := false; X`009rec.name := data; X `009id := 0; `123 monster's number `125 X`009getpers; freepers; getindex(I_PLAYER); freeindex; X`009for i := 1 to indx.top do if not indx.free`091i`093 then X`009 if pers.idents`091i`093 = data then id := i; X`009if id = 0 then writeln('Monster''s name ',data,' not found.'); X X`009getuser; X`009if id > 0 then writev(user.idents`091id`093,':',rec.parm:1); `123 update V username `125 X`009putuser; X X`009if not read_INTEGER(f,'HIDING%',rec.hiding) then flag := false; X`009rec.act := 0; X`009rec.targ := 0; X`009for i := 1 to maxhold do rec.holding`091i`093 := 0; X`009i := 1; X`009while read_NAME(f,'HOLD%',T_OBJNAM,I_OBJECT,a) do begin X`009 rec.holding`091i`093 := a; X X`009 getobj(a); `032 X`009 obj.numexist := obj.numexist + 1; `123 Update counter `125 X`009 putobj; X X X`009 i := i +1; X`009end; X`009getint(N_EXPERIENCE); freeint; X`009if id > 0 then rec.experience := anint.int`091id`093; X X`009if not read_NAME(f,'WEAR%',T_OBJNAM,I_OBJECT,rec.wearing) then flag := f Valse; `123 object name `125 X`009if not read_NAME(f,'WIELD%',T_OBJNAM,I_OBJECT,rec.wielding) then flag := V false; `123 object name `125 X X`009getint(N_HEALTH); freeint; X`009if id > 0 then rec.health := anint.int`091id`093; X X`009getint(N_SELF); freeint; X`009if id > 0 then rec.self := anint.int`091id`093; X X`009if not flag then writeln('Error in loading monster ',rec.name); X`009read_MONSTER := true; X end; Xend; `123 read_MONSTER `125 X X`123 PLAYER `125 X Xprocedure write_PLAYER(var f: text; player: integer); Xvar i,owner: integer; X c: char; Xbegin X getuser; freeuser;`032 X if debug then writeln('Writing player ',user.idents`091player`093); X write_NAME(f,'PLAYER%',T_PERS,player); X X if user.idents`091player`093`0911`093 = ':' then begin `123 monster ? `1 V25 X`009`123 what we can write - real username is MDL number `125 X`009`123 read_MONSTER will be update this data when reading `125 X end else write_ITEM(f,'USER%',user.idents`091player`093); X X getdate; freedate; X write_ITEM(f,'DATE%',adate.idents`091player`093); X X gettime; freetime; X write_ITEM(f,'TIME%',atime.idents`091player`093); X X getpasswd; freepasswd; X if passwd.idents`091player`093 > '' then X`009write_BINARY(f,'PASSWD%',passwd.idents`091player`093); X X getreal_user; freereal_user; X if real_user.idents`091player`093 > '' then +-+-+-+-+-+-+-+- END OF PART 26 +-+-+-+-+-+-+-+-