-+-+-+-+-+-+-+-+ START OF PART 39 -+-+-+-+-+-+-+-+
X        begin
X         prt('Drains resources for healing.',((cur_line + 1) div 2),
X            (41 - 40*(cur_line mod 2)));
X         cur_line := cur_line + 1;
X        end;
X      if (uand(%X'00020000',spells) <> 0) then
X        begin
X         prt('**Unknown spell value**',((cur_line + 1) div 2),
X            (41 - 40*(cur_line mod 2)));
X         cur_line := cur_line + 1;
X        end;
X      if (uand(%X'00040000',spells) <> 0) then
X        begin
X         prt('**Unknown spell value**',((cur_line + 1) div 2),
X            (41 - 40*(cur_line mod 2)));
X         cur_line := cur_line + 1;
X        end;
X      if (uand(%X'00080000',spells) <> 0) then
X        begin
X         prt('Breathes Lightning Breath.',((cur_line + 1) div 2),
X            (41 - 40*(cur_line mod 2)));
X         cur_line := cur_line + 1;
X        end;
X      if (uand(%X'00100000',spells) <> 0) then
X        begin
X         prt('Breathes Gas Breath.',((cur_line + 1) div 2),
X            (41 - 40*(cur_line mod 2)));
X         cur_line := cur_line + 1;
X        end;
X      if (uand(%X'00200000',spells) <> 0) then
X        begin
X         prt('Breathes Acid Breath.',((cur_line + 1) div 2),
X            (41 - 40*(cur_line mod 2)));
X         cur_line := cur_line + 1;
X        end;
X      if (uand(%X'00400000',spells) <> 0) then
X        begin
X         prt('Breathes Frost Breath.',((cur_line + 1) div 2),
X            (41 - 40*(cur_line mod 2)));
X         cur_line := cur_line + 1;
X        end;
X      if (uand(%X'00800000',spells) <> 0) then
X        begin
X         prt('Breathes Fire Breath.',((cur_line + 1) div 2),
X            (41 - 40*(cur_line mod 2)));
X         cur_line := cur_line + 1;
X        end;
X      if (cur_line mod 2) = 0 then cur_line := cur_line + 1;
X      prt('-- Movement:',((cur_line + 1) div 2),1);
X      cur_line := cur_line + 2;
X      if (uand(%X'00000001',cmove) <> 0) then
X        begin
X         prt('Moves only to attack.',((cur_line + 1) div 2),
X            (41 - 40*(cur_line mod 2)));
X         cur_line := cur_line + 1;
X        end;
X      if (uand(%X'00000002',cmove) <> 0) then
X        begin
X         prt('Moves and attacks normally.',((cur_line + 1) div 2),
X            (41 - 40*(cur_line mod 2)));
X         cur_line := cur_line + 1;
X        end;
X      if (uand(%X'00000008',cmove) <> 0) then
X        begin
X         prt('20% random movement.',((cur_line + 1) div 2),
X            (41 - 40*(cur_line mod 2)));
X         cur_line := cur_line + 1;
X        end;
X      if (uand(%X'00000010',cmove) <> 0) then
X        begin
X         prt('40% random movement.',((cur_line + 1) div 2),
X            (41 - 40*(cur_line mod 2)));
X         cur_line := cur_line + 1;
X        end;
X      if (uand(%X'00000020',cmove) <> 0) then
X        begin
X         prt('75% random movement.',((cur_line + 1) div 2),
X            (41 - 40*(cur_line mod 2)));
X         cur_line := cur_line + 1;
X        end;
X      if (uand(%X'00020000',cmove) <> 0) then
X        begin
X         prt('Can open doors.',((cur_line + 1) div 2),
X            (41 - 40*(cur_line mod 2)));
X         cur_line := cur_line + 1;
X        end;
X      if (uand(%X'00040000',cmove) <> 0) then
X        begin
X         prt('Can phase through walls.',((cur_line + 1) div 2),
X            (41 - 40*(cur_line mod 2)));
X         cur_line := cur_line + 1;
X        end;
X      if (cur_line mod 2) = 0 then cur_line := cur_line + 1;
X     prt('-- Creature attacks:',((cur_line + 1) div 2),1);
X     cur_line := cur_line + 2;
X     attstr := damage;
X     while (length(attstr) > 0) do
X       begin
X        xpos := index(attstr,'`7C');
X        if (xpos > 0) then
X          begin
X           attx := substr(attstr,1,xpos-1);
X           attstr := substr(attstr,xpos+1,length(attstr)-xpos);
X          end
X        else
X          begin
X           attx := attstr;
X           attstr := '';
X          end;
X        readv(attx,atype,adesc,damstr);
X    CASE atype of
X`7BNormal attack  `7D     1  : otw := 'normal damage.';
X`7BPoison Strength`7D     2  : otw := 'lowering strength.';
X`7BConfusion attack`7D    3  : otw := 'confusion.';
X`7BFear attack    `7D     4  : otw := 'fear.';
X`7BFire attack    `7D     5  : otw := 'fire damage.';
X`7BAcid attack    `7D     6  : otw := 'acid damage.';
X`7BCold attack    `7D     7  : otw := 'cold damage.';
X`7BLightning attack`7D    8  : otw := 'lightning damage.';
X`7BCorrosion attack`7D    9  : otw := 'corrosion damage.';
X`7BBlindness attack`7D    10 : otw := 'blindness.';
X`7BParalysis attack`7D    11 : otw := 'paralyzation.';
X`7BSteal Money    `7D     12 : otw := 'stealing money.';
X`7BSteal Object   `7D     13 : otw := 'stealing object.';
X`7BPoison         `7D     14 : otw := 'poison damage.';
X`7BLose Dex       `7D     15 : otw := 'lose dexterity.';
X`7BLose Con       `7D     16 : otw := 'lose constitution.';
X`7BLose Int       `7D     17 : otw := 'lose intelligence.';
X`7BLose Wis       `7D     18 : otw := 'lose wisdom.';
X`7BLose Exp       `7D     19 : otw := 'lose experience.';
X`7BAggravation    `7D     20 : otw := 'aggravates monsters.';
X`7BDisenchant     `7D     21 : otw := 'disenchants objects.';
X`7BEats food      `7D     22 : otw := 'eating food.';
X`7BEats light     `7D     23 : otw := 'eating light source.';
X`7BEats charges   `7D     24 : otw := 'absorbing charges.';
X`7BVampire Bite   `7D     25 : otw := 'losing strength and experience';
X`7BTurn to Stone  `7D     26 : otw := 'turning to stone.';
X`7BMind Flayer    `7D     27 : otw := 'sucking your brain out.';
X`7BHell Horse`09`7D     28 : otw := 'NightMare blindness.';
X`7BVargouille`09`7D     29 : otw := 'draining max hit points.';
X`7BDiseases       `7D     30 : otw := 'causes disease.';
X`7BLose Charisma  `7D     31 : otw := 'lose charisma.';
X`7BSpecial        `7D     99 : otw := 'blank message.';
X                      otherwise otw := '**Unknown value**';
X   end;
X   nbt_out_val:= 'It ' +attack_desc`5Badesc`5D+ 'for ' + otw + ' (' +damstr+
V ')';
X   prt(nbt_out_val,((cur_line + 1) div 2),1);
X   cur_line := cur_line + 2;
X  end;
Xend;
Xpause(24);
XDraw_cave;
Xend;
X
X`7BDisplays info about monsters -NBT`7D
X`5Bpsect(misc2$code)`5D procedure mon_info;
X
XVar choice : char;
X    quitflag : boolean;
X    howmany,i,j,moncode,aux_code : integer;
X    namestr,dummy : vtype;
X
XBegin
X   choice := ' ';
X   quitflag := true;
X   Repeat
X      if (get_com
X('Enter creature code for information, ? for the list, or <Esc> to abort: '
X         ,choice)) then
X        begin
X         quitflag := false;
X         if choice = '?' then do_all_mons;
X        end;
X   Until ((choice <> '?') or quitflag);
X   If not(quitflag) then
X   Begin
X      clear (1,1);
X      howmany := 0;
X      for i := 1 to max_creatures do
X         if c_list`5Bi`5D.cchar = choice then howmany := howmany + 1;
X      if howmany = 0 then
X        Begin
X         prt ('That character is not used for any creatures.',12,1);
X         pause (24);
X`09 draw_cave;
X        end
X       else
X        if howmany = 1 then
X          begin
X             for i := 1 to max_creatures do
X                if c_list`5Bi`5D.cchar = choice then moncode := i;
X             do_mon_out(moncode);
X          end
X        else
X          begin `7B there's more than one creature in the list using that co
Vde `7D
X`09     howmany := 0;
X`09     j := 1;
X`09     for i := 1 to max_creatures do
X`09       if c_list`5Bi`5D.cchar = choice then
X `09`09begin
X                   namestr := '';
X`09`09   namestr := '    ' + c_list`5Bi`5D.name +
X                           '                       ';
X`09`09   prt(namestr,(4+(howmany div 2)),(1+(40*(howmany mod 2))));
X`09`09   prt_num ( '',j,(4+(howmany div 2)),(1+40*(howmany mod 2)));
X`09`09   howmany := howmany + 1;
X`09`09   j := j + 1;
X`09`09end;
X`09     Repeat
X`09`09erase_line(msg_line,msg_line);
X`09`09msg_print('Enter the number for your choice:');
X`09`09get_string(dummy,1,36,10);
X`09`09aux_code := 999;
X`09`09readv(dummy,aux_code,error:=continue);
X`09     Until ((aux_code > 0) and (aux_code <= howmany));
X`09     howmany := 0;
X`09     i := 0;
X`09     while howmany <> aux_code do
X               Begin
X`09`09i := i + 1;
X`09`09if c_list`5Bi`5D.cchar = choice then howmany := howmany + 1;
X`09       end;
X`09     moncode := i;
X`09     do_mon_out(moncode);
X`09  end;
X   end;
Xend;
X
X
X`7BHelp for available wizard commands`7D
X`5Bpsect(wizard$code)`5D procedure wizard_help;
X    begin
X      clear(1,1);
X          prt('`5EA - Remove Curse and Cure all maladies.',1,1);
X          prt('`5EB - Print random objects sample.',2,1);
X          prt('`5EC - Make nice character.',3,1);
X          prt('`5ED - Down/Up n levels. Or n*100 to go to town #n',4,1);
X          prt('`5EE - Change character.',5,1);
X          prt('`5EF - Delete monsters.',6,1);
X          prt('`5EG - Allocate treasures.',7,1);
X          prt('`5EH - Wizard Help.',8,1);
X          prt('`5EI - Identify.',9,1);
X          prt('`5EJ - Gain experience.',10,1);
X          prt('`5EK - Summon monster.',11,1);
X          prt('`5EL - Wizard light.',12,1);
X          prt('`5EN - Print monster dictionary.',13,1);
X          prt('`5EO - Make Wierdness Occur.',14,1);
X          prt('`5EP - Wizard password on/off.',15,1);
X          prt('`5ET - Teleport player.',16,1);      `20
X`09  prt('`5EU - Examine character values. (debugging).',17,1);
X          prt('`5EV - Restore lost character.',18,1);
X          prt('`5EW - Create any object *CAN CAUSE FATAL ERROR*',19,1);
X          prt('`5EX - Examine an inventory item in detail.',20,1);
X      pause(24);
X      draw_cave;
X    end;
X`20
X`20
X`20
X`7BSpawn a process to use HELP utility on the BOSS help library -RAK-`7D
X`5Bpsect(misc2$code)`5D procedure moria_help(help_level : vtype);
X    var                        `20
X        dcl_command                     : varying `5B120`5D of char;
X        flag_bits                       : unsigned;
X`20
X        `7B Spawn a shell and execute DCL command                 -RAK-   `7
VD
X    `5Bexternal(LIB$SPAWN)`5D function dcl(
X        %DESCR command  : varying `5Ba`5D of char;
X            dum2        : integer := %immed 0;
X            dum3        : integer := %immed 0;
X        %REF flags      : unsigned;
X            dum5        : integer := %immed 0;
X            dum6        : integer := %immed 0;
X            dum7        : integer := %immed 0;
X            dum8        : integer := %immed 0;
X            dum9        : integer := %immed 0;
X            dum10       : integer := %immed 0 ) : integer;
X        external;
X`20
X    begin
X      flag_bits := %X'00000006';
X      prt('`5BEntering Boss Help Library, Use `5EZ to resume game`5D',1,1);
X      put_qio;
X      dcl_command := 'HELP/PAGE/NOLIBLIST/LIBRARY='+BOSS_HLP;
X      dcl_command := dcl_command + ' ' + help_level;
X      dcl(dcl_command,flags:=flag_bits);
X    end;
X
X
X
X`5Bpsect(misc2$code)`5D procedure moria_help_lbr(help_level : vtype);
X    `5Bexternal(LBR$OUTPUT_HELP)`5D function output_help(
X`09%REF output_routine : unsigned;
X`09%REF output_width   : unsigned;
X`09%DESCR line_desc    : varying `5Ba`5D of char;
X`09%DESCR library_name : varying `5Bb`5D of char;
X        %REF flags      : unsigned) : integer;
X        external;
X`20
X    begin
X    end;
X
X
X
$ CALL UNPACK [.INC]HELP.INC;1 1527304930
$ create 'f'
X`7B Convert an integer into a system bin time
X  NOTE: Int_time is number of 1/100 seconds
X        Max value = 5999`7D
X`5Bpsect(io$code)`5D procedure convert_time(int_time : unsigned;
X                                           var bin_time    : quad_type);
X    type
X        time_type = packed array `5B1..13`5D of char;
X    var
X        time_str  : time_type;
X        secs,tics : unsigned;
X        out_val   : varying`5B2`5D of char;
X`20
X    `5Basynchronous,external(SYS$BINTIM)`5D function $bin_time(
X                %stdescr give_str  : time_type;
X                var slp_time  : quad_type ) : integer;
X        external;
X`20
X    BEGIN
X      time_str := '0 00:00:00.00';
X      bin_time.l0 := 0;
X      bin_time.l1 := 0;
X      tics := int_time mod 100;
X      secs := int_time div 100;
X      if (secs > 0) then
X        BEGIN
X          if (secs > 59) then secs := 59;
X          writev(out_val,secs:2);
X          time_str`5B10`5D := out_val`5B2`5D;
X          if (secs > 9) then time_str`5B9`5D := out_val`5B1`5D;
X        END;
X      if (tics > 0) then
X        BEGIN
X          writev(out_val,tics:2);
X          time_str`5B13`5D := out_val`5B2`5D;
X          if (tics > 9) then time_str`5B12`5D := out_val`5B1`5D;
X        END;
X      $bin_time(time_str,bin_time);
X    END;
X`20
X`20
X`7B Set timer for hibernation `7D
X    `5Basynchronous,external(SYS$SETIMR)`5D function set_time(
X        %immed efn: integer := %immed 5;
X        var bintime     : quad_type;
X        %ref astadr     : integer := %immed 0;
X        %immed reqidt   : integer := %immed 0) : integer;
X        external;
X`20
X`20
X`7B Hibernate `7D
X    `5Basynchronous,external(SYS$WAITFR)`5D function hibernate(
X        %immed efn: integer := %immed 5) : integer;
X        external;
X`20
X`20
X`7B Sleep for given time
X  NOTE: Int_time is in seconds `7D
X`5Bpsect(io$code)`5D procedure sleep(int_time : unsigned);
X    var
X        bin_time  : quad_type;
X    BEGIN
X      convert_time(int_time*100,bin_time);
X      set_time(bintime:=bin_time);
X      hibernate;
X    END;
X`20
X`5Bpsect(io$code)`5D procedure tiny_sleep(int_time : unsigned);
X    var
X        bin_time  : quad_type;
X    BEGIN
X      convert_time(int_time,bin_time);
X      set_time(bintime:=bin_time);
X      hibernate;
X    END;
X`20
X`7B Turns SYSPRV off if 0; on if 1;
X  This is needed if image is installed with SYSPRV because user could write
X  on system areas.  By turning the priv off system areas are secure `7D
X`5Bpsect(io$code)`5D procedure priv_switch(switch_val : integer);
X    type
X        priv_field=     record  `7B Quad word needed for priv mask`7D
X                          low   : unsigned;
X                          high  : unsigned;
X                        END;
X    var
X        priv_mask : priv_field;
X`20
X`7B Turn off SYSPRV `7D
X    `5Bexternal(SYS$SETPRV)`5D function $setprv(
X        %immed enbflg   : integer := %immed 0;
X        var privs : priv_field;
X        %immed prmflg   : integer := %immed 0;
+-+-+-+-+-+-+-+-  END  OF PART 39 +-+-+-+-+-+-+-+-