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 >
Encoding:
Internet Message Format  |  1992-08-02  |  43.0 KB
  1. Path: uunet!mcsun!news.funet.fi!hydra!klaava!hurtta
  2. From: Kari.Hurtta@Helsinki.FI (Kari E. Hurtta)
  3. Newsgroups: vmsnet.sources.games
  4. Subject: Monster Helsinki V 1.04 - part 14/32
  5. Keywords: Monster, a multiplayer adventure game
  6. Message-ID: <1992Jun14.024841.4538@klaava.Helsinki.FI>
  7. Date: 14 Jun 92 02:48:41 GMT
  8. Sender: hurtta@klaava.Helsinki.FI (Kari Hurtta)
  9. Followup-To: vmsnet.sources.d
  10. Organization: University of Helsinki
  11. Lines: 1279
  12.  
  13. Archieve-name: monster_helsinki_104/part14
  14. Author: Kari.Hurtta@Helsinki.FI
  15. Product: Monster Helsinki V 1.04
  16. Environment: VMS, Pascal
  17. Part: 14/32
  18.  
  19. -+-+-+-+-+-+-+-+ START OF PART 14 -+-+-+-+-+-+-+-+
  20. X`009`009`009if current_atom = ')' then atom_readed := false
  21. X`009`009`009else begin
  22. X`009`009`009    LINE_error;
  23. X`009`009`009    writeln('Error: ''',current_atom,''' detected');
  24. X`009`009`009    writeln('       '')''expected.');
  25. X`009`009`009    error_flag := true;
  26. X
  27. X`009`009`009end;
  28. X`009`009    end else eval :=`032
  29. X`009`009`009put_error('Function, variable or string expected.');
  30. X
  31. X`009       end else begin   `032
  32. X                  if name`0911`093 = '"' then`032
  33. X                     eval := put_atom(name)
  34. X                  else begin
  35. X`009`009     refer := '';
  36. X
  37. X                     read_atom;
  38. X                     if current_atom <> '(' then`032
  39. X                        eval := put_atom('_'+name)
  40. X                     else begin
  41. X`009`009`009if length(name) > atom_length then begin
  42. X`009`009`009    LINE_error;
  43. X`009`009`009    writeln('Error: Too long function name.');
  44. X`009`009`009    writeln('       Internal error.');
  45. X`009`009`009    error_flag := true;
  46. X
  47. X`009`009`009    fcode := 0;
  48. X`009`009`009    function_type := n_error;
  49. X
  50. X`009`009`009end else if exact_header (fcode,name) then begin
  51. X`009`009`009    min := htable`091fcode`093.min;
  52. X`009`009`009    max := htable`091fcode`093.max;
  53. X`009`009`009    function_type := n_header;
  54. X`009`009`009    refer := substr(name,length(htable`091fcode`093.name)+1,
  55. X`009`009`009`009    length(name)-length(htable`091fcode`093.name));
  56. X
  57. X`009`009`009end else if exact_function(fcode,name) then begin
  58. X`009`009`009    min := ftable`091fcode`093.min;
  59. X`009`009`009    max := ftable`091fcode`093.max;
  60. X`009`009`009    function_type := n_function;
  61. X
  62. X`009`009`009end else begin
  63. X`009`009`009    LINE_error;
  64. X`009`009`009    writeln ('Error: Unrecognized function: ',name);
  65. X`009`009`009    writeln ('       Check validity and spelling.');
  66. X`009`009`009    error_flag := true;
  67. X`009`009`009    min := 0;
  68. X`009`009`009    max := maxint;
  69. X`009`009`009    fcode := 0;
  70. X`009`009`009    function_type := n_error;
  71. X
  72. X`009`009`009end;
  73. X                        atom_readed := false;
  74. X                       `032
  75. X`009`009`009read_atom;
  76. X`009`009`009while (current_atom <> ')') and
  77. X`009`009`009      (current_atom <> '-') and
  78. X`009`009`009      (current_atom <> '')`032
  79. X`009`009`009  do begin
  80. X`009`009`009    counter := counter +1;
  81. X`009`009`009    if counter > max_param then
  82. X`009`009`009`009eval
  83. X`009`009`009    else params`091counter`093 := eval;
  84. X`009`009`009    if counter = max_param +1 then begin
  85. X`009`009`009`009LINE_error;
  86. X`009`009`009`009writeln('Error: Too many parameters');
  87. X`009`009`009`009writeln('       at function ',name,'.');
  88. X`009`009`009`009writeln('       Limit parameters to ',
  89. X`009`009`009`009    max_param:1,'.');
  90. X`009`009`009`009error_flag := true;
  91. X
  92. X`009`009`009    end; `123 if counter `125
  93. X`009`009`009    read_atom;
  94. X`009`009`009    if current_atom = ')' then `123 ok `125
  95. X`009`009`009    else if current_atom = ',' then`032
  96. X`009`009`009`009atom_readed := false`009`123 ok `125
  97. X`009`009`009    else begin
  98. X`009`009`009`009LINE_error;
  99. X`009`009`009`009writeln ('Error: '')'' or '','' expected');
  100. X`009`009`009`009writeln ('       ''',current_atom,''' detected.');
  101. X`009`009`009`009writeln ('       at function ',name,'.');
  102. X`009`009`009`009error_flag := true;
  103. X
  104. X`009`009`009`009if counter < max_param then begin
  105. X`009`009`009`009    counter := counter +1;
  106. X`009`009`009`009    params`091counter`093 := put_error
  107. X`009`009`009`009    `009(''')'' or '','' expected.');
  108. X`009`009`009`009end;
  109. X`009`009`009
  110. X`009`009`009    end;    `123 else `125
  111. X
  112. X`009`009`009    read_atom;
  113. X`009`009`009end;`009`123 while `125
  114. X`032
  115. X                        if current_atom = ')' then atom_readed := false
  116. X                        else begin
  117. X`009`009`009    LINE_error;
  118. X`009`009`009    writeln ('Error: '')'' expected');
  119. X`009`009`009    writeln ('       at function ',name,'.');
  120. X`009`009`009    error_flag := true;
  121. X
  122. X`009`009`009    if counter < max_param then begin
  123. X`009`009`009`009counter := counter +1;
  124. X`009`009`009`009params`091counter`093 := put_error
  125. X`009`009`009`009    (''')'' expected.');
  126. X`009`009`009    end;
  127. X
  128. X`009`009`009end;`009`123 else `125
  129. X`009`009`009if count_params(params) < min then begin
  130. X`009`009`009    LINE_error;
  131. X`009`009`009    writeln('Error: Too few parameters');
  132. X`009`009`009    writeln('       at function ',name,'.');
  133. X`009`009`009    error_flag := true;
  134. X
  135. X`009`009`009    if counter < max_param then begin
  136. X`009`009`009`009counter := counter +1;
  137. X`009`009`009`009params`091counter`093 := put_error(
  138. X`009`009`009`009    'Too few parameters.');
  139. X`009`009`009    end;
  140. X
  141. X`009`009`009end else if count_params(params) > max then begin
  142. X`009`009`009    LINE_error;
  143. X`009`009`009    writeln('Error: Too many parameters');
  144. X`009`009`009    writeln('       at function ',name,'.');
  145. X`009`009`009    error_flag := true;
  146. X
  147. X`009`009`009    if counter < max_param then begin
  148. X`009`009`009`009counter := counter +1;
  149. X`009`009`009`009params`091counter`093 := put_error(
  150. X`009`009`009`009    'Too many parameters.');
  151. X`009`009`009    end;
  152. X
  153. X`009`009`009end;    `123 if `125
  154. X`009`009`009case function_type of
  155. X`009`009`009    n_function: eval := put_atom_2 (fcode,params);
  156. X`009`009`009    n_header: eval := put_atom_h (fcode,params,refer);
  157. X`009`009`009    otherwise eval := put_error(
  158. X`009`009`009`009'Unrecognized function: '+name);
  159. X
  160. X`009`009`009end;`009`123 else `125
  161. X                     end;   `123 else `125
  162. X                  end`009`123 else `125
  163. X               end  `123 else `125
  164. X            end`009`123 else `125
  165. X          end;
  166. X       `032
  167. X`009  procedure dump_buffer;
  168. X`009  var count,num,i: integer;
  169. X`009  begin`032
  170. X`009    rewrite(result);
  171. X`009    with pool`091current_buffer`093 do `009`009
  172. X`009    `009for count := 1 to atom_count do with table `091 count `093 do`03
  173. V2
  174. X`009`009begin
  175. X`009`009used := count;
  176. X`009        `123 --- `125`009`009
  177. X`009`009case nametype of
  178. X`009`009    n_comment: begin
  179. X`009`009`009writeln(result,count:1,':0:0:0:',long_name`094)
  180. X`009`009    end;
  181. X`009`009    n_head: begin
  182. X`009`009`009writeln(result,count:1,':',params`0911`093:1,':0:0:-');
  183. X`009`009    end;
  184. X`009`009    n_const: begin
  185. X`009`009`009write(result,count:1,':0:0:0:"');
  186. X`009`009`009writeln(result,long_name`094,'"');
  187. X`009`009    end;
  188. X`009`009    n_variable: begin
  189. X`009`009`009writeln(result,count:1,':0:0:0:_',long_name`094);
  190. X`009`009    end;
  191. X`009`009    n_gosub: begin
  192. X`009`009`009num := count_params(params);
  193. X`009`009`009write(result,'J',name:1,':',num:1);
  194. X`009`009`009for i := 1 to num do write(result,':',params`091i`093:1);
  195. X`009`009`009writeln(result);
  196. X`009`009    end;
  197. X`009`009    n_header: begin
  198. X`009`009`009num := count_params(params);
  199. X`009`009`009write(result,'H',name:1,':',num:1);
  200. X`009`009`009for i := 1 to num do write(result,':',params`091i`093:1);
  201. X`009`009`009writeln(result,':',long_name`094);
  202. X`009`009    end;
  203. X`009`009    n_function: begin
  204. X`009`009`009write(result,-count:1,':',params`0911`093:1,':',
  205. X`009`009`009    params`0912`093:1,':',params`0913`093:1,':',name:1);
  206. X`009`009`009num := count_params(params);
  207. X`009`009`009if num <= 3 then writeln(result)
  208. X`009`009`009else begin
  209. X`009`009`009    write(result,':',num-3);
  210. X`009`009`009    for i := 4 to num do write(result,':',params`091i`093:1);
  211. X`009`009`009    writeln(result);
  212. X`009`009`009end;
  213. X`009`009    end;
  214. X`009`009end; `123 case `125
  215. X`009    `123 ---- `125
  216. X`009    end;
  217. X`009  end;
  218. X `032
  219. X      begin `123 parse `125
  220. X`009write_debug('%parse');
  221. X
  222. X`009clear_program(current_buffer);
  223. X`009reset (source);
  224. X
  225. X`009line := '';
  226. X`009linecount := 0;
  227. X`009linep := 1;
  228. X`009read_line;
  229. X
  230. X`009error_flag := false;
  231. X        atom_readed := false; `032
  232. X        atom_count := 0;
  233. X`009label_count := 0;
  234. X
  235. X        while not LINE_EOF do begin
  236. X           read_atom; if current_atom = '-' then atom_readed := false;
  237. X           put_atom ('-',eval);
  238. X           read_atom; if (current_atom = '(') or
  239. X              (current_atom = ')') or (current_atom=',') then begin
  240. X`009      LINE_error;
  241. X              writeln('Error: ''',current_atom,''' detected as function star
  242. Vt.');
  243. X`009      writeln('       ''',current_atom,''' skipped.');
  244. X`009      error_flag := true;
  245. X
  246. X`009      put_atom('-',
  247. X`009`009 put_error(''''+current_atom+''' detected as function start.'));
  248. X
  249. X`009      atom_readed := false
  250. X           end;
  251. X        end;
  252. X`009replace_GOSUB;
  253. X        999:
  254. X`009if error_flag then begin
  255. X`009    LINE_error;
  256. X`009    writeln('FATAL: Error(s) occured. Code not produced.');
  257. X`009    clear_program(current_buffer);
  258. X`009end else dump_buffer;
  259. X
  260. X        close(source);
  261. Xend; `123 parse `125
  262. X        `032
  263. Xfunction alloc_buffer(program_number: integer): integer;
  264. Xvar i: integer;
  265. X    found: integer;
  266. X    biggest: integer;
  267. Xbegin
  268. X    write_debug('%alloc_buffer');
  269. X    found := 0;
  270. X    biggest := 1;
  271. X    for i := 1 to max_buffer do with pool`091i`093 do begin
  272. X`009if used > 0 then begin
  273. X`009    if current_program = program_number then found := i;
  274. X`009    if pool`091biggest`093.time < time then biggest := i;
  275. X`009    if time < maxint then time := time+1;
  276. X`009end else if found = 0 then found := i;
  277. X    end; `123 for `125
  278. X    if found = 0 then found := biggest;
  279. X    if debug then writeln('%alloc_buffer : result ',found:1);
  280. X    alloc_buffer := found;
  281. Xend; `123 alloc buffer `125
  282. X         `032
  283. X            `032
  284. Xprocedure read_program (var source: text; buffer: integer);
  285. Xvar ln,i,cn: integer;
  286. X       prms: paramtable;
  287. X       atom: string_t;          `032
  288. X       a,b,c,d: char;
  289. X       code: integer;
  290. X       code_index: integer;
  291. X       code_type:  name_type;
  292. X       dataline: boolean;
  293. X       linetype: char;
  294. Xbegin
  295. X    reset (source);
  296. X    with pool`091buffer`093 do begin
  297. X`009used := 0;
  298. X`009time := 0;
  299. X`009while not (eof(source)) do begin
  300. X`009    for i := 1 to max_param do prms`091i`093 := 0;
  301. X`009    dataline := false;
  302. X`009    linetype := ' ';
  303. X`009    if eoln(source) then ln := 0
  304. X`009    else if source`094 in `091 '0' .. '9' , ' ' , '-' `093 then read (so
  305. Vurce,ln)
  306. X`009    else if source`094 = '!' then ln := 0
  307. X`009    else begin
  308. X`009`009ln := used +1;`009`009`123 default value - not check `125
  309. X`009`009read(source,linetype);
  310. X`009    end;
  311. X
  312. X`009    if ln = 0 then readln(source)   `123 skip end of line `125
  313. X`009    else dataline := true;
  314. X
  315. X`009    code_index := 0;
  316. X`009    code_type  := n_error;
  317. X
  318. X`009     if dataline then begin
  319. X
  320. X
  321. X`009`009case linetype of
  322. X
  323. X`009`009    ' ':
  324. X`009`009    begin`032
  325. X`009`009`009if ln > 0 then
  326. X`009`009`009    readln(source,a,prms`0911`093,b,prms`0912`093,c,prms`0913`09
  327. V3,d,atom)
  328. X`009`009`009else begin
  329. X`009`009`009    read(source,a,prms`0911`093,b,prms`0912`093,c,prms`0913`093,
  330. Vd,code);
  331. X`009`009`009    if eoln(source) then readln(source)
  332. X`009`009`009    else begin
  333. X`009`009`009`009read(source,a,cn);
  334. X`009`009`009`009for i := 1 to cn do`032
  335. X`009`009`009`009    read(source,a,prms`091i+3`093);
  336. X`009`009`009`009readln(source);
  337. X`009`009`009    end;
  338. X`009`009`009    `123 atom := ftable`091name`093.name; `125
  339. X`009`009`009    code_index := code;
  340. X`009`009`009    code_type  := n_function;
  341. X`009`009`009    ln := -ln;
  342. X`009`009`009end;
  343. X`009`009
  344. X`009`009`009`123 koodin tunnistus `125
  345. X`009`009`009if code_index = 0 then begin
  346. X`009`009`009    if atom`0911`093 = '!' then begin
  347. X`009`009`009`009code_type  := n_comment;
  348. X`009`009`009`009code_index := 1;
  349. X`009`009`009    end else if atom = '-' then begin
  350. X`009`009`009`009code_type := n_head;
  351. X`009`009`009`009code_index := 1;
  352. X`009`009`009`009atom := '';
  353. X`009`009`009    end else if atom`0911`093 = '"' then begin
  354. X`009`009`009`009code_type := n_const;
  355. X`009`009`009`009code_index := 1;
  356. X`009`009`009`009atom := substr(atom,2,length(atom)-2);
  357. X`009`009`009    end else if atom`0911`093 = '_' then begin
  358. X`009`009`009`009code_type := n_variable;
  359. X`009`009`009`009code_index := 1;
  360. X`009`009`009`009atom := substr(atom,2,length(atom)-1);
  361. X`009`009`009    end else if exact_header(code,atom) then begin
  362. X`009`009`009`009code_type := n_header;
  363. X`009`009`009`009code_index := code;
  364. X`009`009`009`009atom := substr(atom,length(htable`091code`093.name)+1,
  365. X`009`009`009`009    length(atom)-length(htable`091code`093.name));
  366. X`009`009`009    end else if exact_function(code,atom) then begin
  367. X`009`009`009`009code_type  := n_function;
  368. X`009`009`009`009code_index := code;
  369. X`009`009`009`009atom := '';
  370. X`009`009`009    end else code_type := n_error;
  371. X`009`009`009end else atom := '';
  372. X`009`009    end;
  373. X
  374. X`009`009    'H':
  375. X`009`009    begin
  376. X`009`009`009code_type := n_header;
  377. X`009`009`009read(source,code_index,a,cn);
  378. X
  379. X`009`009`009for i := 1 to cn do`032
  380. X`009`009`009    read(source,a,prms`091i`093);
  381. X`009`009`009readln(source,a,atom);
  382. X`009`009    end;
  383. X
  384. X`009`009    'J':
  385. X`009`009    begin
  386. X`009`009`009code_type := n_gosub;
  387. X`009`009`009read(source,code_index,a,cn);
  388. X
  389. X`009`009`009for i := 1 to cn do`032
  390. X`009`009`009    read(source,a,prms`091i`093);
  391. X`009`009`009readln(source);
  392. X`009`009`009atom := '';
  393. X`009`009    end;
  394. X
  395. X`009`009    otherwise begin
  396. X`009`009`009writeln('%Bad program file #2. Notify Monster Manager.');
  397. X`009`009`009halt;
  398. X`009`009    end;
  399. X
  400. X`009`009end; `123 case `125
  401. X
  402. X`009`009if ln <> used+1 then begin
  403. X`009`009    writeln ('%Bad program file #1. Notify Monster Manager.');
  404. X`009`009    halt
  405. X`009`009end else if ln > MAXATOM then begin
  406. X`009`009    writeln ('Error: Maximum number of atoms exceeded.');
  407. X`009`009    halt
  408. X`009`009end;
  409. X
  410. X`009`009used := ln;
  411. X`009`009with table `091ln`093 do begin
  412. X`009`009    params := prms;
  413. X`009`009    nametype := code_type;
  414. X`009`009    name := code_index;
  415. X`009`009    case code_type of`032
  416. X`009`009`009n_function,n_head,n_error,n_gosub: long_name := nil;
  417. X`009`009`009n_header,n_variable,n_const,n_comment: begin
  418. X`009`009`009    new(long_name);
  419. X`009`009`009    long_name`094 := atom;
  420. X`009`009`009end;
  421. X`009`009    end; `123 case `125
  422. X`009`009end
  423. X`009    end; `123 if dataline `125
  424. X`009end; `123 while `125
  425. X    end; `123 with `125
  426. X    close(source)
  427. Xend; `123 read_program `125
  428. X                   `032
  429. Xprocedure print_program (buffer: integer;
  430. X`009`009`009procedure print(l: string_t); len: integer := 80);
  431. Xvar line_i: string_t;
  432. X    i:    integer;
  433. X
  434. X     procedure l_print(s: string_t);
  435. X     begin
  436. X`009while length(s) > len do begin
  437. X`009    print(substr(s,1,len));
  438. X`009    s := substr(s,len+1,length(s)-len);
  439. X`009end;
  440. X`009print(s);
  441. X     end; `123 l_print `125
  442. X
  443. X     procedure put_atom (item,level: integer);
  444. X
  445. X        procedure nice_print(c: string_t);
  446. X        var i,cut: integer;
  447. X            subline: string_t;
  448. X        begin
  449. X`009    cut := terminal_line_len - 30;
  450. X`009    if cut < 10 then cut := 10;
  451. X
  452. X           if length(line_i) + length(c) < terminal_line_len -10 then
  453. X`009`009line_i := line_i + c `032
  454. X           else if c`0911`093 = '"' then repeat
  455. X              if length(c) < cut + 5 then begin`032
  456. X                 subline := c; c := '';
  457. X              end else begin
  458. X                 subline := substr(c,1,cut) + '"&';
  459. X                 c := '"' + substr(c,cut+1,length(c) -cut);
  460. X              end;
  461. X              l_print(line_i);
  462. X              line_i := '';
  463. X              for i := 1 to level do line_i := line_i + '   ';
  464. X              line_i := line_i + subline
  465. X           until c = '' else begin`032
  466. X              l_print(line_i);
  467. X              line_i := '';
  468. X              for i := 1 to level do line_i := line_i + '   ';
  469. X              line_i := line_i + c
  470. X           end
  471. X        end; `123 nice_print `125
  472. X        `032
  473. X    var atom_name : string_t;
  474. X`009count,i,j: integer;
  475. X
  476. X    begin with pool `091buffer`093 do begin
  477. X`009if item = 0 then nice_print('""')
  478. X        else with table`091item`093 do begin
  479. X           if long_name = nil then atom_name := ''
  480. X           else atom_name := long_name`094;
  481. X
  482. X`009   case nametype of`032
  483. X`009`009n_function: begin
  484. X`009`009    if name = ERROR_ID then begin
  485. X`009`009`009if line_i >'' then l_print(line_i);
  486. X
  487. X`009`009`009line_i := 'Error: ';
  488. X`009`009`009put_atom(params`0911`093,0);
  489. X
  490. X`009`009`009l_print(line_i);
  491. X`009`009`009line_i := '';
  492. X`009`009
  493. X`009`009    end else begin
  494. X`009`009`009nice_print(ftable`091name`093.name);
  495. X`009`009`009count := count_params(params);
  496. X`009`009`009nice_print('(');
  497. X`009`009`009for i := 1 to count do begin
  498. X`009`009`009    put_atom(params`091i`093,level+1);
  499. X`009`009`009    if i <> count then begin
  500. X`009`009`009`009nice_print(',');
  501. X`009`009`009`009if count >= new_line_limit then begin
  502. X`009`009`009`009    if line_i >'' then l_print(line_i);
  503. X`009`009`009`009    line_i := '';
  504. X`009`009`009`009    for j := 1 to level do line_i := line_i`032
  505. X`009`009`009`009`009+ '   ';
  506. X`009`009`009`009end;
  507. X`009`009`009    end;
  508. X`009`009`009end; `123 for `125
  509. X`009`009`009nice_print(')')
  510. X`009`009    end;
  511. X`009`009end;
  512. X`009`009n_header:    begin
  513. X`009`009    nice_print(htable`091name`093.name + atom_name);
  514. X`009`009    count := count_params(params);
  515. X`009`009    nice_print('(');
  516. X`009`009    for i := 1 to count do begin
  517. X`009`009`009put_atom(params`091i`093,level+1);
  518. X`009`009`009if i <> count then begin
  519. X`009`009`009    nice_print(',');
  520. X`009`009`009    if count >= new_line_limit then begin
  521. X`009`009`009`009if line_i >'' then l_print(line_i);
  522. X`009`009`009`009line_i := '';
  523. X`009`009`009`009for j := 1 to level do line_i := line_i`032
  524. X`009`009`009`009    + '   ';
  525. X`009`009`009    end;
  526. X`009`009`009end;
  527. X`009`009    end; `123 for `125
  528. X`009`009    nice_print(')')
  529. X`009`009end;
  530. X`009`009n_variable:  nice_print(atom_name);
  531. X`009`009n_const:     nice_print('"' + atom_name + '"');
  532. X`009`009n_comment:;
  533. X`009`009n_head:`009     begin
  534. X`009`009    nice_print('- ');
  535. X`009`009    put_atom(params`0911`093,level+1)
  536. X`009`009end;
  537. X`009`009n_error: nice_print( '/' + atom_name + '/');
  538. X`009`009n_gosub: begin
  539. X`009`009    nice_print('GOSUB '+table`091name`093.long_name`094);
  540. X`009`009    count := count_params(params);
  541. X`009`009    nice_print('(');
  542. X`009`009    for i := 1 to count do begin
  543. X`009`009`009put_atom(params`091i`093,level+1);
  544. X`009`009`009if i <> count then begin
  545. X`009`009`009    nice_print(',');
  546. X`009`009`009    if count >= new_line_limit then begin
  547. X`009`009`009`009if line_i >'' then l_print(line_i);
  548. X`009`009`009`009line_i := '';
  549. X`009`009`009`009for j := 1 to level do line_i := line_i`032
  550. X`009`009`009`009    + '   ';
  551. X`009`009`009    end;
  552. X`009`009`009end;
  553. X`009`009    end; `123 for `125
  554. X`009`009    nice_print(')');
  555. X`009`009end;
  556. X`009   end; `123 case `125
  557. X        end
  558. X    end; `123 with `125 end; `123 put_atom `125
  559. X
  560. Xbegin `123 print_program `125
  561. X    with pool`091buffer`093 do begin
  562. X`009line_i := '';
  563. X`009for i := 1 to used do if table `091i`093.nametype = n_head then begin
  564. X`009    if line_i >'' then l_print(line_i);
  565. X`009    line_i := '';
  566. X`009    print('');
  567. X`009    put_atom(i,0)
  568. X`009end else if table `091i`093.nametype = n_comment then begin
  569. X`009    if line_i >'' then l_print(line_i);
  570. X`009    if table`091i`093.long_name <> nil then line_i := table`091i`093.lon
  571. Vg_name`094
  572. X`009    else line_i := '<error>';
  573. X`009end;
  574. X`009l_print(line_i);
  575. X    end; `123 with `125
  576. Xend; `123 print_program `125
  577. X`032
  578. X
  579. Xfunction exec_program (label_name: atom_t; monster: atom_t;
  580. X                          variable: atom_t := '' ; value: string_t := '';
  581. X`009`009`009  buffer: integer;`032
  582. X`009`009`009  spell_name: atom_t := '';
  583. X`009`009`009  summoner_name: atom_t := ''
  584. X                         ): boolean;
  585. X  `032
  586. X      label 1;               `123 minne hyp`228t`228`228n virheen sattuessa
  587. V `125
  588. X     `032
  589. X                 `032
  590. X      const EVENT_CHECK = 50; `123 tarkista tapahtumat joka 50 evaluointi `1
  591. V25
  592. X             MAXEVAL = 500;    `123 Maksimi evaluointien lum`228`228r`228 `1
  593. V25
  594. X             MAX_VARIABLE = 30;                   `032
  595. X
  596. X      type charset = set of char;
  597. X
  598. X      var eval_count: integer;
  599. X          var_count : 0 .. MAX_VARIABLE;   `123 very big variable using `125
  600. X                                           `123 30 kB                   `125
  601. X
  602. X          vars : array `091 1 .. MAX_VARIABLE `093 of`032
  603. X                   record
  604. X                      value: string_t;
  605. X                      name: atom_t
  606. X                   end;
  607. X  `032
  608. X                                                      `032
  609. X      function eval_atom(item: integer): string_t; forward;
  610. X
  611. X
  612. X      function goto_label(label_name: atom_t; var found: boolean): string_t;
  613. X      var i,position : integer;
  614. X         result: string_t;
  615. X
  616. X      begin`032
  617. X         write_debug ('%goto_label: ',label_name);
  618. X         label_name := clean_spaces (label_name);
  619. X         result := '';
  620. X         position := 0;
  621. X`009 with pool`091buffer`093 do begin
  622. X`009    for i:= 1 to used do if table`091i`093.nametype = n_header then
  623. X`009`009    if table`091i`093.name = 6 `123 LABEL `125 then
  624. X`009`009`009if table`091i`093.long_name`094 = label_name then`032
  625. X`009`009`009    position := i;
  626. X`009    if position > 0 then begin
  627. X`009`009found := true; `123 t`228m`228 pit`228`228 olla ennen eval_atom:ia k
  628. Voska `125
  629. X`009`009`009    `123 sen suoritus voidaan keskeytt`228`228          `125
  630. X`009`009result := eval_atom(position);
  631. X`009    end else begin
  632. X`009`009found := false;
  633. X`009`009error_counter := error_counter +1
  634. X`009    end;
  635. X`009 end; `123 with `125
  636. X         write_debug ('%goto_label result: ',result);`009
  637. X         goto_label := result
  638. X      end;
  639. X                                                       `032
  640. X      function eval_variable( variable: atom_t): string_t;            `032
  641. X      var i : integer;
  642. X          result: string_t;
  643. X      begin          `032
  644. X         write_debug('%eval_variable: ',variable);
  645. X         variable := clean_spaces(variable);
  646. X         result := '';               `032
  647. X         for i := 1 to var_count do if variable = vars `091i`093.name then
  648. X            result := vars`091i`093.value;
  649. X         write_debug('%eval_variable result: ',result);`009
  650. X         eval_variable := result
  651. X      end; `123 eval variable `125                           `032
  652. X
  653. X      procedure set_variable ( variable: atom_t; value: string_t);
  654. X      var i,point : integer;
  655. X      begin          `032
  656. X        write_debug ('%set_variable: ',variable);
  657. X        write_debug ('%       value: ',value);
  658. X        variable := clean_spaces(variable);
  659. X        point := 0;                                        `032
  660. X        for i := 1 to var_count do if variable = vars `091i`093.name then
  661. X           point := i;
  662. X        if point > 0 then vars`091point`093.value := value
  663. X        else write_debug('%set variable - no variable');
  664. X      end; `123 eval variable `125                                    `032
  665. X
  666. X      procedure define_variable (variable: atom_t);   `032
  667. X      begin
  668. X         write_debug('%define_variable: ',variable);
  669. X         if var_count < MAX_VARIABLE then begin
  670. X            var_count := var_count +1;
  671. X            vars`091var_count`093.value := '';
  672. X            vars`091var_count`093.name := clean_spaces(variable)
  673. X         end
  674. X      end; `123 define_variable `125              `032
  675. X
  676. X      procedure strim(var s: string_t; a: string_t; raw: boolean := false);
  677. X      begin
  678. X`009write_debug('%strim: ',s);
  679. X`009write_debug('%     : ',a);
  680. X`009if raw then write_debug('%      - raw mode');
  681. X`009if (a > '') and (s > '') and not raw then`032
  682. X`009    if (a`0911`093 in `091 'a'..'z', 'A'..'Z', '0'..'9',`032
  683. X`009`009    '.', ',', '?', ';', '!' `093) and
  684. X`009`009not (s`091length(s)`093 in `091 '''', '"', ' '`093)`032
  685. X`009`009`009    or`032
  686. X`009`009(s`091length(s)`093 in `091 'a'..'z', 'A'..'Z', '0'..'9',`032
  687. X`009`009    '.', ',', '?', ';', '!' `093) and
  688. X`009`009not (a`0911`093 in `091 '''', '"', ' '`093) then
  689. X`009`009    if length(s) < string_length then
  690. X`009`009`009s := s + ' ';
  691. X`009if length(s) + length(a) < string_length then
  692. X`009    s := s + a;
  693. X`009write_debug('%  -> : ',s);
  694. X      end;
  695. X
  696. X      function e_plus (params: paramtable): string_t;
  697. X      var a,result: string_t;
  698. X`009    i: integer;
  699. X      begin            `032
  700. X         write_debug('%e_plus');
  701. X`009 result := '';
  702. X`009 for i := 1 to count_params(params) do begin
  703. X`009    a := eval_atom (params`091i`093);
  704. X`009    write_debug('%e_eval - .. ',a);
  705. X`009    strim (result,a);
  706. X`009 end;
  707. X         write_debug ('%e_plus result: ',result);
  708. X         e_plus := result;
  709. X      end; `123 e_plus `125      `032
  710. X    `032
  711. X      function cut_string ( var main: string_t; var index: integer;
  712. X                            chars: charset; max: integer): string_t;
  713. X      var start,i,upper: integer;
  714. X      begin
  715. X        write_debug ('%cut_string');
  716. X        start := index;
  717. X        if start + max <= length(main) then upper := start + max
  718. X        else upper := length(main);
  719. X        index := upper;
  720. X        for i := start to upper do if main `091i`093 in chars then index :=
  721. V i;
  722. X        cut_string := substr(main,start,index-start+1);
  723. X        index := index+1      `032
  724. X      end; `123 cut_string `125
  725. X
  726. X      function meta_print(params: paramtable;
  727. X`009`009`009     procedure print(s: string_t);
  728. X`009`009`009     raw: boolean;`032
  729. X`009`009`009     len : integer := 80
  730. X`009`009`009 ): string_t;
  731. X      var a: string_t;  `032
  732. X`009  a1: string_t;
  733. X          base,i: integer;
  734. X
  735. X`009    procedure make_upper(var s: string_t);
  736. X`009    var i: integer;
  737. X`009`009upcase: boolean;
  738. X`009    begin
  739. X`009`009upcase := true;
  740. X`009`009for i := 1 to length(s) do begin
  741. X`009`009    if (s`091i`093 in `091 'a' .. 'z' `093) and upcase then
  742. X`009`009`009s`091i`093 := chr(ord(s`091i`093) - ord('a') + ord('A'));
  743. X`009`009    if s`091i`093 in `091 '.','?','!',':' `093 then
  744. X`009`009`009upcase := true
  745. X`009`009    else if classify(s`091i`093) <> space then upcase := false;
  746. X`009`009end;
  747. X`009    end;
  748. X
  749. X      begin  `032
  750. X        write_debug('%meta_print');
  751. X`009if raw then write_debug('%           - raw_mode');
  752. X`009a := '';
  753. X`009for i := 1 to count_params(params) do begin
  754. X`009    a1 := eval_atom(params`091i`093);`032
  755. X`009    write_debug('%meta_print - .. ',a1);
  756. X`009    strim (a,a1,raw);
  757. X`009end;
  758. X`009if (a > '') and not raw then if length(a) < string_length then
  759. X`009    if a`091length(a)`093 in `091 'a' .. 'z', 'A' .. 'Z', '0' .. '9' `09
  760. V3 then
  761. X`009`009a := a + '.';
  762. X`009if length(a) < string_length then a := a + ' ';
  763. X`009if not raw then make_upper(a);
  764. X
  765. X        base := 1;
  766. X        while base <= length(a) do
  767. X          print (cut_string(a,base, `091 '.', ',', ' '`093, len-5 ));
  768. X        write_debug('%meta_print - result: ',a);
  769. X        meta_print := a;
  770. X      end; `123 meta_print `125                `032
  771. X
  772. X      function e_pprint(params: paramtable; raw: boolean): string_t;
  773. X
  774. X`009    procedure print(s: string_t);
  775. X`009    begin
  776. X`009`009writeln(s);
  777. X`009    end;
  778. X
  779. X      begin  `032
  780. X        write_debug('%e_pprint');
  781. X        e_pprint := meta_print(params,print,raw,terminal_line_len);
  782. X      end; `123 e_pprint `125                `032
  783. X
  784. X      function e_print(params:paramtable; raw: boolean): string_t;
  785. X
  786. X`009    procedure print(s: string_t);
  787. X`009    begin
  788. X`009`009int_broadcast(monster,s,false);
  789. X`009    end;
  790. X
  791. X      begin  `032
  792. X        write_debug('%e_print');
  793. X        e_print := meta_print(params,print,raw,80);
  794. X      end; `123 e_print `125                `032
  795. X
  796. X      function e_oprint(params:paramtable; raw: boolean): string_t;
  797. X
  798. X`009    procedure print(s: string_t);
  799. X`009    begin
  800. X`009`009int_broadcast(monster,s,true);
  801. X`009    end;
  802. X
  803. X      begin  `032
  804. X        write_debug('%e_oprint');
  805. X        e_oprint := meta_print(params,print,raw,80);
  806. X      end; `123 e_oprint `125                `032
  807. X
  808. X      function e_print_null (params: paramtable): string_t;
  809. X
  810. X`009    procedure print(s: string_t);
  811. X`009    begin
  812. X`009    end;
  813. X
  814. X      begin  `032
  815. X        write_debug('%e_print');
  816. X        e_print_null := meta_print(params,print,false,132);
  817. X      end; `123 e_print `125                `032
  818. X
  819. X      function e_if (p1,p2,p3: integer): string_t;
  820. X      var result: string_t;
  821. X      begin
  822. X        write_debug('%e_if');
  823. X        if eval_atom(p1) > '' then result := eval_atom(p2)
  824. X        else result := eval_atom(p3);
  825. X        write_debug('%e_if result: ',result);
  826. X        e_if := result
  827. X      end; `123 e_if `125                        `032
  828. X
  829. X      function e_inv: string_t;                      `032
  830. X      var result: string_t;
  831. X      begin               `032
  832. X        write_debug('%e_inv');
  833. X        result := int_inv (monster);
  834. X        write_debug('%e_inv result: ',result);
  835. X        e_inv := result;
  836. X      end; `123 e_inv `125
  837. X
  838. X      function e_pinv: string_t;
  839. X      var result: string_t;
  840. X      begin
  841. X        write_debug('%e_pinv');
  842. X        result := int_inv (myname);
  843. X        write_debug('%e_pinv result: ',result);
  844. X        e_pinv := result;
  845. X      end; `123 e_pinv `125
  846. X     `032
  847. X                    `032
  848. X      procedure add_atom (var main:string_t; atom: atom_t);
  849. X      begin
  850. X        write_debug('%add_atom');
  851. X        if main = '' then main := atom
  852. X        else if length(main) + length (atom) < string_length -3 then
  853. X          main := main + ', ' + atom
  854. X      end; `123 add_atom `125
  855. X
  856. X      function meta_do (p1: integer;
  857. X`009`009`009function action(atom: atom_t): atom_t
  858. X`009`009       ): string_t;
  859. X      var list,result: string_t;
  860. X          atom: atom_t;
  861. X          index: integer;
  862. X      begin
  863. X         write_debug('%meta_do');
  864. X         list := eval_atom (p1);
  865. X         write_debug('%meta_do - param: ',list);
  866. X         index := 1;
  867. X         result := '';
  868. X         while index <= length(list) do
  869. X            begin
  870. X               atom := clean_spaces(cut_atom(list,index,','));
  871. X`009       if atom > '' then atom := action(atom);
  872. X`009       if atom > '' then add_atom(result,atom);
  873. X            end;
  874. X         write_debug('%meta_do result: ',result);
  875. X         meta_do := result
  876. X      end; `123 meta_do `125
  877. X
  878. X      function e_get_global_flag(p1: integer): string_t;
  879. X      var result: string;
  880. X
  881. X`009    function action(atom: atom_t): atom_t;
  882. X`009    var value: INTEGER;
  883. X`009    begin
  884. X`009`009if lookup_flag(value,atom) then`032
  885. X`009`009    if read_global_flag(value) then action := 'TRUE'
  886. X`009`009    else action := ''
  887. X`009`009else action := '';
  888. X`009    end;
  889. X
  890. X      begin
  891. X         write_debug('%e_get_global_flag');
  892. X`009 result := meta_do(p1,action);
  893. X         write_debug('%e_get_global_flag result: ',result);
  894. X         e_get_globaL_FLAG := result
  895. X      end; `123 e_get_get_global_flag `125
  896. X
  897. X    `032
  898. X      function e_get (p1: integer): string_t;
  899. X      var result: string_t;
  900. X
  901. X`009    function action(atom: atom_t): atom_t;
  902. X`009    begin
  903. X`009`009if int_get(monster,atom) then action := atom
  904. X`009`009else action := '';
  905. X`009    end;
  906. X
  907. X      begin
  908. X         write_debug('%e_get');
  909. X`009 result := meta_do(p1,action);
  910. X         write_debug('%e_get result: ',result);
  911. X         e_get := result
  912. X      end; `123 e_get `125
  913. X
  914. X      function e_pget (p1: integer): string_t;
  915. X      var result: string_t;
  916. X
  917. X`009    function action(atom: atom_t): atom_t;
  918. X`009    begin
  919. X`009`009if int_get(myname,atom) then action := atom
  920. X`009`009else action := '';
  921. X`009    end;
  922. X
  923. X      begin
  924. X         write_debug('%e_pget');
  925. X         result := '';
  926. X         if privilegion then begin
  927. X`009    result := meta_do(p1,action);
  928. X         end;
  929. X         write_debug('%e_pget result: ',result);
  930. X         e_pget := result
  931. X      end; `123 e_pget `125                                   `032
  932. X
  933. X      function list_include(list: string_t; atom: atom_t): boolean;
  934. X      var a: atom_t;
  935. X          i: integer;
  936. X          result: boolean;
  937. X
  938. X      begin
  939. X         write_debug('%list_include');
  940. X         write_debug('%list_include - list: ',list);
  941. X         write_debug('%               atom: ',atom);
  942. X         result := false;
  943. X         i := 1;
  944. X         while i <= length(list) do begin
  945. X            a := clean_spaces(cut_atom(list,i,','));
  946. X            if a = atom then result := true;
  947. X         end;
  948. X         write_debug('%list_include - ready.');
  949. X         list_include := result;
  950. X      end; `123 list_include `125
  951. X
  952. X      function e_exclude(p1,p2: integer): string_t;
  953. X      var a1,a2,result: string_t;
  954. X          atom: atom_t;
  955. X          i: integer;
  956. X
  957. X      begin
  958. X         write_debug('%e_exclude');
  959. X         result := '';
  960. X         a1 := eval_atom(p1);
  961. X         a2 := eval_atom(p2);
  962. X         write_debug('%e_and - p1: ',a1);
  963. X         write_debug('%      - p2: ',a2);
  964. X         i := 1;
  965. X         while i <= length(a1) do begin
  966. X            atom := clean_spaces(cut_atom(a1,i,','));
  967. X            if not list_include(a2,atom) then add_atom(result,atom);
  968. X         end;
  969. X         write_debug('%e_exclude - result: ',result);
  970. X         e_exclude := result;
  971. X      end; `123 e_exclude `125
  972. X
  973. X      function e_and (p1,p2: integer): string_t;
  974. X      var result,first,second: string_t;
  975. X          i: integer;
  976. X          atom: atom_t;
  977. X      begin
  978. X         write_debug('%e_and');
  979. X         result := '';
  980. X         first := eval_atom (p1);
  981. X         second := eval_atom (p2);
  982. X         write_debug('%e_and - p1: ',first);
  983. X         write_debug('%        p2: ',second);
  984. X         i := 1;
  985. X         while i <= length(first) do
  986. X            begin
  987. X               atom := clean_spaces(cut_atom(first,i,','));
  988. X               if list_include(second,atom) and not list_include(result,atom
  989. V) then
  990. X                 add_atom(result,atom)
  991. X            end;
  992. X        write_debug('%e_and result: ',result);
  993. X        e_and := result
  994. X      end; `123 e_and `125
  995. X
  996. X      function e_or (p1,p2,p3: integer): string_t;
  997. X      var result: string_t;
  998. X
  999. X`009function action (atom: atom_t): atom_t;
  1000. X`009begin
  1001. X`009    if not list_include(result,atom) then add_atom(result,atom);
  1002. X`009    action := ''
  1003. X`009end;
  1004. X
  1005. X      begin
  1006. X`009write_debug('%e_or');
  1007. X`009result := '';
  1008. X`009meta_do(p1,action);
  1009. X`009meta_do(p2,action);
  1010. X`009meta_do(p3,action);
  1011. X        write_debug('%e_or result: ',result);
  1012. X        e_or := result
  1013. X      end; `123 e_and `125
  1014. X     `032
  1015. X      function e_drop (p1: integer): string_t;
  1016. X      var result: string_t;
  1017. X
  1018. X`009    function action(atom: atom_t): atom_t;
  1019. X`009    begin
  1020. X`009`009if int_drop(monster,atom) then action := atom
  1021. X`009`009else action := '';
  1022. X`009    end;
  1023. X
  1024. X      begin
  1025. X         write_debug('%e_drop');
  1026. X`009 result := meta_do(p1,action);
  1027. X         write_debug('%e_drop result: ',result);
  1028. X         e_drop := result
  1029. X      end; `123 e_drop `125
  1030. X               `032
  1031. X      function e_pdrop (p1: integer): string_t;
  1032. X      var result: string_t;
  1033. X
  1034. X`009    function action(atom: atom_t): atom_t;
  1035. X`009    begin
  1036. X`009`009if int_drop(myname,atom) then action := atom
  1037. X`009`009else action := '';
  1038. X`009    end;
  1039. X
  1040. X      begin
  1041. X         write_debug('%e_pdrop');
  1042. X`009 result := '';
  1043. X         if privilegion then begin                   `032
  1044. X`009    result := meta_do(p1,action);
  1045. X         end;
  1046. X         write_debug('%e_pdrop result: ',result);
  1047. X         e_pdrop := result
  1048. X      end; `123 e_pdrop `125
  1049. X
  1050. X      function e_duplicate (p1: integer): string_t;
  1051. X      var result: string_t;
  1052. X          owner: atom_t;
  1053. X          priv: boolean;
  1054. X
  1055. X`009    function action(atom: atom_t): atom_t;
  1056. X`009    begin
  1057. X                if int_duplicate (monster,atom,owner,priv) then action := at
  1058. Vom
  1059. X`009        else action := '';
  1060. X`009    end;
  1061. X
  1062. X      begin
  1063. X         write_debug('%e_duplicate');
  1064. X         owner := x_monster_owner(pool`091buffer`093.current_program);
  1065. X         priv := int_ask_privilege(monster,'owner') or`032
  1066. X`009`009system_code or spell_mode;
  1067. X`009 result := meta_do(p1,action);
  1068. X         write_debug('%e_duplicate result: ',result);
  1069. X         e_duplicate := result
  1070. X      end; `123 e_duplicate `125
  1071. X               `032
  1072. X      function e_pduplicate (p1: integer): string_t;
  1073. X      var result: string_t;
  1074. X          owner: atom_t;
  1075. X          priv: boolean;
  1076. X
  1077. X`009    function action(atom: atom_t): atom_t;
  1078. X`009    begin
  1079. X                if int_duplicate (myname,atom,owner,priv) then action := ato
  1080. Vm
  1081. X`009        else action := '';
  1082. X`009    end;
  1083. X
  1084. X      begin
  1085. X         write_debug('%e_pduplicate');
  1086. X         owner := x_monster_owner(pool`091buffer`093.current_program);
  1087. X         priv := int_ask_privilege(monster,'owner') or`032
  1088. X`009    system_code or spell_mode;
  1089. X         result := '';
  1090. X         if privilegion then begin
  1091. X`009    result := meta_do(p1,action);
  1092. X         end;
  1093. X         write_debug('%e_pduplicate result: ',result);
  1094. X         e_pduplicate := result
  1095. X      end; `123 e_pduplicate `125
  1096. X
  1097. X      function e_destroy (p1: integer): string_t;
  1098. X      var result: string_t;
  1099. X          owner: atom_t;
  1100. X          priv: boolean;
  1101. X
  1102. X`009    function action(atom: atom_t): atom_t;
  1103. X`009    begin
  1104. X                if int_destroy (monster,atom,owner,priv) then action := atom
  1105. X`009        else action := '';
  1106. X`009    end;
  1107. X
  1108. X
  1109. X      begin
  1110. X         write_debug('%e_destroy');
  1111. X         owner := x_monster_owner(pool`091buffer`093.current_program);
  1112. X         priv := int_ask_privilege(monster,'owner') or`032
  1113. X`009    system_code or spell_mode;
  1114. X         result := meta_do (p1,action);
  1115. X         write_debug('%e_destroy result: ',result);
  1116. X         e_destroy := result
  1117. X      end; `123 e_destroy `125
  1118. X               `032
  1119. X      function e_pdestroy (p1: integer): string_t;
  1120. X      var result: string_t;
  1121. X          owner: atom_t;
  1122. X          priv: boolean;
  1123. X
  1124. X`009    function action(atom: atom_t): atom_t;
  1125. X`009    begin
  1126. X                if int_destroy (myname,atom,owner,priv) then action := atom
  1127. X`009        else action := '';
  1128. X`009    end;
  1129. X
  1130. X      begin
  1131. X         write_debug('%e_pdestroy');
  1132. X         owner := x_monster_owner(pool`091buffer`093.current_program);
  1133. X         priv := int_ask_privilege(monster,'owner') or`032
  1134. X`009    system_code or spell_mode;
  1135. X         result := '';
  1136. X         if privilegion then begin
  1137. X`009    result := meta_do(p1,action);
  1138. X         end;
  1139. X         write_debug('%e_pdestroy result: ',result);
  1140. X         e_pdestroy := result
  1141. X      end; `123 e_pdestroy `125
  1142. X
  1143. X      function e_move (p1: integer): string_t;
  1144. X      var result, line_i: string_t;
  1145. X      begin
  1146. X         write_debug('%e_move');
  1147. X         line_i := eval_atom (p1);
  1148. X         write_debug('%e_move - p1: ',line_i);
  1149. X         if length(line_i) > atom_length then`032
  1150. X            line_i := substr(line_i,1,atom_length);
  1151. X         if int_poof(monster,line_i,x_monster_owner(pool`091buffer`093.curre
  1152. Vnt_program),
  1153. X            int_ask_privilege(monster,'poof')
  1154. X`009    or system_code or spell_mode,privilegion) then result := line_i
  1155. X         else result := '';
  1156. X         write_debug('%e_move result: ',result);
  1157. X         e_move := result
  1158. X      end; `123 e_move `125
  1159. X
  1160. X      function e_pmove (p1: integer): string_t;
  1161. X      var result, line_i: string_t;
  1162. X      begin
  1163. X         write_debug ('%e_pmove');
  1164. X         line_i := eval_atom (p1);
  1165. X         write_debug('%e_pmove - p1: ',line_i);
  1166. X         if length(line_i) > atom_length then`032
  1167. X            line_i := substr(line_i,1,atom_length);
  1168. X         if int_poof(myname,line_i,x_monster_owner(pool`091buffer`093.curren
  1169. Vt_program),
  1170. X            int_ask_privilege(monster,'poof')
  1171. X`009    or system_code or spell_mode,privilegion) then result := line_i
  1172. X         else result := '';
  1173. X         write_debug('%e_pmove result: ',result);
  1174. X         e_pmove := result
  1175. X      end; `123 e_pmove `125
  1176. X
  1177. X      function e_players: string_t;
  1178. X      var result: string_t;
  1179. X      begin
  1180. X        write_debug('%e_players');
  1181. X        result := int_players (monster);
  1182. X        write_debug('%e_players result: ',result);
  1183. X        e_players := result
  1184. X      end; `123 e_players `125                   `032
  1185. X
  1186. X
  1187. X      function e_objects: string_t;
  1188. X      var result: string_t;
  1189. X      begin
  1190. X        write_debug('%e_objects');
  1191. X        result := int_objects (monster);
  1192. X        write_debug('%e_objects result: ',result);
  1193. X        e_objects := result
  1194. X      end; `123 e_onjects `125
  1195. X
  1196. X      function e_remote_objects(p1: integer): string_t;
  1197. X      var result,a1: string_t;
  1198. X      begin
  1199. X         write_debug('%e_remote_objects');
  1200. X         a1 := eval_atom(p1);
  1201. X         write_debug('%e_remote_objects - p1: ',a1);
  1202. X         if length (a1) > atom_length then
  1203. X            line_i := substr(a1,1,atom_length);
  1204. X         result := int_remote_objects (a1);
  1205. X         write_debug('%e_objects result: ',result);
  1206. X         e_remote_objects := result
  1207. X      end; `123 e_remote_objects `125
  1208. X                         `032
  1209. X      function e_remote_players(p1: integer): string_t;
  1210. X      var result,a1: string_t;
  1211. X      begin
  1212. X         write_debug('%e_remote_players');
  1213. X         a1 := eval_atom(p1);
  1214. X         write_debug('%e_remote_players - p1: ',a1);
  1215. X         if length (a1) > atom_length then
  1216. X            a1 := substr(a1,1,atom_length);
  1217. X         result := int_remote_players (a1);
  1218. X         write_debug('%e_remote_players - result: ',result);
  1219. X         e_remote_players := result
  1220. X      end; `123 e_remote_players `125
  1221. X                         `032
  1222. X      function e_where(p1: integer): atom_t;
  1223. X      var line_i,result: string_t;
  1224. X      begin
  1225. X        write_debug('%e_where');
  1226. X        line_i := eval_atom (p1);
  1227. X        write_debug('%e_where - p1: ',line_i);
  1228. X        if length (line_i) > atom_length then
  1229. X           line_i := substr(line_i,1,atom_length);
  1230. X        result := int_where (line_i);
  1231. X        write_debug('%e_where result: ',result);
  1232. X        e_where := result;
  1233. X      end; `123 e_where `125                                  `032
  1234. X
  1235. X      function e_equal(p1,p2: integer): string_t;
  1236. X      var a,b: string_t;
  1237. X      begin
  1238. X        write_debug('%e_equal');
  1239. X        a := eval_atom (p1);
  1240. X        b := eval_atom (p2);
  1241. X        write_debug('%e_equal - p1: ',a);
  1242. X        write_debug('%          p2: ',b);
  1243. X        if a = b then e_equal := a
  1244. X        else e_equal := '';
  1245. X        write_debug ('%e_equal leaving');
  1246. X      end; `123 e_equal `125
  1247. X
  1248. X      function e_equal2(p1,p2: integer): string_t;
  1249. X      var a,b: string_t;
  1250. X      begin
  1251. X        write_debug('%e_equal2');
  1252. X        a := eval_atom (p1);
  1253. X        b := eval_atom (p2);
  1254. X        write_debug('%e_equal - p1: ',a);
  1255. X        write_debug('%          p2: ',b);
  1256. X        if EQ (a,b) then e_equal2 := a
  1257. X        else e_equal2 := '';
  1258. X        write_debug ('%e_equal2 leaving');
  1259. X      end; `123 e_equal `125
  1260. X
  1261. X      function e_equal3(p1,p2: integer): string_t;
  1262. X      var a,b: string_t;
  1263. X      begin
  1264. X        write_debug('%e_equal3');
  1265. X        a := lowcase(clean_spaces(eval_atom (p1)));
  1266. X        b := lowcase(clean_spaces(eval_atom (p2)));
  1267. X        write_debug('%e_equal - p1: ',a);
  1268. X        write_debug('%          p2: ',b);
  1269. X        if a = b then e_equal3 := a
  1270. X        else e_equal3 := '';
  1271. X        write_debug ('%e_equal2 leaving');
  1272. X      end; `123 e_equal `125
  1273. X
  1274. X      function e_null(params: paramtable): string_t;
  1275. X      var i,count: integer;
  1276. X      begin
  1277. X        write_debug('%e_null');
  1278. X`009count := count_params(params);
  1279. X`009for i := 1 to count do eval_atom(params`091i`093);
  1280. X        write_debug('%e_null leaving');
  1281. X        e_null := ''
  1282. X      end; `123 e_null `125                            `032
  1283. X
  1284. X      function e_attack(p1: integer): string_t;
  1285. X      var a,result: string_t;
  1286. X          value : integer;
  1287. X`009  left  : integer;
  1288. X      begin
  1289. X        write_debug('%e_attack');
  1290. X`009left := attack_limit - used_attack;
  1291. +-+-+-+-+-+-+-+-  END  OF PART 14 +-+-+-+-+-+-+-+-
  1292.