home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Source Code 1994 March
/
Source_Code_CD-ROM_Walnut_Creek_March_1994.iso
/
compsrcs
/
games
/
vmsnet
/
monhl104
/
part14
< prev
next >
Wrap
Internet Message Format
|
1992-08-02
|
44KB
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 14/32
Keywords: Monster, a multiplayer adventure game
Message-ID: <1992Jun14.024841.4538@klaava.Helsinki.FI>
Date: 14 Jun 92 02:48:41 GMT
Sender: hurtta@klaava.Helsinki.FI (Kari Hurtta)
Followup-To: vmsnet.sources.d
Organization: University of Helsinki
Lines: 1279
Archieve-name: monster_helsinki_104/part14
Author: Kari.Hurtta@Helsinki.FI
Product: Monster Helsinki V 1.04
Environment: VMS, Pascal
Part: 14/32
-+-+-+-+-+-+-+-+ START OF PART 14 -+-+-+-+-+-+-+-+
X`009`009`009if current_atom = ')' then atom_readed := false
X`009`009`009else begin
X`009`009`009 LINE_error;
X`009`009`009 writeln('Error: ''',current_atom,''' detected');
X`009`009`009 writeln(' '')''expected.');
X`009`009`009 error_flag := true;
X
X`009`009`009end;
X`009`009 end else eval :=`032
X`009`009`009put_error('Function, variable or string expected.');
X
X`009 end else begin `032
X if name`0911`093 = '"' then`032
X eval := put_atom(name)
X else begin
X`009`009 refer := '';
X
X read_atom;
X if current_atom <> '(' then`032
X eval := put_atom('_'+name)
X else begin
X`009`009`009if length(name) > atom_length then begin
X`009`009`009 LINE_error;
X`009`009`009 writeln('Error: Too long function name.');
X`009`009`009 writeln(' Internal error.');
X`009`009`009 error_flag := true;
X
X`009`009`009 fcode := 0;
X`009`009`009 function_type := n_error;
X
X`009`009`009end else if exact_header (fcode,name) then begin
X`009`009`009 min := htable`091fcode`093.min;
X`009`009`009 max := htable`091fcode`093.max;
X`009`009`009 function_type := n_header;
X`009`009`009 refer := substr(name,length(htable`091fcode`093.name)+1,
X`009`009`009`009 length(name)-length(htable`091fcode`093.name));
X
X`009`009`009end else if exact_function(fcode,name) then begin
X`009`009`009 min := ftable`091fcode`093.min;
X`009`009`009 max := ftable`091fcode`093.max;
X`009`009`009 function_type := n_function;
X
X`009`009`009end else begin
X`009`009`009 LINE_error;
X`009`009`009 writeln ('Error: Unrecognized function: ',name);
X`009`009`009 writeln (' Check validity and spelling.');
X`009`009`009 error_flag := true;
X`009`009`009 min := 0;
X`009`009`009 max := maxint;
X`009`009`009 fcode := 0;
X`009`009`009 function_type := n_error;
X
X`009`009`009end;
X atom_readed := false;
X `032
X`009`009`009read_atom;
X`009`009`009while (current_atom <> ')') and
X`009`009`009 (current_atom <> '-') and
X`009`009`009 (current_atom <> '')`032
X`009`009`009 do begin
X`009`009`009 counter := counter +1;
X`009`009`009 if counter > max_param then
X`009`009`009`009eval
X`009`009`009 else params`091counter`093 := eval;
X`009`009`009 if counter = max_param +1 then begin
X`009`009`009`009LINE_error;
X`009`009`009`009writeln('Error: Too many parameters');
X`009`009`009`009writeln(' at function ',name,'.');
X`009`009`009`009writeln(' Limit parameters to ',
X`009`009`009`009 max_param:1,'.');
X`009`009`009`009error_flag := true;
X
X`009`009`009 end; `123 if counter `125
X`009`009`009 read_atom;
X`009`009`009 if current_atom = ')' then `123 ok `125
X`009`009`009 else if current_atom = ',' then`032
X`009`009`009`009atom_readed := false`009`123 ok `125
X`009`009`009 else begin
X`009`009`009`009LINE_error;
X`009`009`009`009writeln ('Error: '')'' or '','' expected');
X`009`009`009`009writeln (' ''',current_atom,''' detected.');
X`009`009`009`009writeln (' at function ',name,'.');
X`009`009`009`009error_flag := true;
X
X`009`009`009`009if counter < max_param then begin
X`009`009`009`009 counter := counter +1;
X`009`009`009`009 params`091counter`093 := put_error
X`009`009`009`009 `009(''')'' or '','' expected.');
X`009`009`009`009end;
X`009`009`009
X`009`009`009 end; `123 else `125
X
X`009`009`009 read_atom;
X`009`009`009end;`009`123 while `125
X`032
X if current_atom = ')' then atom_readed := false
X else begin
X`009`009`009 LINE_error;
X`009`009`009 writeln ('Error: '')'' expected');
X`009`009`009 writeln (' at function ',name,'.');
X`009`009`009 error_flag := true;
X
X`009`009`009 if counter < max_param then begin
X`009`009`009`009counter := counter +1;
X`009`009`009`009params`091counter`093 := put_error
X`009`009`009`009 (''')'' expected.');
X`009`009`009 end;
X
X`009`009`009end;`009`123 else `125
X`009`009`009if count_params(params) < min then begin
X`009`009`009 LINE_error;
X`009`009`009 writeln('Error: Too few parameters');
X`009`009`009 writeln(' at function ',name,'.');
X`009`009`009 error_flag := true;
X
X`009`009`009 if counter < max_param then begin
X`009`009`009`009counter := counter +1;
X`009`009`009`009params`091counter`093 := put_error(
X`009`009`009`009 'Too few parameters.');
X`009`009`009 end;
X
X`009`009`009end else if count_params(params) > max then begin
X`009`009`009 LINE_error;
X`009`009`009 writeln('Error: Too many parameters');
X`009`009`009 writeln(' at function ',name,'.');
X`009`009`009 error_flag := true;
X
X`009`009`009 if counter < max_param then begin
X`009`009`009`009counter := counter +1;
X`009`009`009`009params`091counter`093 := put_error(
X`009`009`009`009 'Too many parameters.');
X`009`009`009 end;
X
X`009`009`009end; `123 if `125
X`009`009`009case function_type of
X`009`009`009 n_function: eval := put_atom_2 (fcode,params);
X`009`009`009 n_header: eval := put_atom_h (fcode,params,refer);
X`009`009`009 otherwise eval := put_error(
X`009`009`009`009'Unrecognized function: '+name);
X
X`009`009`009end;`009`123 else `125
X end; `123 else `125
X end`009`123 else `125
X end `123 else `125
X end`009`123 else `125
X end;
X `032
X`009 procedure dump_buffer;
X`009 var count,num,i: integer;
X`009 begin`032
X`009 rewrite(result);
X`009 with pool`091current_buffer`093 do `009`009
X`009 `009for count := 1 to atom_count do with table `091 count `093 do`03
V2
X`009`009begin
X`009`009used := count;
X`009 `123 --- `125`009`009
X`009`009case nametype of
X`009`009 n_comment: begin
X`009`009`009writeln(result,count:1,':0:0:0:',long_name`094)
X`009`009 end;
X`009`009 n_head: begin
X`009`009`009writeln(result,count:1,':',params`0911`093:1,':0:0:-');
X`009`009 end;
X`009`009 n_const: begin
X`009`009`009write(result,count:1,':0:0:0:"');
X`009`009`009writeln(result,long_name`094,'"');
X`009`009 end;
X`009`009 n_variable: begin
X`009`009`009writeln(result,count:1,':0:0:0:_',long_name`094);
X`009`009 end;
X`009`009 n_gosub: begin
X`009`009`009num := count_params(params);
X`009`009`009write(result,'J',name:1,':',num:1);
X`009`009`009for i := 1 to num do write(result,':',params`091i`093:1);
X`009`009`009writeln(result);
X`009`009 end;
X`009`009 n_header: begin
X`009`009`009num := count_params(params);
X`009`009`009write(result,'H',name:1,':',num:1);
X`009`009`009for i := 1 to num do write(result,':',params`091i`093:1);
X`009`009`009writeln(result,':',long_name`094);
X`009`009 end;
X`009`009 n_function: begin
X`009`009`009write(result,-count:1,':',params`0911`093:1,':',
X`009`009`009 params`0912`093:1,':',params`0913`093:1,':',name:1);
X`009`009`009num := count_params(params);
X`009`009`009if num <= 3 then writeln(result)
X`009`009`009else begin
X`009`009`009 write(result,':',num-3);
X`009`009`009 for i := 4 to num do write(result,':',params`091i`093:1);
X`009`009`009 writeln(result);
X`009`009`009end;
X`009`009 end;
X`009`009end; `123 case `125
X`009 `123 ---- `125
X`009 end;
X`009 end;
X `032
X begin `123 parse `125
X`009write_debug('%parse');
X
X`009clear_program(current_buffer);
X`009reset (source);
X
X`009line := '';
X`009linecount := 0;
X`009linep := 1;
X`009read_line;
X
X`009error_flag := false;
X atom_readed := false; `032
X atom_count := 0;
X`009label_count := 0;
X
X while not LINE_EOF do begin
X read_atom; if current_atom = '-' then atom_readed := false;
X put_atom ('-',eval);
X read_atom; if (current_atom = '(') or
X (current_atom = ')') or (current_atom=',') then begin
X`009 LINE_error;
X writeln('Error: ''',current_atom,''' detected as function star
Vt.');
X`009 writeln(' ''',current_atom,''' skipped.');
X`009 error_flag := true;
X
X`009 put_atom('-',
X`009`009 put_error(''''+current_atom+''' detected as function start.'));
X
X`009 atom_readed := false
X end;
X end;
X`009replace_GOSUB;
X 999:
X`009if error_flag then begin
X`009 LINE_error;
X`009 writeln('FATAL: Error(s) occured. Code not produced.');
X`009 clear_program(current_buffer);
X`009end else dump_buffer;
X
X close(source);
Xend; `123 parse `125
X `032
Xfunction alloc_buffer(program_number: integer): integer;
Xvar i: integer;
X found: integer;
X biggest: integer;
Xbegin
X write_debug('%alloc_buffer');
X found := 0;
X biggest := 1;
X for i := 1 to max_buffer do with pool`091i`093 do begin
X`009if used > 0 then begin
X`009 if current_program = program_number then found := i;
X`009 if pool`091biggest`093.time < time then biggest := i;
X`009 if time < maxint then time := time+1;
X`009end else if found = 0 then found := i;
X end; `123 for `125
X if found = 0 then found := biggest;
X if debug then writeln('%alloc_buffer : result ',found:1);
X alloc_buffer := found;
Xend; `123 alloc buffer `125
X `032
X `032
Xprocedure read_program (var source: text; buffer: integer);
Xvar ln,i,cn: integer;
X prms: paramtable;
X atom: string_t; `032
X a,b,c,d: char;
X code: integer;
X code_index: integer;
X code_type: name_type;
X dataline: boolean;
X linetype: char;
Xbegin
X reset (source);
X with pool`091buffer`093 do begin
X`009used := 0;
X`009time := 0;
X`009while not (eof(source)) do begin
X`009 for i := 1 to max_param do prms`091i`093 := 0;
X`009 dataline := false;
X`009 linetype := ' ';
X`009 if eoln(source) then ln := 0
X`009 else if source`094 in `091 '0' .. '9' , ' ' , '-' `093 then read (so
Vurce,ln)
X`009 else if source`094 = '!' then ln := 0
X`009 else begin
X`009`009ln := used +1;`009`009`123 default value - not check `125
X`009`009read(source,linetype);
X`009 end;
X
X`009 if ln = 0 then readln(source) `123 skip end of line `125
X`009 else dataline := true;
X
X`009 code_index := 0;
X`009 code_type := n_error;
X
X`009 if dataline then begin
X
X
X`009`009case linetype of
X
X`009`009 ' ':
X`009`009 begin`032
X`009`009`009if ln > 0 then
X`009`009`009 readln(source,a,prms`0911`093,b,prms`0912`093,c,prms`0913`09
V3,d,atom)
X`009`009`009else begin
X`009`009`009 read(source,a,prms`0911`093,b,prms`0912`093,c,prms`0913`093,
Vd,code);
X`009`009`009 if eoln(source) then readln(source)
X`009`009`009 else begin
X`009`009`009`009read(source,a,cn);
X`009`009`009`009for i := 1 to cn do`032
X`009`009`009`009 read(source,a,prms`091i+3`093);
X`009`009`009`009readln(source);
X`009`009`009 end;
X`009`009`009 `123 atom := ftable`091name`093.name; `125
X`009`009`009 code_index := code;
X`009`009`009 code_type := n_function;
X`009`009`009 ln := -ln;
X`009`009`009end;
X`009`009
X`009`009`009`123 koodin tunnistus `125
X`009`009`009if code_index = 0 then begin
X`009`009`009 if atom`0911`093 = '!' then begin
X`009`009`009`009code_type := n_comment;
X`009`009`009`009code_index := 1;
X`009`009`009 end else if atom = '-' then begin
X`009`009`009`009code_type := n_head;
X`009`009`009`009code_index := 1;
X`009`009`009`009atom := '';
X`009`009`009 end else if atom`0911`093 = '"' then begin
X`009`009`009`009code_type := n_const;
X`009`009`009`009code_index := 1;
X`009`009`009`009atom := substr(atom,2,length(atom)-2);
X`009`009`009 end else if atom`0911`093 = '_' then begin
X`009`009`009`009code_type := n_variable;
X`009`009`009`009code_index := 1;
X`009`009`009`009atom := substr(atom,2,length(atom)-1);
X`009`009`009 end else if exact_header(code,atom) then begin
X`009`009`009`009code_type := n_header;
X`009`009`009`009code_index := code;
X`009`009`009`009atom := substr(atom,length(htable`091code`093.name)+1,
X`009`009`009`009 length(atom)-length(htable`091code`093.name));
X`009`009`009 end else if exact_function(code,atom) then begin
X`009`009`009`009code_type := n_function;
X`009`009`009`009code_index := code;
X`009`009`009`009atom := '';
X`009`009`009 end else code_type := n_error;
X`009`009`009end else atom := '';
X`009`009 end;
X
X`009`009 'H':
X`009`009 begin
X`009`009`009code_type := n_header;
X`009`009`009read(source,code_index,a,cn);
X
X`009`009`009for i := 1 to cn do`032
X`009`009`009 read(source,a,prms`091i`093);
X`009`009`009readln(source,a,atom);
X`009`009 end;
X
X`009`009 'J':
X`009`009 begin
X`009`009`009code_type := n_gosub;
X`009`009`009read(source,code_index,a,cn);
X
X`009`009`009for i := 1 to cn do`032
X`009`009`009 read(source,a,prms`091i`093);
X`009`009`009readln(source);
X`009`009`009atom := '';
X`009`009 end;
X
X`009`009 otherwise begin
X`009`009`009writeln('%Bad program file #2. Notify Monster Manager.');
X`009`009`009halt;
X`009`009 end;
X
X`009`009end; `123 case `125
X
X`009`009if ln <> used+1 then begin
X`009`009 writeln ('%Bad program file #1. Notify Monster Manager.');
X`009`009 halt
X`009`009end else if ln > MAXATOM then begin
X`009`009 writeln ('Error: Maximum number of atoms exceeded.');
X`009`009 halt
X`009`009end;
X
X`009`009used := ln;
X`009`009with table `091ln`093 do begin
X`009`009 params := prms;
X`009`009 nametype := code_type;
X`009`009 name := code_index;
X`009`009 case code_type of`032
X`009`009`009n_function,n_head,n_error,n_gosub: long_name := nil;
X`009`009`009n_header,n_variable,n_const,n_comment: begin
X`009`009`009 new(long_name);
X`009`009`009 long_name`094 := atom;
X`009`009`009end;
X`009`009 end; `123 case `125
X`009`009end
X`009 end; `123 if dataline `125
X`009end; `123 while `125
X end; `123 with `125
X close(source)
Xend; `123 read_program `125
X `032
Xprocedure print_program (buffer: integer;
X`009`009`009procedure print(l: string_t); len: integer := 80);
Xvar line_i: string_t;
X i: integer;
X
X procedure l_print(s: string_t);
X begin
X`009while length(s) > len do begin
X`009 print(substr(s,1,len));
X`009 s := substr(s,len+1,length(s)-len);
X`009end;
X`009print(s);
X end; `123 l_print `125
X
X procedure put_atom (item,level: integer);
X
X procedure nice_print(c: string_t);
X var i,cut: integer;
X subline: string_t;
X begin
X`009 cut := terminal_line_len - 30;
X`009 if cut < 10 then cut := 10;
X
X if length(line_i) + length(c) < terminal_line_len -10 then
X`009`009line_i := line_i + c `032
X else if c`0911`093 = '"' then repeat
X if length(c) < cut + 5 then begin`032
X subline := c; c := '';
X end else begin
X subline := substr(c,1,cut) + '"&';
X c := '"' + substr(c,cut+1,length(c) -cut);
X end;
X l_print(line_i);
X line_i := '';
X for i := 1 to level do line_i := line_i + ' ';
X line_i := line_i + subline
X until c = '' else begin`032
X l_print(line_i);
X line_i := '';
X for i := 1 to level do line_i := line_i + ' ';
X line_i := line_i + c
X end
X end; `123 nice_print `125
X `032
X var atom_name : string_t;
X`009count,i,j: integer;
X
X begin with pool `091buffer`093 do begin
X`009if item = 0 then nice_print('""')
X else with table`091item`093 do begin
X if long_name = nil then atom_name := ''
X else atom_name := long_name`094;
X
X`009 case nametype of`032
X`009`009n_function: begin
X`009`009 if name = ERROR_ID then begin
X`009`009`009if line_i >'' then l_print(line_i);
X
X`009`009`009line_i := 'Error: ';
X`009`009`009put_atom(params`0911`093,0);
X
X`009`009`009l_print(line_i);
X`009`009`009line_i := '';
X`009`009
X`009`009 end else begin
X`009`009`009nice_print(ftable`091name`093.name);
X`009`009`009count := count_params(params);
X`009`009`009nice_print('(');
X`009`009`009for i := 1 to count do begin
X`009`009`009 put_atom(params`091i`093,level+1);
X`009`009`009 if i <> count then begin
X`009`009`009`009nice_print(',');
X`009`009`009`009if count >= new_line_limit then begin
X`009`009`009`009 if line_i >'' then l_print(line_i);
X`009`009`009`009 line_i := '';
X`009`009`009`009 for j := 1 to level do line_i := line_i`032
X`009`009`009`009`009+ ' ';
X`009`009`009`009end;
X`009`009`009 end;
X`009`009`009end; `123 for `125
X`009`009`009nice_print(')')
X`009`009 end;
X`009`009end;
X`009`009n_header: begin
X`009`009 nice_print(htable`091name`093.name + atom_name);
X`009`009 count := count_params(params);
X`009`009 nice_print('(');
X`009`009 for i := 1 to count do begin
X`009`009`009put_atom(params`091i`093,level+1);
X`009`009`009if i <> count then begin
X`009`009`009 nice_print(',');
X`009`009`009 if count >= new_line_limit then begin
X`009`009`009`009if line_i >'' then l_print(line_i);
X`009`009`009`009line_i := '';
X`009`009`009`009for j := 1 to level do line_i := line_i`032
X`009`009`009`009 + ' ';
X`009`009`009 end;
X`009`009`009end;
X`009`009 end; `123 for `125
X`009`009 nice_print(')')
X`009`009end;
X`009`009n_variable: nice_print(atom_name);
X`009`009n_const: nice_print('"' + atom_name + '"');
X`009`009n_comment:;
X`009`009n_head:`009 begin
X`009`009 nice_print('- ');
X`009`009 put_atom(params`0911`093,level+1)
X`009`009end;
X`009`009n_error: nice_print( '/' + atom_name + '/');
X`009`009n_gosub: begin
X`009`009 nice_print('GOSUB '+table`091name`093.long_name`094);
X`009`009 count := count_params(params);
X`009`009 nice_print('(');
X`009`009 for i := 1 to count do begin
X`009`009`009put_atom(params`091i`093,level+1);
X`009`009`009if i <> count then begin
X`009`009`009 nice_print(',');
X`009`009`009 if count >= new_line_limit then begin
X`009`009`009`009if line_i >'' then l_print(line_i);
X`009`009`009`009line_i := '';
X`009`009`009`009for j := 1 to level do line_i := line_i`032
X`009`009`009`009 + ' ';
X`009`009`009 end;
X`009`009`009end;
X`009`009 end; `123 for `125
X`009`009 nice_print(')');
X`009`009end;
X`009 end; `123 case `125
X end
X end; `123 with `125 end; `123 put_atom `125
X
Xbegin `123 print_program `125
X with pool`091buffer`093 do begin
X`009line_i := '';
X`009for i := 1 to used do if table `091i`093.nametype = n_head then begin
X`009 if line_i >'' then l_print(line_i);
X`009 line_i := '';
X`009 print('');
X`009 put_atom(i,0)
X`009end else if table `091i`093.nametype = n_comment then begin
X`009 if line_i >'' then l_print(line_i);
X`009 if table`091i`093.long_name <> nil then line_i := table`091i`093.lon
Vg_name`094
X`009 else line_i := '<error>';
X`009end;
X`009l_print(line_i);
X end; `123 with `125
Xend; `123 print_program `125
X`032
X
Xfunction exec_program (label_name: atom_t; monster: atom_t;
X variable: atom_t := '' ; value: string_t := '';
X`009`009`009 buffer: integer;`032
X`009`009`009 spell_name: atom_t := '';
X`009`009`009 summoner_name: atom_t := ''
X ): boolean;
X `032
X label 1; `123 minne hyp`228t`228`228n virheen sattuessa
V `125
X `032
X `032
X const EVENT_CHECK = 50; `123 tarkista tapahtumat joka 50 evaluointi `1
V25
X MAXEVAL = 500; `123 Maksimi evaluointien lum`228`228r`228 `1
V25
X MAX_VARIABLE = 30; `032
X
X type charset = set of char;
X
X var eval_count: integer;
X var_count : 0 .. MAX_VARIABLE; `123 very big variable using `125
X `123 30 kB `125
X
X vars : array `091 1 .. MAX_VARIABLE `093 of`032
X record
X value: string_t;
X name: atom_t
X end;
X `032
X `032
X function eval_atom(item: integer): string_t; forward;
X
X
X function goto_label(label_name: atom_t; var found: boolean): string_t;
X var i,position : integer;
X result: string_t;
X
X begin`032
X write_debug ('%goto_label: ',label_name);
X label_name := clean_spaces (label_name);
X result := '';
X position := 0;
X`009 with pool`091buffer`093 do begin
X`009 for i:= 1 to used do if table`091i`093.nametype = n_header then
X`009`009 if table`091i`093.name = 6 `123 LABEL `125 then
X`009`009`009if table`091i`093.long_name`094 = label_name then`032
X`009`009`009 position := i;
X`009 if position > 0 then begin
X`009`009found := true; `123 t`228m`228 pit`228`228 olla ennen eval_atom:ia k
Voska `125
X`009`009`009 `123 sen suoritus voidaan keskeytt`228`228 `125
X`009`009result := eval_atom(position);
X`009 end else begin
X`009`009found := false;
X`009`009error_counter := error_counter +1
X`009 end;
X`009 end; `123 with `125
X write_debug ('%goto_label result: ',result);`009
X goto_label := result
X end;
X `032
X function eval_variable( variable: atom_t): string_t; `032
X var i : integer;
X result: string_t;
X begin `032
X write_debug('%eval_variable: ',variable);
X variable := clean_spaces(variable);
X result := ''; `032
X for i := 1 to var_count do if variable = vars `091i`093.name then
X result := vars`091i`093.value;
X write_debug('%eval_variable result: ',result);`009
X eval_variable := result
X end; `123 eval variable `125 `032
X
X procedure set_variable ( variable: atom_t; value: string_t);
X var i,point : integer;
X begin `032
X write_debug ('%set_variable: ',variable);
X write_debug ('% value: ',value);
X variable := clean_spaces(variable);
X point := 0; `032
X for i := 1 to var_count do if variable = vars `091i`093.name then
X point := i;
X if point > 0 then vars`091point`093.value := value
X else write_debug('%set variable - no variable');
X end; `123 eval variable `125 `032
X
X procedure define_variable (variable: atom_t); `032
X begin
X write_debug('%define_variable: ',variable);
X if var_count < MAX_VARIABLE then begin
X var_count := var_count +1;
X vars`091var_count`093.value := '';
X vars`091var_count`093.name := clean_spaces(variable)
X end
X end; `123 define_variable `125 `032
X
X procedure strim(var s: string_t; a: string_t; raw: boolean := false);
X begin
X`009write_debug('%strim: ',s);
X`009write_debug('% : ',a);
X`009if raw then write_debug('% - raw mode');
X`009if (a > '') and (s > '') and not raw then`032
X`009 if (a`0911`093 in `091 'a'..'z', 'A'..'Z', '0'..'9',`032
X`009`009 '.', ',', '?', ';', '!' `093) and
X`009`009not (s`091length(s)`093 in `091 '''', '"', ' '`093)`032
X`009`009`009 or`032
X`009`009(s`091length(s)`093 in `091 'a'..'z', 'A'..'Z', '0'..'9',`032
X`009`009 '.', ',', '?', ';', '!' `093) and
X`009`009not (a`0911`093 in `091 '''', '"', ' '`093) then
X`009`009 if length(s) < string_length then
X`009`009`009s := s + ' ';
X`009if length(s) + length(a) < string_length then
X`009 s := s + a;
X`009write_debug('% -> : ',s);
X end;
X
X function e_plus (params: paramtable): string_t;
X var a,result: string_t;
X`009 i: integer;
X begin `032
X write_debug('%e_plus');
X`009 result := '';
X`009 for i := 1 to count_params(params) do begin
X`009 a := eval_atom (params`091i`093);
X`009 write_debug('%e_eval - .. ',a);
X`009 strim (result,a);
X`009 end;
X write_debug ('%e_plus result: ',result);
X e_plus := result;
X end; `123 e_plus `125 `032
X `032
X function cut_string ( var main: string_t; var index: integer;
X chars: charset; max: integer): string_t;
X var start,i,upper: integer;
X begin
X write_debug ('%cut_string');
X start := index;
X if start + max <= length(main) then upper := start + max
X else upper := length(main);
X index := upper;
X for i := start to upper do if main `091i`093 in chars then index :=
V i;
X cut_string := substr(main,start,index-start+1);
X index := index+1 `032
X end; `123 cut_string `125
X
X function meta_print(params: paramtable;
X`009`009`009 procedure print(s: string_t);
X`009`009`009 raw: boolean;`032
X`009`009`009 len : integer := 80
X`009`009`009 ): string_t;
X var a: string_t; `032
X`009 a1: string_t;
X base,i: integer;
X
X`009 procedure make_upper(var s: string_t);
X`009 var i: integer;
X`009`009upcase: boolean;
X`009 begin
X`009`009upcase := true;
X`009`009for i := 1 to length(s) do begin
X`009`009 if (s`091i`093 in `091 'a' .. 'z' `093) and upcase then
X`009`009`009s`091i`093 := chr(ord(s`091i`093) - ord('a') + ord('A'));
X`009`009 if s`091i`093 in `091 '.','?','!',':' `093 then
X`009`009`009upcase := true
X`009`009 else if classify(s`091i`093) <> space then upcase := false;
X`009`009end;
X`009 end;
X
X begin `032
X write_debug('%meta_print');
X`009if raw then write_debug('% - raw_mode');
X`009a := '';
X`009for i := 1 to count_params(params) do begin
X`009 a1 := eval_atom(params`091i`093);`032
X`009 write_debug('%meta_print - .. ',a1);
X`009 strim (a,a1,raw);
X`009end;
X`009if (a > '') and not raw then if length(a) < string_length then
X`009 if a`091length(a)`093 in `091 'a' .. 'z', 'A' .. 'Z', '0' .. '9' `09
V3 then
X`009`009a := a + '.';
X`009if length(a) < string_length then a := a + ' ';
X`009if not raw then make_upper(a);
X
X base := 1;
X while base <= length(a) do
X print (cut_string(a,base, `091 '.', ',', ' '`093, len-5 ));
X write_debug('%meta_print - result: ',a);
X meta_print := a;
X end; `123 meta_print `125 `032
X
X function e_pprint(params: paramtable; raw: boolean): string_t;
X
X`009 procedure print(s: string_t);
X`009 begin
X`009`009writeln(s);
X`009 end;
X
X begin `032
X write_debug('%e_pprint');
X e_pprint := meta_print(params,print,raw,terminal_line_len);
X end; `123 e_pprint `125 `032
X
X function e_print(params:paramtable; raw: boolean): string_t;
X
X`009 procedure print(s: string_t);
X`009 begin
X`009`009int_broadcast(monster,s,false);
X`009 end;
X
X begin `032
X write_debug('%e_print');
X e_print := meta_print(params,print,raw,80);
X end; `123 e_print `125 `032
X
X function e_oprint(params:paramtable; raw: boolean): string_t;
X
X`009 procedure print(s: string_t);
X`009 begin
X`009`009int_broadcast(monster,s,true);
X`009 end;
X
X begin `032
X write_debug('%e_oprint');
X e_oprint := meta_print(params,print,raw,80);
X end; `123 e_oprint `125 `032
X
X function e_print_null (params: paramtable): string_t;
X
X`009 procedure print(s: string_t);
X`009 begin
X`009 end;
X
X begin `032
X write_debug('%e_print');
X e_print_null := meta_print(params,print,false,132);
X end; `123 e_print `125 `032
X
X function e_if (p1,p2,p3: integer): string_t;
X var result: string_t;
X begin
X write_debug('%e_if');
X if eval_atom(p1) > '' then result := eval_atom(p2)
X else result := eval_atom(p3);
X write_debug('%e_if result: ',result);
X e_if := result
X end; `123 e_if `125 `032
X
X function e_inv: string_t; `032
X var result: string_t;
X begin `032
X write_debug('%e_inv');
X result := int_inv (monster);
X write_debug('%e_inv result: ',result);
X e_inv := result;
X end; `123 e_inv `125
X
X function e_pinv: string_t;
X var result: string_t;
X begin
X write_debug('%e_pinv');
X result := int_inv (myname);
X write_debug('%e_pinv result: ',result);
X e_pinv := result;
X end; `123 e_pinv `125
X `032
X `032
X procedure add_atom (var main:string_t; atom: atom_t);
X begin
X write_debug('%add_atom');
X if main = '' then main := atom
X else if length(main) + length (atom) < string_length -3 then
X main := main + ', ' + atom
X end; `123 add_atom `125
X
X function meta_do (p1: integer;
X`009`009`009function action(atom: atom_t): atom_t
X`009`009 ): string_t;
X var list,result: string_t;
X atom: atom_t;
X index: integer;
X begin
X write_debug('%meta_do');
X list := eval_atom (p1);
X write_debug('%meta_do - param: ',list);
X index := 1;
X result := '';
X while index <= length(list) do
X begin
X atom := clean_spaces(cut_atom(list,index,','));
X`009 if atom > '' then atom := action(atom);
X`009 if atom > '' then add_atom(result,atom);
X end;
X write_debug('%meta_do result: ',result);
X meta_do := result
X end; `123 meta_do `125
X
X function e_get_global_flag(p1: integer): string_t;
X var result: string;
X
X`009 function action(atom: atom_t): atom_t;
X`009 var value: INTEGER;
X`009 begin
X`009`009if lookup_flag(value,atom) then`032
X`009`009 if read_global_flag(value) then action := 'TRUE'
X`009`009 else action := ''
X`009`009else action := '';
X`009 end;
X
X begin
X write_debug('%e_get_global_flag');
X`009 result := meta_do(p1,action);
X write_debug('%e_get_global_flag result: ',result);
X e_get_globaL_FLAG := result
X end; `123 e_get_get_global_flag `125
X
X `032
X function e_get (p1: integer): string_t;
X var result: string_t;
X
X`009 function action(atom: atom_t): atom_t;
X`009 begin
X`009`009if int_get(monster,atom) then action := atom
X`009`009else action := '';
X`009 end;
X
X begin
X write_debug('%e_get');
X`009 result := meta_do(p1,action);
X write_debug('%e_get result: ',result);
X e_get := result
X end; `123 e_get `125
X
X function e_pget (p1: integer): string_t;
X var result: string_t;
X
X`009 function action(atom: atom_t): atom_t;
X`009 begin
X`009`009if int_get(myname,atom) then action := atom
X`009`009else action := '';
X`009 end;
X
X begin
X write_debug('%e_pget');
X result := '';
X if privilegion then begin
X`009 result := meta_do(p1,action);
X end;
X write_debug('%e_pget result: ',result);
X e_pget := result
X end; `123 e_pget `125 `032
X
X function list_include(list: string_t; atom: atom_t): boolean;
X var a: atom_t;
X i: integer;
X result: boolean;
X
X begin
X write_debug('%list_include');
X write_debug('%list_include - list: ',list);
X write_debug('% atom: ',atom);
X result := false;
X i := 1;
X while i <= length(list) do begin
X a := clean_spaces(cut_atom(list,i,','));
X if a = atom then result := true;
X end;
X write_debug('%list_include - ready.');
X list_include := result;
X end; `123 list_include `125
X
X function e_exclude(p1,p2: integer): string_t;
X var a1,a2,result: string_t;
X atom: atom_t;
X i: integer;
X
X begin
X write_debug('%e_exclude');
X result := '';
X a1 := eval_atom(p1);
X a2 := eval_atom(p2);
X write_debug('%e_and - p1: ',a1);
X write_debug('% - p2: ',a2);
X i := 1;
X while i <= length(a1) do begin
X atom := clean_spaces(cut_atom(a1,i,','));
X if not list_include(a2,atom) then add_atom(result,atom);
X end;
X write_debug('%e_exclude - result: ',result);
X e_exclude := result;
X end; `123 e_exclude `125
X
X function e_and (p1,p2: integer): string_t;
X var result,first,second: string_t;
X i: integer;
X atom: atom_t;
X begin
X write_debug('%e_and');
X result := '';
X first := eval_atom (p1);
X second := eval_atom (p2);
X write_debug('%e_and - p1: ',first);
X write_debug('% p2: ',second);
X i := 1;
X while i <= length(first) do
X begin
X atom := clean_spaces(cut_atom(first,i,','));
X if list_include(second,atom) and not list_include(result,atom
V) then
X add_atom(result,atom)
X end;
X write_debug('%e_and result: ',result);
X e_and := result
X end; `123 e_and `125
X
X function e_or (p1,p2,p3: integer): string_t;
X var result: string_t;
X
X`009function action (atom: atom_t): atom_t;
X`009begin
X`009 if not list_include(result,atom) then add_atom(result,atom);
X`009 action := ''
X`009end;
X
X begin
X`009write_debug('%e_or');
X`009result := '';
X`009meta_do(p1,action);
X`009meta_do(p2,action);
X`009meta_do(p3,action);
X write_debug('%e_or result: ',result);
X e_or := result
X end; `123 e_and `125
X `032
X function e_drop (p1: integer): string_t;
X var result: string_t;
X
X`009 function action(atom: atom_t): atom_t;
X`009 begin
X`009`009if int_drop(monster,atom) then action := atom
X`009`009else action := '';
X`009 end;
X
X begin
X write_debug('%e_drop');
X`009 result := meta_do(p1,action);
X write_debug('%e_drop result: ',result);
X e_drop := result
X end; `123 e_drop `125
X `032
X function e_pdrop (p1: integer): string_t;
X var result: string_t;
X
X`009 function action(atom: atom_t): atom_t;
X`009 begin
X`009`009if int_drop(myname,atom) then action := atom
X`009`009else action := '';
X`009 end;
X
X begin
X write_debug('%e_pdrop');
X`009 result := '';
X if privilegion then begin `032
X`009 result := meta_do(p1,action);
X end;
X write_debug('%e_pdrop result: ',result);
X e_pdrop := result
X end; `123 e_pdrop `125
X
X function e_duplicate (p1: integer): string_t;
X var result: string_t;
X owner: atom_t;
X priv: boolean;
X
X`009 function action(atom: atom_t): atom_t;
X`009 begin
X if int_duplicate (monster,atom,owner,priv) then action := at
Vom
X`009 else action := '';
X`009 end;
X
X begin
X write_debug('%e_duplicate');
X owner := x_monster_owner(pool`091buffer`093.current_program);
X priv := int_ask_privilege(monster,'owner') or`032
X`009`009system_code or spell_mode;
X`009 result := meta_do(p1,action);
X write_debug('%e_duplicate result: ',result);
X e_duplicate := result
X end; `123 e_duplicate `125
X `032
X function e_pduplicate (p1: integer): string_t;
X var result: string_t;
X owner: atom_t;
X priv: boolean;
X
X`009 function action(atom: atom_t): atom_t;
X`009 begin
X if int_duplicate (myname,atom,owner,priv) then action := ato
Vm
X`009 else action := '';
X`009 end;
X
X begin
X write_debug('%e_pduplicate');
X owner := x_monster_owner(pool`091buffer`093.current_program);
X priv := int_ask_privilege(monster,'owner') or`032
X`009 system_code or spell_mode;
X result := '';
X if privilegion then begin
X`009 result := meta_do(p1,action);
X end;
X write_debug('%e_pduplicate result: ',result);
X e_pduplicate := result
X end; `123 e_pduplicate `125
X
X function e_destroy (p1: integer): string_t;
X var result: string_t;
X owner: atom_t;
X priv: boolean;
X
X`009 function action(atom: atom_t): atom_t;
X`009 begin
X if int_destroy (monster,atom,owner,priv) then action := atom
X`009 else action := '';
X`009 end;
X
X
X begin
X write_debug('%e_destroy');
X owner := x_monster_owner(pool`091buffer`093.current_program);
X priv := int_ask_privilege(monster,'owner') or`032
X`009 system_code or spell_mode;
X result := meta_do (p1,action);
X write_debug('%e_destroy result: ',result);
X e_destroy := result
X end; `123 e_destroy `125
X `032
X function e_pdestroy (p1: integer): string_t;
X var result: string_t;
X owner: atom_t;
X priv: boolean;
X
X`009 function action(atom: atom_t): atom_t;
X`009 begin
X if int_destroy (myname,atom,owner,priv) then action := atom
X`009 else action := '';
X`009 end;
X
X begin
X write_debug('%e_pdestroy');
X owner := x_monster_owner(pool`091buffer`093.current_program);
X priv := int_ask_privilege(monster,'owner') or`032
X`009 system_code or spell_mode;
X result := '';
X if privilegion then begin
X`009 result := meta_do(p1,action);
X end;
X write_debug('%e_pdestroy result: ',result);
X e_pdestroy := result
X end; `123 e_pdestroy `125
X
X function e_move (p1: integer): string_t;
X var result, line_i: string_t;
X begin
X write_debug('%e_move');
X line_i := eval_atom (p1);
X write_debug('%e_move - p1: ',line_i);
X if length(line_i) > atom_length then`032
X line_i := substr(line_i,1,atom_length);
X if int_poof(monster,line_i,x_monster_owner(pool`091buffer`093.curre
Vnt_program),
X int_ask_privilege(monster,'poof')
X`009 or system_code or spell_mode,privilegion) then result := line_i
X else result := '';
X write_debug('%e_move result: ',result);
X e_move := result
X end; `123 e_move `125
X
X function e_pmove (p1: integer): string_t;
X var result, line_i: string_t;
X begin
X write_debug ('%e_pmove');
X line_i := eval_atom (p1);
X write_debug('%e_pmove - p1: ',line_i);
X if length(line_i) > atom_length then`032
X line_i := substr(line_i,1,atom_length);
X if int_poof(myname,line_i,x_monster_owner(pool`091buffer`093.curren
Vt_program),
X int_ask_privilege(monster,'poof')
X`009 or system_code or spell_mode,privilegion) then result := line_i
X else result := '';
X write_debug('%e_pmove result: ',result);
X e_pmove := result
X end; `123 e_pmove `125
X
X function e_players: string_t;
X var result: string_t;
X begin
X write_debug('%e_players');
X result := int_players (monster);
X write_debug('%e_players result: ',result);
X e_players := result
X end; `123 e_players `125 `032
X
X
X function e_objects: string_t;
X var result: string_t;
X begin
X write_debug('%e_objects');
X result := int_objects (monster);
X write_debug('%e_objects result: ',result);
X e_objects := result
X end; `123 e_onjects `125
X
X function e_remote_objects(p1: integer): string_t;
X var result,a1: string_t;
X begin
X write_debug('%e_remote_objects');
X a1 := eval_atom(p1);
X write_debug('%e_remote_objects - p1: ',a1);
X if length (a1) > atom_length then
X line_i := substr(a1,1,atom_length);
X result := int_remote_objects (a1);
X write_debug('%e_objects result: ',result);
X e_remote_objects := result
X end; `123 e_remote_objects `125
X `032
X function e_remote_players(p1: integer): string_t;
X var result,a1: string_t;
X begin
X write_debug('%e_remote_players');
X a1 := eval_atom(p1);
X write_debug('%e_remote_players - p1: ',a1);
X if length (a1) > atom_length then
X a1 := substr(a1,1,atom_length);
X result := int_remote_players (a1);
X write_debug('%e_remote_players - result: ',result);
X e_remote_players := result
X end; `123 e_remote_players `125
X `032
X function e_where(p1: integer): atom_t;
X var line_i,result: string_t;
X begin
X write_debug('%e_where');
X line_i := eval_atom (p1);
X write_debug('%e_where - p1: ',line_i);
X if length (line_i) > atom_length then
X line_i := substr(line_i,1,atom_length);
X result := int_where (line_i);
X write_debug('%e_where result: ',result);
X e_where := result;
X end; `123 e_where `125 `032
X
X function e_equal(p1,p2: integer): string_t;
X var a,b: string_t;
X begin
X write_debug('%e_equal');
X a := eval_atom (p1);
X b := eval_atom (p2);
X write_debug('%e_equal - p1: ',a);
X write_debug('% p2: ',b);
X if a = b then e_equal := a
X else e_equal := '';
X write_debug ('%e_equal leaving');
X end; `123 e_equal `125
X
X function e_equal2(p1,p2: integer): string_t;
X var a,b: string_t;
X begin
X write_debug('%e_equal2');
X a := eval_atom (p1);
X b := eval_atom (p2);
X write_debug('%e_equal - p1: ',a);
X write_debug('% p2: ',b);
X if EQ (a,b) then e_equal2 := a
X else e_equal2 := '';
X write_debug ('%e_equal2 leaving');
X end; `123 e_equal `125
X
X function e_equal3(p1,p2: integer): string_t;
X var a,b: string_t;
X begin
X write_debug('%e_equal3');
X a := lowcase(clean_spaces(eval_atom (p1)));
X b := lowcase(clean_spaces(eval_atom (p2)));
X write_debug('%e_equal - p1: ',a);
X write_debug('% p2: ',b);
X if a = b then e_equal3 := a
X else e_equal3 := '';
X write_debug ('%e_equal2 leaving');
X end; `123 e_equal `125
X
X function e_null(params: paramtable): string_t;
X var i,count: integer;
X begin
X write_debug('%e_null');
X`009count := count_params(params);
X`009for i := 1 to count do eval_atom(params`091i`093);
X write_debug('%e_null leaving');
X e_null := ''
X end; `123 e_null `125 `032
X
X function e_attack(p1: integer): string_t;
X var a,result: string_t;
X value : integer;
X`009 left : integer;
X begin
X write_debug('%e_attack');
X`009left := attack_limit - used_attack;
+-+-+-+-+-+-+-+- END OF PART 14 +-+-+-+-+-+-+-+-