Source Code 1994 March/Source_Code_CD-ROM_Walnut_Creek_March_1994.iso/compsrcs/games/vmsnet/monhl10b/delta3

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

Path: uunet!mcsun!news.funet.fi!hydra!klaava!hurtta
From: [e-mail] (Kari. E. Hurtta)
Newsgroups: vmsnet.sources.games
Subject: Monster Helsinki, Delta from 1.04 to 1.05 - part 3/7
Message-ID: <[e-mail]>
Date: 30 Jun 92 20:39:50 GMT
Sender: [e-mail] (Kari Hurtta)
Followup-To: vmsnet.sources.d
Organization: University of Helsinki
Lines: 1197

Archive-name: monster_helsinki_104_to_105/delta3
Environment: VMS, Pascal
Author: [e-mail]

-+-+-+-+-+-+-+-+ START OF PART 3 -+-+-+-+-+-+-+-+
X         putobj;
X         writeln ('Updated.');
X       end else writeln ('Out of range.');
X   end else writeln ('No such experience.');
X   writeln;
X
X   exit_label:
Xend;                                `032
X
Xprocedure program_trap (objnum: integer);
Xlabel exit_label;
Xvar attack_power: integer;
X    n,top,lev: integer;
X    s: string;
X
X    procedure leave;
X    begin
X`009writeln('EXIT - no changes.');
X`009goto exit_label;
X    end;
X
Xbegin
X`123 getobj (objnum);
X   freeobj;  `125   `123 prog_obj do this already `125
X  `032
X   writeln ('Use f to edit what victim sees when (s)he tries to get trap.');
X   writeln ('Use x to edit what others see when someone fails to get trap');
X
X   writeln;
X   writeln ('Attack power that the trap uses when it bites someone');
X   attack_power := obj.ap;
X   lev := level(myexperience);
X   top := leveltable`091lev`093.maxpower;
X
X   writeln ('Select attack power, range is 0 - ',top:1);
X   writeln ('Current attack power is ',attack_power:1);
X   grab_line ('Power? ',s,eof_handler := leave);
X   if isnum (s) then begin
X     n := number (s);
X     if (n >= 0) and (n <=top) then`032
X       begin
X         attack_power := n;           `032
X         getobj (objnum);
X         obj.ap := attack_power;
X         putobj;
X         writeln ('Updated.');
X
X       end
X     else writeln ('Out of range.'); `032
X   end else writeln('No such power.');
X   exit_label:
Xend;              `032
X
Xprocedure program_armor(objnum: integer);
Xlabel exit_label;
Xvar attack_power: integer;
X    n,top,lev: integer;
X    s: string;
X
X    procedure leave;
X    begin
X`009writeln('EXIT - no changes.');
X`009goto exit_label;
X    end;
X
Xbegin
X`123 getobj (objnum);
X   freeobj;  `125   `123 prog_obj do this already `125
X   writeln ('Protection rate of armor');
X   attack_power := obj.ap;
X   lev := level(myexperience);
X   top := leveltable`091lev`093.maxpower;
X
X   writeln ('Select protection rate, range is 0 - ',top:1);
X   writeln ('Current protection rate is ',attack_power:1);
X   grab_line ('Power? ',s,eof_handler := leave);
X   if isnum (s) then begin
X     n := number (s);
X     if (n >= 0) and (n <=top) then`032
X       begin
X         attack_power := n;           `032
X         getobj (objnum);
X         obj.ap := attack_power;
X         putobj;
X         writeln ('updated.');
X
X       end
X     else Writeln ('Out of range.'); `032
X   end else writeln('No such power.');
X   exit_label:
Xend;              `032
X
Xprocedure prog_obj(objnum: integer);
Xvar object_type: integer;
Xbegin            `032
X  getobj (objnum);
X  freeobj;
X`032
X  object_type := obj.kind;
X  case object_type of
X`009O_BLAND : WriteLn ('You can''t program ordinary object.');           `03
V2
X`009O_WEAPON: program_weapon (objnum);      `032
X`009O_TRAP: program_trap(objnum);
X`009O_ARMOR: program_armor(objnum);
X`009O_DISGUISE: Writeln ('You can''t program disguise.');
X`009O_BOOK: program_book(objnum);
X    otherwise  WriteLn ('This kind of object is not supported here.')
X  end; `123 case `125
Xend;
X
X
X`091global`093 PROCEDURE show_kind(p: integer; cr: boolean := true);
Xvar s: string;
Xbegin
X`009case p of
X`009`009O_BLAND:    s := 'Ordinary object';
X`009`009O_WEAPON:   s := 'Weapon';
X`009`009O_ARMOR:    s := 'Armor';
X       `009`009O_TRAP:     s := 'Trap';
X`009`009O_DISGUISE: s := 'Disguise';
X`009`009O_BOOK:`009    s := 'Magic book';
X`009`009O_BAG:      s := 'Bag';
X`009`009O_CRYSTAL:  s := 'Crystal Ball';
X`009`009O_WAND:     s := 'Wand of Power';
X`009`009O_HAND:     s := 'Hand of Glory';
X`009`009O_TELEPORT_RING:  s := 'Teleport Ring';
X`009`009O_HEALTH_RING:    s := 'Health Ring';
X`009`009O_MAGIC_RING:     s := 'Magic Ring';
X`009`009otherwise   s := 'Bad object type';
X`009end;
X`009if cr then writeln(s)
X`009else write(lowcase(s));
Xend;
X
Xprocedure obj_view(objnum: integer);
Xbegin
X`009writeln;
X`009getobj(objnum);
X`009freeobj;
X`009getobjown;
X`009freeobjown;
X`009writeln('Object name:    ',obj.oname);
X`009if objown.idents`091objnum`093 = public_id then writeln('Public')
X`009else if objown.idents`091objnum`093 = disowned_id then writeln('Disowned
V')
X`009else writeln('Owner:          ',class_out(objown.idents`091objnum`093));
X`009writeln;
X`009show_kind(obj.kind);
X`009writeln;
X
X`009if obj.linedesc = 0 then
X`009`009writeln('There is a(n) # here')
X`009else
X`009`009print_line(obj.linedesc);
X
X`009if obj.examine = 0 then
X`009`009writeln('No inspection description set')
X`009else
X`009`009print_desc(obj.examine);
X
X`123`009writeln('Worth (in points) of this object: ',obj.worth:1);`009`125
X`009if obj.home > 0 then begin
X`009    getnam;
X`009    freenam;
X`009    writeln('Home of this object is ',nam.idents`091obj.home`093);
X`009end;
X`009if obj.kind in `091O_WEAPON,O_ARMOR,O_TRAP`093 then`032
X`009`009writeln ('Power of this object: ',obj.ap:1);
X`009if obj.kind in `091O_WEAPON,O_BOOK`093 then
X`009`009writeln ('Required experience to use this object: ',obj.exreq:1);
X        if obj.kind = O_BOOK then begin
X`009`009getspell_name; freespell_name;
X`009`009if obj.parms`091OP_SPELL`093 > 0 then
X`009`009    writeln('Spell name of this object: ',
X`009`009`009spell_name.idents`091obj.parms`091OP_SPELL`093`093)
X`009`009else writeln('Spell name of this object: <none>');
X`009end;
X`009if obj.actindx > 0 then
X`009`009writeln ('In this object is a hook.')
X`009else writeln ('No hook in this object.');
X`009writeln('Number in existence: ',obj.numexist:1);
X- 2055, 2059
X
X
XPROCEDURE do_program;`009`123 (object_name: string);  declared forward `125
Xlabel exit_label;
Xvar
X`009prompt: string;
X`009done : boolean;
X`009s,param: string;
X`009objnum: integer;
X`009n: integer;
X`009newdsc: integer;
X- 2063
X`009log_event(myslot,E_OBJDONE,objnum,0);
X- 2069, 2132
X    gethere;
X    if checkhide then begin
X`009if object_name = '' then writeln('To customize an object, type CUSTOM OB
VJECT <object name>.')
X`009else if lookup_obj(objnum,object_name) then begin
X`009    if not is_owner(location,TRUE) then begin
X`009`009writeln('You may only work on your objects when you are in one of yo
Vur own rooms.');
X`009    end else if obj_owner(objnum) then begin
X`009`009log_action(e_program,0);
X`009`009writeln;
X`009`009writeln('Customizing object');
X`009`009writeln('If you would rather be customizing an EXIT, type CUSTOM <di
Vrection of exit>');
X`009`009writeln('If you would rather be customizing this room, type CUSTOM')
V;
X`009`009writeln;
X`009`009getobj(objnum);
X`009`009freeobj;
X`009`009if (obj.kind = O_MAGIC_RING) and not wizard then begin
X`009`009`009writeln ('That kind of object may be customized only by Monster
V Manager.');
X`009`009`009done := true;
X`009`009end else done := false;
X`009`009prompt := 'Custom object> ';
X`009`009while not done do begin
X- 2136, 2136
X`009`009`009`009s := bite(param)
X- 2140, 2289
X`009`009`009`009'?','h': command_help('*program help*');
X`009`009`009`009'q','e': done := true;
X`009`009`009`009'v': obj_view(objnum);
X`009`009`009`009'r': do_objrename(objnum,param);
X`009`009`009`009'c': begin
X`009`009`009`009`009getobj(objnum);
X`009`009`009`009`009freeobj;
X`009`009`009`009`009n := obj.actindx;
X`009`009`009`009`009`123 obj_owner is made getobjown `125
X`009`009`009`009`009`123 lookup_obj is made getobjnam `125
X`009`009`009`009`009custom_hook(n,objown.idents`091objnum`093,
X`009`009`009`009`009    trim_filename(
X`009`009`009`009`009`009objnam.idents`091objnum`093)
X`009`009`009`009`009    );
X`009`009`009`009`009getobj(objnum);
X`009`009`009`009`009obj.actindx := n;
X`009`009`009`009`009putobj;
X`009`009`009`009     end;
X`009`009`009`009'g': begin
X`009`009`009`009`009if param > '' then s := param
X`009`009`009`009`009else begin
X`009`009`009`009`009`009writeln('Enter * for no object');
X`009`009`009`009`009`009grab_line('Object required for GET? ',
X`009`009`009`009`009`009    s,eof_handler := leave);
X`009`009`009`009`009end;
X`009`009`009`009`009if s = '*' then begin
X`009`009`009`009`009`009getobj(objnum);
X`009`009`009`009`009`009obj.getobjreq := 0;
X`009`009`009`009`009`009putobj;
X`009`009`009`009`009end else if lookup_obj(n,s) then begin
X`009`009`009`009`009`009getobj(objnum);
X`009`009`009`009`009`009obj.getobjreq := n;
X`009`009`009`009`009`009putobj;
X`009`009`009`009`009`009writeln('Object modified.');
X`009`009`009`009`009end else
X`009`009`009`009`009`009writeln('No such object.');
X`009`009`009`009     end;
X`009`009`009`009'7': begin
X`009`009`009`009`009if param > '' then s := param
X`009`009`009`009`009else begin
X`009`009`009`009`009`009writeln('Enter * for no home.');
X`009`009`009`009`009`009writeln('Set home of object. ');
X`009`009`009`009`009`009grab_line('Home? ',s,
X`009`009`009`009`009`009    eof_handler := leave);
X`009`009`009`009`009end;
X`009`009`009`009`009if s = '*' then begin
X`009`009`009`009`009`009getobj(objnum);
X`009`009`009`009`009`009obj.home := 0;
X`009`009`009`009`009`009putobj;
X`009`009`009`009`009`009writeln('Object modified.');
X`009`009`009`009`009end else if lookup_room(n,s) then begin
X`009`009`009`009`009    gethere(n);
X`009`009`009`009`009    if (here.owner <> userid) and`032
X`009`009`009`009`009`009    (not owner_priv) then
X`009`009`009`009`009`009    writeln('Can''t set home to others room')
X`009`009`009`009`009    else begin
X`009`009`009`009`009`009getobj(objnum);
X`009`009`009`009`009`009obj.home := n;
X`009`009`009`009`009`009putobj;
X`009`009`009`009`009`009writeln('Object modified.');
X`009`009`009`009`009    end;
X`009`009`009`009`009end else writeln('No such room.');
X`009`009`009`009     end;
X`009`009`009`009'u': begin
X`009`009`009`009`009if param > '' then s := param
X`009`009`009`009`009else begin
X`009`009`009`009`009`009writeln('Enter * for no object');
X`009`009`009`009`009`009grab_line('Object required for USE? ',
X`009`009`009`009`009`009    s,eof_handler := leave);
X`009`009`009`009`009end;
X`009`009`009`009`009if s = '*' then begin
X`009`009`009`009`009`009getobj(objnum);
X`009`009`009`009`009`009obj.useobjreq := 0;
X`009`009`009`009`009`009putobj;
X`009`009`009`009`009end else if lookup_obj(n,s) then begin
X`009`009`009`009`009`009getobj(objnum);
X`009`009`009`009`009`009obj.useobjreq := n;
X`009`009`009`009`009`009putobj;
X`009`009`009`009`009`009writeln('Object modified.');
X`009`009`009`009`009end else
X`009`009`009`009`009`009writeln('No such object.');
X`009`009`009`009     end;
X`009`009`009`009'2': begin
X`009`009`009`009`009if param > '' then s := param
X`009`009`009`009`009else begin
X`009`009`009`009`009`009writeln('Enter * for no special place');
X`009`009`009`009`009`009grab_line('Place required for USE? ',
X`009`009`009`009`009`009    s,eof_handler := leave);
X`009`009`009`009`009end;
X`009`009`009`009`009if s = '*' then begin
X`009`009`009`009`009`009getobj(objnum);
X`009`009`009`009`009`009obj.uselocreq := 0;
X`009`009`009`009`009`009putobj;
X`009`009`009`009`009end else if lookup_room(n,s) then begin
X`009`009`009`009`009`009getobj(objnum);
X`009`009`009`009`009`009obj.uselocreq := n;
X`009`009`009`009`009`009putobj;
X`009`009`009`009`009`009writeln('Object modified.');
X`009`009`009`009`009end else
X`009`009`009`009`009`009writeln('No such object.');
X`009`009`009`009     end;
X`009`009`009`009's': begin
X`009`009`009`009`009getobj(objnum);
X`009`009`009`009`009obj.sticky := not(obj.sticky);
X`009`009`009`009`009putobj;
X`009`009`009`009`009if obj.sticky then
X`009`009`009`009`009`009writeln('The object will not be takeable.')
X`009`009`009`009`009else
X`009`009`009`009`009`009writeln('The object will be takeable.');
X`009`009`009`009     end;
X`009`009`009`009'a': begin
X`009`009`009`009`009writeln;
X`009  `009`009`009`009writeln('Select the article for your object:');
X`009`009`009`009`009writeln;
X`009`009`009`009`009writeln('0)`009None                ex: " You have taken
V Excalibur "');
X`009`009`009`009`009writeln('1)`009"a"                 ex: " You have taken
V a small box "');
X`009`009`009`009`009writeln('2)`009"an"                ex: " You have taken
V an empty bottle "');
X`009`009`009`009`009writeln('3)`009"some"              ex: " You have picked
V up some jelly beans "');
X`009`009`009`009`009writeln('4)     "the"               ex: " You have picke
Vd up the Scepter of Power"');
X`009`009`009`009`009writeln;
X`009`009`009`009`009grab_line('? ',s,eof_handler := leave);
X`009`009`009`009`009if isnum(s) then begin
X`009`009`009`009`009`009n := number(s);
X`009`009`009`009`009`009if n in `0910..4`093 then begin
X`009`009`009`009`009`009`009getobj(objnum);
X`009`009`009`009`009`009`009obj.particle := n;
X`009`009`009`009`009`009`009putobj;
X`009`009`009`009`009`009end else
X`009`009`009`009`009`009`009writeln('Out of range.');
X`009`009`009`009`009end else
X`009`009`009`009`009`009writeln('No changes.');
X`009`009`009`009     end;
X`009`009`009`009'k': begin
X`009`009`009`009`009prog_kind(objnum);
X`009`009`009`009     end;
X`009`009`009`009'p': begin
X`009`009`009`009`009prog_obj(objnum);
X`009`009`009`009     end;
X`009`009`009`009'd': begin
X`009`009`009`009`009newdsc := obj.examine;
X`009`009`009`009`009writeln('`091 Editing the description of the object `093
V');
X`009`009`009`009`009if edit_desc(newdsc) then begin
X`009`009`009`009`009`009getobj(objnum);
X`009`009`009`009`009`009obj.examine := newdsc;
X`009`009`009`009`009`009putobj;
X`009`009`009`009`009end;
X`009`009`009`009     end;
X`009`009`009`009'x': begin
X`009`009`009`009`009newdsc := obj.d1;
X`009`009`009`009`009writeln('`091 Editing extra description #1 `093');
X`009`009`009`009`009if obj.kind = O_WEAPON then`032
X                                          WriteLn ('Victim sees this. ',
X`009`009`009`009`009`009'# attacks you.')
X`009`009`009`009`009else if obj.kind = O_TRAP then
X`009`009    `009`009`009  writeln ('Others see this. ',
X`009`009`009`009`009`009'# tries to get a trap.');
X                                        if edit_desc(newdsc) then begin
X`009`009`009`009`009`009getobj(objnum);
X`009`009`009`009`009`009obj.d1 := newdsc;
X`009`009`009`009`009`009putobj;
X`009`009`009`009`009end;
X`009`009`009`009     end;
X`009`009`009`009'5': begin
X`009`009`009`009`009newdsc := obj.d2;
X`009`009`009`009`009writeln('`091 Editing extra description #2 `093');
X`009`009`009`009`009if obj.kind = O_WEAPON then
X                                          WriteLn ('Others see this. ',
X`009`009`009`009`009`009'# is attacker.');
X                                        if edit_desc(newdsc) then begin
X`009`009`009`009`009`009getobj(objnum);
X`009`009`009`009`009`009obj.d2 := newdsc;
X`009`009`009`009`009`009putobj;
X`009`009`009`009`009end;
X`009`009`009`009     end;
X`009`009`009`009'f': begin
X`009`009`009`009`009newdsc := obj.getfail;
X`009`009`009`009`009writeln('`091 Editing the get failure description `093')
V;
X`009`009`009`009`009if edit_desc(newdsc) then begin
X`009`009`009`009`009`009getobj(objnum);
X`009`009`009`009`009`009obj.getfail := newdsc;
X`009`009`009`009`009`009putobj;
X`009`009`009`009`009end;
X`009`009`009`009     end;
X`009`009`009`009'1': begin
X`009`009`009`009`009newdsc := obj.getsuccess;
X`009`009`009`009`009writeln('`091 Editing the get success description `093')
V;
X`009`009`009`009`009if edit_desc(newdsc) then begin
X`009`009`009`009`009`009getobj(objnum);
X`009`009`009`009`009`009obj.getsuccess := newdsc;
X`009`009`009`009`009`009putobj;
X`009`009`009`009`009end;
X`009`009`009`009     end;
X`009`009`009`009'3': begin
X`009`009`009`009`009newdsc := obj.usefail;
X`009`009`009`009`009writeln('`091 Editing the use failure description `093')
V;
X`009`009`009`009`009if edit_desc(newdsc) then begin
X`009`009`009`009`009`009getobj(objnum);
X`009`009`009`009`009`009obj.usefail := newdsc;
X`009`009`009`009`009`009putobj;
X`009`009`009`009`009end;
X`009`009`009`009     end;
X`009`009`009`009'6': begin
X`009`009`009`009`009newdsc := obj.homedesc;
X`009`009`009`009`009writeln('`091 Editing the home description `093');
X`009`009`009`009`009if edit_desc(newdsc) then begin
X`009`009`009`009`009`009getobj(objnum);
X`009`009`009`009`009`009obj.homedesc := newdsc;
X`009`009`009`009`009`009putobj;
X`009`009`009`009`009end;
X`009`009`009`009     end;
X`009`009`009`009'4': begin
X`009`009`009`009`009newdsc := obj.usesuccess;
X`009`009`009`009`009writeln('`091 Editing the use success description `093')
V;
X`009`009`009`009`009if obj.kind = O_WEAPON then
X`009`009`009`009`009`009writeln ('# is victim.');
X`009`009`009`009`009if edit_desc(newdsc) then begin
X`009`009`009`009`009`009getobj(objnum);
X`009`009`009`009`009`009obj.usesuccess := newdsc;
X`009`009`009`009`009`009putobj;
X`009`009`009`009`009end;
X`009`009`009`009     end;
X`009`009`009`009'l': begin
X`009`009`009`009`009writeln('Enter a one line description of what the object
V will look like in any room.');
X`009`009`009`009`009writeln('Example: "There is an as yet unknown object her
Ve."');
X`009`009`009`009`009writeln;
X`009`009`009`009`009getobj(objnum);
X`009`009`009`009`009freeobj;
X`009`009`009`009`009n := obj.linedesc;
X`009`009`009`009`009make_line(n);
X`009`009`009`009`009getobj(objnum);
X`009`009`009`009`009obj.linedesc := n;
X`009`009`009`009`009putobj;
X- 2293, 2350
X`009`009end;
X`009`009log_event(myslot,E_OBJDONE,objnum,0);
X
X`009end else
X`009`009writeln('You are not allowed to program that object.');
X`009end else
X`009`009writeln('There is no object by that name.');
X`009end;
X`009exit_label:
Xend;
X
X`123 -----------------------------------------------------------------------
V---- `125
X`091global`093 PROCEDURE type_paper;
Xvar c_file: text;
X    count,errorcode: integer;
X    line: string;
X    continue: boolean;
X
X    procedure leave;
X    begin
X`009writeln('EXIT');
X`009line  := '-';
X    end;
X
Xbegin
X   open(c_file,root+'COMMANDS.PAPER',HISTORY := READONLY,
X      sharing := READONLY ,error := continue);
X   errorcode := status(c_file);
X   if errorcode > 0 then begin
X      case errorcode of
X`0093: `123 PAS$K_FILNOTFOU `125 writeln('%File COMMANDS.PAPER not found.');
X`009otherwise writeln('%Can''t open file COMMANDS.PAPER, error code (status)
V: ',
X`009    errorcode:1);
X      end; `123 case `125
X      writeln('% Notify Monster Manager.');
X   end else begin
X      reset(c_file);
X      count := 0;
X      continue := true;
X      while not eof(c_file) and continue do begin
X         readln(c_file,line);
X         writeln(line);
X         count := count +1;
X         if count > terminal_page_len -2 then begin
X            grab_line('-more-',line,,true,eof_handler := leave);
X            continue := line = '';
X            count := 0;
X         end;
X      end;
X      close(c_file);
X   end;
Xend; `123 type_paper `125
X
Xprocedure do_y_altmsg;
Xvar
X`009newdsc: integer;
X
Xbegin
X`009if is_owner then begin
X`009`009gethere;
X`009`009newdsc := here.xmsg2;
X`009`009writeln('`091 Editing the alternate mystery message for this room `0
V93');
X`009`009if edit_desc(newdsc) then begin
X`009`009`009getroom;
X`009`009`009here.xmsg2 := newdsc;
X`009`009`009putroom;
X`009`009end;
X- 2354, 2366
X
Xprocedure do_group1;
Xlabel exit_label;
Xvar
X`009grpnam: string;
X`009loc: integer;
X`009tmp: string;
X- 2370, 2370
X`009writeln('EXIT - No changes.');
X- 2374, 2419
X`009
Xbegin
X`009if is_owner then begin
X`009`009gethere;
X`009`009if here.grploc1 = 0 then
X`009`009`009writeln('No primary group location set')
X`009`009else begin
X`009`009`009getnam;
X`009`009`009freenam;
X`009`009`009writeln('The primary group location is ',nam.idents`091here.grpl
Voc1`093,'.');
X`009`009`009writeln('Descriptor string: `091',here.grpnam1,'`093');
X`009`009end;
X`009`009writeln;
X`009`009writeln('Type * to turn off the primary group location');
X`009`009grab_line('Room name of primary group? ',grpnam,
X`009`009    eof_handler := leave);
X`009`009if length(grpnam) = 0 then
X`009`009`009writeln('No changes.')
X`009`009else if grpnam = '*' then begin
X`009`009`009getroom;
X`009`009`009here.grploc1 := 0;
X`009`009`009putroom;
X`009`009end else if lookup_room(loc,grpnam) then begin
X`009`009`009writeln('Enter the descriptive string.  It will be placed after
V player names.');
X`009`009`009writeln('Example:  Monster Manager is `091descriptive string, in
Vstead of "here."`093');
X`009`009`009writeln;
X`009`009`009grab_line('Enter string? ',tmp,
X`009`009`009    eof_handler := leave);
X`009`009`009if length(tmp) > shortlen then begin
X`009`009`009`009writeln('Your string was truncated to ',shortlen:1,' charact
Vers.');
X`009`009`009`009tmp := substr(tmp,1,shortlen);
X`009`009`009end;
X`009`009`009getroom;
X`009`009`009here.grploc1 := loc;
X`009`009`009here.grpnam1 := tmp;
X`009`009`009putroom;
X`009`009end else
X`009`009`009writeln('No such room.');
X- 2423, 2435
X
Xprocedure do_group2;
Xlabel exit_label;
Xvar
X`009grpnam: string;
X`009loc: integer;
X`009tmp: string;
X- 2439, 2439
X`009writeln('EXIT - No changes.');
X- 2444, 2502
X`009if is_owner then begin
X`009`009gethere;
X`009`009if here.grploc2 = 0 then
X`009`009`009writeln('No secondary group location set')
X`009`009else begin
X`009`009`009getnam;
X`009`009`009freenam;
X`009`009`009writeln('The secondary group location is ',nam.idents`091here.gr
Vploc2`093,'.');
X`009`009`009writeln('Descriptor string: `091',here.grpnam2,'`093');
X`009`009end;
X`009`009writeln;
X`009`009writeln('Type * to turn off the secondary group location');
X`009`009grab_line('Room name of secondary group? ',grpnam,
X`009`009    eof_handler := leave);
X`009`009if length(grpnam) = 0 then
X`009`009`009writeln('No changes.')
X`009`009else if grpnam = '*' then begin
X`009`009`009getroom;
X`009`009`009here.grploc2 := 0;
X`009`009`009putroom;
X`009`009end else if lookup_room(loc,grpnam) then begin
X`009`009`009writeln('Enter the descriptive string.  It will be placed after
V player names.');
X`009`009`009writeln('Example:  Monster Manager is `091descriptive string, in
Vstead of "here."`093');
X`009`009`009writeln;
X`009`009`009grab_line('Enter string? ',tmp,
X`009`009`009    eof_handler := leave);
X`009`009`009if length(tmp) > shortlen then begin
X`009`009`009`009writeln('Your string was truncated to ',shortlen:1,' charact
Vers.');
X`009`009`009`009tmp := substr(tmp,1,shortlen);
X`009`009`009end;
X`009`009`009getroom;
X`009`009`009here.grploc2 := loc;
X`009`009`009here.grpnam2 := tmp;
X`009`009`009putroom;
X`009`009end else
X`009`009`009writeln('No such room.');
X`009end;
X    exit_label:
Xend;
X
X`123 custom MONSTER --------------------------------------------------------
V---- `125
X
Xprocedure view2_monster(mid: integer);
Xbegin
X    getpers;
X    freepers;
X    writeln('Monster     : ',pers.idents`091mid`093);
X    getint(N_EXPERIENCE);
X    freeint;
X    writeln(' experience : ',anint.int`091mid`093:1);
X    writeln(' level      : ',leveltable`091level(anint.int`091mid`093)`093.n
Vame);
X    getint(N_HEALTH);
X    freeint;
X    writeln(' health     : ',anint.int`091mid`093:1);
X    getint(N_PRIVILEGES);
X    freeint;
X    write  (' privileges : '); list_privileges(uint(anint.int`091mid`093));
X    writeln;
X    getint(N_SELF);
X    freeint;
X    if (anint.int`091mid`093 = 0) or (anint.int`091mid`093 = DEFAULT_LINE) t
Vhen
X`009writeln('Monster haven''t the self-description.')
X    else print_desc(anint.int`091mid`093);
Xend; `123 view2_monster `125
X
Xprocedure lister(code: integer);
Xlabel 0; `123 out `125
Xvar count: integer;
X- 2506, 2506
X`009writeln('EXIT');
X`009goto 0;
X    end;
X
X
X    procedure print(l: mega_string);
X    var s: string;
X    begin
X`009writeln(l);
X`009count := count +1;
X`009if count > terminal_page_len -2 then begin
X`009    grab_line('-more-',s,erase := true,eof_handler := leave);
X`009    if s > '' then goto 0;
X`009    count := 0;
X`009end;
X    end; `123 print `125
X
Xbegin
X    count := 0;
X    list_program(code,print,terminal_line_len);
X    0:
Xend; `123 lister `125
X
Xprocedure lister_2(code: integer; param: string);
Xlabel exit_label;
Xvar list_file: text;
X    name: string;
X    counter,errorcode: integer;
X    s: string;
X
X    procedure print(l: mega_string);
X    begin
X`009counter := counter + 1;
X`009if (counter mod 50) = 0 then checkevents(TRUE);
X`009writeln(list_file,l);
X    end; `123 print `125
X
X    procedure leave;
X    begin
X`009writeln('EXIT');
X- 2511, 2563
X    counter := 0;
X    if param = '' then begin
X`009writeln('File name for listing ?');
X`009writeln('Default: MDL.LIS');
X`009grab_line('File name? ',s,eof_handler := leave);
X    end else s := param;
X    open(list_file,s,new,default := 'MDL.LIS',error := continue);
X    errorcode := status(list_file);
X    if errorcode > 0 then case errorcode of
X`0094: `123 PAS$K_INVFILSYN `125 writeln('Illegal file name.');
X`009otherwise writeln('Can''t open file for writing, error code (status): ',
X`009    errorcode:1)
X    end `123case `125
X    else begin
X`009rewrite(list_file);
X`009list_program(code,print,terminal_line_len);
X`009close(list_file);
X    end;
X    exit_label:
Xend; `123 lister_2 `125
X              `032
XPROCEDURE custom_monster; `123 (name: string); forward; `125
Xlabel exit_label;
Xvar s,param,def: string;
X    done,ok: boolean;
X    mid,mslot,code,self,oldloc,old: integer;
X    mname: shortstring;    `032
X    notice: shortstring;
X    lev,max,value,health,exp,i: integer;
X    prevloc: integer;
X- 2567, 2567
X`009writeln('EXIT');
X        log_event (myslot,E_MONSTERDONE,0,0,'');
X- 2571, 2607
X
Xbegin
X  oldloc := location;
X  if not is_owner(location,TRUE) then `123 is_owner make gethere `125
X     writeln('You must be in one of your own rooms to customize a monster.')
X  else if name = '' then writeln('To customize a monster, type CUSTOM MONSTE
VR <monster name>.')
X  else if parse_pers(mslot,name) then begin
X
X     mname := here.people`091mslot`093.name;
X     def := trim_filename(mname);
X
X     if exact_pers(mid,mname) then begin   `032
X        if here.people`091mslot`093.kind = P_MONSTER then begin
X           code := here.people`091mslot`093.parm;
X           if (monster_owner(code) = userid) or owner_priv then begin
X              log_action (e_custommonster,0);
X              done := false;
X              repeat
X`009`009prevloc := location;
X                grab_line ('Custom monster> ',s,eof_handler := leave);
X                param := lowcase(s);
X`009`009s := bite(param);
X                getint(N_LOCATION);
X                freeint;
X`009`009if prevloc <> location then begin
X`009`009   writeln('You can no longer customize this monster.');
X                   done := true;
X                end else if anint.int`091mid`093 <> location then begin
X                   writeln ('Monster is no longer here.');
X                   done := true
X                end else if s > '' then case s`0911`093 of
X                  'h','?': command_help('*monster help*');
X                  'a'    : begin`032
X                             lev := level(myexperience);
X`009`009`009     if lev = levels then max := maxexperience
X`009`009`009     else if leveltable`091lev+1`093.exp > maxexperience then
X`009`009`009`009 max := maxexperience
X`009`009`009     else max := leveltable`091lev+1`093.exp -1;
X                             if param > '' then s := param
X                             else begin
X                                write('Give monster''s level ');
X                                write(leveltable`0911`093.name,' - ');
X`009`009`009`009writeln(leveltable`091lev`093.name);
X`009`009`009`009writeln('or experience 0 - ',max:1,'.');
X                                grab_line('Level or experience? ',s,
X`009`009`009`009    eof_handler := leave);
X                             end;
X`009`009`009     value := -1;
X                             if lookup_level(value,s) then begin
X`009`009`009`009 value := leveltable`091value`093.exp;
X`009`009`009     end else if isnum(s) then begin
X`009`009`009`009 value := number(s);
X`009`009`009`009 if (value < 0) or (value > max) then begin
X`009`009`009`009     writeln('Out of range.');
X`009`009`009`009     value := -1;
X`009`009`009`009 end;
X`009`009`009     end else begin
X`009`009`009`009 writeln('Not such level or experience.');
X`009`009`009`009 value := -1
X`009`009`009     end;
X`009`009`009     if userid <> MM_userid then begin
X`009`009`009`009if leveltable`091level(value)`093.hidden and`032
X`009`009`009`009    (level(value) <> lev) then begin
X`009`009`009`009    writeln('You can give only your own hidden level.');
X`009`009`009`009    value := -1;
X`009`009`009`009end else if level(value) > lev then begin
X`009`009`009`009    writeln('Not allowed.');
X`009`009`009`009    value := -1;
X`009`009`009`009end;
X`009`009`009    end;
X`009`009`009    if value >= 0 then begin
X`009`009`009`009exp := value;`032
X                                lev := level(value);
X                                health := leveltable`091lev`093.health * goo
Vdhealth`032
X                                   div 10;
X         `032
X                                getroom;
X                                here.people`091mslot`093.health := health;
X                                here.people`091mslot`093.experience := exp;
X                                putroom;
X                                getint(N_HEALTH);
X                                anint.int`091mid`093 := health;
X                                putint;
X                                getint(N_EXPERIENCE);
X                                anint.int`091mid`093 := exp;
X                                putint;
X                                writeln('Monster''s experience is now ',exp:
V1);
X                                writeln('and health is ',health:1);
X                             end;
X                           end;
X`009`009  'i'    : begin
X`009`009`009     getint(N_EXPERIENCE);
X`009`009`009     freeint;
X`009`009`009     lev := level(anint.int`091mid`093);
X`009`009`009     max := leveltable`091lev`093.health;
X`009`009`009     if param > '' then s := param
X`009`009`009     else begin
X`009`009`009`009writeln('Give monster''s health 0 - ',max:1);
X`009`009`009`009grab_line('Health? ',s,eof_handler := leave);
X`009`009`009    end;
X`009`009`009    if not isnum(s) then
X`009`009`009`009writeln('Not such value.')
X`009`009`009    else if (number(s) < 0) or (number(s) > max) then
X`009`009`009`009writeln('Out of range.')
X`009`009`009    else begin
X`009`009`009`009health := number(s);
X                                getroom;
X                                here.people`091mslot`093.health := health;
X                                putroom;
X                                getint(N_HEALTH);
X                                anint.int`091mid`093 := health;
X                                putint;
X`009`009`009`009writeln('Database updated.');
X`009`009`009    end;
X`009`009`009end;
X                  'b'    : set_runnable(code,false);
X                  'c'    : type_paper;
X                  'd'    : begin
X                             getint(N_PRIVILEGES);
X                             freeint;
X                             value := anint.int`091mid`093;
X                             if custom_privileges(value,
X`009`009`009`009read_cur_priv) then begin
X                                getint(N_PRIVILEGES);
X                                anint.int`091mid`093 := value;
X                                putint;
X                                writeln('Database updated.');
X                             end else writeln('Database not updated.');
X                           end;
X                  'p'    : if monster_priv then monsterpriv(code)
X                           else writeln ('This command is for Monster Manage
Vr.');
X                  'f'    : set_runnable(code,true);
X                  'v'    : begin
X`009`009`009       view2_monster(mid);
X`009`009`009       grab_line('-more-',s,erase := true,
X`009`009`009`009    eof_handler := leave);
X`009`009`009       if s = '' then view_monster(code);
X`009`009`009   end;
X                  'm'    : begin
X                             if param > '' then s := param
X                             else grab_line('Label? ',s,eof_handler := leave
V);
X                             if s > '' then begin
X                                if length(s) > shortlen then
X                                  s := substr(s,1,shortlen);
X                                if not run_monster(mname,code,s,'','',
X                                   sysdate+' '+systime)
X                                   then writeln ('Label not found or monster
V is dead.');
X                                if oldloc <> location then begin
X                                   writeln('You are no longer customizing mo
Vnster.');
X                                   done := true;
X                                end;
X                             end;
X                           end;
X                  'g'    : begin
X                             if param > '' then s := param
X                             else begin
X`009`009`009`009writeln('Default: ',def);
X`009`009`009`009grab_line('File name? ',s,eof_handler := leave);
X`009`009`009     end;
X`009`009`009     load(code,s,sysdate+' '+systime,userid,def);
X`009`009`009     getint(N_PRIVILEGES);
X`009`009`009     value := anint.int`091mid`093;
X`009`009`009     anint.int`091mid`093 := 0;
X`009`009`009     putint;
X`009`009`009     if value <> 0 then writeln('Monster''s privilege set is now
V empty.');
X                           end;
X`009`009  'j'    : begin
X`009`009`009     if get_flag(code,CF_NO_CONTROL) then begin
X`009`009`009`009set_flag(code,CF_NO_CONTROL,false);
X`009`009`009`009getint(N_PRIVILEGES);
X`009`009`009`009value := anint.int`091mid`093;
X`009`009`009`009anint.int`091mid`093 := 0;
X`009`009`009`009putint;
X`009`009`009`009if value <> 0 then writeln('Monster''s pprivilege set is now
V empty.');
X`009`009`009     end else set_flag(code,CF_NO_CONTROL,TRUE);
X`009`009`009     writeln('Databse updated.');
X`009`009`009   end;
X                  's'    : begin
X                             writeln ('Edit monster self description');
X                             getint(N_SELF);
X                             freeint;
X                             self := anint.int`091mid`093;
X                             if edit_desc(self) then begin
X                                getroom;
X                                here.people`091mslot`093.self := self;
X                                putroom;
X                                getint(N_SELF);
X                                anint.int`091mid`093 := self;
X                                putint;
X                             end;
X                           end;
X                  'l'    : lister (code);
X`009`009  'o'`009 : lister_2 (code,param);
X                  'n'    : begin
X                              if param > '' then s := param
X                              else grab_line ('New name? ',s,eof_handler :=
V leave);
X                              if s = '' then writeln ('No changes')
X                              else if length(s) > shortlen then
X                                 writeln('Limit new name to ',shortlen:1,' c
Vharacters.')
X                              else if lowcase(s) = 'monster manager' then
X                                 writeln ('That name is reserved for the Mon
Vster Manager.')
X                              else begin
X                                 if exact_pers(old,s) then
X                                    if old = mid then ok := true
X                                    else begin
X                                       ok := false;
X                                       writeln ('Someone already has that na
Vme.');
X                                    end
X                                 else ok := true;
X                                 if ok then begin
X                                    getroom;
X                                    notice := here.people`091mslot`093.name;
X                                    here.people`091mslot`093.name := s;
X                                    putroom;
X                                    getpers;
X                                    pers.idents`091mid`093 := s;
X                                    putpers;
X                                    mname := s;
X                                    log_event(0,E_SETNAM,0,0,notice+' is now
V known as ' + s);
X                                 end
X                              end;
X                           end;
X                  'e','q': done := true;
X                   otherwise writeln ('Enter ? for help.');
X                end; `123 case `125
X              until done;               `032
X              log_event (myslot,E_MONSTERDONE,0,0,'');
X           end else writeln ('You are not the owner of this monster.');
X        end else writeln ('You can only customize monsters.');
X     end else writeln ('%serius error in custom_monster. Notify monster mana
Vger.');
X  end else writeln ('That monster isn''t here.');
X   exit_label:
X
Xend;`009`123 custom_monster `125
X
X`123 custom HOOK -----------------------------------------------------------
V---- `125
X
XPROCEDURE custom_hook `123(var code: integer; owner: shortstring;
X`009`009`009default: string := '.MDL')`125;
Xlabel exit_label;
Xvar done: boolean;
X    s,param: string;
X- 2611, 2611
X`009writeln('EXIT');
X- 2615, 2744
X
Xbegin
X  if code = 0 then begin `123 alloc code `125
X     if alloc_general(I_HEADER,code) then begin
X        create_program (code,owner,sysdate+' '+systime);
X        writeln ('New hook created.');
X     end else begin
X        writeln ('There is no place for any more hooks in this universe.');
X        code := 0
X     end;
X  end;
X  if code > 0 then begin
X     done := false;
X     repeat
X        grab_line ('Custom hook> ',s,eof_handler := leave);
X        param := lowcase(s);
X`009s := bite(param);
X        if s > '' then case s`0911`093 of
X           'h','?': command_help('*hook help*');
X           'b'    : set_runnable(code,false);
X           'c'    : type_paper;
X           'p'    : if monster_priv then monsterpriv(code)
X                    else writeln ('This command is for Monster Manager.');
X           'f'    : set_runnable(code,true);
X           'v'    : view_monster(code);
X           'm'    : begin
X                       if param > '' then s := param
X                       else grab_line('Label? ',s,eof_handler := leave);
X                       if s > '' then begin
X                          if length(s) > shortlen then
X                             s := substr(s,1,shortlen);
X                          if not run_monster('',code,s,'','',
X                             sysdate+' '+systime)
X                             then writeln ('Label not found.');
X                       end;
X                    end;
X           'g'    : begin
X                       if param > '' then s := param
X                       else begin
X`009`009`009    writeln('Default: ',default);
X`009`009`009    grab_line('File name? ',s,eof_handler := leave);
X`009`009       end;
X`009`009       load(code,s,sysdate+' '+systime,userid,default);
X                    end;                      `032
X           'l'    : lister (code);
X`009   'o'`009  : lister_2 (code,param);
X           'e','q': done := true;
X           'd'    : begin
X                       delete_program(code);
X                       delete_general(I_HEADER,code);
X                       done := true;
X                       code := 0;
X                       writeln ('Hook deleted.');
X                    end;
X           otherwise writeln ('Enter ? for help.');
X       end; `123 case `125
X     until done;
X  end;
X  exit_label:
Xend;
X
X`123 custom SPELL ----------------------------------------------------------
V----- `125
X
X`091global`093 PROCEDURE custom_spell(s: string);
Xlabel exit_label;
X
Xvar done: boolean;
X    param: string;
X    code: integer; owner: shortstring;
X    default: string;
X- 2748, 2749
X`009writeln('EXIT');
X`009log_event(myslot,E_SPELLDONE,0,0,'');
X- 2753, 3034
X    var new: boolean;
X`009sid,player: integer;
Xbegin
X  if (s = '') or (s = '?') then`032
X    writeln('Use SET SPELL <spell name> to customize spell.')
X  else begin
X    new := not lookup_spell(sid,s);
X `032
X    if new then begin
X`009code := 0;
X`009if alloc_general(I_SPELL,sid) then begin
X`009    getspell_name;
X`009    spell_name.idents`091sid`093 := s;
X`009    putspell_name;
X
X`009    if alloc_general(I_HEADER,code) then begin
X`009`009create_program (code,userid,sysdate+' '+systime);
X`009`009getint(N_SPELL);
X`009`009anint.int`091sid`093 := code;
X`009`009putint;
X
X`009`009getindex(I_PLAYER);
X`009`009freeindex;
X`009`009for player := 1 to indx.top do if not indx.free`091player`093 then
X`009`009    begin
X`009`009`009getspell(player);
X`009`009`009spell.level`091sid`093 := 0;
X`009`009`009putspell;
X`009`009    end;
X`009`009writeln ('New spell created.');
X`009`009       `009`009
X`009    end else begin
X`009`009writeln ('There is no place for any more spell codes in this univers
Ve.');
X`009`009code := 0;
X`009`009getspell_name;
X`009`009spell_name.idents`091sid`093 := '';
X`009`009putspell_name;
X`009`009delete_general(I_SPELL,sid);
X`009    end;
X`009end else writeln('There is no place for any more spells in this universe
V.');
X
X    end else begin
X`009getint(N_SPELL);
X`009freeint;
X`009code := anint.int`091sid`093;
X
X`009if not is_spell_owner(sid) then
X`009    begin
X`009`009writeln('You haven''t owner of this spell.');
X`009`009code := 0;
X`009    end;
X    end;
X
X    if code > 0 then begin
X       getspell_name;
X       freespell_name;
X       default := trim_filename(spell_name.idents`091sid`093);
X       log_action(e_customspell,0);
X
X       done := false;
X       repeat
X        grab_line ('Custom spell> ',s,eof_handler := leave);
X        param := lowcase(s);
X`009s := bite(param);
X        if s > '' then case s`0911`093 of
X           'h','?': command_help('*spell help*');
X           'b'    : set_runnable(code,false);
X           'c'    : type_paper;
X           'p'    : if monster_priv then monsterpriv(code)
X                    else writeln ('This command is for Monster Manager.');
X           'f'    : set_runnable(code,true);
X           'v'    : view_monster(code);
X           'm'    : begin
X                       if param > '' then s := param
X                       else grab_line('Label? ',s,eof_handler := leave);
X                       if s > '' then begin
X                          if length(s) > shortlen then
X                             s := substr(s,1,shortlen);
X                          if not run_monster('',code,s,'','',
X                             sysdate+' '+systime)
X                             then writeln ('Label not found.');
X                       end;
X                    end;
X           'g'    : begin
X                       if param > '' then s := param
X                       else begin
X`009`009`009    writeln('Default: ',default);
X`009`009`009    grab_line('File name? ',s,eof_handler := leave);
X`009`009       end;
X`009`009       if get_flag(code, CF_SPELL_MODE) then`032
X`009`009`009    set_flag(code, CF_SPELL_MODE,FALSE);
X`009`009       load(code,s,sysdate+' '+systime,userid,default);
X                    end;                      `032
X           'l'    : lister (code);
X`009   'o'`009  : lister_2 (code,param);
X           'e','q': done := true;
X           'd'    : begin
+-+-+-+-+-+-+-+-  END  OF PART 3 +-+-+-+-+-+-+-+-