-+-+-+-+-+-+-+-+ START OF PART 43 -+-+-+-+-+-+-+-+
X`09    end;
X`094 : begin`09`09`09`09`7B Hard`09`09`7D
X`09`09dun_str_mc`09:= 97;
X`09`09dun_str_qc`09:= 75;
X`09`09dun_unusual`09:= 60;
X`09`09obj_great`09:= 24;
X`09`09treas_room_alloc:= 12;
X`09`09treas_any_alloc`09:= 3;
X`09`09treas_gold_alloc:= 2;
X`09`09obj_std_adj`09:= 1.5;
X`09`09obj_std_min`09:= 10;
X`09`09obj_town_level`09:= 10;
X`09`09obj_base_magic`09:= 15;
X`09`09obj_base_max`09:= 115;
X`09`09obj_div_special`09:= 8;
X`09`09obj_div_cursed`09:= 1.2;
X`09`09mon_nasty`09:= 20;
X`09`09mon_mult_adj`09:= 5;
X`09    end;
X`095 : begin`09`09`09`09`7B Ultra-hard`09`7D
X`09`09dun_str_mc`09:= 99;
X`09`09dun_str_qc`09:= 85;
X`09`09dun_unusual`09:= 30;
X`09`09obj_great`09:= 15;
X`09`09treas_room_alloc:= 15;
X`09`09treas_any_alloc`09:= 4;
X`09`09treas_gold_alloc:= 1;
X`09`09obj_std_adj`09:= 2.0;
X`09`09obj_std_min`09:= 15;
X`09`09obj_town_level`09:= 15;
X`09`09obj_base_magic`09:= 18;
X`09`09obj_base_max`09:= 130;
X`09`09obj_div_special`09:= 6;
X`09`09obj_div_cursed`09:= 1.2;
X`09`09mon_nasty`09:= 5;
X`09`09mon_mult_adj`09:= 3;
X`09    end;
X`09end;
X    end;
X
X
X`09`7B Center a string inside of a field`09`09`09-DMF-`09`7D
X`5Bglobal,psect(misc4$code)`5D function center(str : string; len : integer)
V : string;
X`09var
X`09`09i1,i2,i3`09: integer;
X`09begin
X`09  if (length(str) > 0) and ((str`5B1`5D = ' ') or
X`09`09`09`09    (str`5Blength(str)`5D = ' ')) then
X`09    begin
X`09      i1 := 1;
X`09      i2 := length(str);
X`09      i3 := i2;
X`09      while (str`5Bi1`5D = ' ') do
X`09`09begin
X`09`09  i1 := i1 + 1;
X`09`09  i3 := i3 - 1;
X`09`09end;
X`09      while (str`5Bi2`5D = ' ') do
X`09`09begin
X`09`09  i2 := i2 - 1;
X`09`09  i3 := i3 - 1;
X`09`09end;
X`09      str := substr(str,i1,i3);
X`09    end;
X`09  i1 := length(str);
X`09  for i2 := 1 to (len-i1) div 2 do
X`09    str := ' ' + str;
X`09  center := pad(str,' ',len);
X`09end;
X
X
X`09`7B Check to see if everyone should be kicke out of the game,`09`7D
X`09`7B by attempting to open the kick-out file.`09`09-DMF-`09`7D
X`5Bglobal,psect(setup$code)`5D function check_kickout : boolean;
X    var
X`09kick`09: text;
X    begin
X      open(kick,file_name:=moria_lck,history:=old,sharing:=readonly,
X`09      error:=continue);
X      if (status(kick) = 0) then
X`09check_kickout := true
X      else
X`09check_kickout := false;
X    end;
X
X
X`09`7B Check the day-time strings to see if open`09`09-RAK-`09`7D
X`5Bglobal,psect(setup$code)`5D function check_time : boolean;
X    begin
X      case days`5Bday_num,(hour_num+5)`5D of
X`09'.'  :`09check_time := false;`09`7B Closed`09`09`7D
X`09'X'  :`09check_time := true;`09`7B Normal hours`09`09`7D
X`09otherwise check_time := false;`09`7B Other, assumed closed `7D
X      end;
X    end;
X
X
X`09`7B Generates a random integer number of NORMAL distribution -RAK-`7D
X`5Bglobal,psect(misc1$code)`5D function randnor(mean,stand : integer) : inte
Vger;
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 Checks a co-ordinate for in bounds status`09`09-RAK-`09`7D
X`5Bglobal,psect(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 Checks points north, south, east, and west for a type -RAK-`09`7D
X`5Bglobal,psect(misc1$code)`5D function next_to4   (
X`09`09`09y,x`09`09:`09integer;
X`09`09`09group_set`09: obj_set
X`09`09`09`09`09) : integer;
X    var
X`09i1`09: 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`5Bglobal,psect(misc1$code)`5D function next_to8   (
X`09`09`09y,x`09`09:`09integer;
X`09`09`09group_set`09:`09obj_set
X`09`09`09`09`09) : integer;
X    var
X`09i1,i2,i3`09: 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`5Bglobal,psect(misc1$code)`5D function rotate_dir(dir,rot : integer) : inte
Vger;
X    begin
X      if (dir = 5) then
X`09rotate_dir := 5
X      else
X`09rotate_dir := key_of`5B(oct_of`5Bdir`5D + rot) mod 8`5D
X    end;
X
X`09`7B Returns hexdecant of dy,dx`09`09`09`7D
X`09`7B 0,1 = ea 2,3 = ne, 4,5 = n ... 14,15 = se`09`7D
X`5Bglobal,psect(misc1$code)`5D function get_hexdecant(dy,dx : integer) : byt
Vlint;
X    var
X`09ay,ax`09`09: integer;
X`09hexdecant`09: bytlint;
X    begin
X`09ay := abs(dy); ax := abs(dx);
X`09if (ay*2.41421 < ax) then hexdecant := 1
X`09else if (ay < ax) then hexdecant := 2
X`09else if (ay/2.41421 < ax) then hexdecant := 3
X`09else hexdecant := 4;
X`09if (dx < 0) then hexdecant := 9 - hexdecant;
X`09if (dy > 0) then get_hexdecant := (17 - hexdecant) mod 16
X`09else get_hexdecant := hexdecant;
X    end;
X
X
X`09`7B Link all free space in treasure list together`09`09`09`7D
X`5Bglobal,psect(generate$code)`5D procedure tlink;
X      var
X`09i1`09`09: 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`5Bglobal,psect(generate$code)`5D procedure mlink;
X      var
X`09i1`09`09: 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`5Bglobal,psect(setup$code)`5D procedure init_m_level;
X    var
X`09i1,i2,i3`09`09: 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`5Bglobal,psect(setup$code)`5D procedure init_t_level;
X    var
X`09i1,i2`09`09`09: 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`5Bglobal,psect(setup$code)`5D procedure price_adjust;
X    var
X`09i1`09`09`09: 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 Adjust weights of objects`09`09`09`09-DMF-`09`7D
X`5Bglobal,psect(setup$code)`5D procedure item_weight_adjust;
X    var
X`09i1`09`09`09: integer;
X    begin
X      for i1 := 1 to max_objects do
X`09with object_list`5Bi1`5D do
X`09  weight := weight * weight_adj;
X      for i1 := 1 to inven_init_max do
X`09with inventory_init`5Bi1`5D do
X`09  weight := weight * weight_adj;
X    end;
X
X
X`09`7B Converts input string into a dice roll`09`09-RAK-`09`7D
X`09`7B`09Normal input string will look like '2d6', '3d8'... ect. `7D
X`5Bglobal,psect(misc1$code)`5D function damroll(dice : dtype) : integer;
X    var
X`09i1,num,sides`09`09`09: 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`5Bglobal,psect(misc1$code)`5D function los(y1,x1,y2,x2 : integer) : boolean
V;
X    var
X`09ty,tx,stepy,stepx,p1,p2`09`09: integer;
X`09slp,tmp`09`09`09`09: real;
X`09flag`09`09`09`09: 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`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`5Bglobal,psect(misc5$code)`5D procedure loc_symbol(y,x : integer; var sym :
V 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(not(fval in water_set) or ((fval in water_set) and
X`09`09`09     ((uand(c_list`5Bmptr`5D.cmove,%X'00800000') <> 0) or
X`09`09`09     (distance(char_row,char_col,y,x) <=
X`09`09`09`095)))) 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 if (fval < 16) then
X`09`09    sym := '#'
X`09`09  else
X`09`09    sym := '`60';
X`09      end
X`09    else if (tptr > 0) then
X`09      if (fval in water_set) then
X`09`09if (t_list`5Btptr`5D.tval in float_set) or
X`09`09   ((distance(char_row,char_col,y,x) <= 5) and
X`09`09    (los(char_row,char_col,y,x))) then
X`09`09  sym := t_list`5Btptr`5D.tchar
X`09`09else
X`09`09  sym := '`60'
X`09      else
X`09`09sym := t_list`5Btptr`5D.tchar
X`09    else if (fval < 10) then
X`09      sym := '.'
X`09    else if (fval < 16) then
X`09      sym := '#'
X`09    else
X`09      sym := '`60';
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`5Bglobal,psect(misc1$code)`5D function test_light(y,x : integer) : boolean;
X    begin
X      with cave`5By,x`5D do
X`09test_light := ((pl) or (fm) or (tl))
X    end;
X
X
X`09`7B Compact monsters`09`09`09`09`09-RAK-`09`7D
X`5Bglobal,psect(misc2$code)`5D procedure compact_monsters;
X    var
X`09i1,i2,i3,ctr,cur_dis`09`09: integer;
X`09delete_1,delete_any`09`09: 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`5Bglobal,psect(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`5Bglobal,psect(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`5Bglobal,psect(misc3$code)`5D function max_hp(hp_str : dtype) : integer;
X    var
X`09i1,num,die`09`09: 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,error:=continue);
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`5Bglobal,psect(misc3$code)`5D procedure place_monster(y,x,z : integer; slp
V : boolean);
X    var
X`09i1,cur_pos`09`09: integer;
X    begin
X      popm(cur_pos);
X      with m_list`5Bcur_pos`5D do
X`09begin
+-+-+-+-+-+-+-+-  END  OF PART 43 +-+-+-+-+-+-+-+-