home *** CD-ROM | disk | FTP | other *** search
/ Source Code 1994 March / Source_Code_CD-ROM_Walnut_Creek_March_1994.iso / compsrcs / games / vmsnet / monhl104 / part23 < prev    next >
Encoding:
Internet Message Format  |  1992-08-02  |  42.7 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 23/32
  5. Keywords: Monster, a multiplayer adventure game
  6. Message-ID: <1992Jun14.071859.11484@klaava.Helsinki.FI>
  7. Date: 14 Jun 92 07:18:59 GMT
  8. Sender: hurtta@klaava.Helsinki.FI (Kari Hurtta)
  9. Followup-To: vmsnet.sources.d
  10. Organization: University of Helsinki
  11. Lines: 1432
  12.  
  13. Archieve-name: monster_helsinki_104/part23
  14. Author: Kari.Hurtta@Helsinki.FI
  15. Product: Monster Helsinki V 1.04
  16. Environment: VMS, Pascal
  17. Part: 23/32
  18.  
  19. -+-+-+-+-+-+-+-+ START OF PART 23 -+-+-+-+-+-+-+-+
  20. X`009`009end else if (obj.kind = O_BOOK) and`032
  21. X                            ((obj.exreq > myexperience)) then begin
  22. X`009`009`009log_event(myslot,E_FAILUSE,n,0);
  23. X`009`009`009p_usefail(n);
  24. X                end else begin
  25. X`009`009`009case obj.kind of
  26. X`009`009`009`009O_BLAND: p_usesucc(n);
  27. X`009`009`009`009O_CRYSTAL: begin
  28. X                                             p_usesucc(n);
  29. X`009`009`009                     use_crystal(n);
  30. X                                           end;
  31. X                                O_WEAPON: use_weapon (n);
  32. X`009`009`009`009O_BOOK:`009  begin
  33. X`009`009`009`009`009    p_usesucc(n);
  34. X`009`009`009`009`009    use_book(n);
  35. X`009`009`009`009`009  end;
  36. X`009`009`009`009otherwise p_usesucc(n);
  37. X`009`009`009end;
  38. X`009`009`009if obj.actindx > 0 then
  39. X`009`009`009`009run_monster('',obj.actindx,
  40. X`009`009`009`009`009'use succeed','','',
  41. X`009`009`009`009`009sysdate+' '+systime);
  42. X
  43. X`009`009end;
  44. X`009end else
  45. X`009`009writeln('There is no such object here.');
  46. X    exit_label:
  47. Xend;
  48. X
  49. X
  50. Xprocedure do_whisper(s: string);
  51. Xlabel exit_label;
  52. Xvar
  53. X`009n: integer;
  54. X
  55. X    procedure leave;
  56. X    begin
  57. X`009writeln('EXIT');
  58. X`009goto exit_label;
  59. X    end;
  60. X
  61. Xbegin
  62. X`009if s = '' then grab_line('Player? ',s,eof_handler := leave);
  63. X
  64. X`009if length(s) = 0 then begin
  65. X`009`009writeln('To whisper to someone, type WHISPER <personal name>.');
  66. X`009end else if parse_pers(n,s) then begin
  67. X`009`009if n = myslot then
  68. X`009`009    writeln('You can''t whisper to yourself.')
  69. X`009`009else begin
  70. X`009`009    grab_line('>> ',s,eof_handler := leave);
  71. X`009`009    if length(s) > 0 then begin
  72. X`009`009`009nice_say(s);
  73. X`009`009`009log_event(myslot,E_WHISPER,n,0,s);
  74. X`009`009`009if here.people`091n`093.kind = P_MONSTER then
  75. X`009`009`009    if here.people`091n`093.health > 0 then begin
  76. X`009`009`009`009run_monster (here.people`091n`093.name,
  77. X`009`009`009`009    here.people`091n`093.parm,
  78. X`009`009`009`009    'say','speech',s,
  79. X`009`009`009`009    sysdate+' '+systime);
  80. X`009`009`009    end;
  81. X`009`009    end else
  82. X`009`009`009    writeln('Nothing whispered.');
  83. X`009`009end;
  84. X`009end else
  85. X`009`009writeln('No such person can be seen here.');
  86. X
  87. X    exit_label:
  88. Xend;
  89. X
  90. Xprocedure health_player; `123 hurtta@finuh `125
  91. Xvar tmp: intrec;
  92. X    lev: integer;
  93. Xbegin
  94. X  if rnd100 > 70 then begin
  95. X     lev := level(myexperience);
  96. X     myhealth := myhealth + leveltable`091lev`093.health div 3;
  97. X     if myhealth > leveltable`091lev`093.health then`032
  98. X        myhealth := leveltable`091lev`093.health;
  99. X
  100. X     getroom;
  101. X     here.people`091myslot`093.health := myhealth;
  102. X     putroom;
  103. X
  104. X     tmp := anint;
  105. X     getint(N_HEALTH);
  106. X     anint.int`091mylog`093 := myhealth;
  107. X     putint;
  108. X     anint := tmp;
  109. X
  110. X  end;
  111. Xend;
  112. X
  113. Xprocedure x_unwield;
  114. Xvar tmp: shortstring;
  115. Xbegin
  116. X    getobj(mywield);
  117. X    freeobj;
  118. X    tmp := obj.oname;
  119. X    if obj.kind = O_MAGIC_RING then reset_queue;
  120. X    `123 action queue must reset, because it not in `125
  121. X    `123 runnning when use MAGIC RING `125
  122. X    log_event(myslot,E_UNWIELD,0,0,tmp);
  123. X    writeln('You are no longer wielding the ',tmp,'.');
  124. X
  125. X    mywield := 0;
  126. X    getroom;
  127. X    here.people`091myslot`093.wielding := 0;
  128. X    putroom;
  129. Xend;
  130. X
  131. X
  132. Xprocedure do_wield(s: string);
  133. Xvar
  134. X`009tmp: string;
  135. X`009slot,n: integer;
  136. X
  137. Xbegin
  138. X`009if length(s) = 0 then begin`009`123 no parms means unwield `125
  139. X`009`009if mywield = 0 then
  140. X`009`009`009writeln('You are not wielding anything.')
  141. X`009`009else begin
  142. X`009`009    x_unwield;
  143. X`009`009end;
  144. X`009end else if parse_obj(n,s) then begin
  145. X`009`009if mywield <> 0 then begin
  146. X`009`009`009writeln('You are already wielding ',obj_part(mywield),'.');
  147. X`009`009end else begin
  148. X`009`009`009getobj(n);
  149. X`009`009`009freeobj;
  150. X`009`009`009tmp := obj.oname;
  151. X`009`009`009if obj.kind in `091O_WEAPON,O_MAGIC_RING,
  152. X`009`009`009`009O_TELEPORT_RING,O_HEALTH_RING`093 then begin
  153. X`009`009`009`009if obj_hold(n) then begin
  154. X`009`009`009`009`009mywield := n;
  155. X`009`009`009`009`009getroom;
  156. X`009`009`009`009`009here.people`091myslot`093.wielding := n;
  157. X`009`009`009`009`009putroom;
  158. X
  159. X`009`009`009`009`009if (obj.kind = O_HEALTH_RING) then
  160. X`009`009`009`009`009`009health_player;
  161. X
  162. X`009`009`009`009`009log_event(myslot,E_WIELD,0,0,tmp);
  163. X`009`009`009`009`009writeln('You are now wielding the ',tmp,'.');
  164. X`009`009`009`009end else
  165. X`009`009`009`009`009writeln('You must be holding it first.');
  166. X`009`009`009end else
  167. X`009`009`009writeln('That is not a weapon.');
  168. X`009`009end;
  169. X`009end else
  170. X`009`009writeln('No such weapon can be seen here.');
  171. Xend;
  172. X
  173. Xprocedure x_unwear;
  174. Xvar tmp: shortstring;
  175. Xbegin
  176. X    getobj(mywear);
  177. X    freeobj;
  178. X    tmp := obj.oname;
  179. X    log_event(myslot,E_UNWEAR,0,0,tmp);
  180. X    writeln('You are no longer wearing the ',tmp,'.');
  181. X
  182. X    mywear := 0;
  183. X    mydisguise := 0;
  184. X    getroom;
  185. X    here.people`091myslot`093.wearing := 0;
  186. X    putroom;
  187. Xend;
  188. X
  189. X
  190. Xprocedure do_wear(s: string);
  191. Xvar
  192. X`009tmp: string;
  193. X`009slot,n: integer;
  194. X
  195. Xbegin
  196. X`009if length(s) = 0 then begin`009`123 no parms means unwear `125
  197. X`009`009if mywear = 0 then
  198. X`009  `009`009writeln('You are not wearing anything.')
  199. X`009`009else begin
  200. X`009`009    x_unwear;
  201. X`009`009end;
  202. X`009end else if parse_obj(n,s) then begin
  203. X`009`009if mywear > 0 then begin
  204. X`009`009    getobj(mywear);
  205. X`009`009    freeobj;
  206. X`009`009    writeln('You are already wearing the ',obj.oname,'.');
  207. X`009`009end else begin
  208. X`009`009    getobj(n);
  209. X`009`009    freeobj;
  210. X`009`009    tmp := obj.oname;
  211. X`009`009    if (obj.kind in `091O_ARMOR, O_DISGUISE`093 ) then begin
  212. X`009`009`009if obj_hold(n) then begin
  213. X`009`009`009`009mywear := n;
  214. X`009`009`009`009if obj.kind = O_DISGUISE then
  215. X`009`009`009`009`009mydisguise := n;
  216. X`009`009`009`009getroom;
  217. X`009`009`009`009here.people`091myslot`093.wearing := n;
  218. X`009`009`009`009putroom;
  219. X
  220. X`009`009`009`009log_event(myslot,E_WEAR,0,0,tmp);
  221. X`009`009`009`009writeln('You are now wearing the ',tmp,'.');
  222. X`009`009`009end else
  223. X`009`009`009`009writeln('You must be holding it first.');
  224. X`009`009    end else
  225. X`009`009`009writeln('That cannot be worn.');
  226. X`009`009end;
  227. X`009end else
  228. X`009`009writeln('No such thing can be seen here.');
  229. Xend;
  230. X
  231. X
  232. Xprocedure do_brief;
  233. Xbegin
  234. X`009brief := not(brief);
  235. X`009if brief then writeln('Brief descriptions.')
  236. X`009else writeln('Verbose descriptions.');
  237. Xend;
  238. X
  239. X
  240. Xfunction p_door_key(n: integer): string;
  241. X
  242. Xbegin
  243. X`009if n = 0 then
  244. X`009`009p_door_key := '<none>'
  245. X`009else
  246. X`009`009p_door_key := objnam.idents`091n`093;
  247. Xend;
  248. X
  249. X
  250. X
  251. Xprocedure anal_exit(dir: integer);
  252. X
  253. Xbegin
  254. X`009if (here.exits`091dir`093.toloc = 0) and (here.exits`091dir`093.kind <>
  255. V 5) then
  256. X`009`009`123 no exit here, don't print anything `125
  257. X`009else with here.exits`091dir`093 do begin
  258. X`009`009write(direct`091dir`093);
  259. X`009`009if length(alias) > 0 then begin
  260. X`009`009`009write('(',alias);
  261. X`009`009`009if reqalias then
  262. X`009`009`009`009write(' required): ')
  263. X`009`009`009else
  264. X`009`009`009`009write('): ');
  265. X`009`009end else
  266. X`009`009`009write(': ');
  267. X
  268. X`009`009if (toloc = 0) and (kind = 5) then
  269. X`009`009`009write('accept, no exit yet')
  270. X`009`009else if toloc > 0 then begin
  271. X`009`009`009write('to ',nam.idents`091toloc`093,', ');
  272. X`009`009`009case kind of
  273. X`009`009`009`0090: write('no exit');
  274. X`009`009`009`0091: write('open passage');
  275. X`009`009`009`0092: write('door, key=',p_door_key(objreq));
  276. X`009`009`009`0093: write('`126door, `126key=',p_door_key(objreq));
  277. X`009`009`009`0094: write('exit open randomly');
  278. X`009`009`009`0095: write('potential exit');
  279. X`009`009`009`0096: write('xdoor, key=',p_door_key(objreq));
  280. X`009`009`009`0097: begin
  281. X`009`009`009`009`009write('timed exit, now ');
  282. X`009`009`009`009`009if cycle_open then
  283. X`009`009`009`009`009`009write('open')
  284. X`009`009`009`009`009else
  285. X`009`009`009`009`009`009write('closed');
  286. X`009`009`009`009   end;
  287. X`009`009`009end;
  288. X`009`009`009if hidden <> 0 then
  289. X`009`009`009`009write(', hidden');
  290. X`009`009`009if reqverb then
  291. X`009`009`009`009write(', reqverb');
  292. X`009`009`009if not(autolook) then
  293. X`009`009`009`009write(', autolook off');
  294. X`009`009`009if here.trapto = dir then
  295. X`009`009`009`009write(', trapdoor (',here.trapchance:1,'%)');
  296. X`009`009end;
  297. X`009`009writeln;
  298. X`009end;
  299. Xend;
  300. X
  301. Xprocedure do_s_exits;
  302. Xvar
  303. X`009i: integer;
  304. X`009accept,one: boolean;`009`123 accept is true if the particular exit is
  305. X`009`009`009`009  an "accept" (other players may link there)
  306. X`009`009`009`009  one means at least one exit was shown `125
  307. X
  308. Xbegin
  309. X`009one := false;
  310. X`009gethere;
  311. X
  312. X`009for i := 1 to maxexit do begin
  313. X`009`009if (here.exits`091i`093.toloc = 0) and (here.exits`091i`093.kind = 5
  314. V) then
  315. X`009`009`009accept := true
  316. X`009`009else
  317. X`009`009`009accept := false;
  318. X
  319. X`009`009if (can_alter(i)) or (accept) then begin
  320. X`009`009`009if not(one) then begin`009`123 first time we do this then `125
  321. X`009`009`009`009getnam;`009`009`123 read room name list in `125
  322. X`009`009`009`009freenam;
  323. X`009`009`009`009getobjnam;
  324. X`009`009`009`009freeobjnam;
  325. X`009`009`009end;
  326. X`009`009`009one := true;
  327. X`009`009`009anal_exit(i);
  328. X`009`009end;
  329. X`009end;
  330. X
  331. X`009if not(one) then
  332. X`009`009writeln('There are no exits here which you may inspect.');
  333. Xend;
  334. X
  335. X
  336. X`123 Return object owner as value (I hope)`009`009jlaiho@finuh `125
  337. Xfunction tell_owner(n: integer):shortstring;
  338. Xvar
  339. X `009s: string;
  340. X
  341. Xbegin
  342. X`009getobjown;
  343. X`009freeobjown;
  344. X`009s := objown.idents`091n`093;
  345. X`009s := class_out(s);`009
  346. X`009if substr(s,1,1)<>'<' then begin
  347. X`009`009if lookup_user(n,objown.idents`091n`093) then begin
  348. X`009`009`009getpers;
  349. X`009`009`009freepers;
  350. X`009`009`009tell_owner := pers.idents`091n`093;
  351. X`009`009end else
  352. X`009`009`009tell_owner := '<Unknown>';
  353. X`009end else if s.length>shortlen then begin
  354. X`009`009tell_owner := substr(s,1,shortlen);
  355. X`009end else
  356. X`009`009tell_owner := substr(s,1,s.length);
  357. Xend;
  358. X
  359. X
  360. Xprocedure do_s_object(s: string);
  361. Xlabel 0;    `123 for panic `125
  362. Xvar
  363. X`009n,oldloc: integer;
  364. X`009x: objectrec;
  365. X
  366. X    function action(s: shortstring; n: integer): boolean;
  367. X    begin
  368. X`009write(obj_part(n),': ');
  369. X`009if objown.idents`091n`093 = public_id then write('public')
  370. X`009else if objown.idents`091n`093 = disowned_id then write('disowned')
  371. X`009else write(class_out(objown.idents`091n`093),' is owner');
  372. X
  373. X`009if obj_owner(n,TRUE) then begin
  374. X`009    write(', ');
  375. X`009    show_kind(obj.kind,false);
  376. X`009    x := obj;
  377. X
  378. X`009    if x.sticky then
  379. X`009`009write(', sticky');
  380. X`009    if x.getobjreq > 0 then
  381. X`009`009write(', ',obj_part(x.getobjreq),' required to get');
  382. X`009    if x.useobjreq > 0 then
  383. X`009`009write(', ',obj_part(x.useobjreq),' required to use');
  384. X`009    if x.uselocreq > 0 then begin
  385. X`009`009getnam;
  386. X`009`009freenam;
  387. X`009`009write(', used only in ',nam.idents`091x.uselocreq`093);
  388. X`009    end;
  389. X`009    if x.usealias <> '' then begin
  390. X`009`009write(', use="',x.usealias,'"');
  391. X`009`009if x.reqalias then
  392. X`009`009    write(' (required)');
  393. X`009    end;
  394. X`009end;
  395. X`009writeln;
  396. X`009action := true;
  397. X`009checkevents(TRUE);
  398. X`009if oldloc <> location then goto 0; `123 panic `125
  399. X    end;    `123 action `125
  400. X
  401. X    function restriction (n: integer): boolean;
  402. X`009begin
  403. X`009`009restriction := true;
  404. X`009end;
  405. X
  406. X    procedure leave;
  407. X    begin
  408. X`009writeln('EXIT - No changes.');
  409. X`009goto 0;
  410. X    end;
  411. X
  412. X
  413. Xbegin
  414. X
  415. X`009if length(s) = 0 then begin
  416. X`009`009grab_line('Object? ',s,eof_handler := leave);
  417. X`009end;
  418. X`009getobjown;
  419. X`009freeobjown;
  420. X
  421. X`009oldloc := location;
  422. X`009if scan_obj(action,s,,restriction) then begin
  423. X`009end else
  424. X`009`009writeln('There is no such object.');
  425. X`0090: `123 for panic `125
  426. Xend;
  427. X
  428. Xprocedure do_s_monster(s: string);
  429. Xlabel 0; `123 for panic `125
  430. Xvar`009n,code,oldloc: integer;
  431. X`009owner, coder,name,dis,pub: shortstring;
  432. X
  433. X    function restriction (n: integer): boolean;
  434. X    begin
  435. X`009restriction := here.people`091n`093.kind = P_MONSTER;
  436. X`009`123 can see monster even it is hiding `125
  437. X    end;`032
  438. X
  439. X    function action(s: shortstring; n: integer): boolean;
  440. X    begin
  441. X`009name := here.people`091n`093.name;
  442. X`009code := here.people`091n`093.parm;
  443. X`009owner := monster_owner(code);
  444. X`009coder := monster_owner(code,1);
  445. X`009write (name,': ');
  446. X`009if owner = public_id then write('public')
  447. X`009else if owner = disowned_id then write('disowned')
  448. X`009else write (class_out(owner),' is owner');
  449. X`009if ((owner = userid) or
  450. X`009    (coder = userid) or`032
  451. X`009    (owner_priv and (owner <> system_id)) or
  452. X`009    manager_priv)
  453. X`009    and (coder > '') then begin
  454. X`009    if coder = owner then write(' and writer')
  455. X`009    else write(', ',coder,' is writer');
  456. X`009end;
  457. X`009writeln('.');
  458. X`009action := true;
  459. X`009checkevents(TRUE);
  460. X`009if oldloc <> location then goto 0; `123 for panic `125
  461. X    end;
  462. X
  463. X    procedure leave;
  464. X    begin
  465. X`009writeln('EXIT - No changes.');
  466. X`009goto 0;
  467. X    end;
  468. X
  469. Xbegin
  470. X
  471. X`009if length(s) = 0 then begin
  472. X`009`009grab_line('Monster? ',s,eof_handler := leave);
  473. X`009end;
  474. X
  475. X`009oldloc := location;
  476. X`009if scan_pers_slot(action,s,,restriction) then begin
  477. X`009end else writeln ('There is no such monster.');
  478. X`009writeln;
  479. X`0090: `123 for panic `125
  480. Xend;
  481. X
  482. X
  483. X
  484. Xprocedure do_s_details;
  485. Xvar
  486. X`009i: integer;
  487. X`009one: boolean;
  488. X
  489. Xbegin
  490. X`009gethere;
  491. X`009one := false;
  492. X`009for i := 1 to maxdetail do
  493. X`009`009if (here.detail`091i`093 <> '') and (here.detaildesc`091i`093 <> 0)
  494. V then begin
  495. X`009`009`009if not(one) then begin
  496. X`009`009`009`009one := true;
  497. X`009`009`009`009writeln('Details here that you may inspect:');
  498. X`009`009`009end;
  499. X`009`009`009writeln('    ',here.detail`091i`093);
  500. X`009`009end;
  501. X`009if not(one) then
  502. X`009`009writeln('There are no details of this room that you can inspect.');
  503. Xend;
  504. X
  505. Xprocedure do_s_privs;
  506. Xbegin
  507. X`009write ('Your authorized privileges: ');
  508. X`009    list_privileges(read_auth_priv);
  509. X`009write ('Your current privileges: ');
  510. X`009    list_privileges(read_cur_priv);
  511. Xend;
  512. X
  513. Xprocedure do_s_time;
  514. Xbegin
  515. X`009writeln(sysdate,'  ',systime);
  516. Xend;
  517. X
  518. Xprocedure do_s_room(s: string);
  519. Xlabel 0;    `123 for panic `125
  520. Xvar`009room,oldloc: integer;
  521. X
  522. X    function action(s: shortstring; room: integer): boolean;
  523. X    begin
  524. X`009gethere(room);
  525. X`009if here.owner = public_id then writeln(s,' is public.')
  526. X`009else if here.owner = disowned_id then writeln(s,' is disowned.')
  527. X`009else writeln('Owner of ',s,' is ',class_out(here.owner));
  528. X`009checkevents(TRUE);
  529. X`009action := true;
  530. X`009if oldloc <> location then goto 0; `123 panic `125
  531. X    end; `123 action `125
  532. X
  533. X    function restriction (n: integer): boolean;
  534. X`009begin
  535. X`009`009restriction := true;
  536. X`009end;
  537. X
  538. Xbegin
  539. X
  540. X`009oldloc := location;
  541. X`009if s = '' then action('this room',location)
  542. X`009else if not scan_room(action,s,,restriction) then begin
  543. X`009`009writeln('No such room.');
  544. X`009end;
  545. X`0090: `123 for panic `125
  546. Xend;
  547. X
  548. Xprocedure do_s_levels;
  549. Xlabel`0091;
  550. Xvar i,j,n,line: integer;
  551. X`009s: string;
  552. X
  553. X    procedure leave;
  554. X    begin
  555. X`009writeln('EXIT');
  556. X`009goto 1;
  557. X    end;
  558. X   `032
  559. Xbegin
  560. X    line := 1;
  561. X   write('  Name                 Score     '); `123 34 `125
  562. X       `123  123456789012345678901234567890123 `125
  563. X   if terminal_line_len > 50 then
  564. X`009write('Power MaxHealth '); `123 50 `125
  565. X`009    `123  4567890123456789 `125
  566. X   if terminal_line_len >= 80 then
  567. X`009write('Privilege');
  568. X   writeln;
  569. X                    `032
  570. X   for i := 1 to levels do with leveltable`091i`093 do`032
  571. X`009if not hidden or manager_priv then begin
  572. X`009`009if hidden then write('* ') else write('  ');
  573. X`009`009write(name);
  574. X`009`009for j := 1 to 17-length(name) do write(' ');
  575. X`009`009if exp > maxexperience then write('-':9,' ')
  576. X`009`009else write(exp:9,' ');
  577. X`009`009if terminal_line_len > 50 then begin
  578. X`009`009    write(maxpower:9,' ');
  579. X`009`009    write(health:9,' ');
  580. X`009`009end;
  581. X`009`009if (i < levels) and (terminal_line_len >= 80) then
  582. X`009`009`009list_privileges(uint(priv))
  583. X`009`009else writeln;
  584. X`009`009line := line + 1;
  585. X`009`009if line > terminal_page_len - 2 then begin
  586. X`009`009    line := 0;
  587. X`009`009    grab_line('-more-',s,erase := true,
  588. X`009`009`009eof_handler := leave); if s > '' then goto 1;
  589. X`009`009end;
  590. X`009end;
  591. X    1:
  592. Xend; `123 do_s_levels `125
  593. X
  594. X`123 procedure type_paper moved to module CUSTOM `125
  595. X
  596. Xprocedure do_s_quota;
  597. Xbegin
  598. X   writeln('Counters: ');
  599. X   writeln('  Number of rooms:            ',get_counter(N_NUMROOMS,mylog):1)
  600. V;
  601. X   writeln('  Room quota:                 ',get_counter(N_ALLOW,mylog):1);
  602. X   writeln('  Number of accepts:          ',get_counter(N_ACCEPT,mylog):1);
  603. X   writeln('Consts: ');
  604. X   writeln('  Minimun rooms'' number:      ',min_room:1);
  605. X   writeln('  Required amount of accepts: ',min_accept:1);
  606. X   writeln('    (if more rooms than minimum rooms'' number)');
  607. X   if manager_priv then
  608. X      writeln('  Default room quota:         ',default_allow:1);
  609. Xend; `123 do_s_quota `125
  610. X
  611. Xprocedure do_s_spell(name: string);
  612. Xlabel`0091;
  613. Xvar i,j,n,line: integer;
  614. X`009s: string;
  615. X
  616. X    myspell: spellrec;
  617. X
  618. X    procedure leave;
  619. X    begin
  620. X`009writeln('EXIT');
  621. X`009goto 1;
  622. X    end;
  623. Xvar header: boolean;
  624. X
  625. X    procedure spell_data(sid: integer);
  626. X    var j: integer;
  627. X    begin
  628. X`009if not header then begin
  629. X`009    writeln('  Spell''s name     Level');
  630. X`009    `123        1234567890123456  `125
  631. X`009    header := true;
  632. X`009    line := line + 1;
  633. X`009end;
  634. X`009write('  ',spell_name.idents`091sid`093);
  635. X`009for j := 1 to 17-length(spell_name.idents`091sid`093) do write(' ');
  636. X`009writeln(myspell.level`091sid`093:5);
  637. X`009line := line + 1;
  638. X`009if line > terminal_page_len - 2 then begin
  639. X`009    line := 0;
  640. X`009    grab_line('-more-',s,erase := true,
  641. X`009`009eof_handler := leave); if s > '' then goto 1;
  642. X`009end;
  643. X    end;
  644. X
  645. X    procedure list_spell;
  646. X    var I :integer;
  647. X`009myindex: indexrec;
  648. X    begin
  649. X`009getindex(I_SPELL);
  650. X`009freeindex;
  651. X`009myindex := indx;
  652. X`009for i := 1 to myindex.top do if not myindex.free`091i`093 then
  653. X`009    if myspell.level`091i`093 > 0 then spell_data(i);
  654. X`009if not header then writeln('You don''t know any spell.');
  655. X    end;
  656. X   `032
  657. Xbegin
  658. X    line := 0;
  659. X    header := false;
  660. X    getspell_name;
  661. X    freespell_name;
  662. X    getspell(mylog);
  663. X    freespell;
  664. X    myspell := spell;
  665. X    name := lowcase(name);
  666. X
  667. X    if (name = '') or (name = '*') or (name = 'all') then list_spell
  668. X    else if lookup_spell(i,name) then spell_data(i)
  669. X    else writeln('Unkown spell.');
  670. X    1:
  671. Xend;
  672. X
  673. Xprocedure s_show(n: integer;s: string);
  674. X
  675. Xbegin
  676. X`009case n of
  677. X`009`009s_exits: do_s_exits;
  678. X`009`009s_object: do_s_object(s);
  679. X`009`009s_quest: command_help('*do s help*');
  680. X`009`009s_details: do_s_details;
  681. X`009`009s_monster: do_s_monster(s);
  682. X`009`009s_priv: do_s_privs;
  683. X`009`009s_time: do_s_time;
  684. X`009`009s_room: do_s_room(s);
  685. X`009`009s_paper: type_paper;
  686. X`009`009s_levels: do_s_levels;
  687. X`009`009s_quota:  do_s_quota;
  688. X`009`009s_spell:  do_s_spell (s);
  689. X`009end;
  690. Xend;
  691. X
  692. X`123 procedures do_y_altmsg, do_group1 and do_group2 moved to module CUSTOM
  693. V `125
  694. X
  695. Xprocedure do_passwd;
  696. Xlabel exit_label;
  697. Xvar oldpwd,pwd,pwd_check: shortstring;
  698. X    s:  string;
  699. X    ok: boolean;
  700. X
  701. X    procedure leave;
  702. X    begin
  703. X`009writeln('EXIT - No changes');
  704. X`009goto exit_label;
  705. X    end;
  706. X
  707. Xbegin
  708. X`009grab_line ('Old password: ', s, false,eof_handler := leave);
  709. X`009if length(s) > shortlen then
  710. X`009`009oldpwd := substr(s,1,shortlen)
  711. X`009else oldpwd := s;
  712. X`009encrypt(oldpwd);
  713. X`009getpasswd;
  714. X`009freepasswd;
  715. X`009ok := passwd.idents `091mylog`093 = oldpwd;
  716. X
  717. X`009if ok then begin
  718. X`009`009grab_line ('New password: ', s, false,eof_handler := leave);
  719. X`009`009if length(s) > shortlen then
  720. X`009`009`009pwd := substr(s,1,shortlen)
  721. X`009`009else pwd := s;
  722. X`009`009while (pwd = '') and (userid`0911`093 = '"') do begin
  723. X`009`009`009writeln ('Sorry, you must have a password for ', myname, '.');
  724. X`009`009`009grab_line ('New password: ', s, false,eof_handler := leave);
  725. X`009`009`009if length(s) > shortlen then
  726. X`009`009`009`009pwd := substr(s,1,shortlen)
  727. X`009`009`009else pwd := s;
  728. X`009`009end;
  729. X`009`009grab_line ('Verification: ', s, false,eof_handler := leave);
  730. X`009`009if length(s) > shortlen then
  731. X`009`009`009pwd_check := substr(s,1,shortlen)
  732. X`009`009else pwd_check := s;
  733. X`009`009if pwd = pwd_check then begin
  734. X`009`009`009ok := true;
  735. X`009`009`009encrypt (pwd);
  736. X
  737. X`009`009`009getpasswd;
  738. X`009`009`009passwd.idents `091mylog`093 := pwd;
  739. X`009`009`009putpasswd;
  740. X
  741. X`009`009`009writeln('Database updated.');
  742. X`009`009end else begin
  743. X`009`009`009ok := false;
  744. X`009`009`009writeln ('You seem to have made a mistake. ');
  745. X`009`009`009writeln ('Password not changed.');
  746. X`009`009end;
  747. X`009end else begin
  748. X`009`009`009writeln ('Old password verification error.');
  749. X`009`009`009writeln ('Password not changed.');
  750. X`009end;
  751. X    exit_label:
  752. Xend;
  753. X
  754. Xprocedure do_y_priv(s: string);
  755. Xtype action = (activate, reset);
  756. Xvar direction: action;
  757. X    mask,prev: unsigned;
  758. X    mask2: integer;
  759. Xbegin
  760. X    direction := activate;
  761. X    s := slead(s);
  762. X    if s = '' then begin
  763. X`009mask2 := int(read_cur_priv);
  764. X`009if custom_privileges(mask2,read_auth_priv) then begin
  765. X`009    set_cur_priv(uint(mask2));
  766. X`009    write('Setting follow privileges: ');
  767. X`009    list_privileges(read_cur_priv);
  768. X`009end else writeln('Not changed.');
  769. X    end else if (s = '?') then begin
  770. X`009writeln('Use set privileges + <privilege> to set privilege');
  771. X`009writeln('Use set privileges - <privilege> to reset privilege');
  772. X    end else begin
  773. X`009if s`0911`093 = '+' then begin
  774. X`009    direction := activate;
  775. X`009    if length(s) > 1 then
  776. X`009`009s := slead(substr(s,2,length(s)-1));
  777. X`009end else if s`0911`093 = '-' then begin
  778. X`009    direction := reset;
  779. X`009    if length(s) > 1 then
  780. X`009`009s := slead(substr(s,2,length(s)-1));
  781. X`009end;
  782. X
  783. X`009mask := 0;
  784. X`009if (s = 'all') or (s = '*') then mask := all_privileges
  785. X`009else if not lookup_priv(mask,s,true) then begin
  786. X`009    mask := 0;
  787. X`009    writeln('Unknown privilege: ',s);
  788. X`009end;
  789. X
  790. X`009if mask > 0 then begin
  791. X`009    prev := read_cur_priv;
  792. X`009    if direction = reset then begin
  793. X`009`009set_cur_priv(uand(prev,unot(mask)));
  794. X`009`009write('Resetting follow privileges: ');
  795. X`009`009    list_privileges(uand(prev,unot(read_cur_priv)));
  796. X`009    end else begin
  797. X`009`009set_cur_priv(uor(prev,mask));
  798. X`009`009write('Setting follow privileges: ');
  799. X`009`009    list_privileges(uand(read_cur_priv,unot(prev)));
  800. X`009    end;
  801. X`009end;
  802. X    end;
  803. X
  804. Xend;
  805. X
  806. Xprocedure s_set(n: integer;s: string);
  807. X
  808. Xbegin
  809. X`009case n of
  810. X`009`009y_quest: command_help('*do y help*');
  811. X
  812. X`123`009`009y_altmsg: do_y_altmsg;
  813. X`009`009y_group1: do_group1;
  814. X`009`009y_group2: do_group2;`009`125
  815. X`009
  816. X`009`009y_passwd: do_passwd;
  817. X`009`009y_peace: if not global_priv then`032
  818. X`009`009`009writeln('There is too much hate in the world.')
  819. X`009`009    else if not read_global_flag(GF_WARTIME,TRUE) then
  820. X`009`009`009writeln('The war is over already.')
  821. X`009`009    else set_global_flag(GF_WARTIME,FALSE,
  822. X`009`009'...And on earth peace, good will toward men (and monsters).');
  823. X`009`009y_war: if not global_priv then`032
  824. X`009`009`009writeln('You are not angry enough.')
  825. X`009`009    else if read_global_flag(GF_WARTIME,TRUE) then
  826. X`009`009`009writeln('You call this peace?')
  827. X`009`009    else set_global_flag(GF_WARTIME,TRUE,
  828. X'Go your ways, and pour out the vials of the wrath of God upon the earth.');
  829. X`009`009y_priv: do_y_priv(s);
  830. X`009`009y_spell: custom_spell(s);
  831. X`009`009y_newplayer: custom_global_desc(GF_NEWPLAYER);
  832. X`009`009y_welcome: custom_global_desc(GF_STARTGAME);
  833. X`009end;
  834. Xend;
  835. X
  836. X
  837. Xprocedure do_show(s: string);
  838. Xlabel exit_label;
  839. Xvar
  840. X`009n: integer;
  841. X`009cmd: string;
  842. X
  843. X    procedure leave;
  844. X    begin
  845. X`009writeln('EXIT');
  846. X`009goto exit_label;
  847. X    end;
  848. X
  849. Xbegin
  850. X`009cmd := bite(s);
  851. X`009if length(cmd) = 0 then
  852. X`009`009grab_line('Show what attribute? (type ? for a list) ',cmd,
  853. X`009`009    eof_handler := leave);
  854. X
  855. X`009if length(cmd) = 0 then
  856. X`009else if lookup_show(n,cmd,true) then
  857. X`009`009s_show(n,s)
  858. X`009else
  859. X`009`009writeln('Invalid show option, type SHOW ? for a list.');
  860. X    exit_label:
  861. Xend;
  862. X
  863. X
  864. Xprocedure do_set(s: string);
  865. Xlabel exit_label;
  866. Xvar
  867. X`009n: integer;
  868. X`009cmd: string;
  869. X
  870. X    procedure leave;
  871. X    begin
  872. X`009writeln('EXIT - No changes.');
  873. X`009goto exit_label;
  874. X    end;
  875. X
  876. Xbegin
  877. X`009cmd := bite(s);
  878. X`009if length(cmd) = 0 then
  879. X`009`009grab_line('Set what attribute? (type ? for a list) ',cmd,
  880. X`009`009    eof_handler := leave);
  881. X         `032
  882. X`009if length(cmd) = 0 then
  883. X`009else if lookup_set(n,cmd,true) then
  884. X`009`009s_set(n,s)
  885. X`009else
  886. X`009`009writeln('Invalid set option, type SET ? for a list.');
  887. X
  888. X    exit_label:
  889. Xend;  `032
  890. X
  891. Xprocedure go_dcl (s: string);
  892. XVar changed: boolean;
  893. Xbegin `032
  894. X  log_action (c_dcl,0);
  895. X  do_dcl (s);   `123 Spawn subprocess .. `125
  896. X  log_event (myslot,E_DCLDONE,0,0,'');
  897. X `032
  898. X  `123 check database `125
  899. X  getindex (I_ASLEEP);        `032
  900. X  freeindex;
  901. X  if indx.free `091mylog`093 then `123 Oops ! I am in asleep ... `125
  902. X    begin
  903. X      WriteLn ('You are throw out from Monster-universe during your stay on
  904. V DCL-level.');
  905. X`009finish_interpreter;
  906. X`009halt;
  907. X    end;
  908. X         `032
  909. X  `123 Because only my process update my situation, I can suppose that
  910. X     datatabase and data in memory is valid - I hope so ...        `125
  911. X
  912. Xend;                                                                `032
  913. X         `032
  914. X`123 hurtta@finuh `125      `032
  915. X
  916. Xfunction x_where (player: shortstring; var pr: integer): integer;
  917. Xbegin
  918. X  if debug then writeln('%x_where: ',player);
  919. X  if exact_pers(pr,player) then begin
  920. X     getint(N_LOCATION);
  921. X     freeint;
  922. X     x_where := anint.int`091pr`093
  923. X  end else x_where := 0
  924. Xend; `123 x_where `125
  925. X
  926. Xprocedure x_add(var string: mega_string; adding: shortstring);
  927. Xbegin
  928. X  if debug then writeln('%x_add: ... <- ',adding);
  929. X  if string = '' then string := adding
  930. X  else if length(string) < MEGA_LENGTH - shortlen - 3 then
  931. X    string := string + ', ' + adding
  932. Xend; `123 x_add `125
  933. X
  934. Xfunction x_slot (player: shortstring): integer;
  935. Xvar i: integer;
  936. Xbegin `032
  937. X  if debug then writeln('%x_slot: ',player);
  938. X  player := lowcase(player);
  939. X  x_slot := 0;
  940. X  for i := 1 to maxpeople do`032
  941. X`009if here.people`091i`093.kind > 0 then`032
  942. X    `009`009if lowcase(here.people`091i`093.name) = player then x_slot := i
  943. Xend; `123 x_slot `125
  944. X
  945. Xfunction x_hold(n,slot: integer): boolean;
  946. Xvar
  947. X`009i: integer;
  948. X`009found: boolean;
  949. X
  950. Xbegin
  951. X   if debug then writeln('%x_hold');
  952. X`009if n = 0 then
  953. X`009`009x_hold := false
  954. X`009else begin
  955. X`009`009i := 1;
  956. X`009`009found := false;
  957. X`009`009while (i <= maxhold) and (not found) do begin
  958. X`009`009`009if here.people`091slot`093.holding`091i`093 = n then
  959. X`009`009`009`009found := true
  960. X`009`009`009else
  961. X`009`009`009`009i := i + 1;
  962. X`009`009end;
  963. X`009`009x_hold := found;
  964. X`009end;
  965. Xend;   `032
  966. X
  967. Xfunction x_puttoken (from,mlog,mslot,room: integer; var aslot: integer;
  968. X                   first_x_puttoken : boolean := false;
  969. X                   a_kind: integer := P_MONSTER;
  970. X                   a_name: shortstring := '';`032
  971. X                   mcode : integer := 0): boolean;
  972. Xvar
  973. X`009i,j: integer;
  974. X`009found: boolean;
  975. X`009savehold: array`0911..maxhold`093 of integer;
  976. X        var kind,parm,hiding,wearing,wielding,health,self,
  977. X            experience: integer;
  978. X            name: shortstring;
  979. X            username: veryshortstring;
  980. Xbegin
  981. X   if debug then writeln('%x_puttoken');
  982. X`009if first_x_puttoken then begin
  983. X`009`009for i := 1 to maxhold do
  984. X`009`009`009savehold`091i`093 := 0;
  985. X                kind := a_kind;
  986. X                parm := mcode;
  987. X                hiding := 0;
  988. X                wearing := 0;
  989. X                wielding := 0;
  990. X                health := GOODHEALTH;
  991. X`009`009experience := 0;
  992. X                self := 0;
  993. X                writev(username,':',mcode:1);
  994. X                name := a_name;
  995. X
  996. X`009end else begin
  997. X`009`009gethere (from);              `032
  998. X`009`009for i := 1 to maxhold do
  999. X`009`009`009savehold`091i`093 := here.people`091mslot`093.holding`091i`093;
  1000. X                kind := here.people`091mslot`093.kind;
  1001. X                parm := here.people`091mslot`093.parm;
  1002. X                hiding := here.people`091mslot`093.hiding;
  1003. X                wearing := here.people`091mslot`093.wearing;
  1004. X                wielding := here.people`091mslot`093.wielding;
  1005. X                health  := here.people`091mslot`093.health;
  1006. X                self    := here.people`091mslot`093.self; `032
  1007. X                name    := here.people`091mslot`093.name; `032
  1008. X`009`009experience := here.people`091mslot`093.experience;
  1009. X                username := here.people`091mslot`093.username; `123 what ? `
  1010. V125
  1011. X
  1012. X`009end;
  1013. X
  1014. X`009getroom(room);
  1015. X`009i := 1;
  1016. X`009found := false;
  1017. X`009while (i <= maxpeople) and (not found) do begin
  1018. X`009`009if here.people`091i`093.kind = 0 then`009`123 hurtta@finuh `125
  1019. X`009`009`009found := true
  1020. X`009`009else
  1021. X`009`009`009i := i + 1;
  1022. X`009end;
  1023. X`009if found and (kind <> 0) then begin
  1024. X`009`009here.people`091i`093.kind := kind;   `123 probably monster `125
  1025. X`009`009here.people`091i`093.name := name;
  1026. X`009  `009here.people`091i`093.username := username;
  1027. X`009`009here.people`091i`093.hiding := hiding;
  1028. X`009`009`009`123 hidelev is zero for most everyone
  1029. X`009`009`009  unless you want to poof in and remain hidden `125
  1030. X
  1031. X`009`009here.people`091i`093.wearing := wearing;
  1032. X`009`009here.people`091i`093.wielding := wielding;
  1033. X`009`009here.people`091i`093.health := health;
  1034. X`009`009here.people`091i`093.experience := experience;
  1035. X`009`009here.people`091i`093.self := self;
  1036. X`009`009here.people`091i`093.parm := parm;
  1037. X`009`009here.people`091i`093.act := 0;
  1038. X
  1039. X`009`009for j := 1 to maxhold do
  1040. X`009`009`009here.people`091i`093.holding`091j`093 := savehold`091j`093;
  1041. X`009`009putroom;
  1042. X
  1043. X`009`009aslot := i;
  1044. X
  1045. X`009`009`123 note the user's new location in the logfile `125
  1046. X`009`009getint(N_LOCATION);`032
  1047. X`009`009anint.int`091mlog`093 := room;
  1048. X`009`009putint;             `032
  1049. X                x_puttoken := true;
  1050. X`009end else begin
  1051. X`009`009freeroom;
  1052. X`009`009x_puttoken := false
  1053. X        end;
  1054. Xend;    `032
  1055. X
  1056. Xprocedure do_monster(s: string);
  1057. Xlabel exit_label;
  1058. Xvar mid,aslot,i,mcode: integer;
  1059. X    muserid: veryshortstring;
  1060. X
  1061. X    procedure leave;
  1062. X    begin
  1063. X`009writeln('EXIT');
  1064. X`009goto exit_label;
  1065. X    end;
  1066. X
  1067. Xbegin
  1068. X   if s = '' then grab_line('Monster? ',s,eof_handler := leave);
  1069. X
  1070. X   gethere;
  1071. X   if checkhide then begin
  1072. X      if not is_owner(location,TRUE) then begin
  1073. X         writeln('You may only create monsters when you are in one of your o
  1074. Vwn rooms.');
  1075. X      end else if s <> '' then begin
  1076. X         if length(s) > shortlen then
  1077. X            writeln('Please limit your monster names to ',shortlen:1,' chara
  1078. Vcters.')
  1079. X         else if exact_pers(mid,s) then begin`009`123 monster already exits
  1080. V `125
  1081. X            writeln('That monster or player already exits.')
  1082. X         end else begin
  1083. X            if debug then
  1084. X               writeln('%beggining to create monster');
  1085. X            if alloc_log(mid) then begin
  1086. X               if alloc_general(I_HEADER,mcode) then begin
  1087. X                  if x_puttoken (0,mid,0,location,aslot,true,2,s,mcode) then
  1088. V begin
  1089. X                    `032
  1090. X                     create_program (mcode,userid,sysdate+' '+systime);
  1091. X
  1092. X                     getuser;
  1093. X                     writev(user.idents`091mid`093,':',mcode:1);
  1094. X                     putuser;  `032
  1095. X                            `032
  1096. X                     getpers;
  1097. X                     pers.idents`091mid`093 := s;
  1098. X                     putpers;
  1099. X         `032
  1100. X                     getdate;
  1101. X                     adate.idents`091mid`093 := sysdate + ' ' + systime;
  1102. X                     putdate;
  1103. X
  1104. X                     getindex(I_ASLEEP);
  1105. X                     indx.free`091mid`093 := true; `123 Yes. Monster isn't a
  1106. Vctive now `125
  1107. X                     putindex;
  1108. X                                                                  `032
  1109. X                     getint(N_EXPERIENCE);
  1110. X                     anint.int`091mid`093 := 0;
  1111. X                     putint;
  1112. X`009`009 `032
  1113. X                     getint(N_PRIVILEGES); `123 leino@finuha `125`032
  1114. X                     anint.int`091mid`093 := 0;  `123 this is ridiculous `12
  1115. V5
  1116. X                     putint;
  1117. X
  1118. X                     getint(N_SELF);
  1119. X                     anint.int`091mid`093 := 0;
  1120. X                     putint;
  1121. X
  1122. X                     getint(N_HEALTH);
  1123. X                     anint.int`091mid`093 := GOODHEALTH;
  1124. X                     putint;
  1125. X
  1126. X                     `123 initialize the record containing the
  1127. X                       level of each spell they have to start;
  1128. X                       all start at zero; since the spellfile is
  1129. X                       directly parallel with mylog, we can hack
  1130. X                       init it here without dealing with SYSTEM `125
  1131. X
  1132. X                     locate(spellfile,mid);
  1133. X                     for i := 1 to maxspells do
  1134. X                        spellfile`094.level`091i`093 := 0;
  1135. X                     spellfile`094.recnum := mid;
  1136. X                     put(spellfile);
  1137. X
  1138. X                     log_event(myslot,E_MADEOBJ,0,0,log_name + ' has created
  1139. V a monster here.');
  1140. X                     writeln('Monster created.');
  1141. X                  end else begin
  1142. X                     writeln('This place is too crowded to create any more m
  1143. Vonsters.  Try somewhere else.');
  1144. X                     delete_log (mid);
  1145. X                     delete_general (I_HEADER,mcode);
  1146. X                  end;
  1147. X               end else begin
  1148. X                   writeln ('There is no place for any more monsters in this
  1149. V universe.');
  1150. X                   delete_log (mid);
  1151. X               end;
  1152. X`009    end else writeln ('There is no place for any more monsters or player
  1153. Vs in this universe.')`032
  1154. X         end
  1155. X      end else writeln('To create a monster, type BEAR <monster name>.');
  1156. X   end;
  1157. X   exit_label:
  1158. Xend; `123 do_monster `125
  1159. X
  1160. Xprocedure do_erase(s: string);
  1161. Xlabel exit_label;
  1162. Xvar mslot,mid: integer;
  1163. X    mname: shortstring;
  1164. X    reply: string;
  1165. X    ok,dropped: boolean;
  1166. X
  1167. X    procedure leave;
  1168. X    begin
  1169. X`009writeln('EXIT');
  1170. X`009goto exit_label;
  1171. X    end;
  1172. X
  1173. Xbegin
  1174. X  if s = '' then grab_line('Monster? ',s,eof_handler := leave);
  1175. X
  1176. X  if length(s) = 0 then`009
  1177. X     writeln('To destroy a monster you own, type ERASE <monster name>.')
  1178. X  else if not is_owner(location,TRUE) then `123 is_owner make gethere `125
  1179. X     writeln('You must be in one of your own rooms to destroy a monster.')
  1180. X  else if parse_pers(mslot,s) then begin
  1181. X     mname := here.people`091mslot`093.name;
  1182. X     if exact_pers(mid,mname) then begin   `032
  1183. X        if here.people`091mslot`093.kind = P_MONSTER then begin
  1184. X           if (monster_owner(here.people`091mslot`093.parm) = userid)`032
  1185. X              or owner_priv then begin
  1186. X              getindex(I_ASLEEP);
  1187. X              freeindex;
  1188. X              if indx.free`091mid`093 then ok := true
  1189. X              else begin
  1190. X                 writeln ('Monster is active now (or there is some problem)'
  1191. V);
  1192. X                 grab_line ('Enter `091C`093ontinue or `091A`093bort: ',repl
  1193. Vy,
  1194. X`009`009    eof_handler := leave);
  1195. X                 if (reply = 'c') or (reply = 'C') then ok := true
  1196. X                 else ok := false
  1197. X              end;
  1198. X              if ok then begin
  1199. X                 dropped := drop_everything(mslot);
  1200. X`009`009 delete_program(here.people`091mslot`093.parm);
  1201. X                 delete_general(I_HEADER,
  1202. X                    here.people`091mslot`093.parm);  `123 release header  `1
  1203. V25
  1204. X`009`009 delete_block(here.people`091mslot`093.self); `123 release       `12
  1205. V5
  1206. X                                                      `123 selfdescription `
  1207. V125
  1208. X                 getint(N_SELF);
  1209. X                 anint.int`091mid`093 := 0;                   `123 also in h
  1210. Vere  `125
  1211. X                 putint;
  1212. X
  1213. X                 take_token(mslot,location);
  1214. X                 delete_log(mid);                                    `032
  1215. X                 writeln ('Monster deleted.');
  1216. X              end
  1217. X           end else writeln ('You are not the owner of this monster.');
  1218. X        end else writeln ('You can only erase monsters.');
  1219. X     end else writeln ('%serious error in do_erase. Notify monster manager.'
  1220. V);
  1221. X  end else writeln ('Here isn''t that monster.');
  1222. X  exit_label:
  1223. Xend;
  1224. X
  1225. X`123 procedure custom_monster moved to module CUSTOM `125
  1226. X
  1227. X`123 procedure custom_hook moved to module CUSTOM `125
  1228. X
  1229. Xprocedure do_atmosphere(s: string);
  1230. Xbegin
  1231. X    if length(myname) + length(s) > string_len-2 then
  1232. X`009writeln('Too long atmosphere text.')
  1233. X    else if s > '' then log_event(0,E_ATMOSPHERE,,,myname+' '+s);
  1234. Xend;
  1235. X
  1236. Xprocedure do_scan(s: string);
  1237. Xlabel 0; `123 for panic `125
  1238. Xvar`009oid: integer;
  1239. X`009room,i,j,num,pcarry,mcarry,oldloc: integer;
  1240. X`009found: Boolean;
  1241. X
  1242. X    function action(s: shortstring; oid: integer): boolean;
  1243. X    begin
  1244. X`009getobjown;
  1245. X`009freeobjown;
  1246. X
  1247. X`009if not obj_owner(oid,true) then`032
  1248. X`009    writeln('You aren''t the owner of ',s,'.')
  1249. X`009else begin
  1250. X`009    log_event(myslot,E_SCAN);
  1251. X`009    getindex(I_ROOM);
  1252. X`009    freeindex;
  1253. X`009    found := false;
  1254. X`009    pcarry := 0;
  1255. X`009    mcarry := 0;
  1256. X`009    for room := 1 to indx.top do if not indx.free`091room`093 then begin
  1257. X`009`009gethere(room);
  1258. X`009`009`009`009
  1259. X`009`009num := 0;
  1260. X`009`009for i := 1 to maxobjs do
  1261. X`009`009    if here.objs`091i`093 = oid then num := num +1;
  1262. X
  1263. X`009`009for i := 1 to maxpeople do
  1264. X`009`009    case here.people`091i`093.kind of`032
  1265. X`009`009`009P_PLAYER: for j := 1 to maxhold do
  1266. X`009`009`009    if here.people`091i`093.holding`091j`093 = oid then
  1267. X`009`009`009`009pcarry := pcarry +1;
  1268. X`009`009
  1269. X`009`009`009P_MONSTER: for j := 1 to maxhold do
  1270. X`009`009`009    if here.people`091i`093.holding`091j`093 = oid then
  1271. X`009`009`009`009mcarry := mcarry +1;
  1272. X
  1273. X`009`009`009otherwise;
  1274. X`009`009    end; `123case`125`032
  1275. X`009
  1276. X`009`009if num > 0 then begin
  1277. X`009`009    if not found then writeln (s,' found from the following rooms:')
  1278. V;
  1279. X`009`009    found := true;
  1280. X`009
  1281. X`009`009    if not manager_priv and
  1282. X`009`009`009(((here.owner <> userid) and`032
  1283. X`009`009`009(here.owner <> public_id) and`032
  1284. X`009`009`009(not owner_priv)) or
  1285. X`009`009`009(here.owner = system_id)) then
  1286. X`009`009`009writeln(num:3,' n/a')
  1287. X`009`009    else writeln (num:3,' ',here.nicename);
  1288. X`009`009end;
  1289. X`009    end;
  1290. X`009    if (pcarry > 0) or (mcarry > 0) then begin
  1291. X`009`009if not found then
  1292. X`009`009    writeln(s,' found from someone:');
  1293. X`009`009if pcarry > 0 then
  1294. X`009`009    writeln(pcarry:3,' carrying by some player(s).');
  1295. X`009`009if mcarry > 0 then
  1296. X`009`009    writeln(mcarry:3,' carrying by some monster(s).');
  1297. X`009`009found := true;
  1298. X`009    end;
  1299. X`009    if not found then writeln (s,' not found.');
  1300. X`009end;`009
  1301. X`009action := true;
  1302. X`009checkevents(TRUE);
  1303. X`009if oldloc <> location then goto 0; `123 panic `125
  1304. X    end; `123 action `125
  1305. X
  1306. X    function restriction (n: integer): boolean;
  1307. X`009begin
  1308. X`009`009restriction := true;
  1309. X`009end;
  1310. X
  1311. X    procedure leave;
  1312. X    begin
  1313. X`009writeln('EXIT');
  1314. X`009goto 0;
  1315. X    end;
  1316. X
  1317. Xbegin
  1318. X
  1319. X`009if s = '' then grab_line('Object? ',s,eof_handler := leave);
  1320. X
  1321. X`009oldloc := location;
  1322. X`009if not is_owner(location,TRUE) then begin
  1323. X`009`009writeln('You may only work on your objects when you are in one of yo
  1324. Vur own rooms.');
  1325. X`009end else if scan_obj(action,s,,restriction) then begin
  1326. X`009end else writeln ('To search object use SCAN <object name>');
  1327. X`0090:  `123 for panic `125
  1328. Xend;
  1329. X
  1330. Xfunction reset_object(oid: integer): boolean; `123 put object to it home `12
  1331. V5
  1332. Xvar found: boolean;
  1333. X    num,room,i,j: integer;
  1334. X    error: boolean;
  1335. X    owner: veryshortstring;
  1336. Xbegin
  1337. X    getindex(I_ROOM);`009   `032
  1338. X    freeindex;`009`009    `123 not full safety - but I don't want
  1339. X`009`009`009`009lock index to whole time `125
  1340. X
  1341. X    getobj(oid);`009    `123 lock obj -record ************************* `125
  1342. X
  1343. X    found := false;
  1344. X    if obj.home = 0 then begin
  1345. X`009`123 no home !!! `125
  1346. X`009freeobj;`009    `123 free obj `125
  1347. X    end else begin
  1348. X`009num := 0;
  1349. X`009for room := 1 to indx.top do if not indx.free`091room`093 then begin
  1350. X`009    getroom(room);`009`009`009    `123 lock room `125
  1351. X`009`009`009`009
  1352. X`009    if not manager_priv and
  1353. X`009`009`009(((here.owner <> userid) and`032
  1354. X`009`009`009(here.owner <> public_id) and`032
  1355. X`009`009`009(not owner_priv)) or
  1356. X`009`009`009(here.owner = system_id)) then
  1357. X`009`009`009`123 NO ACTION `125
  1358. X`009    else for i := 1 to maxobjs do
  1359. X`009`009    if here.objs`091i`093 = oid then begin
  1360. X`009`009`009num := num +1;
  1361. X`009`009`009here.objs`091i`093 := 0;`009`009    `123 RESET `125
  1362. X`009`009`009here.objhide`091i`093 := 0;
  1363. X`009`009    end;
  1364. X
  1365. X`009`009    for i := 1 to maxpeople do
  1366. X`009`009`009case here.people`091i`093.kind of`032
  1367. X`009`009   `032
  1368. X`009`009`009    P_MONSTER: begin
  1369. X`009`009`009`009owner := monster_owner(here.people`091i`093.parm);
  1370. X`009`009`009`009if not manager_priv and
  1371. X`009`009`009`009    (((owner <> userid) and`032
  1372. X`009`009`009`009    (owner <> public_id) and`032
  1373. X`009`009`009`009    (not owner_priv)) or
  1374. X`009`009`009`009    (owner = system_id)) then
  1375. X`009`009`009`009    `123 NO ACTION `125
  1376. X`009`009`009`009else for j := 1 to maxhold do
  1377. X`009`009`009`009    if here.people`091i`093.holding`091j`093 = oid then begi
  1378. Vn
  1379. X`009`009`009`009`009num := num +1;
  1380. X`009`009`009`009`009here.people`091i`093.holding`091j`093 := 0; `123 RESET `
  1381. V125
  1382. X`009`009`009`009    end;
  1383. X`009`009`009    end;
  1384. X`009`009`009    otherwise;
  1385. X`009`009`009end; `123case`125`032
  1386. X`009    putroom;`009`009`009`009    `123 free room `125
  1387. X`009end; `123 for room `125
  1388. X`009error := false;
  1389. X`009found := num > 0;
  1390. X
  1391. X`009if found then begin
  1392. X
  1393. X`009    getroom(obj.home);`009`009`009    `123 lock room `125
  1394. X`009    i := 1;
  1395. X`009    found := false;
  1396. X`009    while (i <= maxobjs) and (not found) do begin
  1397. X`009`009if here.objs`091i`093 = 0 then
  1398. X`009`009`009found := true
  1399. X`009`009else
  1400. X`009`009`009i := i + 1;
  1401. X`009    end;
  1402. X`009    if found then begin
  1403. X`009`009here.objs`091i`093 := oid;
  1404. X`009`009here.objhide`091i`093 := 0;
  1405. X`009`009num := num -1;
  1406. X`009    end;
  1407. X`009    putroom;`009`009`123 free room location `125
  1408. X
  1409. X`009end;
  1410. X
  1411. X`009obj.numexist := obj.numexist -num;
  1412. X`009if obj.numexist < 0 then begin
  1413. X`009    obj.numexist := 0;
  1414. X`009    error := true;
  1415. X`009end;
  1416. X
  1417. X`009putobj;`009`009`009`009`009    `123 free obj `125
  1418. X
  1419. X`009if error then begin
  1420. X`009    writeln('%Database invalid. Object count of ',
  1421. X`009`009obj.oname,' is wrong.');
  1422. X`009    writeln('%Notify Monster Manager.');
  1423. X`009end;
  1424. X    end;
  1425. X    reset_object := found;
  1426. Xend;
  1427. X
  1428. Xprocedure do_reset(s: string);
  1429. Xlabel 0; `123 for panic `125
  1430. Xvar`009oid: integer;
  1431. X`009room,i,oldloc: integer;
  1432. X`009found: Boolean;
  1433. X
  1434. X    function action(s: shortstring; oid: integer): boolean;
  1435. X    begin
  1436. X`009getobjown;
  1437. X`009freeobjown;
  1438. X
  1439. X`009if not obj_owner(oid,true) then`032
  1440. X`009    writeln('You aren''t the owner of ',s,'.')
  1441. X`009else begin
  1442. X`009    log_event(myslot,E_RESET,s := s);
  1443. X
  1444. +-+-+-+-+-+-+-+-  END  OF PART 23 +-+-+-+-+-+-+-+-
  1445.