home *** CD-ROM | disk | FTP | other *** search
- 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 10/32
- Keywords: Monster, a multiplayer adventure game
- Message-ID: <1992Jun14.004836.3978@klaava.Helsinki.FI>
- Date: 14 Jun 92 00:48:36 GMT
- Sender: hurtta@klaava.Helsinki.FI (Kari Hurtta)
- Followup-To: vmsnet.sources.d
- Organization: University of Helsinki
- Lines: 1217
-
- Archieve-name: monster_helsinki_104/part10
- Author: Kari.Hurtta@Helsinki.FI
- Product: Monster Helsinki V 1.04
- Environment: VMS, Pascal
- Part: 10/32
-
- -+-+-+-+-+-+-+-+ START OF PART 10 -+-+-+-+-+-+-+-+
- 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`009`009`009`009 end;
- X`009`009`009`009otherwise writeln('-- Bad command, type ? for a list');
- X`009`009`009end;
- 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`009end;
- Xend;
- X
- X
- Xprocedure do_group1;
- Xlabel exit_label;
- Xvar
- X`009grpnam: string;
- X`009loc: integer;
- X`009tmp: string;
- X
- X procedure leave;
- X begin
- X`009writeln('EXIT - No changes.');
- X`009goto exit_label;
- X end;
- X
- 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`009end;
- X exit_label:
- Xend;
- X
- Xprocedure do_group2;
- Xlabel exit_label;
- Xvar
- X`009grpnam: string;
- X`009loc: integer;
- X`009tmp: string;
- X
- X procedure leave;
- X begin
- X`009writeln('EXIT - No changes.');
- X`009goto exit_label;
- X end;
- X
- Xbegin
- 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
- X procedure leave;
- X begin
- 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`009goto exit_label;
- X end;
- X
- Xbegin
- 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
- X procedure leave;
- X begin
- X`009writeln('EXIT');
- X log_event (myslot,E_MONSTERDONE,0,0,'');
- X`009goto exit_label;
- X end;
- X
- 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
- X procedure leave;
- X begin
- X`009writeln('EXIT');
- X`009goto exit_label;
- X end;
- X
- 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
- X procedure leave;
- X begin
- X`009writeln('EXIT');
- X`009log_event(myslot,E_SPELLDONE,0,0,'');
- X`009goto exit_label;
- X end;
- X
- 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
- X delete_program(code);
- X delete_general(I_HEADER,code);
- X
- X`009`009 getspell_name;
- X`009`009 spell_name.idents`091sid`093 := '';
- X`009`009 putspell_name;
- X`009`009 getint(N_SPELL);
- X`009`009 anint.int`091sid`093 := 0;
- X`009`009 putint;
- X
- X`009`009 delete_general(I_SPELL,sid);
- X done := true;
- X code := 0;
- X writeln ('Spell deleted.');
- X end;
- X`009`009'i': begin
- X if param > '' then s := param
- X else begin
- X`009`009`009 writeln('Seting your level of this spell.');
- X`009`009`009 grab_line('Level? ',s,eof_handler := leave);
- X`009`009 end;
- X`009`009`009
- X`009`009 if isnum(s) then begin
- X`009`009`009 if number(s) < 0 then writeln('Must be positive or zero.')
- X`009`009`009 else begin
- X`009`009`009 getspell(mylog);
- X`009`009`009 spell.level`091sid`093 := number(s);
- X`009`009`009 putspell;
- X`009`009`009 writeln('Database modified');
- X`009`009`009end;
- X`009`009 end else writeln('Invalid number.');
- X`009`009`009`032
- X`009`009 end;
- X 'a'`009 : if get_flag(code, CF_SPELL_MODE) then`032
- X`009`009`009set_flag(code, CF_SPELL_MODE,FALSE)
- X`009`009 else if not spell_priv then`032
- X`009`009`009writeln('You haven''t power for this.')
- X`009`009 else set_flag(code, CF_SPELL_MODE,TRUE);
- X otherwise writeln ('Enter ? for help.');
- X end; `123 case `125
- X until done;
- X log_event (myslot,E_SPELLDONE,0,0,'');
- X end;
- X end;
- X exit_label:
- Xend;
- X
- X`123 Global Code -----------------------------------------------------------
- V---- `125
- X
- X`091global`093 procedure exec_global(flag: integer; label_name: shortstring;
- V`032
- X`009force_read: boolean := false; variable: shortstring := '';
- X`009value: mega_string := '');
- Xvar code: integer;
- Xbegin
- X if Gf_Types `091 flag`093 <> G_code then begin
- X`009writeln('%Error in exec_global:');
- X writeln('%Global value #',flag:1,' isn''t global MDL code');
- X`009writeln('%Notify Monster Manager.');
- X`009code := 0;
- X end else begin
- X`009if read_global or force_read then begin
- X`009 getglobal;
- X`009 freeglobal;
- X`009 read_global := false;
- X`009end;
- X`009code := global.int`091flag`093;
- X end;
- X
- X if code <> 0 then`032
- X`009run_monster(monster_name := '',
- X`009`009 code := code,
- X`009`009 label_name := label_name,
- X`009`009 variable := variable,
- X`009`009 value := value,
- X`009`009 time := sysdate + ' ' + systime);
- X
- Xend; `123 exec_global `125
- X
- XPROCEDURE custom_g_code(var code: integer);
- Xlabel exit_label;
- X
- Xvar done: boolean;
- X param: string;
- X default,s: string;
- X
- X procedure leave;
- X begin
- X`009writeln('EXIT');
- X`009goto exit_label;
- X end;
- X
- Xbegin
- X if code = 0 then begin
- X`009if alloc_general(I_HEADER,code) then begin
- X`009 create_program (code,system_id,sysdate+' '+systime);
- X
- X`009 writeln ('New global MDL code created.');
- X`009`009 `009`009
- X`009end else begin
- X`009 writeln ('There is no place for any more codes in this universe.');
- X`009 code := 0;
- X`009end;
- X end;
- X
- X if code > 0 then begin
- X default := 'GLOBAL_CODE';
- X
- X done := false;
- X repeat
- X grab_line ('Custom global code> ',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('*global c help*');
- X 'b' : set_runnable(code,false);
- X 'c' : type_paper;
- 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
- X code := 0;
- X writeln ('Code deleted.');
- X`009`009 done := true;
- X end;
- X otherwise writeln ('Enter ? for help.');
- X end; `123 case `125
- X until done;
- X end;
- X exit_label:
- Xend;
- X
- X`091global`093 procedure custom_global_code(code: integer);
- Xvar val,lcv: integer;
- Xbegin
- X if GF_Types`091code`093 <> G_code then begin
- X`009writeln('%Error in custom_global_code:');
- X`009writeln('%Global item #',code:1,' isn''t global MDL code.');
- X`009writeln('%Notify Monster Manager.');
- X end else begin
- X`009case code of
- X`009 GF_CODE: writeln('Customize global hook.');
- X`009 otherwise writeln('Edit global code #',code:1,' (unknown).');
- X`009end; `123 case `125
- X`009getglobal; freeglobal;
- X`009val := global.int`091code`093;
- X`009custom_g_code(val);
- X`009getglobal;
- X`009global.int`091code`093 := val;
- X`009putglobal;
- X`009read_global := false;
- X writeln('Database is updated.');
- X`009for lcv :=1 to numevnts do log_event(0,E_GLOBAL_CHANGE,0,0,'',lcv);
- X end;
- Xend; `123 custom_global_code `125
- X
- X
- X`123 -----------------------------------------------------------------------
- V---- `125
- X
- X`123 TO BEGIN DO ; `125
- X`032
- X`123 TO END DO ; `125
- X
- XEND.
- $ CALL UNPACK CUSTOM.PAS;61 1193144491
- $ create/nolog 'f'
- X`091environment,inherit ('Global','Guts')`093
- XMODULE database (output);
- X`123+
- XCOMPONENT: Tietokannan liittym`228
- X`032
- XPROGRAM DESCRIPTION:
- X`032
- X `032
- X`032
- XAUTHORS:
- X`032
- X Rich Skrenta (when code was in MON.PAS)
- X Kari Hurtta
- X`032
- XCREATION DATE: Unknown
- X`032
- XDESIGN ISSUES:
- X`032
- X Saada MON.PAS pienemm`228ksi
- X
- X`032
- XMODIFICATION HISTORY:
- X`032
- X Date `124 Name `124 Description
- X--------------+---------+---------------------------------------------------
- V----
- X 31.5.1992 `124`009Hurtta`009`124 T`228m`228 headeri, add* rutiineihin yl
- V`228rajan tarkistus
- X-`125
- X
- XVar
- X root: `091external`093 string;`009`123 database root `125
- X mylog: `091global`093 integer;`009`123 which log entry this player is `1
- V25
- X location: `091global`093 integer := 0;`009`123 current place number `125
- X
- X inmem: `091global`093 boolean := FALSE;`009
- X`009`009`009 `123 Is this rooms roomrec (here....) in memory?
- X`009`009`009 We call gethere many times to make sure
- X`009`009`009 here is current. However, we only want to
- X`009`009`009 actually do a getroom if the roomrec has been
- X`009`009`009 modified`009`125
- X
- X
- X `123 Tietueet : `125
- X
- X header: `091global`093 headerrec;`009 `123 koodin header -tietue `125
- X here: `091global`093 room;`009`009`123 current room record `125
- X event: `091global`093 eventrec;
- X`009nam,`009`009`009`123 record 1 is room names `125
- X`009own,`009`009`009`123 rec 2 is room owners `125
- X`009pers,`009`009`009`123 3 is player personal names `125
- X`009user,`009`009`009`123 4 is player userid`009`125
- X`009objnam,`009`009`009`123 5 is object name `125
- X`009objown,`009`009`009`123 6 is object owner `125
- X`009adate,`009`009`009`123 7 is date of last play `125
- X`009atime,`009`009`009`123 8 is time of last play `125
- X`009passwd,`009`009`009`123 9 is player password `125
- +-+-+-+-+-+-+-+- END OF PART 10 +-+-+-+-+-+-+-+-
-