-+-+-+-+-+-+-+-+ START OF PART 29 -+-+-+-+-+-+-+-+
X`09`09`09`09`09) : integer;
X`09external;
X
X
X`09`7B Generates a random integer number of NORMAL distribution -RAK-`7D
X`5Bpsect(misc1$code)`5D function randnor(mean,stand : integer) : integer;
X    begin
X      randnor :=  trunc(sqrt(-2.0*ln(randint(9999999)/10000000.0))*
X`09`09  cos(6.283*(randint(9999999)/10000000.0))*stand) + mean;
X    end;
X
X
X`09`7B Returns position of first set bit`09`09`09-RAK-`09`7D
X  function bit_pos              (
X`09`09%ref  test      : unsigned
X`09`09`09`09) : integer;
X`09external;
X
X
X`09`7B Checks a co-ordinate for in bounds status`09`09-RAK-`09`7D
X`5Bpsect(misc1$code)`5D function in_bounds(y,x : integer) : boolean;
X    begin
X      if ((y > 1) and (y < cur_height) and
X`09  (x > 1) and (x < cur_width)) then
X`09in_bounds := true
X      else
X`09in_bounds := false;
X    end;
X
X
X`09`7B Distance between two points`09`09`09`09-RAK-`09`7D
X  function distance                     (
X`09`09`09%immed y1       : integer;
X`09`09`09%immed x1       : integer;
X`09`09`09%immed y2       : integer;
X`09`09`09%immed x2       : integer
X`09`09`09`09`09)       : integer;
X`09external;
X
X
X`09`7B Checks points north, south, east, and west for a type -RAK-`09`7D
X`5Bpsect(misc1$code)`5D function next_to4   (
X`09`09`09y,x             :       integer;
X`09`09`09group_set       : obj_set
X`09`09`09`09`09) : integer;
X    var
X`09i1      : integer;
X    begin
X      i1 := 0;
X      if (y > 1) then
X`09if (cave`5By-1,x`5D.fval in group_set) then
X`09  i1 := i1 + 1;
X      if (y < cur_height) then
X`09if (cave`5By+1,x`5D.fval in group_set) then
X`09  i1 := i1 + 1;
X      if (x > 1) then
X`09if (cave`5By,x-1`5D.fval in group_set) then
X`09  i1 := i1 + 1;
X      if (x < cur_width) then
X`09if (cave`5By,x+1`5D.fval in group_set) then
X`09  i1 := i1 + 1;
X      next_to4 := i1
X    end;
X
X
X`09`7B Checks all adjacent spots for elements`09`09-RAK-`09`7D
X`5Bpsect(misc1$code)`5D function next_to8   (
X`09`09`09y,x             :       integer;
X`09`09`09group_set       :       obj_set
X`09`09`09`09`09) : integer;
X    var
X`09i1,i2,i3        : integer;
X    begin
X      i1 := 0;
X      for i2 := (y - 1) to (y + 1) do
X`09for i3 := (x - 1) to (x + 1) do
X`09  if (in_bounds(i2,i3)) then
X`09    if (cave`5Bi2,i3`5D.fval in group_set) then
X`09      i1 := i1 + 1;
X      next_to8 := i1
X    end;
X
X
X`09`7B Link all free space in treasure list together `09`09`7D
X`5Bpsect(generate$code)`5D procedure tlink;
X      var
X`09i1              : integer;
X      begin
X`09for i1 := 1 to max_talloc do
X`09  begin
X`09    t_list`5Bi1`5D := blank_treasure;
X`09    t_list`5Bi1`5D.p1 := i1 - 1;
X`09  end;
X`09tcptr := max_talloc;
X      end;
X
X
X`09`7B Link all free space in monster list together`09`09`09`7D
X`5Bpsect(generate$code)`5D procedure mlink;
X      var
X`09i1              : integer;
X      begin
X`09for i1 := 1 to max_malloc do
X`09  begin
X`09    m_list`5Bi1`5D := blank_monster;
X`09    m_list`5Bi1`5D.nptr := i1 - 1;
X`09  end;
X`09m_list`5B2`5D.nptr := 0;
X`09muptr := 0;
X`09mfptr := max_malloc;
X      end;
X
X
X`09`7B Initializes M_LEVEL array for use with PLACE_MONSTER`09-RAK-`09`7D
X`5Bpsect(setup$code)`5D procedure init_m_level;
X    var
X`09i1,i2,i3                : integer;
X    begin
X      i1 := 1;
X      i2 := 0;
X      i3 := max_creatures - win_mon_tot;
X      repeat
X`09m_level`5Bi2`5D := 0;
X`09while ((i1 <= i3) and (c_list`5Bi1`5D.level = i2)) do
X`09  begin
X`09    m_level`5Bi2`5D := m_level`5Bi2`5D + 1;
X`09    i1 := i1 + 1;
X`09  end;
X`09i2 := i2 + 1;
X      until (i2 > max_mons_level);
X      for i1 := 2 to max_mons_level do
X`09m_level`5Bi1`5D := m_level`5Bi1`5D + m_level`5Bi1-1`5D;
X    end;
X
X
X`09`7B Initializes T_LEVEL array for use with PLACE_OBJECT`09-RAK-`09`7D
X`5Bpsect(setup$code)`5D procedure init_t_level;
X    var
X`09i1,i2                   : integer;
X    begin
X      i1 := 1;
X      i2 := 0;
X      repeat
X`09while ((i1 <= max_objects) and (object_list`5Bi1`5D.level = i2)) do
X`09  begin
X`09    t_level`5Bi2`5D := t_level`5Bi2`5D + 1;
X`09    i1 := i1 + 1;
X`09  end;
X`09i2 := i2 + 1;
X      until ((i2 > max_obj_level) or (i1 > max_objects));
X      for i1 := 1 to max_obj_level do
X`09t_level`5Bi1`5D := t_level`5Bi1`5D + t_level`5Bi1-1`5D;
X    end;
X
X
X`09`7B Adjust prices of objects`09`09`09`09-RAK-`09`7D
X  procedure price_adjust;
X    var
X`09i1                      : integer;
X    begin
X      for i1 := 1 to max_objects do
X`09with object_list`5Bi1`5D do
X`09  cost := trunc(cost*cost_adj + 0.99);
X      for i1 := 1 to inven_init_max do
X`09with inventory_init`5Bi1`5D do
X`09  cost := trunc(cost*cost_adj + 0.99);
X    end;
X
X
X`09`7B Converts input string into a dice roll`09`09-RAK-`09`7D
X`09`7B       Normal input string will look like '2d6', '3d8'... ect. `7D
X`5Bpsect(misc1$code)`5D function damroll(dice : dtype) : integer;
X    var
X`09i1,num,sides                    : integer;
X    begin
X      for i1 := 1 to length(dice) do
X`09if (dice`5Bi1`5D = 'd') then
X`09  dice`5Bi1`5D := ' ';
X      num := 0;
X      sides := 0;
X      readv(dice,num,sides,error:=continue);
X      damroll := rand_rep(num,sides);
X    end;
X
X
X`09`7B Returns true if no obstructions between two given points -RAK-`7D
X`5Bpsect(misc1$code)`5D function los(y1,x1,y2,x2 : integer) : boolean;
X    var
X`09ty,tx,stepy,stepx,p1,p2         : integer;
X`09slp,tmp                         : real;
X`09flag                            : boolean;
X    begin
X      ty := (y1 - y2);
X      tx := (x1 - x2);
X      flag := true;
X      if ((ty <> 0) or (tx <> 0)) then
X`09begin
X`09  if (ty < 0) then
X`09    stepy := -1
X`09  else
X`09    stepy := 1;
X`09  if (tx < 0) then
X`09    stepx := -1
X`09  else
X`09    stepx := 1;
X`09  if (ty = 0) then
X`09    repeat
X`09      x2 := x2 + stepx;
X`09      flag := cave`5By2,x2`5D.fopen;
X`09    until((x1 = x2) or (not (flag)))
X`09  else if (tx = 0) then
X`09    repeat
X`09      y2 := y2 + stepy;
X`09      flag := cave`5By2,x2`5D.fopen;
X`09    until((y1 = y2) or (not (flag)))
X`09  else if (abs(ty) > abs(tx)) then
X`09    begin
X`09      slp := abs(tx/ty)*stepx;
X`09      tmp := x2;
X`09      repeat
X`09`09y2 := y2 + stepy;
X`09`09tmp := tmp + slp;
X`09`09p1 := round(tmp - 0.1);
X`09`09p2 := round(tmp + 0.1);
X`09`09if (not ((cave`5By2,p1`5D.fopen) or (cave`5By2,p2`5D.fopen))) then
X`09`09  flag := false;
X`09      until((y1 = y2) or (not (flag)))
X`09    end
X`09  else
X`09    begin
X`09      slp := abs(ty/tx)*stepy;
X`09      tmp := y2;
X`09      repeat
X`09`09x2 := x2 + stepx;
X`09`09tmp := tmp + slp;
X`09`09p1 := round(tmp - 0.1);
X`09`09p2 := round(tmp + 0.1);
X`09`09if (not ((cave`5Bp1,x2`5D.fopen) or (cave`5Bp2,x2`5D.fopen))) then
X`09`09  flag := false;
X`09      until((x1 = x2) or (not (flag)))
X`09    end;
X`09end;
X      los := flag;
X    end;
X
X
X`09`7B Returns symbol for given row, column`09`09`09-RAK-`09`7D
X`5Bpsect(misc5$code)`5D procedure loc_symbol(y,x : integer; var sym : char);
X    begin
X      with cave`5By,x`5D do
X`09if ((cptr = 1) and (not(find_flag))) then
X`09  sym := '@'
X`09else if (py.flags.blind > 0) then
X`09  sym := ' '
X`09else
X`09  begin
X`09    if (cptr > 1) then
X`09      begin
X`09`09with m_list`5Bcptr`5D do
X`09`09  if ((ml) and
X`09`09      ((uand(c_list`5Bmptr`5D.cmove,%X'00010000') = 0) or
X`09`09       (py.flags.see_inv))) then
X`09`09    sym := c_list`5Bmptr`5D.cchar
X`09`09  else if (tptr > 0) then
X`09`09    sym := t_list`5Btptr`5D.tchar
X`09`09  else if (fval < 10) then
X`09`09    sym := '.'
X`09`09  else
X`09`09    sym := '#';
X`09      end
X`09    else if (tptr > 0) then
X`09      sym := t_list`5Btptr`5D.tchar
X`09    else if (fval < 10) then
X`09      sym := '.'
X`09    else
X`09      sym := '#';
X`09  end;
X    end;
X
X
X`09`7B Tests a spot for light or field mark status`09`09-RAK-`09`7D
X`5Bpsect(misc1$code)`5D function test_light(y,x : integer) : boolean;
X    begin
X      with cave`5By,x`5D do
X`09if ((pl) or (fm) or (tl)) then
X`09  test_light := true
X`09else
X`09  test_light := false;
X    end;
X
X
X`09`7B Prints the map of the dungeon `09`09`09-RAK-`09`7D
X`5Bpsect(misc2$code)`5D procedure prt_map;
X    var
X`09i1,i2,i3,i4,i5  : integer;
X`09ypos,xpos,isp   : integer;
X`09floor_str       : vtype;
X`09tmp_char        : char;
X`09flag            : boolean;
X    begin
X      redraw := false;                  `7B Screen has been redrawn       `7
VD
X      i3 := 1;                          `7B Used for erasing dirty lines  `7
VD
X      i4 := 14;                         `7B Erasure starts in this column `7
VD
X      for i1 := panel_row_min to panel_row_max do       `7B Top to bottom `7
VD
X`09begin
X`09  i3 := i3 + 1;                 `7B Increment dirty line ctr      `7D
X`09  if (used_line`5Bi3`5D) then       `7B If line is dirty...           `7D
X`09    begin
X`09      erase_line(i3,i4);        `7B erase it.                     `7D
X`09      used_line`5Bi3`5D := false;   `7B Now it's a clean line         `7D
X`09    end;
X`09  floor_str := '';              `7B Floor_str is string to be printed`7D
X`09  ypos := i1;                   `7B Save row                      `7D
X`09  flag := false;                `7B False until floor_str <> ''   `7D
X`09  isp := 0;                     `7B Number of blanks encountered  `7D
X`09  for i2 := panel_col_min to panel_col_max do   `7B Left to right `7D
X`09    with cave`5Bi1,i2`5D do
X`09      begin                     `7B Get character for location    `7D
X`09`09if (test_light(i1,i2)) then
X`09`09  loc_symbol(i1,i2,tmp_char)
X`09`09else if ((cptr = 1) and (not(find_flag))) then
X`09`09  tmp_char := '@'
X`09`09else if (cptr > 1) then
X`09`09  if (m_list`5Bcptr`5D.ml) then
X`09`09    loc_symbol(i1,i2,tmp_char)
X`09`09  else
X`09`09    tmp_char := ' '
X`09`09else
X`09`09  tmp_char := ' ';
X`09`09if (tmp_char = ' ') then`7B If blank...                   `7D
X`09`09  begin
X`09`09    if (flag) then      `7B If floor_str <> '' then       `7D
X`09`09      begin
X`09`09`09isp := isp + 1; `7B Increment blank ctr           `7D
X`09`09`09if (isp > 3) then       `7B Too many blanks, print`7D
X`09`09`09  begin                 `7B floor_str and reset   `7D
X`09`09`09    print(floor_str,ypos,xpos);
X`09`09`09    flag := false;
X`09`09`09    isp := 0;
X`09`09`09  end;
X`09`09      end
X`09`09  end
X`09`09else
X`09`09  begin
X`09`09    if (flag) then      `7B Floor_str <> ''               `7D
X`09`09      begin
X`09`09`09if (isp > 0) then       `7B Add on the blanks     `7D
X`09`09`09  begin
X`09`09`09    for i5 := 1 to isp do
X`09`09`09      floor_str := floor_str + ' ';
X`09`09`09    isp := 0;
X`09`09`09  end;                  `7B Add on the character  `7D
X`09`09`09floor_str := floor_str + tmp_char;
X`09`09      end
X`09`09    else
X`09`09      begin             `7B Floor_str = ''                `7D
X`09`09`09xpos := i2;     `7B Save column for printing      `7D
X`09`09`09flag := true;   `7B Set flag to true              `7D
X`09`09`09floor_str := tmp_char;  `7B Floor_str <> ''       `7D
X`09`09      end;
X`09`09  end;
X`09      end;
X`09  if (flag) then                `7B Print remainder, if any       `7D
X`09    print(floor_str,ypos,xpos);
X`09end;
X    end;
X
X
X`09`7B Compact monsters`09`09`09`09`09-RAK-`09`7D
X`5Bpsect(misc2$code)`5D procedure compact_monsters;
X    var
X`09i1,i2,i3,ctr,cur_dis            : integer;
X`09delete_1,delete_any             : boolean;
X    begin
X      cur_dis := 66;
X      delete_any := false;
X      repeat
X`09i1 := muptr;
X`09i2 := 0;
X`09repeat
X`09  delete_1 := false;
X`09  i3 := m_list`5Bi1`5D.nptr;
X`09  with m_list`5Bi1`5D do
X`09    if (cur_dis > cdis) then
X`09      if (randint(3) = 1) then
X`09`09begin
X`09`09  if (i2 = 0) then
X`09`09    muptr := i3
X`09`09  else
X`09`09    m_list`5Bi2`5D.nptr := i3;
X`09`09  cave`5Bfy,fx`5D.cptr := 0;
X`09`09  m_list`5Bi1`5D := blank_monster;
X`09`09  m_list`5Bi1`5D.nptr := mfptr;
X`09`09  mfptr := i1;
X`09`09  ctr := ctr + 1;
X`09`09  delete_1 := true;
X`09`09  delete_any := true;
X`09`09end;
X`09  if (not(delete_1)) then i2 := i1;
X`09  i1 := i3;
X`09until (i1 = 0);
X`09if (not(delete_any)) then cur_dis := cur_dis - 6;
X      until (delete_any);
X      if (cur_dis < 66) then prt_map;
X    end;
X
X
X`09`7B Returns a pointer to next free space`09`09`09-RAK-`09`7D
X`5Bpsect(misc3$code)`5D procedure popm(var x : integer);
X    begin
X      if (mfptr < 1) then compact_monsters;
X      x := mfptr;
X      mfptr := m_list`5Bx`5D.nptr;
X    end;
X
X
X`09`7B Pushs a record back onto free space list`09`09-RAK-`09`7D
X`5Bpsect(misc3$code)`5D procedure pushm(x : integer);
X    begin
X      m_list`5Bx`5D := blank_monster;
X      m_list`5Bx`5D.nptr := mfptr;
X      mfptr := x;
X    end;
X
X
X`09`7B Gives Max hit points`09`09`09`09`09-RAK-`09`7D
X`5Bpsect(misc3$code)`5D function max_hp(hp_str : dtype) : integer;
X    var
X`09i1,num,die              : integer;
X    begin
X      for i1 := 1 to length(hp_str) do
X`09if (hp_str`5Bi1`5D = 'd') then
X`09  hp_str`5Bi1`5D := ' ';
X      readv(hp_str,num,die);
X      max_hp := num*die;
X    end;
X
X
X`09`7B Places a monster at given location`09`09`09-RAK-`09`7D
X`5Bpsect(misc3$code)`5D procedure place_monster(y,x,z : integer; slp : boole
Van);
X    var
X`09i1,cur_pos              : integer;
X    begin
X      popm(cur_pos);
X      with m_list`5Bcur_pos`5D do
X`09begin
X`09  fy := y;
X`09  fx := x;
X`09  mptr := z;
X`09  nptr := muptr;
X`09  muptr := cur_pos;
X`09  if (uand(c_list`5Bz`5D.cdefense,%X'4000') <> 0) then
X`09    hp := max_hp(c_list`5Bz`5D.hd)
X`09  else
X`09    hp := damroll(c_list`5Bz`5D.hd);
X`09  cspeed := c_list`5Bz`5D.speed + py.flags.speed;
X`09  stuned := 0;
X`09  cdis := distance(char_row,char_col,y,x);
X`09  cave`5By,x`5D.cptr := cur_pos;
X`09  if (slp) then
X`09    begin
X`09      csleep := trunc(c_list`5Bz`5D.sleep/5.0) + randint(c_list`5Bz`5D.sl
Veep);
X`09    end
X`09  else
X`09    csleep := 0;
X`09end;
X    end;
X
X
X`09`7B Places a monster at given location`09`09`09-RAK-`09`7D
X`5Bpsect(misc3$code)`5D procedure place_win_monster;
X    var
X`09cur_pos                 : integer;
X`09y,x                     : integer;
X    begin
X      if (not(total_winner)) then
X`09begin
X`09  popm(cur_pos);
+-+-+-+-+-+-+-+-  END  OF PART 29 +-+-+-+-+-+-+-+-