Source Code 1994 March/Source_Code_CD-ROM_Walnut_Creek_March_1994.iso/compsrcs/games/vmsnet/monhl104/part16

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

Path: uunet!mcsun!news.funet.fi!hydra!klaava!hurtta
From: [e-mail] (Kari E. Hurtta)
Newsgroups: vmsnet.sources.games
Subject: Monster Helsinki V 1.04 - part 16/32
Keywords: Monster, a multiplayer adventure game
Message-ID: <[e-mail]>
Date: 14 Jun 92 03:48:43 GMT
Sender: [e-mail] (Kari Hurtta)
Followup-To: vmsnet.sources.d
Organization: University of Helsinki
Lines: 1405

Archieve-name: monster_helsinki_104/part16
Author: [e-mail]
Product: Monster Helsinki V 1.04
Environment: VMS, Pascal
Part: 16/32

-+-+-+-+-+-+-+-+ START OF PART 16 -+-+-+-+-+-+-+-+
X`009`009otherwise error_counter := error_counter +1;
X`009    end;
X         end;                    `032
X         var_count := var_pointer; `123 remove all inner variables `125
X         write_debug('%eval_atom LEAVE');
X      end; `123 eval_atom `125
X  `032
X   var result: string_t;
X       found: boolean;
X   begin `123 exec_program `125
X     write_debug('%exec_program');
X     eval_count := 0;
X     var_count := 0;
X `032
X     `123 ennaltam`228`228ritelt`228v`228t muuttujat: `125
X     define_variable ('monster name');
X     set_variable ('monster name',monster);
X     define_variable ('player name');
X     set_variable ('player name',myname);
X
X     if variable > '' then begin
X        define_variable(variable);
X        set_variable(variable,value)
X     end;
X
X     if spell_name > '' then begin
X`009define_variable('spell name');
X`009set_variable('spell name',spell_name);
X`009define_variable('summoner name');
X`009set_variable('summoner name',summoner_name);
X     end;
X
X     result := goto_label (label_name,found);
X     1:`032
X     exec_program := found
Xend; `123 exec program `125
X
X`123 file_name moved to module DATABASE `125
X
X`091global`093
Xfunction current_run: integer;
Xbegin
X  if not code_running then current_run := 0
X  else current_run := pool`091current_buffer`093.current_program;
Xend; `123 current_run `125
X
X`091global`093
Xfunction monster_runnable(code: integer): boolean;
Xbegin
X   getheader(code);
X   freeheader;
X   monster_runnable := header.runnable;
Xend;
X
X
X`091global`093`032
Xfunction monster_owner  (code: integer; class : integer := 0): atom_t;
Xbegin `032
X  write_debug ('%monster_owner');
X  getheader(code);
X  freeheader;
X  case class of
X    0: monster_owner := header.owner;
X    1: monster_owner := header.author;
X  end; `123 case `125
Xend; `123 monster_owner `125
X
Xfunction x_monster_owner `123 (code: integer; class : integer := 0): atom_t
V `125;
Xbegin
X  x_monster_owner := monster_owner(code,class);
Xend; `123 x_monster_owner `125
X
X
X`091global`093`032
Xprocedure set_owner (code: integer; class : integer := 0; owner: atom_t);
Xbegin `032
X  write_debug ('%set_owner');
X  getheader(code);
X  case class of
X    0: header.owner := owner;
X    1: header.author := owner;
X  end; `123 case `125
X  putheader
Xend; `123 set_owner `125
X
X`091global`093
Xprocedure set_runnable(code: integer; value: boolean);
Xbegin
X  getheader(code);
X  header.runnable := value;
X  putheader
Xend;
X
X`091global`093
Xprocedure monsterpriv(code: integer);
Xvar priv: boolean;
Xbegin
X  getheader(code);
X  priv := not header.priv;
X  header.priv := priv;
X  putheader;
X  if priv then writeln ('Monster/Hook is now privileged.')
X  else writeln ('Monster/Hook is no longer privileged.');
Xend;
X
X`091global`093
Xprocedure set_flag(code: integer; flag: integer; turn_on: boolean);
Xvar bit,old: unsigned;
Xbegin
X  write_debug('%set_flag');
X  bit := flagtable`091flag`093.value;
X  getheader(code);
X  old := uint(header.flags);
X  if turn_on then header.flags := int(uor(old,bit))
X  else  header.flags := int(uand(old,unot(bit)));
X  putheader;
X  if turn_on and (old <> uint(header.flags)) then
X    writeln(flagtable`091flag`093.on);
X  if (not turn_on) and (old <> uint(header.flags)) then
X    writeln(flagtable`091flag`093.off);
Xend;
X
X`091global`093
Xfunction get_flag(code: integer; flag: integer): boolean;
Xvar bit: unsigned;
Xbegin
X  write_debug('%get_flag');
X  bit := flagtable`091flag`093.value;
X  getheader(code);
X  freeheader;
X  get_flag := uand(bit,uint(header.flags)) > 0;
X
Xend;
X
Xfunction x_get_flag `123 (code: integer; flag: integer): boolean `125;
Xbegin
X    x_get_flag := get_flag(code,flag);
Xend;
X
X
X`091global`093
Xprocedure view_monster(code: integer);
Xvar i: integer;
X    pub,dis: atom_t;
X    flag_typed: boolean;
X    value: string_l;
X
Xbegin
X
X    flag_typed := false;
X    if not lookup_class(pub,'public') then
X`009writeln('%error #1 in view monster');
X    if not lookup_class(dis,'disowned') then
X`009writeln('%error #2 in view monster');
X
X
X  getheader(code);
X  freeheader;
X
X  writeln ('Monster/Hook statistics:');
X  writeln;
X  if header.owner = pub  then
X    writeln ('Monster/Hook is public')
X  else if header.owner = dis then
X    writeln ('Monster/Hook is disowned')
X  else writeln ('Owner:          ',class_out(header.owner));
X  writeln ('Creation time:  ',header.ctime);
X  if header.author <> '' then    `032
X     writeln ('Author:         ',class_out(header.author));`032
X  if header.wtime <> '' then
X     writeln ('Load time:      ',header.wtime); `032
X
X  if header.running_id > '' then
X    writeln ('Running under:  ',header.running_id);
X  if header.runnable then writeln ('Code is runnable')
X  else writeln ('Code is blocked');
X  if header.priv then`032
X     writeln ('Monster/Hook is privileged');
X    for i := 1 to max_flag do begin
X`009if uand (uint(header.flags),flagtable`091i`093.value) > 0 then`032
X`009    value := flagtable`091i`093.on
X`009else value := flagtable`091i`093.off;
X`009if value > '' then begin
X`009    if not flag_typed then writeln('Flags: ',value)
X`009    else                   writeln('       ',value);
X`009    flag_typed := true;
X`009end;
X    end;
X
X  writeln;                                   `032
X  writeln ('Label             Run num.    Error count   Last run');
X  for i := 1 to statmax do if header.stats`091i`093.lab > '' then`032
X     with header.stats`091i`093 do`032
X        writeln (substr(lab+'                ',1,17),
X                 runcount:4,'        ',
X                 errorcount:4,'          ',
X                 lastrun);
X  writeln
Xend;
X
X
X`091global`093
Xfunction run_monster (monster_name: atom_t;
X                      code: integer;
X                      label_name: atom_t;
X                      variable: atom_t;
X                      value: string_t;
X                      time: atom_t;
X`009`009      spell: atom_t := '';
X`009`009      summoner: atom_t := '' ): boolean;
Xlabel 1;
Xvar o_file: text;
X    i,count,lb,temp: integer;
X    ok: boolean;
X    health,errorcode: integer;
X    sys: atom_t;
Xbegin                           `032
X    run_monster := false;   `123 default value for error situation `125
X  `032
X    write_debug ('%run_monster.');
X    if not lookup_class(sys,'system') then`032
X`009writeln('%error in run_monster');
X    if not code_running then begin
X`009code_running := true;
X`009getheader(code);
X`009freeheader;
X`009health := int_get_health(monster_name); `123 -1 = not monster `125
X`009if debug then writeln('%run_monster - health: ',health);`032
X`009if header.runnable and (health <> 0) then begin
X`009    current_buffer := alloc_buffer(code);
X
X`009    with pool`091current_buffer`093 do begin `032
X
X`009`009`123 ladataan monsterin koodi `125
X`009`009if (current_program <> code) or`032
X`009`009    (current_version <> header.version) then begin
X`009`009    if current_program <> 0 then clear_program (current_buffer);
X`009`009    current_program := 0;
X
X`009`009    count := 0;  `032
X`009`009    repeat
X`009`009`009getheader(code);
X`009`009`009if header.interlocker > '' then begin
X`009`009`009    freeheader;
X`009`009`009    write_debug ('%locking in run_monster');
X`009`009`009    count := count +1 ;
X`009`009`009    wait (1); `123 wait a second `125
X`009`009`009    if count > 10 then begin
X`009`009`009`009if debug then begin
X`009`009`009`009    writeln ('%deadlock in run_monster.');
X`009`009`009`009    writeln ('%deadlock will be ignored.');
X`009`009`009`009end;
X`009`009`009`009getheader(code);
X`009`009`009`009header.interlocker := '';
X`009`009`009    end;
X`009`009`009end;
X`009`009    until header.interlocker = '';
X`009`009    header.interlocker := userid;
X`009`009    putheader;
X   `032
X`009`009    open(o_file,file_name(code),old,error:=continue,
X`009`009`009RECORD_LENGTH := string_length + 20);
X`009`009    errorcode := status(o_file);
X`009`009    if errorcode > 0 then begin
X`009`009`009writeln ('%code file read failure in run_monster - possible dead
Vlock.');
X`009`009`009writeln ('% Error code (status): ',errorcode:1);
X`009`009`009writeln ('% Notify monster manager.');
X`009`009`009
X
X`009`009`009getheader(code);
X`009`009`009header.interlocker := '';
X`009`009`009putheader;
X
X`009`009`009goto 1
X`009`009    end;
X`009`009    read_program (o_file,current_buffer);
X `009`009    current_program := code;
X             `032
X`009`009    getheader(code);
X`009`009    header.interlocker := '';
X`009`009    putheader;             `032
X`009`009    current_version := header.version;
X`009`009end;
X`009    end; `123 with pool `125
X
X        ok := false;
X        i := 0;
X        while not ok and (i < 10) do
X          case int_login(monster_name,false) of
X              0: begin
X                 writeln ('%serious error in run_monster. Notify Monster Man
Vager.');
X                 writeln ('% bad monster name');
X                 goto 1
X              end;
X              1: ok := true;
X              2,3: begin            `123 odotetetaan edllisen valmistumista
V `125
X                i := i+1;
X                 wait(1);
X                 checkevents(true)
X              end;
X              otherwise begin
X                 writeln ('%serious error in run_monster. Notify Monster Man
Vager.');
X                 writeln ('% bad return from int_login');
X
X                 goto 1
X              end;
X          end; `123 case `125
X         if not ok then`032
X            case int_login(monster_name,true) of  `123 k`228ynistet`228`228n
V pakolla `125
X               0: begin
X                  writeln ('%serious error in run_monster. Notify Monster Ma
Vnager.');
X                  writeln ('% bad monster name');
X
X                  goto 1
X               end;
X               1: ok := true;
X               3: ok := false;                `123 k`228`228k `125
X               otherwise begin `032
X                  writeln ('%serious error in run_monster. Notify Monster Ma
Vnager.');
X                  writeln ('% bad return from int_login');
X
X                  goto 1
X               end;
X            end; `123 case `125
X
X         if ok then begin
X
X            getheader(code);
X            header.running_id := userid;
X     `032
X            lb := 0;
X            for i := 1 to statmax do if header.stats`091i`093.lab = '' then
V lb := i;
X            for i := 1 to statmax do`032
X               if header.stats`091i`093.lab = label_name then lb := i;
X
X            if lb = 0 then begin
X                        lb := 1;
X                        header.stats`091lb`093.lab := label_name;
X                        header.stats`091lb`093.errorcount := 0;
X                        header.stats`091lb`093.runcount := 1
X            end else if header.stats`091lb`093.lab = '' then begin
X                        header.stats`091lb`093.lab := label_name;
X                        header.stats`091lb`093.errorcount := 0;
X                        header.stats`091lb`093.runcount := 1
X            end else if header.stats`091lb`093.runcount < MaxInt then
X`009       header.stats`091lb`093.runcount := header.stats`091lb`093.runcoun
Vt +1;
X`009    system_code := header.owner = sys;
X            privilegion := header.priv or system_code;
X            putheader;
X`009   `032
X`009    spell_mode := get_flag(code,CF_SPELL_MODE);
X
X            error_counter := 0;
X`009    used_attack   := 0;
X
X`009    temp := int_get_experience(monster_name);
X`009    if temp = -1 then begin
X`009`009monster_level := 0;
X`009`009attack_limit  := maxint;
X`009    end else begin`032
X`009`009monster_level := level(temp);
X`009`009attack_limit  := leveltable`091monster_level`093.maxpower;
X`009    end;
X`009    if system_code then attack_limit := MaxInt;
X
X`009    if debug then begin
X`009`009writeln('%run_monster - monster_level ',monster_level:1);
X`009`009writeln('%run_monster - attack_limit  ',attack_limit:1);
X`009    end;
X           `032
X            run_monster := exec_program (label_name,monster_name,
X`009`009variable,value,current_buffer,spell,summoner);
X
X            getheader(code);
X            header.running_id := '';
X            if header.stats`091lb`093.errorcount < MaxInt - error_counter th
Ven
X               header.stats`091lb`093.errorcount := header.stats`091lb`093.e
Vrrorcount +
X                  error_counter
X            else header.stats`091lb`093.errorcount := MaxInt;
X            header.stats`091lb`093.lastrun := time;
X            putheader;
X                                                         `032
X           int_logout(monster_name)
X        end else run_monster := false;
X     end else run_monster := false;   `123 if not header.runnable `125
X     code_running := false;
X  end else run_monster := false; `123 re_entrance `125
X  1:
Xend; `123 run monster `125
X
X`091global`093                            `032
Xprocedure list_program(code: integer;
X                       procedure print(l: string_t); len: integer := 80);
Xlabel 1;
Xvar o_file: text;
X    count,errorcode: integer;
Xbegin`032
X    write_debug('%list_program.');
X    getheader(code);
X    freeheader;
X
X    current_buffer := alloc_buffer(code);
X    with pool `091current_buffer`093 do begin
X`009`123 ladataan monsterin koodi `125
X`009if (current_program <> code) or`032
X`009    (header.version <> current_version) then begin
X`009    if current_program <> 0 then clear_program (current_buffer);
X`009    current_program := 0;
X
X`009    count := 0;  `032
X`009    repeat
X`009`009getheader(code);
X`009`009if header.interlocker > '' then begin
X`009`009    freeheader;
X`009`009    write_debug ('%locking in list_program');
X`009`009    count := count +1 ;
X`009`009    wait (1); `123 wait a second `125
X`009`009    if count > 10 then begin
X`009`009`009if debug then begin
X`009`009`009    writeln ('%deadlock in list_program.');
X`009`009`009    writeln ('%deadlock will be ignored.');
X`009`009`009end;
X`009`009`009getheader(code);
X`009`009`009header.interlocker := '';
X`009`009    end;
X`009`009end;
X`009    until header.interlocker = '';
X`009    header.interlocker := userid;
X`009    putheader;
X  `032
X`009    open(o_file,file_name(code),history := READONLY,
X`009`009sharing := READONLY,error:=continue,`032
X`009`009record_length := string_length +20);
X`009    errorcode := status(o_file);
X`009    if errorcode > 0 then begin
X`009`009writeln ('%code file read failure in list_program.');
X`009`009writeln ('%Try later. Error code (status): ',errorcode:1);
X
X`009`009getheader(code);
X`009`009header.interlocker := '';
X`009`009putheader;
X
X`009`009goto 1
X`009    end;
X`009    read_program (o_file,current_buffer);
X`009    current_program := code;
X             `032
X`009    getheader(code);
X`009    header.interlocker := '';
X`009    putheader;             `032
X`009    current_version := header.version;
X`009end;
X
X`009print_program (current_buffer,print,len);
X    end; `123 with `125
X    1:
Xend; `123 list_program `125
X
Xtype medium_t = varying `091 80 `093 of char;
X                     `032
X`091global`093
Xprocedure load (code: integer; source: string_l;
X                time: atom_t;`032
X                author: atom_t;
X`009`009def : string_l := '.MDL');
X
Xlabel 1;
Xvar o_file,s_file: text;
X    count,i,errorcode,s_errorcode: integer;
Xbegin
X    write_debug('%load');
X`009open(s_file,source,old,error := continue,
X`009    record_length := string_length +20,
X`009    default := def );
X`009s_errorcode := status(s_file);
X`009if s_errorcode <= 0 then begin `032
X`009    count := 0;  `032
X`009    repeat`032
X`009`009getheader(code);
X`009`009if header.interlocker > '' then begin
X`009`009    freeheader;
X`009`009    write_debug ('%locking in load');
X`009`009    count := count +1 ;
X`009`009    wait (1);
X`009`009    if count > 10 then begin
X`009`009`009if debug then begin
X`009`009`009    writeln ('%Deadlock in load. Deadlock will be ignored.');
X`009`009`009end;
X`009`009`009getheader(code);
X`009`009`009header.interlocker := '';
X`009`009    end; `123 count > 10 `125
X`009`009end;
X`009    until header.interlocker = '';
X`009    header.interlocker := author;
X`009    header.author := author;
X`009    header.wtime := time;
X`009    putheader;     `032
X`009    if header.priv then writeln('Monster/Hook is no longer privileged.')
V;
X
X`009    open(o_file,file_name(code),old,SHARING := NONE,ERROR := CONTINUE,
X`009`009record_length := string_length +20);
X`009    errorcode := status(o_file);
X`009    if errorcode > 0 then begin
X`009`009writeln ('%Can''t open code file. Try later.');
X`009`009writeln ('% It''s really deadlocked.');
X`009`009writeln ('% Error code (status): ',errorcode:1);
X
X`009`009getheader(code);
X`009`009header.interlocker := '';
X`009`009putheader;
X      `032
X`009`009close(s_file);
X`009`009goto 1
X`009    end; `032
X
X`009    current_buffer := alloc_buffer(code);
X`009    parse (s_file,o_file);
X                                                      `032
X`009    getheader(code);
X`009    header.version := (header.version +1) mod 100000;
X`009    header.interlocker := '';
X`009    header.runnable := TRUE;
X`009    header.priv := FALSE;
X`009    for i := 1 to statmax do header.stats`091i`093.lab := '';
X`009    for i := 1 to statmax do header.stats`091i`093.runcount := 0;
X`009    for i := 1 to statmax do header.stats`091i`093.errorcount := 0;
X`009    for i := 1 to statmax do header.stats`091i`093.lastrun := '';
X`009    putheader;
X
X`0091:
X`009end else case s_errorcode of
X`009    3: `123 PAS$K_FILNOTFOU `125 writeln('Error: File not found.');
X`009    4: `123 PAS$K_INVFILSYN `125 writeln('Error: Illegal file name.');
X`009    otherwise writeln('Error: (status) ',s_errorcode:1);
X`009end; `123 case `125
Xend; `123 load `125
X
X`091global`093                                `032
Xprocedure delete_program (code: integer);
Xlabel 1; `032
Xvar fl: text;
X    count,apu,errorcode: integer;
Xbegin
X  write_debug ('%delete_program');
X  apu := code;
X  count := 0;
X  repeat
X    open (fl,file_name(code),old,sharing:=NONE,error := continue,
X          record_length := string_length +20);
X    errorcode := status(fl);
X    if errorcode > 0 then begin
X       count := count +1;
X       write_debug ('%collision in delete_program');
X       if count > 10 then  begin
X          if debug then begin
X`009     writeln ('%Deadlock in delete_program.');
X`009     writeln ('% Error code (status): ',errorcode:1);
X`009  end;
X          goto 1
X       end;
X       wait (0.2);      `123 collision is very rare in here `125
X    end
X  until errorcode <= 0;
X  reset (fl);
X  truncate(fl);
X  close(fl);
X1:
Xend; `123 delete_program `125
X
X`091global`093    `032
Xprocedure init_interpreter;
Xvar i: integer;
Xbegin    `032
X    write_debug ('%init_interpreter');
X    `123 alustetaan ohjelma puskuri `125
X    for i := 1 to max_buffer do with pool`091i`093 do begin
X`009used := 0;
X`009current_program := 0;
X`009current_version := 0;
X`009time := 0;
X    end;
X
Xend; `123 init_interpreter `125
X
X`091global`093        `032
Xprocedure finish_interpreter;`009`123 not need yet `125
Xbegin
X  write_debug('%finish_interpreter');
X
Xend; `123 finish_interpreter `125
X
X`091global`093               `032
Xprocedure create_program (hdr: integer; owner: atom_t; time: atom_t);
Xvar i: integer;
Xbegin
X  write_debug('%create_program');
X  delete_program(hdr); `123 truncate code file `125
X  getheader(hdr);
X  header.interlocker := '';
X  header.runnable := FALSE;
X  header.owner := owner;
X  header.ctime := time;
X  header.priv  := false;
X  for i := 1 to statmax do header.stats`091i`093.lab := '';
X  for i := 1 to statmax do header.stats`091i`093.runcount := 0;
X  for i := 1 to statmax do header.stats`091i`093.errorcount := 0;
X  for i := 1 to statmax do header.stats`091i`093.lastrun := '';
X  header.author := '';
X  header.wtime  := '';
X  header.running_id := '';
X  header.version    := 0;
X  header.state      := '';
X  header.flags`009    := 0;
X  putheader;
Xend; `123 create_program `125
X           `032
X`123 addheaders moved to module DATABASE `125
X
Xend. `123 end of module interpreter `125
X                                     `032
$ CALL UNPACK INTERPRETER.PAS;256 1888820432
$ create/nolog 'f'
X`091inherit ('global') `093
Xmodule keys(input,output);
X
X`123
X    This file contains the keys used in encrypting the player
X    passwords. The file should be kept well protected.
X`125
X
Xconst maxkeys = 10;
Xtype`032
X     keyarray = array`0911..maxkeys`093 of shortstring;
X
Xvar     mylog : `091external`093 integer;
X
X`009keys: keyarray := (
X
X'Kaupungin keskustaan',
X'meneva juna saapuu e',
X'dell`228`228n aalto kostea',
X'ilmaa ja ontto humin',
X'a. Se on tuskin puol',
X'illaan, koska kello ',
X'on yli kuusi illalla',
X'ka liikenne on vilkk',`032
X'aampi l`228hi`246iden suun',
X'taan. Moni vaunussa '
X
X);
X
X`091global`093
Xprocedure encrypt (var s: shortstring; code: integer := -1);
Xvar i, l : integer;
Xbegin
X`009if code = -1 then code := mylog;
X
X`009l := (code mod maxkeys) + 1;
X`009for i := 1 to s.length do
X`009`009s`091i`093 := chr ((ord (s`091i`093) + ord (keys`091l`093`091i`093))
V mod 256);
Xend;
X
Xend. `123 end of module keys `125
$ CALL UNPACK KEYS.PAS;2 4242112905
$ create/nolog 'f'
X`091inherit ('Global','Guts','Database','Cli','Privusers','Parser',
X          'Custom','Queue','Interpreter')`093
Xprogram monster(input,output);
X
X`123+
XCOMPONENT: Main program
X`032
XPROGRAM DESCRIPTION:
X`032
X`009This is Monster, a multiuser adventure game system
X`009where the players create the universe.
X`032
XAUTHORS:
X`032
X    Rich Skrenta`032
X    Juha Laiho
X    Antti Leino
X    Kari Hurtta
X
X`032
XCREATION DATE: (unknown) ?.??.1988
X`032
XDESIGN ISSUES:
X`032
X   `032
X`032
XVERSION:
X`032
X    Monster Helsinki 1.04
X   `032
X`032
XMODIFICATION HISTORY:
X`032
X     Date     `124   Name  `124 Description
X--------------+---------+---------------------------------------------------
V----
X    ??.3.1989 `124  Hurtta `124  Starting of Helsinki version of Monster
X    12.2.1991 `124         `124  This comment header                   `032
X    12.2.1991 `124         `124  Some help text replace with call command_he
Vlp
X    25.5.1992 `124`009`009`124  fix_owner: owner check for /FIX -subsystem
X    13.6.1992 `124  Hurtta `124  Distributed as version 1.04
X-`125
X
X
X`123
X`009This is Monster, a multiuser adventure game system
X`009where the players create the universe.
X
X`009Written by Rich Skrenta at Northwestern University, 1988.
X
X`009`[e-mail]
X`009`[e-mail]
X
X`125
X`123
X
X`009This version modified by
X`009`[e-mail]  ([e-mail])
X`009`[e-mail]   ([e-mail])
X`009`[e-mail]  ([e-mail])
X`009Thanks for ready-to-run modifications to
X`009`[e-mail]
X`009`[e-mail]   ([e-mail])
X`009`[e-mail]  ([e-mail])
X`009Thanks for useful ideas to those who play Monster at finuh.
X
X`125
X
X`123 all functions in FINUHTIME.PAS moved to PRIVUSERS.PAS `125
X
X`123 all consts is moved to global.pas `125
X
X`123 all types is moved to global.pas `125
X
Xvar
X
X        `123 variables in privusers module are available with PRIVUSERS.PEN
V `125
X
X`009oldcmd:`009string := '';`009`009`123 string for '.' command to do last c
Vommand `125
X
X`009in_main_prompt : boolean := false;
X`009`009    `123 if in main promp player can throw out monster immediatly `1
V25
X
X
X`009`123 GUTS.PAS exports old_promp,line and grab_next `125
X
X        `123 system_id, disowned_id and public_id moved to module CUSTOM `12
V5
X
X
X`009`123 inmem moved to DATABASE.PAS `125
X
X  `123`009starting : boolean := FALSE;`009`125  `123 Not yet entered the uni
Vverse --
X `009`009`009`009`009  hopefully a temporary hack
X                                          by leino@finuh `125
X
X`009brief: boolean := FALSE;`009`123 brief/verbose descriptions `125
X
X`009rndcycle: integer;`009`009`123 integer for rnd_event `125
X
X`009`123 debug moved to GLOBAL.PAS `125
X
X`009ping_answered: boolean;`009`009  `123 flag for ping answers `125
X`009`123 hiding moved to module CUSTOM `125
X`009midnight_notyet: boolean := TRUE; `123 hasn't been midnight yet `125
X`009first_puttoken: boolean := TRUE;  `123 flag for first place into world `
V125
X`009`123 logged_act moved to module CUSTOM `125
X   `032
X
X`009cmds: array`0911..maxcmds`093 of shortstring := (
X
X`009`009'name',`009`009`123 setnam = 1`009`125
X`009`009'help',`009`009`123 help = 2`009`125
X`009`009'?',`009`009`123 quest = 3`009`125
X`009`009'quit',`009`009`123 quit = 4`009`125
X`009`009'look',`009`009`123 look = 5`009`125
X`009`009'go',`009`009`123 go = 6`009`125
X`009`009'form',`009`009`123 form = 7`009`125
X`009`009'link',`009`009`123 link = 8`009`125
X`009`009'unlink',`009`123 unlink = 9`009`125
X`009`009'whisper',`009`123 c_whisper = 10`125
X`009`009'poof',`009`009`123 poof = 11`009`125
X`009`009'describe',`009`123 desc = 12`009`125
X`009`009'dcl',          `123 c_dcl = 13   `125
X`009`009'debug',`009`123 dbg = 14`009`125
X`009`009'say',`009`009`123 say = 15`009`125
X`009`009'scan',`009`009`123 c_scan = 16`009`125
X`009`009'rooms',`009`123 c_rooms = 17`009`125
X`009`009'system',`009`123 c_system = 18`009`125
X`009`009'disown',`009`123 c_disown = 19`009`125
X`009`009'claim',`009`123 c_claim = 20`009`125
X`009`009'make',`009`009`123 c_create = 21`009`125
X`009`009'public',`009`123 c_public = 22`009`125
X`009`009'accept',`009`123 c_accept = 23`009`125
X`009`009'refuse',`009`123 c_refuse = 24`009`125
X`009`009'zap',`009`009`123 c_zap = 25`009`125
X`009`009'hide',`009`009`123 c_hide = 26`009`125
X`009`009'l',`009`009`123 c_l = 27`009`125
X`009`009'north',`009`123 c_north = 28`009`125
X`009`009'south',`009`123 c_south = 29`009`125
X`009`009'east',`009`009`123 c_east = 30`009`125
X`009`009'west',`009`009`123 c_west = 31`009`125
X`009`009'up',`009`009`123 c_up = 32`009`125
X`009`009'down',`009`009`123 c_down = 33`009`125
X`009`009'n',`009`009`123 c_n = 34`009`125
X`009`009's',`009`009`123 c_s = 35`009`125
X`009`009'e',`009`009`123 c_e = 36`009`125
X`009`009'w',`009`009`123 c_w = 37`009`125
X`009`009'u',`009`009`123 c_u = 38`009`125
X`009`009'd',`009`009`123 c_d = 39`009`125
X`009`009'customize',`009`123 c_custom = 40`009`125
X`009`009'who',`009`009`123 c_who = 41`009`125
X`009`009'players',`009`123 c_players = 42`125
X`009`009'search',`009`123 c_search = 43`009`125
X`009`009'reveal',`009`123 c_unhide = 44`009`125
X`009`009'punch',`009`123 c_punch = 45`009`125
X`009`009'ping',`009`009`123 c_ping = 46`009`125
X`009`009'health',`009`123 c_health = 47`009`125
X`009`009'get',`009`009`123 c_get = 48`009`125
X`009`009'drop',`009`009`123 c_drop = 49`009`125
X`009`009'inventory',`009`123 c_inv = 50`009`125
X`009`009'i',`009`009`123 c_i = 51`009`125
X`009`009'self',`009`009`123 c_self = 52`009`125
X`009`009'whois',`009`123 c_whois = 53`009`125
X`009`009'duplicate',`009`123 c_duplicate = 54 `125
X`009`009'score',`009`123 c_score = 55`009`125
X`009`009'version',`009`123 c_version = 56`125
X`009`009'objects',`009`123 c_objects = 57`125
X`009`009'use',`009`009`123 c_use = 58`009`125
X`009`009'wield',`009`123 c_wield = 59`009`125
X`009`009'brief',`009`123 c_brief = 60`009`125
X`009`009'wear',`009`009`123 c_wear = 61`009`125
X`009`009'relink',`009`123 c_relink = 62`009`125
X`009`009'unmake',`009`123 c_unmake = 63`009`125
X`009`009'destroy',`009`123 c_destroy = 64`125
X`009`009'show',`009`009`123 c_show = 65`009`125
X`009`009'set',`009`009`123 c_set = 66`009`125
X`009`009'bear',`009`009`123 c_monster = 67    `125
X`009`009'erase',        `123 c_erase = 68`009    `125
X`009`009'atmosphere',`009`123 c_atmospehere = 69 `125
X`009`009'reset',`009`123 c_reset = 70 `125
X`009`009'summon',       `123 c_summon = 71 `125
X`009`009'spells',`009`123 c_spells = 72 `125
X`009`009'monsters',`009`123 c_monsters = 73 `125
X`009`009'list',`009`009`123 A_list = 74 `125
X`009`009'create',`009`123 A_create = 75 `125
X`009`009'delete',`009`123 A_delete = 76 `125
X`009`009'',`009`009`123 77 `125
X`009`009'',`009`009`123 78 `125
X`009`009'',`009`009`123 79 `125
X`009`009'',`009`009`123 80 `125
X`009`009'',`009`009`123 81 `125
X`009`009'',`009`009`123 82 `125
X`009`009'',`009`009`123 83 `125
X`009`009'',`009`009`123 84 `125
X`009`009'',`009`009`123 85 `125
X`009`009'',`009`009`123 86 `125
X`009`009'',`009`009`123 87 `125
X`009`009'',`009`009`123 88 `125
X`009`009'',`009`009`123 89 `125
X`009`009'',`009`009`123 90 `125
X`009`009'',`009`009`123 91 `125
X`009`009'',`009`009`123 92 `125
X`009`009'',`009`009`123 93 `125
X`009`009'',`009`009`123 94 `125
X`009`009'',`009`009`123 95 `125
X`009`009'',`009`009`123 96 `125
X`009`009'',`009`009`123 97 `125
X`009`009'',`009`009`123 98 `125
X`009`009''`009`009`123 99 `125
X
X`009);
X
X`009`123 show moved to parser.pas `125
X
X`009numcmds: integer;`009`123 number of got main level commands there are `1
V25
X
X`009`123 numshow moved to parser.pas `125
X
X`009`123 setkey moved to parser.pas `125
X
X`009`123 numset moved to parser.pas `125
X
X`009`123 direct moved to parser.pas `125
X
X`009spells: array`0911..maxspells`093 of string;`009  `123 names of spells `
V125
X`009numspells: integer;`009`009`123 number of spells there actually are `125
X
X`009done: `091global`093 boolean;`009`009`123 flag for QUIT `125
X`009`123 userid moved to module CUSTOM `125
X`009real_userid: veryshortstring;`009`123 real VMS userid `125
X
X`009`123 location moved to DATABASE.PAS `125
X
X`009hold_kind: array`0911..maxhold`093 of integer; `123 kinds of the objects
V i'm
X`009`009`009`009`009`009   holding `125
X
X`009`123 myslot moved to module CUSTOM `125
X`009myevent: integer;`009`123 which point in event buffer we are at `125
X`009`123 myname moved to module CUSTOM `125
X
X`009found_exit: array`0911..maxexit`093 of boolean;
X`009`009`009`009`123 has exit i been found by the player? `125
X
X`009`123 mylog moved to DATABASE.PAS `125
X
X`009mywear: integer;`009`123 what I'm wearing `125
X`009`123 mydisguise moved to module CUSTOM `125
X`009mywield: integer;`009`123 weapon I'm wielding `125
X`009myhealth: integer;`009`123 how well I'm feeling `125
X`009myself: integer;`009`123 self description block `125
X`009`123 myexperience moved to module CUSTOM `125
X`009healthcycle: integer;`009`123 used in rnd_event to control how quickly a
X`009`009`009`009  player heals `125
X
X`009`123 privs moved to module PARSER `125
X`009`123 module GLOBAL exports leveltable `125
X
X`123 procedures in module CLI is available now with CLI.PEN `125
X
X`123 in module KEYS `125
X
X`091external`093
Xprocedure encrypt(key: shortstring; n : integer := 0);
Xexternal;
X
X`123 Routines in module QUEUE are declared in environment file QUEUE.PEN `12
V5
X`009`009
X`123 Routines in module GUTS are declared in environment file GUTS.PEN `125
X
X`123 Routines in module INTERPRETER are declared in environment file`032
X  INTERPRETER.PEN `125
X
X
X`123 ----- `125
Xprocedure xpoof(loc: integer); forward;
X
Xprocedure newlevel(oldlev,newlev: integer); forward;
X
Xprocedure prevlevel(oldlev,newlev: integer); forward;
X
Xprocedure do_exit(exit_slot: integer); forward;
X
X`123 function put_token declared as external in module CUSTOM `125
X
Xprocedure take_token(aslot, roomno: integer); forward;
X
Xprocedure maybe_drop; forward;                  `032
X
X`123 procedure do_program moved to module CUSTOM `125
X
Xfunction drop_everything(pslot: integer := 0): boolean;
Xforward;
X
X`123 procedures do_y_altmsg, do_group1, do_group2 moved to module CUSTOM `12
V5
X       `032
Xprocedure meta_run (label_name,variable: shortstring;
X                    value: mega_string); forward;
X
Xprocedure meta_run_2 (label_name,variable: shortstring;
X                    value: mega_string); forward;
X
X`123 procedure custom_hook moved to module CUSTOM `125
X
Xprocedure x_unwield; forward;
Xprocedure x_unwear; forward;
X
Xprocedure leave_universe; forward;
X
X`123 function trim_filename moved to module CUSTOM `125
X
Xfunction play_allow: boolean; `123 check when database is open `125
Xbegin
X    play_allow := manager_priv or (userid = MM_userid)
X`009`009    or not work_time;
Xend;
X
X`123 function sysdate moved to module CUSTOM `125
X         `032
X`123 procedure gethere moved to module CUSTOM `125
X
X`123 alloc_X and delete_X routines moved to module CUSTOM `125
X
X`123 lowcase moved to parser.pas `125
X
X`123 lookup_spell reimplemented in module PARSER `125
X
X`123 alloc_general and delete_general moved to DATABASE.PAS `125
X
X`123 returns true if object N is in this room. if nohidden is true, not foun
Vd
X  hidden objects (hurtta@finuh) `125
X
Xfunction obj_here(n: integer; nohidden: boolean := false): boolean;
Xvar
X`009i: integer;
X`009found: boolean;
X
Xbegin
X    i := 1;
X    found := false;
X    while (i <= maxobjs) and (not found) do begin
X`009if here.objs`091i`093 = n then begin
X`009    if not nohidden then found := true
X`009    else if here.objhide`091i`093 = 0 then found := true
X`009    else i := i + 1;
X`009end else i := i + 1;
X    end;
X    obj_here := found;
Xend;
X
X`091global`093    `123 for PARSER module `125
Xfunction player_here(id: integer; var slot: integer): boolean;
X    `123 suppose that gethere and getpers have made `125
Xvar i: integer;
X    name: shortstring;
Xbegin
X    slot := 0;
X    name := lowcase(pers.idents`091id`093);
X    for i := 1 to maxpeople do
X`009if here.people`091i`093.kind > 0 then
X`009`009if lowcase(here.people`091i`093.name) = name then slot := i;
X    player_here := slot > 0;
Xend; `123 player_here `125
X
X
X`123 returns true if object N is being held by the player (id slot)`125
X
Xfunction obj_hold(n: integer; slot: integer := 0): boolean;
Xvar
X`009i: integer;
X`009found: boolean;
X
Xbegin
X`009if slot = 0 then slot := myslot;
X`009
X`009if n = 0 then
X`009`009obj_hold := false
X`009else begin
X`009`009i := 1;
X`009`009found := false;
X`009`009while (i <= maxhold) and (not found) do begin
X`009`009`009if here.people`091slot`093.holding`091i`093 = n then
X`009`009`009`009found := true
X`009`009`009else
X`009`009`009`009i := i + 1;
X`009`009end;
X`009`009obj_hold := found;
X`009end;
Xend;
X
X
X
X`123 return the slot of an object that is HERE `125
Xfunction find_obj(objnum: integer): integer;
Xvar
X`009i: integer;
X
Xbegin
X`009i := 1;
X`009find_obj := 0;
X`009while i <= maxobjs do begin
X`009`009if here.objs`091i`093 = objnum then
X`009`009`009find_obj := i;
X`009`009i := i + 1;
X`009end;
Xend;
X
X
X
X
X`123 similar to lookup_obj, but only returns true if the object is in
X  this room or is being held by the player `125
X`123 and s may be in the middle of the objact name -- Leino@finuh `125
X
Xfunction parse_obj (var pnum: integer;
X`009`009`009s: string;
X`009`009`009override: boolean := false): boolean;
Xvar
X`009i,poss,maybe,num: integer;
X`009tmp: string;
X`009found: boolean;
X
Xbegin
X`009getobjnam;
X`009freeobjnam;
X`009getindex(I_OBJECT);
X`009freeindex;
X
X`009s := lowcase(s);
X`009i := 1;
X`009maybe := 0;
X`009num := 0;
X`009found := false;
X`009for i := 1 to indx.top do begin
X`009`009if not(indx.free`091i`093) then begin
X`009`009`009if s = objnam.idents`091i`093 then
X`009`009`009`009num := i
X`009`009`009else if ((index(objnam.idents`091i`093,s) = 1) or
X`009`009`009`009(index(objnam.idents`091i`093,' '+s) > 0)) and
X`009`009`009`009(obj_here(i) or obj_hold(i)) then begin
X`009`009`009`009maybe := maybe + 1;
X`009`009`009`009poss := i;
X`009`009`009end;
X`009`009end;
X`009end;
X`009if num <> 0 then begin
X`009`009found := obj_here(num) or obj_hold(num);
X`009`009if found then
X`009`009`009pnum := num;
X`009`009parse_obj := found;
X`009end else if maybe = 1 then begin
X`009`009found := obj_here(poss) or obj_hold(poss);
X`009`009if found then
X`009`009`009pnum := poss;
X`009`009parse_obj := found;
X`009end else if maybe > 1 then begin
X`009`009if lookup_obj (poss, s) then begin
X`009`009`009found := obj_here(poss) or obj_hold(poss);
X`009`009`009if found then
X`009`009`009`009pnum := poss;
X`009`009`009parse_obj := found;
X`009`009end else parse_obj := false;
X`009end else begin
X`009`009parse_obj := false;
X`009end;
Xend;
X
X`123 functions parse_pers, is_owner, room_owner, can_alter and can_make move
Vd to`032
X  module CUSTOM `125
X
X`123 procedures nice_print, print_short print_line, print_desc and make_line
X   moved to module CUSTOM `125
X
X`123
XReturn n as the direction number if s is a valid alias for an exit
X`125
Xfunction lookup_alias(var n: integer; s: string): boolean;
Xvar
X`009i,poss,maybe,num: integer;
X
Xbegin
X`009gethere;
X`009s := lowcase(s);
X`009i := 1;
X`009maybe := 0;
X`009num := 0;
X`009for i := 1 to maxexit do begin
X`009`009if s = here.exits`091i`093.alias then
X`009`009`009num := i
X`123`009`009else if index(here.exits`091i`093.alias,s) = 1 then begin
X`009`009`009maybe := maybe + 1;
X`009`009`009poss := i;
X`009`009end;`009`009`009`009`125
X`009end;
X`009if num <> 0 then begin
X`009`009n := num;
X`009`009lookup_alias := true;
X`123`009end else if maybe = 1 then begin
X`009`009n := poss;
X`009`009lookup_alias := true;
X`009end else if maybe > 1 then begin
X`009`009lookup_alias := false;`009`009`125
X`009end else begin
X`009`009lookup_alias := false;
X`009end;
Xend;
X
X`123 procedure exit_default moved to module CUSTOM `125
X
X`123
XPrints out the exits here for DO_LOOK()
X`125
Xprocedure show_exits;
Xvar
X`009i: integer;
X`009one: boolean;
X`009cansee: boolean;
X
Xbegin
X`009one := false;
X`009for i := 1 to maxexit do begin
X`009`009if (here.exits`091i`093.toloc <> 0) or `123 there is an exit `125
X`009`009   (here.exits`091i`093.kind = 5) then begin `123 there could be an
V exit `125
X`009`009`009if (here.exits`091i`093.hidden = 0) or
X`009`009`009   (found_exit`091i`093)`032
X                        then cansee := true
X`009`009`009else cansee := false;
X
X`009`009`009if here.exits`091i`093.kind = 6 then begin
X`009`009`009`009`123 door kind only visible with object `125
X`009`009`009`009if obj_hold( here.exits`091i`093.objreq ) then
X`009`009`009`009`009cansee := true
X`009`009`009`009else cansee := false;
X`009`009`009end;
X
X`009`009`009if cansee then begin
X`009`009`009`009if here.exits`091i`093.exitdesc = DEFAULT_LINE then begin
X`009`009`009`009`009exit_default(i,here.exits`091i`093.kind);
X`009`009`009`009`009`123 give it direction and type `125
X`009`009`009`009`009one := true;
X`009`009`009`009end else if here.exits`091i`093.exitdesc > 0 then begin
X`009`009`009`009`009print_line(here.exits`091i`093.exitdesc);
X`009`009`009`009`009one := true;
X`009`009`009`009end;
X`009`009`009end;
X`009`009end;
X`009end;
X`009if one then writeln;
Xend;
X
Xprocedure setevent;
Xbegin
X`009getevent;
X`009freeevent;
X`009myevent := event.point;
Xend;
X
X`123 functions isnum and number moved to module CUSTOM `125
X
X`123 log_event moved to DATABASE.PAS `125
X
X`123 function log_name moved to module CUSTOM `125
X
Xfunction desc_action(theaction,thetarget: integer): string;
Xvar s: string;
Xbegin
X`009case theaction of`009`123 use command mnemonics `125
X`009`009look:      s:= ' looking around the room.';
X`009`009form:      s:= ' creating a new room.';
X`009`009desc:      s:= ' editing the description to this room.';
X`009`009e_detail:  s := ' adding details to the room.';
X`009`009c_custom:  s := ' customizing an exit here.';
X`009`009e_custroom:s := ' customizing this room.';
X`009`009e_program: s := ' customizing an object.';
X`009`009c_self:`009   s := ' editing a self-description.';
X`009`009e_usecrystal: s := ' hunched over a crystal orb, immersed in its glo
Vw.';
X`009`009link:`009   s := ' creating an exit here.';
X`009`009c_system:  s := ' in system maintenance mode.';
X                c_dcl:     s := ' executing dcl.';
X`009`009e_custommonster: s := ' customizing a monster.';
X`009`009e_customspell: s := ' customizing a spell.';
X
X`009`009otherwise s := ' here.'
X`009end;
X`009desc_action := s;
Xend;
X
X`091global`093
Xfunction protected(n: integer := 0): boolean;
Xvar tmp: objectrec;`009`009`009`123 is this necessary ? `125
Xbegin
X`009protected := false;
X`009if n = 0 then n := myslot;
X`009tmp := obj;
X`009if here.people`091n`093.wielding > 0 then begin
X`009`009getobj(here.people`091n`093.wielding);
X`009`009freeobj;
X`009`009if obj.kind = O_MAGIC_RING then protected := true;
X`009end;
X`009if here.people`091n`093.act in `091e_detail,c_custom,
X`009`009`009`009  e_custroom,e_program,
X`009`009`009`009  c_self,c_system,c_dcl,
X`009`009`009`009  e_custommonster,
X`009`009`009`009  e_customspell`093 then
X`009`009protected := true;
X
X`009obj := tmp;
Xend;
X
X`123 ------- Stolen from MONSTER Version 3.0 -------------------------------
V--- `125
X
Xprocedure do_s_announce (s:string);
Xvar
X   lcv : integer;
Xbegin
X    if (s<>'') and (s <> '?') then
X`009for lcv :=1 to numevnts do
X          log_event(0,E_ANNOUNCE,0,0,s,lcv)
X    else writeln('Usage: w <message>');
Xend; `123do_announce`125
X
Xprocedure do_s_shutdown (s:string);
Xvar
X   lcv : integer;
Xbegin
X      if (s<>'') and (s <> '?') then
X`009for lcv :=1 to numevnts do
X          log_event(0,E_SHUTDOWN,0,0,s,lcv)
X      else writeln('Usage: d <message>')
Xend; `123do_shutdown`125
X
X
X`123 -----------------------------------------------------------------------
V---- `125
X
X
X`123
Xuser procedure to designate an exit for acceptance of links
X`125
Xprocedure do_accept(s: string);
Xlabel exit_label;
Xvar
X`009dir,owner: integer;
X
X    procedure leave;
X    begin
X`009writeln('EXIT - no changes.');
X`009goto exit_label;
X    end;
X
Xbegin
X`009if s = '' then grab_line('Direction? ',s,eof_handler := leave);
X
X`009if lookup_dir(dir,s,true) then begin
X`009`009if can_make(dir) then begin
X`009`009`009getroom;
X`009`009`009here.exits`091dir`093.kind := 5;
X`009`009`009putroom;
X
X`009`009`009if exact_user(owner,here.owner) then
X`009`009`009    add_counter(N_ACCEPT,owner);
X
X`009`009`009log_event(myslot,E_ACCEPT,0,0);
X`009`009`009writeln('Someone will be able to make an exit ',direct`091dir`09
V3,'.');
X`009`009end;
X`009end else
X`009`009writeln('To allow others to make an exit, type ACCEPT <direction of
V exit>.');
X    exit_label:
Xend;
X
X`123
XUser procedure to refuse an exit for links
XNote: may be unlink
X`125
Xprocedure do_refuse(s: string);
Xlabel exit_label;
Xvar
X`009dir,owner: integer;
X`009ok: boolean;
X
X    procedure leave;
X    begin
X`009writeln('EXIT - no changes.');
X`009goto exit_label;
X    end;
X
Xbegin
X`009if s = '' then grab_line('Direction? ',s,eof_handler := leave);
X
X`009if not(is_owner) then
X`009`009`123 is_owner prints error message itself `125
X`009else if lookup_dir(dir,s,true) then begin
X`009`009getroom;
X`009`009with here.exits`091dir`093 do begin
X`009`009`009if (toloc = 0) and (kind = 5) then begin
X`009`009`009`009kind := 0;
X`009`009`009`009ok := true;
X`009`009`009
X`009`009`009    if exact_user(owner,here.owner) then
X`009`009`009`009sub_counter(N_ACCEPT,owner);
+-+-+-+-+-+-+-+-  END  OF PART 16 +-+-+-+-+-+-+-+-